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"
#Include "CommCtrl.inc"
#Resource "gbsnippets.pbr"
%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,600,500, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
AddAllControls hDlg
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
GetCursorPos pt : ScreenToClient hDlg, pt
Dialog Set Text hDlg, "SetCursor at " + Str$(pt.x) + " : " + Str$(pt.y)
Case %WM_LButtonDown, %WM_LButtonDblClk
GetCursorPos pt : ScreenToClient hDlg, pt : If SnapToGrid Then AdjustPT
Dialog Set Text hDlg, "Mouse is down at " + Str$(pt.x) + " : " + Str$(pt.y)
Dialog Get Client hDlg To w,h
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
End If
Case %WM_MouseMove
GetCursorPos pt : ScreenToClient hDlg, pt : If SnapToGrid Then AdjustPT
Dialog Set Text hDlg, "Mouse moving at " + Str$(pt.x) + " : " + Str$(pt.y)
If DrawInWork Then RefreshDrawing
Case %WM_LButtonUp
Dialog Set Text hDlg, "Mouse is up at " + Str$(pt.x) + " : " + Str$(pt.y)
GetCursorPos pt : ScreenToClient hDlg, pt : If SnapToGrid Then AdjustPT
DrawInWork = 0
Case %WM_Size
ResizeWindow
End Select
End Function
Sub ResizeWindow
End Sub
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
Sub AdjustPT
pt.x = (pt.x \ GridSize) * GridSize
pt.y = (pt.y \ GridSize) * GridSize
End Sub
Sub AddAllControls(hWnd As Dword)
'requires #Include "commctrl.inc"
'requires #Resource "gbsnippet.pbr" (won't fail without it, just won't show images)
'add all 21 controls, plus a menu, to a dialog
Local hLst1, hLst2, hMenu, hMenuHelp, hPage1, hPage2 As DWord
Local hItem, hTemp, hTemp2 as DWord, style&
Dim MyArray(1) as String
MyArray(0) = "Items" : MyArray(1)= "ListBox"
Control Add Button, hWnd, 8100,"Button", 20,60,100,20
Control Add Label, hWnd, 8110,"Label1", 20,90,120,20
Control Add TextBox, hWnd, 8120,"TextBox", 20,120,100,20
Control Add ListBox, hWnd, 8130,MyArray() , 20,150,100,100
Control Add ComboBox, hWnd, 8140,MyArray(), 20,260, 100,20
Control Add Option, hWnd, 8150, "Pick Me!", 20,285, 100,20, %WS_Group
Control Add Option, hWnd, 8155, "Pick Him!", 20,300, 100,20, %WS_Group
Control Add Checkbox, hWnd, 8160, "No, Pick Me!", 20, 325, 100,20, %WS_Group
Control Add Check3State, hWnd, 8170, "Forget them, pick Me!", 20, 350, 120,20
Control Add ScrollBar, hWnd, 8180, "", 20, 380, 120,20
Control Add Line, hWnd, 8190, "", 20, 420, 100,10 ',%SS_Notify Or %WS_Border
Control Add ProgressBar, hWnd, 8200, "", 20, 440, 100,20
Control Add ImgButton, hWnd, 8300,"cowgirl", 140,60,100,100, %WS_Border
Control Add ImgButtonX, hWnd, 8310,"cowgirl", 140,180,100,100, %WS_Border
Control Add Image, hWnd, 8500,"cowgirl", 270,60,100,100, %WS_Border ',%SS_Notify
Control Add ImageX, hWnd, 8510,"cowgirl", 270,180,100,100, %WS_Border ',%SS_Notify
Control Add Graphic, hWnd, 8520,"", 270,300,100,100, %WS_Border ',%SS_Notify
Graphic Attach hWnd, 8520 : Graphic Render "cowgirl", (0,0)-(100,100)
Control Add Frame, hWnd, 8530,"Frame", 400,300,150,50, %WS_Border ',%SS_Notify
'toolbar
Control Add Toolbar, hWnd, 8700,"", 0,0,0,0
ImageList New Icon 16,16,32,3 To hLst1
ImageList Add Icon hLst1, "x" '1
Toolbar Set ImageList hWnd, 8700, hLst1, 0
Toolbar Add Button hWnd, 8700, 1, 200, %TbStyle_Button, "x"
'menu
Menu New Bar To hMenu
Menu New Popup To hMenuHelp
Menu Add Popup, hMenu, "&Help", hMenuHelp, %MF_Enabled
Menu Add String, hMenuHelp, "&About", 8000, %MF_Enabled
Menu Attach hMenu, hWnd
'statusbar
Control Add StatusBar, hWnd, 800, "",0,0,0,0
StatusBar Set Parts hWnd, 8800, 75,75,99999
StatusBar Set Text hWnd, 8800, 1, 0, "one"
StatusBar Set Text hWnd, 8800, 2, 0, "two"
StatusBar Set Text hWnd, 8800, 3, 0, "three"
'listview
Control Add ListView, hWnd, 8900, "", 400,60,150,100, %WS_Border
ImageList New Icon 16,16,32,3 To hLst2 'create SMALL imagelist w,h,depth,size
ImageList Add Icon hLst2, "x"
ListView Set ImageList hWnd, 8900, hLst2, %lvsil_small
ListView Insert Column hWnd, 8900, 1, "test1", 75, 0 'columns hWnd, id&, col, "test", width, format
ListView Insert Item hWnd, 8900, 1, 1, "one" 'row 1, col1 'rows hWnd, id&, row, image, "text"
ListView Set Text hWnd, 8900, 1,2, "12" 'row1 col2 'items hWnd, id&, row, col, "text"
ListView Set Mode hWnd, 8900, 1 '0-icon 1-report 2-small 3-list
'TreeView
style& = %TVS_HASBUTTONS Or %TVS_LINESATROOT Or %TVS_HASLINES Or %WS_Border
Control Add TreeView, hWnd, 8950, "", 400,180,150,100, Style&
TreeView Insert Item hWnd, 8950, 0, %TVI_Last, 0,0,"Root" To hItem
TreeView Insert Item hWnd, 8950, hItem, %TVI_Last, 0,0,"Mother" To hTemp
TreeView Insert Item hWnd, 8950, hTemp, %TVI_Last, 0,0,"Dan" To hTemp2
TreeView Set Expanded hWnd, 8950, hItem, %True
TreeView Set Expanded hWnd, 8950, hTemp, %True
'TAB
Control Add Tab, hWnd, 8540, "", 400,370,150,75
Tab Insert Page hWnd, 8540, 1,0,"Page1" To hPage1
Control Add Label, hPage1, 8550, "Label1", 20,20,60,20
Tab Insert Page hWnd, 8540, 2,0,"Page2" To hPage2
Control Add TextBox, hPage2, 8560, "Text1", 20,20,60,20
End Sub
'gbs_01097
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm