Date: 02-16-2022
Return to Index
created by gbSnippets
'In lieu of a transparent toolbar, you can also just draw on a subclassed toolbar,
'drawing in the WM_EraseBkgnd of the subclass procedure.
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
Global hDlg,hLst,hToolbar As Dword, OldProc& 'main dialog handle
Function PBMain()
'create dialog
Dialog New Pixels, 0, "Toolbar Test",,, 200,150, %WS_OverlappedWindow, To hDlg
Dialog Set Color hDlg, %Black, %rgb_LightBlue
'add toolbar
Control Add Toolbar, hDlg, 500,"", 0,0,0,0, %TbStyle_Flat
Control Handle hDlg, 500 To hToolbar
'create imagelist
ImageList New Icon 16,16,24,10 To hLst
ImageList Add Icon hLst, LoadImage(%Null, Exe.Path$ + "print.ico", %Image_Icon, 24,24, %LR_LoadFromFile)
ImageList Add Icon hLst, LoadImage(%Null, Exe.Path$ + "help.ico", %Image_Icon, 24,24, %LR_LoadFromFile)
Toolbar Set ImageList hDlg, 500, hLst, 0 'attach imagelist
'create buttons
Toolbar Add Button hDlg, 500, 1, 200, %TbStyle_Button, "Print"
Toolbar Add Button hDlg, 500, 2, 201, %TbStyle_Button, "Help"
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
OldProc& = SetWindowLong(hToolbar, %GWL_WndProc, CodePtr(NewProc)) 'subclass
Case %WM_Destroy
SetWindowLong hToolbar, %GWL_WNDPROC, OldProc& 'un-subclass
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 w,h,origpen,origbrush As Long, gRect As Gradient_Rect
Dim V(1) As TriVertex
Select Case Msg
Case %WM_EraseBkgnd 'cb.wParam is the DC of the dialog
Dialog Get Client hDlg To w,h
V(0).x = 0
V(0).y = 0
V(0).Red = Mak(Word,0,255)
V(0).Green = 0
V(0).Blue = 0
V(1).x = w '<--- not w-1
V(1).y = 40 '<--- not h-1
V(1).Red = 0
V(1).Green = 0
V(1).Blue = Mak(Word,0,255)
gRect.UpperLeft = 0
gRect.LowerRight = 1
GradientFill WParam, V(0), 2, gRect, 1, %Gradient_Fill_Rect_H
Function = %True : Exit Function
End Select
Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
'gbs_01111
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm