ListBox - OwnerDrawn Colored ListBox

Category: Controls - .Techniques

Date: 03-28-2012

Return to Index


 
'Credit: Pierre Bellisle
 
'Compilable Example:
'------------------------------------------------------------------------------
' ownerdrawn listbox - based on borje work at http://www.powerbasic.com/support/pb...ead.php?t=7325
'------------------------------------------------------------------------------
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc'# 2005-01-27 #
 
%listbox   =  101
 
'______________________________________________________________________________
 
CallBack Function dlgproc
   Local hpen   As Dword
   Local hbrush As Dword
   Local lpdis  As drawitemstruct Ptr
   Local ztxt   As Asciiz * 300
 
   Select Case CbMsg
      Case %WM_Command
         Select Case CbCtl
 
            Case %IdCancel
               If CbCtlMsg = %BN_Clicked Then Dialog End CbHndl
 
            Case %listbox
               If CbCtlMsg = %LBN_SelChange Then
                  'whatever needs to be done..
               End If
 
         End Select
 
      Case %WM_DrawItem
         If CbWParam = %listbox Then   'cbwparam holds control's id
            lpdis = CbLParam            'cblparam points to a drawitemstruct structure
            If @lpdis.itemid = &hffffffff Then Exit Function 'if list is empty
 
            Select Case @lpdis.itemaction
               Case %oda_drawentire, %oda_select
 
                  Control Send CbHndl, %listbox, %lb_gettext, @lpdis.itemid, VarPtr(ztxt)
 
                  If (@lpdis.itemstate And %ods_selected) = 0 Then               'item is not selected
                     ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
                     'if @lpdis.itemid mod 2 then ' <- change color if item is even or odd
                     '  hbrush = rgb(255, 255, 255) 'white
                     'else
                     '  hbrush = rgb(235, 235, 235) 'light gray
                     'end if
                     ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
                     If InStr(ztxt, "-") Then ' <- change color if item is negative
                        hbrush = RGB(255, 200, 200) 'red
                     Else
                        hbrush = RGB(200, 255, 200) 'green
                     End If
                     ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
                     fillrect @lpdis.hdc, @lpdis.rcitem, createsolidbrush(hbrush) 'cls
                     setbkcolor @lpdis.hdc, hbrush                                'text background
                     settextcolor @lpdis.hdc, getsyscolor(%color_windowtext)      'text color
                  Else                                                           'item is selected
                     hbrush = getsyscolorbrush(%color_highlight)
                     fillrect @lpdis.hdc, @lpdis.rcitem, getsyscolorbrush(%color_highlight) 'cls
                     setbkcolor @lpdis.hdc, getsyscolor(%color_highlight)         'text background
                     settextcolor @lpdis.hdc, getsyscolor(%color_highlighttext)   'text color
                  End If
 
                  'get/draw current item's text
                  Call drawtext(@lpdis.hdc, ztxt, Len(ztxt), @lpdis.rcitem, %dt_singleline Or %dt_left Or %dt_vcenter)
 
                  'draw grid lines
                  'hpen = createpen(%ps_solid, 1, getsyscolor(%color_3dface))
                  hpen = createpen(%ps_solid, 1, RGB(255, 0, 0)) 'red
                  hpen = selectobject(@lpdis.hdc, hpen)
                  movetoex @lpdis.hdc, 0, @lpdis.rcitem.nbottom - 1, ByVal %null
                  lineto @lpdis.hdc, @lpdis.rcitem.nright, @lpdis.rcitem.nbottom - 1
                  deleteobject selectobject(@lpdis.hdc, hpen)
 
                  Function = %true
                  Exit Function
            End Select
         End If
 
   End Select
 
End Function
   '______________________________________________________________________________
 
Function PBMain() As Long
   Local hdlg       As Dword
   Local counter    As Long
   Local itemheight As Long
 
   Dialog New 0, "ownerdrawn listbox",,, 160, 100, %WS_Caption Or %WS_SysMenu To hdlg
 
   Control Add ListBox, hdlg, %listbox, , 5, 5, 150, 100, %WS_Child Or _
      %WS_Visible Or %LBS_OwnerDrawFixed Or %LBS_HasStrings Or %LBS_Notify Or _
      %WS_TabStop Or %WS_HScroll Or %WS_VScroll, %WS_Ex_ClientEdge
 
   Randomize Timer
   For counter = 1 To 50
      ListBox Add hdlg, %listbox, "this is item" + Str$(counter) & ", value is " & Str$(Rnd(-9, 9))
   Next
   ListBox Select hdlg, %listbox, 1
 
   'ownerdrawn lists gets bigger line height, so adjust some..
   Control Send hdlg, %listbox, %lb_getitemheight, 0, 0 To itemheight 'get current
   Control Send hdlg, %listbox, %lb_setitemheight, 0, itemheight - 2  'set new to adjust
   'control send hdlg, %listbox, %lb_sethorizontalextent, 300, 0       'want horizontal scrollbar?
 
   Dialog Show Modal hdlg, Call dlgproc
 
End Function
   '______________________________________________
 
'gbs_00796
'Date: 03-10-2012


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