Draw Only - Holbrook/Beene - Transparent Dialog

Category: gbDesigner

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Debug Error On     'catch array/pointer errors - OFF in production
#Debug Display On   'display untrapped errors   - OFF in production
#Include "Win32api.inc"
 
Global hDlg, hDC, memDC, hBMP, hOverlayDlg As Dword
Global pt, ptDrawOrig, truept As Point
Global DrawInWork, SnapToGrid, ShowGrid, iMsgCount, GridSize As Long
 
Function PBMain()
   Dialog New Pixels, 0, "Overlay Drawing Test",800,300,300,250, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
   Control Add TextBox, hDlg, 500, "Under", 30,20,60,20
   Control Add Button, hDlg, 501, "Under", 30,60,60,60
   Control Add TextBox, hDlg, 600, "Not Under", 180,20,60,20
   Control Add Button, hDlg, 601, "Not Under", 180,60,60,60
   Dialog Show Modal hDlg Call DlgProc()
End Function
 
CallBack Function DlgProc() As Long
   Local i,x,y,w,h,iReturn As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         SnapToGrid = 1 : GridSize = 25
         CreateInvisibleBitmap
         Dialog Get Client hDlg to w,h
         Dialog New Pixels, hDlg, "", 0,0,0,0, %WS_Popup Or %WS_Visible, %WS_Ex_Layered To hOverlayDlg
         Dialog Show Modeless hOverlayDlg, Call OverLayProc
         RefreshDrawing
      Case %WM_Size
         Dialog Get Client hDlg To w,h
         Dialog Set Size hOverLayDlg, w/2,h
      Case %WM_Move
         Dialog Set Loc hOverlayDlg, 0,0
   End Select
End Function
 
CallBack Function OverlayProc() As Long
   Local i,x,y,w,h,iReturn As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         SetLayeredWindowAttributes(hOverlayDLG, %Blue, 60, %LWA_ALPHA)
      Case %WM_Paint
         RefreshDrawing   '1=PB 0=API
      Case %WM_SetCursor
         Dialog Get Client hOverlayDlg To w,h
         GetCursorPos pt
         ScreenToClient hOverlayDlg, pt
         If pt.x < 0 Or pt.y < 0 Then Exit Function  'do nothing if in caption
         truePT = pt                                 'pre-snap coordinates
         If SnapToGrid Then
            pt.x = (pt.x \ GridSize) * GridSize      'truncates to integer value below truePT
            pt.y = (pt.y \ GridSize) * GridSize
         End If
         iReturn = GetDlgCtrlID (Cb.WParam'identify over which label control the mouse action took place
         Select Case Hi(Word, Cb.LParam)  'monitors the 3 basic mouse actions, lbuttondown, mousemose, lbuttonup
            Case %WM_LButtonDown
               If (pt.x>-1) And (pt.x<(w+1)) And (pt.y>0) And (pt.y<h) Then 'inside GUI bounds
                  DrawInWork = 1
                  ptDrawOrig = pt
                  Dialog Set Text hDlg, "Mouse is down at " + Str$(pt.x) + " : " + Str$(pt.y)
               End If
            Case %WM_MouseMove
               Dialog Send hOverlayDlg, %WM_User + 510, 0, 0
               If DrawInWork Then
                  Dialog Set Text hDlg, "Mouse moving at " + Str$(pt.x) + " : " + Str$(pt.y)
                  RefreshDrawing
               End If
            Case %WM_LButtonUp
               If DrawInWork Then
                  DrawInWork = 0
                  Dialog Set Text hDlg, "Mouse is up at " + Str$(pt.x) + " : " + Str$(pt.y)
               End If
         End Select
   End Select
End Function
 
Sub RefreshDrawing   'using PB Bitmap
   Local i,x,y,w,h As Long
   Dialog Get Client hOverlayDlg To w,h
   Graphic Clear
   For x = GridSize To w Step GridSize
      For y = GridSize To h Step GridSize
         Graphic Box (x-1,y-1) - (x+1,y+1), %Black 'draw grid
      Next y
   Next x
   If DrawInWork Then Graphic Box (ptDrawOrig.x, ptDrawOrig.y) - (pt.x, pt.y),, %Red  'rectangle that follows mouse
   hDC = GetDC(hOverlayDlg)
   BitBlt hDC, 0, 0, w, h, memDC, 0, 0, %SRCCopy   'bitblt the drawing to visual screen
   ReleaseDC(hOverlayDlg,hDC)
End Sub
 
Sub CreateInvisibleBitmap
   Local x,y,w,h As Long
   Dialog Get Client hDlg To w,h
   Graphic Bitmap New w/2,h To hBMP
   Graphic Attach hBMP, 0
   Graphic Get DC To memDC
End Sub
 
'gbs_00938
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm