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"
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
http://www.garybeene.com/sw/gbsnippets.htm