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 "Win32API.inc"
Global hDlg As Dword
%IDC_Toolbar = 500
%IDC_Button = 501
Global hDlg As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "Dynamic Toolbar Icons",300,300,250,100, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 501,"Redraw && Replace Icons", 20,60,160,20
CreateToolbarAndImageList
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_Command
If Cb.Ctl = 501 Then
Control Kill hDlg, %IDC_Toolbar
CreateToolbarAndImageList
End If
End Select
End Function
Sub CreateToolbarAndImageList
Local hLst,hToolbar As Dword
ImageList New Icon 24,24,32,50 To hLst
ImageList Add Icon hLst, CreateColorIcon(RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)),16,16)
ImageList Add Icon hLst, CreateColorIcon(RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)),16,16)
ImageList Add Icon hLst, CreateColorIcon(RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)),16,16)
Control Add Toolbar, hDlg, %IDC_Toolbar,"", 0,0,0,0, %TbStyle_Flat Or %WS_Border Or %WS_Child
Toolbar Set ImageList hDlg, %IDC_Toolbar, hLst, 0 'attach imagelist
Toolbar Add Button hDlg, %IDC_Toolbar, 1, 600, %TbStyle_Button, "Color"
Toolbar Add Button hDlg, %IDC_Toolbar, 2, 600, %TbStyle_Button, "Color"
Toolbar Add Button hDlg, %IDC_Toolbar, 3, 600, %TbStyle_Button, "Color"
Control Handle hDlg, %IDC_Toolbar To hToolbar
End Sub
Function CreateColorIcon(iColor As Long, w As Long, h As Long) As Dword
Local B As Bitmap, P As IconInfo, hBMPXor, hBMPAnd As Dword
'Create an XOR bitmap using the bitstring in bmp$
Graphic Bitmap New w,h To hBMPXOR
Graphic Attach hBMPXOR, 0
Graphic Clear iColor
'create the MASK bitmap variable information
Dim Mask(1 To w*h/8) As Static Byte
B.bmType = 0 : B.bmWidth = w : B.bmHeight = h
B.bmWidthBytes = w/8 : B.bmPlanes = 1 : B.bmBitsPixel = 1
B.bmBits = VarPtr(Mask(1))
hBMPAND = CreateBitmapIndirect(B)
'fill in the ICONINFO variable and create the icon (.xHotSpot/.yHotSpot are ignored)
P.fIcon = %True
P.hbmColor = hBMPXOR
P.hbmMask = hBMPAND
Function = CreateIconIndirect (P)
End Function
'gbs_01394
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm