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
#Include "commctrl.inc"
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
%IDC_Toolbar = 500
Global hDlg,hList,hToolbar As Dword 'main dialog handle
Global OldProc As Long
Function PBMain()
Dialog New Pixels, 0, "Toolbar Test",500,200,200,25, %WS_PopUp, To hDlg
'add toolbar
Control Add Toolbar, hDlg, %IDC_Toolbar,"", 0,0,0,0 ', %CCS_NoMoveY
Control Handle hDlg, %IDC_Toolbar To hToolbar
'create imagelist
ImageList New Icon 16,16,32,3 To hList
ImageList Add Icon hList, "x" '1
ImageList Add Icon hList, "y" '2
ImageList Add Icon hList, "z" '3
'attach imagelist
Toolbar Set ImageList hDlg, %IDC_Toolbar, hList, 0
'create buttons
Toolbar Add Button hDlg, %IDC_Toolbar, 1, 200, %TbStyle_Button, ""
Toolbar Add Button hDlg, %IDC_Toolbar, 2, 201, %TbStyle_Button, ""
Toolbar Add Button hDlg, %IDC_Toolbar, 3, 202, %TbStyle_Button, ""
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
OldProc = SetWindowLong(GetDlgItem(hDlg, %IDC_Toolbar), %GWL_WndProc, CodePtr(NewProc)) 'subclass a control
Case %WM_Destroy
SetWindowLong hToolbar, %GWL_WNDPROC, OldProc 'un-subclass, restore original window procedure
Case %WM_ContextMenu
Dialog End hDlg
Case %WM_LButtonDown
If Cb.WParam = %MK_LBUTTON Then SendMessage hDlg, %WM_NCLButtonDown, %HTCaption, ByVal %Null ' force drag
End Select
End Function
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Local iReturn As Long
Select Case Msg
Case %WM_ContextMenu
Dialog End hDlg
Case %WM_LButtonDown
If WParam = %MK_LBUTTON Then SendMessage hDlg, %WM_NCLButtonDown, %HTCaption, ByVal %Null ' force drag
End Select
Function = CallWindowProc(OldProc, hWnd, Msg, wParam, lParam)
End Function
'gbs_00760
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm