Draw Only - Jules - SetCursor + GetWindowDC

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
         truept = pt
         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
 
      Case %WM_Size
         ResizeWindow
 
   End Select
End Function
 
Sub ResizeWindow
End Sub
 
Sub RefreshDrawing   'using PB Bitmap
   #If %Debug = 1
   Incr iMsgCount : cprint "RefreshDrawing"
   #EndIf
 
   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 CPrint (txtA As String)
   Static cWritten As Long
   Local SOut As String
   If iMsgCount& > 9999 Then iMsgCount& = 1
   SOut = Format$(iMsgCount&,"* ###0") + " " + txtA '+ Space$(30-Len(txtA)) + " " + txtB
   If hConsole = 0 Then AllocConsole: hConsole = GetStdHandle(-11&)
   WriteConsole hConsole, ByCopy sOut + $CrLf, Len(sOut) + 2, cWritten, ByVal 0&
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_01099
'Date: 03-10-2012


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