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"
#Resource "gbsnippets.pbr"
Global hDlg, hLst, hIcon As Dword
%ID_Data = 500 : %ID_Graphic = 501 : %IDC_Toolbar = 502 : %ID_Timer = 503
Global hDlg, hToolbar, hLst As Dword, P As IconInfo, w As Long, h As Long, bmp$
Global bmpXOR() As Byte, bmpAND() As Byte, hIcon As Dword
Global hBMPXor As Dword, hBMPAnd As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "Dynamic Toolbar Icons",300,300,350,150, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Redraw && Replace Icons", 20,60,160,20
Control Add Graphic, hDlg, %ID_Graphic,"", 50,100,24,24 ', %ws_border
Graphic Attach hDlg, %ID_Graphic
Graphic Width 2
CreateImageList
CreateToolbar
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Static iCount as Long
Select Case Cb.Msg
Case %WM_InitDialog
SetTimer(CB.Hndl, %ID_Timer, 500, ByVal %NULL) 'uses callback messages
Case %WM_Command
If Cb.Ctl = 100 Then
CreateImageList
Control Kill hDlg, %IDC_Toolbar
CreateToolbar
End If
Case %WM_Timer
CreateImageList
Control Kill hDlg, %IDC_Toolbar
CreateToolbar
Case %WM_Destroy
KillTimer CB.Hndl, %ID_Timer
End Select
End Function
Sub CreateImageList
ImageList Kill hLst
ImageList New Icon 24,24,32,50 To hLst
ImageList Add Icon hLst, CreateColorIcon(1, RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))
ImageList Add Icon hLst, CreateColorIcon(2, RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))
ImageList Add Icon hLst, CreateColorIcon(3, RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))
End Sub
Sub CreateToolbar
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(iImage As Long, iColor As Long) As Dword
Local B As Bitmap, iPos As Long, x As Long
Static iCount as Long
'Create an XOR bitmap using the bitstring in bmp$
w = 16 : h = 16
Graphic Bitmap New w,h To hBMPXOR
Graphic Attach hBMPXOR, 0
Graphic Clear iColor
Select Case iImage
Case 1 : 'optional drawing on the icon
Case 2 : 'optional drawing on the icon
Case 3 :
'Graphic Box (1,1)-(iCount,iCount),%Red 'optional demo of animated toolbar icon
'Incr iCount
'iF iCount > 16 Then iCount = 0
End Select
Graphic Get Bits To bmp$
'create the bit array for the monochrome MASK bitmask. &HECE9D8 is transparent color
Dim Mask(1 To w*h/8) As Static Byte
For x = 9 To Len(bmp$) Step 4
If Cvl(bmp$,x) = &HECE9D8 Then
Bit Set Mask(1),(iPos And &hfffffff8) + 7 - (iPos And &h7) 'bit is transparent
Else
Bit Reset Mask(1),(iPos And &hfffffff8) + 7 - (iPos And &h7) 'bit is not transparent
End If
Incr iPos
Next
'fill out the MASK bitmap variable information
B.bmType = 0 : B.bmWidth = w : B.bmHeight = h
B.bmWidthBytes = w/8 : B.bmPlanes = 1 : B.bmBitsPixel = 1
B.bmBits = VarPtr(Mask(1))
'create the MASK bitmap
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_00815
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm