Toolbar - Dynamic Images

Category: Controls - .Techniques

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#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 LongAs 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


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