Date: 02-16-2022
Return to Index
created by gbSnippets
'Credit: Pierre Bellisle
'Compilable Example: (Jose Includes)
'Ownerdrawn 2 columns, 2 colors listbox, based on B�rje work
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "WIN32API.INC"
Global hDlg AS DWord
%LISTBOX = 101
'______________________________________________________________________________
CallBack Function PbProc
Local DiSPtr AS DRAWITEMSTRUCT POINTER
Local zItem As AsciiZ * 100
Local zItemLeft As AsciiZ * 100
Local zItemRight As AsciiZ * 100
Local hPen AS DWord
Local hBrush AS DWord
Local hBrushLeft AS DWord
Local hBrushRight AS DWord
Local Looper As Long
STATIC TabLen As Long
STATIC TextMargin As Long
Local Colori AS BYTE
SELECT CASE CBMSG
CASE %WM_INITDIALOG
TabLen = 100
TextMargin = 5
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %LISTBOX
IF CBCTLMSG = %LBN_SELCHANGE THEN
END IF
END SELECT
CASE %WM_DRAWITEM
IF CBWPARAM = %LISTBOX THEN
DiSPtr = CBLPARAM 'CBLPARAM points to a DRAWITEMSTRUCT structure
IF @DiSPtr.itemID = &HFFFFFFFF THEN EXIT Function 'If list is empty
SELECT CASE @DiSPtr.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
CONTROL SEND CBHNDL, %LISTBOX, %LB_GETTEXT, @DiSPtr.itemID, VARPTR(zItem)
hBrushLeft = RGB(200, 220, 255) 'Blue
hBrushRight = RGB(255, 255, 200) 'Yellow
IF (@DiSPtr.itemState AND %ODS_SELECTED) = 0 THEN '...................'Item is not selected.....
FillRect(@DiSPtr.hDC, @DiSPtr.rcItem, CreateSolidBrush(hBrushLeft)) 'Cls
SetBkColor(@DiSPtr.hDC, hBrushLeft) 'Text background
SetTextColor(@DiSPtr.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Text color
ELSE '................................................................'Item is Selected.........
hBrush = hBrushRight
FOR Looper = 0 TO 2 'Calculate darker color
Colori = PEEK(VARPTR(hBrushRight) + Looper)
Colori = Colori - ((255 - Colori) * 2)
POKE VARPTR(hBrushRight) + Looper, Colori
NEXT
'If item is highlighted
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft + TabLen 'Set tabbed position
@DiSPtr.rcItem.nRight = @DiSPtr.rcItem.nRight + TabLen 'Set tabbed position
FillRect(@DiSPtr.hDC, @DiSPtr.rcItem, CreateSolidBrush(hBrushRight))'Cls
SetBkColor(@DiSPtr.hDC, hBrushRight) 'Text background
SetTextColor(@DiSPtr.hDC,(RGB(0, 0, 255))) 'Highligthed Text color
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft - TabLen 'Reset tabbed position
@DiSPtr.rcItem.nRight = @DiSPtr.rcItem.nRight - TabLen 'Reset tabbed position
END IF
'Draw current left item's text
zItemLeft = LEFT$(zItem, INSTR(zItem, $TAB) - 1)
FillRect(@DiSPtr.hDC, @DiSPtr.rcItem, CreateSolidBrush(hBrushLeft)) 'Cls
SetBkColor(@DiSPtr.hDC, hBrushLeft) 'Text background
SetTextColor(@DiSPtr.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Text color
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft + TextMargin 'Set optionnal text margin
DrawText(@DiSPtr.hDC, zItemLeft, LEN(zItemLeft), @DiSPtr.rcItem, %DT_SINGLELINE OR %DT_LEFT OR %DT_VCENTER)
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft - TextMargin 'Reset optionnal text margin
'Draw current right item's text
zItemRight = MID$(zItem, INSTR(zItem, $TAB))
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft + TabLen 'Set tabbed position
@DiSPtr.rcItem.nRight = @DiSPtr.rcItem.nRight + TabLen 'Set tabbed position
FillRect(@DiSPtr.hDC, @DiSPtr.rcItem, CreateSolidBrush(hBrushRight)) 'Cls
SetBkColor(@DiSPtr.hDC, hBrushRight) 'Text background
SetTextColor(@DiSPtr.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Text color
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft + TextMargin 'Set optionnal text margin
DrawText(@DiSPtr.hDC, zItemRight, LEN(zItemRight), @DiSPtr.rcItem, %DT_SINGLELINE OR %DT_LEFT OR %DT_VCENTER)
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft - TextMargin 'Reset optionnal text margin
@DiSPtr.rcItem.nLeft = @DiSPtr.rcItem.nLeft - TabLen 'Reset tabbed position
@DiSPtr.rcItem.nRight = @DiSPtr.rcItem.nRight - TabLen 'Reset tabbed position
'Draw grid lines
hPen = CreatePen(%PS_SOLID, 1, RGB(200, 200, 200))
hPen = SelectObject(@DiSPtr.hDC, hPen)
MoveToEx(@DiSPtr.hDC, 0, @DiSPtr.rcItem.nBottom - 1, ByVal %NULL)
LineTo(@DiSPtr.hDC, @DiSPtr.rcItem.nRight, @DiSPtr.rcItem.nBottom - 1)
DeleteObject(SelectObject(@DiSPtr.hDC, hPen))
Function = %TRUE
EXIT Function
END SELECT
END IF
END SELECT
End Function
'______________________________________________________________________________
Function PBMain() As Long
Local Looper As Long
Local ItemHeight As Long
DIM sList(1 TO 50) As String
DIALOG NEW %HWND_DESKTOP, "2 columns ownerdrawn listbox",,, 200, 200, %WS_CAPTION OR %WS_SYSMENU TO hDlg
FOR Looper = 1 TO 50
sList(Looper) = "This is item " + FORMAT$(Looper, "00") & $TAB & "Value is " & STR$(Looper + 100)
NEXT
CONTROL ADD LISTBOX, hDlg, %LISTBOX, sList(), 5, 5, 190, 190, _
%WS_CHILD OR %WS_VISIBLE OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _
%LBS_NOTIFY OR %WS_TABSTOP OR %WS_VSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT
CONTROL SEND hDlg, %LISTBOX, %LB_GETITEMHEIGHT, 0, 0 TO ItemHeight 'Get current
CONTROL SEND hDlg, %LISTBOX, %LB_SETITEMHEIGHT, 0, ItemHeight - 2 'Adjust bigger line height
LISTBOX SELECT hDlg, %LISTBOX, 1
SetClassLong hDlg, %GCL_HICON, LoadIcon(ByVal %NULL, ByVal %IDI_INFORMATION)
DIALOG SHOW MODAL hDlg, CALL PbProc
End Function
'______________________________________________________________________________
'
'gbs_00791
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm