Change Toolbar Icon Colors at RunTime

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
 
#Resource Icon xup, "up.ico"
#Resource Icon xdown, "down.ico"
#Resource Icon xbelow, "below.ico"
 
%IDC_Toolbar = 500
%IDC_Button  = 501
 
Global hDlg,hLst As Dword, wIcon,hIcon,NewColor As Long
 
Function PBMain() As Long
   Dialog Default Font "Tahoma", 10, 1
   Dialog New Pixels, 0, "Dynamic Icon Colors",,,350,100, %WS_OverlappedWindow To hDlg
   Dialog Set Icon hDlg, "xup"
   Control Add Button, hDlg, %IDC_Button,"New Color", 20,60,200,25
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Randomize Timer
         wIcon = 16 : hIcon = 16
         NewColor = RGB(Rnd(0,255) , Rnd(0,255), Rnd(0,255))
         CreateToolbarAndImageList
      Case %WM_Command
         If Cb.Ctl = %IDC_Button Then
            NewColor = RGB(Rnd(0,255) , Rnd(0,255), Rnd(0,255))
            CreateToolbarAndImageList
         End If
   End Select
End Function
 
Sub CreateToolbarAndImageList
   ImageList Kill hLst
   Control Kill hDlg, %IDC_Toolbar
 
   ImageList New Icon wIcon,hIcon,32,10 To hLst
   ImageList Add Icon hLst, CreateColorIcon("xup")
   ImageList Add Icon hLst, CreateColorIcon("xdown")
   ImageList Add Icon hLst, CreateColorIcon("xbelow")
 
   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, "Up"
   Toolbar Add Button  hDlg, %IDC_Toolbar, 2, 600,  %TbStyle_Button, "Down"
   Toolbar Add Button  hDlg, %IDC_Toolbar, 3, 600,  %TbStyle_Button, "Below"
End Sub
 
Function CreateColorIcon(ImageName$) As Dword
   Local B As Bitmap, P As IconInfo, hBMPXor, hBMPAnd As Dword, bmp$
   Local bgColor,x,y,i As Long, PixelPtr As Long Ptr
 
   bgColor = GetSysColor(%Color_BtnFace)
 
   'Create an XOR bitmap using the bitstring in bmp$
   Graphic Bitmap New wIcon,hIcon To hBMPXOR
   Graphic Attach hBMPXOR, 0
   Graphic Clear bgColor
   Graphic Render Icon ImageName$, (0,0)-(wIcon-1,hIcon-1)
 
   'replace icon colors with newcolor
   Graphic Get Bits To bmp$
   x = Cvl(bmp$,1) : y = Cvl(bmp$,5) : PixelPtr = StrPtr(bmp$) + 8
   For i = 1 To wIcon*hIcon
      If @PixelPtr <> Bgr(bgColor) Then @PixelPtr = Bgr(NewColor)
      Incr PixelPtr
   Next i
   Graphic Set Bits bmp$
 
   'create the MASK bitmap variable information
   Dim Mask(1 To wIcon*hIcon/8) As Static Byte
   B.bmType = 0               :   B.bmWidth = wIcon  :   B.bmHeight = hIcon
   B.bmWidthBytes = wIcon/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
 

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm