Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm