Date: 02-16-2022
Return to Index
created by gbSnippets
'Credit: Pierre Bellisle
'Compilable Example: (Jose Includes)
'------------------------------------------------------------------------------
' 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
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm