Announcement

Collapse
No announcement yet.

Change Icon Colors On The Fly

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Change Icon Colors On The Fly

    For a long time, my GoDo list has included changing the color of toolbar icons on the fly, where the icons are a symbols using a single color with transparent backgrounds.

    Here's the strategy I'm thinking of ...
    1. Start with black icons with a transparent background
    2. Select a new color
    3. Read in all icon file, change the black pixels to the new color and save the icons under the same name
    4. Kill the imagelist and toolbar
    5. Re-create the imagelist and toolbar

  • #2
    I've posted some code that creates color icons on the fly, but those icons were just colored rectangles.

    This next example is similar but uses a short method to create the icons. When the ImageList New Icon statements are created, it creates the colored images on the fly. Each time you press the button a new set of icons, with different colors, is created.

    Code:
    'Compilable Example:
    #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
    Each

    Comment


    • #3
      Cool beans, partial success! Here's code that does change the colors of the icons. Full source, EXE and icons are at http://www.garybeene.com/files/coloricon.zip

      I've not worked out how to make the background transparent nor to change the size to a larger icon size, such as 24x24. It's time to crash, so I will work on it some more tomorrow. Both of those issues will need to be addressed in the CreateBitmapIndirect and CreateIconIndirect API, I think. Not my specialty so some digging will be required.

      Click image for larger version  Name:	pb_2077.jpg Views:	1 Size:	24.2 KB ID:	776886
      Code:
      'Compilable Example:
      #Compiler PBWin 9, PBWin 10
      #Compile Exe
      #Dim All
      %Unicode=1
      #Include "Win32API.inc"
      
      #Resource Icon xup, "up.ico"
      #Resource Icon xdown, "down.ico"
      
      %IDC_Toolbar = 500
      %IDC_Button  = 501
      
      Global hDlg,hLst As Dword
      
      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
         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 CreateToolbarAndImageList
         End Select
      End Function
      
      Sub CreateToolbarAndImageList
         Local iColor As Long
         iColor = RGB(Rnd(0,255) , Rnd(0,255), Rnd(0,255))
         ImageList Kill hLst
         Control Kill hDlg, %IDC_Toolbar
      
         ImageList New Icon 16,16,32,10 To hLst
         ImageList Add Icon hLst, "xup"
         ImageList Add Icon hLst, "xdown"
         ImageList Add Icon hLst, CreateColorIcon(iColor,16,16,1)
         ImageList Add Icon hLst, CreateColorIcon(iColor,16,16,2)
      
         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, 3, 600,  %TbStyle_Button, "Up"
         Toolbar Add Button  hDlg, %IDC_Toolbar, 4, 600,  %TbStyle_Button, "Down"
      End Sub
      
      Function CreateColorIcon(iColor As Long, w As Long, h As Long, ResIndex 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 %White
         Graphic ImageList(0,0),hLst, ResIndex, 0, %ILD_Normal
         Graphic Paint (8,8), iColor, %White  
      
         '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
      Last edited by Gary Beene; 6 Dec 2018, 08:36 AM.

      Comment


      • #4
        To get the look of transparency, replace %White (2 places) with GetSysColor(%Color_BtnFace). It's not real transparency but rather making the background of the icon the same color as the toolbar surface.

        Click image for larger version  Name:	pb_2078.jpg Views:	1 Size:	22.6 KB ID:	776895
        I'm sure there a better/different way to get transparency, but this seems to serve the need unless the color scheme on Windows has been changed. I'll keep my eyes open for a different approach.

        And I still need to figure out how to change the size of the displayed icon. I'd think it has to do with the bitmap B and Mask() part of the code.

        Comment


        • #5
          Notes:

          This discussion is about source icons which use only 2 colors.

          The Paint statement puts the starting pixel at the center of the icon. In general Paint must be applied to each colored area.

          Comment


          • #6
            Here's a new version, where Paint is replaced by code using Graphic Get Bits. This approach allows me to handle images that have non-contiguous black areas anywhere on the icon. The parsing of colors uses a pointer scheme that has been discussed in other threads.

            http://www.garybeene.com/files/coloricon.zip

            The only part of the code I still want to improve is to create icons of any size and have transparency that does not depend on the simply matching background colors.


            Click image for larger version  Name:	pb_2079.jpg Views:	1 Size:	8.4 KB ID:	776898
            (note that the 3rd icon has non-contiguous colored areas)

            Code:
            'Compilable Example:
            #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 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
                     CreateToolbarAndImageList
                  Case %WM_Command
                     If Cb.Ctl = 501 Then CreateToolbarAndImageList
               End Select
            End Function
            
            Sub CreateToolbarAndImageList
               Local iColor As Long
               iColor = RGB(Rnd(0,255) , Rnd(0,255), Rnd(0,255))
            
               ImageList Kill hLst
               Control Kill hDlg, %IDC_Toolbar
            
               ImageList New Icon wIcon,hIcon,32,10 To hLst
               ImageList Add Icon hLst, "xup"
               ImageList Add Icon hLst, "xdown"
               ImageList Add Icon hLst, "xbelow"
               ImageList Add Icon hLst, CreateColorIcon(iColor,wIcon,hIcon,1)
               ImageList Add Icon hLst, CreateColorIcon(iColor,wIcon,hIcon,2)
               ImageList Add Icon hLst, CreateColorIcon(iColor,wIcon,hIcon,3)
            
               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, 4, 600,  %TbStyle_Button, "Up"
               Toolbar Add Button  hDlg, %IDC_Toolbar, 5, 600,  %TbStyle_Button, "Down"
               Toolbar Add Button  hDlg, %IDC_Toolbar, 6, 600,  %TbStyle_Button, "Below"
            End Sub
            
            Function CreateColorIcon(iColor As Long, w As Long, h As Long, ResIndex As Long) As Dword
               Local B As Bitmap, P As IconInfo, hBMPXor, hBMPAnd As Dword, bmp$
               Local bgColor, x,y, iPos, i As Long, PixelPtr As Long Ptr
            
               bgColor = GetSysColor(%Color_BtnFace)
            
               'Create an XOR bitmap using the bitstring in bmp$
               Graphic Bitmap New w,h To hBMPXOR
               Graphic Attach hBMPXOR, 0
               Graphic Clear bgColor
               Graphic ImageList(0,0),hLst, ResIndex, 0, %ILD_Normal
            
               'replacement for previous Paint
               Graphic Get Bits To bmp$
               x = Cvl(bmp$,1) : y = Cvl(bmp$,5) : PixelPtr = StrPtr(bmp$) + 8
               For i = 1 To w*h
                  If @PixelPtr <> Bgr(bgColor) Then @PixelPtr = Bgr(iColor)
                  Incr PixelPtr
               Next i
               Graphic Set Bits bmp$
            
            
               '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

            Comment


            • #7
              Let's make that 3 things open to change:

              1. Any size icon
              2. Transparency not based on matching background color
              3. Replace Graphic ImageList with another approach, so that ImageList requires half as many images.

              Comment


              • #8
                Here's the fix for simplifying content of the imagelist (#3 from above). It uses Graphic Render to grab an icon resource directly.

                3. Replace Graphic ImageList with another approach, so that ImageList requires half as many images.
                http://www.garybeene.com/files/coloricon.zip


                Code:
                'Compilable Example:
                #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

                Comment


                • #9
                  Gary,
                  Perhaps a toolbar on a rebar is what you are looking for to provide transparency. It works for me.

                  Comment


                  • #10
                    Hi Jim!
                    I've never used a rebar before. I thought a rebar was just a container control - didn't realize it would be a helpful in this situation. Can you say more, or better yet, do you have a simple example showing how it might apply in this situation? I'll go nose around the forum for more info.

                    Comment


                    • #11
                      xBot uses a rebar with a toolbar on it. See version 5 and up.

                      Comment

                      Working...
                      X