Draw Only - Beene - SetCursor + GetDC

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"
 
%Debug = 1
Global hDlg, hDC, memDC, hConsole, hBMP, hOverlayDlg, hOverlayProc As Dword
Global pt, ptDrawOrig, truept As Point
Global DrawInWork, SnapToGrid, ShowGrid, iMsgCount, GridSize As Long
Global SA, SB, SC As String  'these 3 used in dialog caption
 
Function PBMain()
   Dialog New Pixels, 0, "Draw",800,300,500,350, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
   Control Add TextBox, hDlg, 500, "TextBox", 20,20,60,20
   Control Add Button, hDlg, 501, "Button", 60,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
 
      Case %WM_Paint
         RefreshDrawing   '1=PB 0=API
 
      Case %WM_SetCursor
         Dialog Get Client hDlg To w,h
         GetCursorPos pt
         ScreenToClient hDlg, pt
         If pt.x < 0 Or pt.y < 0 Then Exit Function   'do nothing if in caption
         If SnapToGrid Then
            pt.x = (pt.x \ GridSize) * GridSize
            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
               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
                  RefreshDrawing
                  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 hDlg To w,h
 
   'use the hidden bitmap
   Graphic Clear     ' GetSysColorBrush(%COLOR_3DFACE)   'clear/fill with color
 
   'draw grid
   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
      Next y
   Next x
 
   'draw rectangle that follows the mouse
   If DrawInWork Then Graphic Box (ptDrawOrig.x, ptDrawOrig.y) - (pt.x, pt.y),, %Red
 
   hDC = GetDC(hDlg)
   BitBlt hDC, 0, 0, w, h, memDC, 0, 0, %SRCCopy
   ReleaseDC(hDlg,hDC)
End Sub
 
Sub CreateInvisibleBitmap
   Local x,y,w,h As Long
   Desktop Get Client To w,h
   Graphic Bitmap New w,h To hBMP
   Graphic Attach hBMP, 0
   Graphic Get DC To memDC
End Sub
 
'gbs_01096
'Date: 03-10-2012


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