' Multi-colored List Box Demo
' By Brent D. Thorn, 5/2004
' Updated 3/2010 to improve efficiency
' Demonstrates an owner-drawn list box in the form of a "color picker".
' NOTE: Even with this improved version, the number and sizes of such controls
' should be kept to a minimum.
' PUBLIC DOMAIN
NoMainWin
' Define structs.
Struct dis, _ ' DRAWITEMSTRUCT
CtlType As ULong, _
CtlID As ULong, _
itemID As ULong, _
itemAction As ULong, _
itemState As ULong, _
hwndItem As ULong, _
hDC As ULong, _
rcItemLeft As Long, _
rcItemTop As Long, _
rcItemRight As Long, _
rcItemBottom As Long, _
itemData As ULong
Struct rc, _ ' RECT
left As Long, top As Long, _
right As Long, bottom As Long
' Open DLLs
Open "WMLiberty" For DLL As #wmlib
' Begin window definition.
' List items and associated color values for #demo.lstColors
demo.lstColors.List$(1) = "Black" : demo.lstColors.Data(1) = RGB( 0, 0, 0)
demo.lstColors.List$(2) = "Blue" : demo.lstColors.Data(2) = RGB( 0, 0, 255)
demo.lstColors.List$(3) = "Green" : demo.lstColors.Data(3) = RGB( 0, 255, 0)
demo.lstColors.List$(4) = "Cyan" : demo.lstColors.Data(4) = RGB( 0, 255, 255)
demo.lstColors.List$(5) = "Red" : demo.lstColors.Data(5) = RGB(255, 0, 0)
demo.lstColors.List$(6) = "Magenta":demo.lstColors.Data(6) = RGB(255, 0, 255)
demo.lstColors.List$(7) = "Yellow": demo.lstColors.Data(7) = RGB(255, 255, 0)
demo.lstColors.List$(8) = "White" : demo.lstColors.Data(8) = RGB(255, 255, 255)
ListBox #demo.lstColors, demo.lstColors.List$(), [demo.lstColors_DblClick], 10, 10, 100, 100
StyleBits #demo.lstColors, _LBS_HASSTRINGS Or _LBS_OWNERDRAWFIXED, 0, 0, 0
Open "Multi-colored Listbox" For Dialog As #demo
#demo "TrapClose [demo_Close]"
hdemo = HWnd(#demo)
hlst = HWnd(#demo.lstColors)
'Set items' data, i.e. the colors
For i = 1 To 8
Call LBSetItemData hlst, i - 1, demo.lstColors.Data(i)
Next
' Change the height of list items. This is normally done by
' trapping the _WM_MEASUREITEM message. However, this message
' is sent before the window is fully initialized/created.
' Hide the scroll bar because it will get messed up by the
' change in height. We'll re-show it later.
CallDLL #user32, "ShowScrollBar", _
hlst As ULong, _
_SB_VERT As Long, _
0 As Long, _
r As Long
' Get list box item height.
CallDLL #user32, "SendMessageA", _
hlst As ULong, _
_LB_GETITEMHEIGHT As ULong, _
0 As Long, _
0 As Long, _
pels As Long
' Increase height by 4 pixels to accommodate a 2 pixel border.
pels = pels + 4
CallDLL #user32, "SendMessageA", _
hlst As ULong, _
_LB_SETITEMHEIGHT As Long, _
0 As Long, _
pels As Long, _
r As Long
' Now re-show the scroll bar.
CallDLL #user32, "ShowScrollBar", _
hlst As ULong, _
_SB_VERT As Long, _
1 As Long, _
r As Long
' Setup message trap for _WM_DRAWITEM.
Callback lpfnCB, OnDrawItem( ULong, ULong, ULong, ULong ), Long
CallDLL #wmlib, "SetWMHandler", _
hdemo As ULong, _
_WM_DRAWITEM As ULong, _
lpfnCB As ULong, _
0 As Long, _
r As Long
' Force the list box to redraw.
CallDLL #user32, "RedrawWindow", _
hlst As ULong, _
_NULL As Long, _
_NULL As Long, _
_RDW_INVALIDATE As Long, _
r As Long
[DoEvents]
Scan
CallDLL #kernel32, "Sleep", _
1 As Long, r As void
GoTo [DoEvents]
[demo_Close]
Close #demo
Close #wmlib
End
[demo.lstColors_DblClick]
CallDLL #user32, "SendMessageA", _
hlst As ULong, _
_LB_GETCURSEL As ULong, _
0 As ULong, _
0 As Long, _
SelIndex As Long 'index of currently selected item
chosen$ = LBGetText$( hlst, SelIndex )
notice "You selected ";chosen$
GoTo [DoEvents]
'OnDrawItem
' Message handler for _WM_DRAWITEM.
Function OnDrawItem( hWnd, uMsg, wParam, lParam )
' Fill dis struct from pointer.
dis.struct = lParam
' Pick out the most relevant data.
hdc = dis.hDC.struct ' Device Context
' Zero-based and one-based indexes of the item
i0 = dis.itemID.struct: i1 = i0 + 1
' Select the proper course of action.
Select Case dis.itemAction.struct
Case _ODA_SELECT, _ODA_DRAWENTIRE
' Fill "rc" struct from pointer.
' This is the same as the "rc*" members in "dis" but more useful.
rc.struct = lParam + 28
' Get the background color for the item.
bg = demo.lstColors.Data(i1) ' faster than "dis.itemData.struct"
' Foreground color needs to contrast well.
fg = ContrastWithColor(bg)
' If item's selected, paint a border around it.
If (_ODS_SELECTED And dis.itemState.struct) Then
' Use the right brush for the job.
If fg Then c = _WHITE_BRUSH Else c = _BLACK_BRUSH
' Use a stock brush.
CallDLL #gdi32, "GetStockObject", _
c As Long, _
hbr As ULong
' Fill the rect with selection color.
CallDLL #user32, "FillRect", _
hdc As ULong, _
rc As Struct, _
hbr As ULong, _
r As Long
' Shrink rect by 2 px for use below.
CallDLL #user32, "InflateRect", _
rc As Struct, _
-2 As Long, _
-2 As Long, _
r As Long
' Calculate where text will be placed.
x = rc.left.struct
y = rc.top.struct
Else
' Without a selection, text needs moved down and to the right.
x = rc.left.struct + 2
y = rc.top.struct + 2
End If
' Create a brush with the background color.
CallDLL #gdi32, "CreateSolidBrush", _
bg As ULong, _
hbr As ULong
' Paint the background.
CallDLL #user32, "FillRect", _
hdc As ULong, _
rc As Struct, _
hbr As ULong, _
r As Long
' Destroy the background brush.
CallDLL #gdi32, "DeleteObject", _
hbr As ULong, _
r As Long
' Prepare to draw text.
CallDLL #gdi32, "SetTextColor", _
hdc As ULong, _
fg As ULong, _
r As ULong
CallDLL #gdi32, "SetBkColor", _
hdc As ULong, _
bg As ULong, _
r As ULong
' Get item's text. Originally called "LBGetText$(dis.hwndItem.struct, i0)"
text$ = demo.lstColors.List$(i1) ' faster than orig.
cbText = Len(text$)
' Draw the text for the item.
CallDLL #gdi32, "TextOutA", _
hdc As ULong, _
x As Long, _
y As Long, _
text$ As Ptr, _
cbText As Long, _
r As Long
' There's no need to forward this message.
OnDrswItem = 1
End Select
End Function
Function RGB( R, G, B )
RGB = 65536 * B + 256 * G + R
End Function
'ContrastWithColor
' Given a COLORREF (32 bits).
' Returns a COLORREF for either black or white, whichever
' contrasts most, based on "perceived brightness."
' Dependent on Function RGB.
Function ContrastWithColor( Color )
R = (Color And 255): Color = Int(Color / 256)
G = (Color And 255): Color = Int(Color / 256)
B = (Color And 255)
perceived = (299 * R + 587 * G + 114 * B) / 1000
If perceived < 128 Then _
ContrastWithColor = RGB(255, 255, 255)
End Function
'LBGetText$
' Wraps SendMessage _LB_GETTEXT.
Function LBGetText$( hWnd, Index )
CallDLL #user32, "SendMessageA", _
hWnd As ULong, _
_LB_GETTEXTLEN As ULong, _
Index As ULong, _
0 As Long, _
cch As Long
If cch <> _LB_ERR Then
text$ = Space$(cch) + Chr$(0)
CallDLL #user32, "SendMessageA", _
hWnd As ULong, _
_LB_GETTEXT As ULong, _
Index As ULong, _
text$ As Ptr, _
cch As Long
LBGetText$ = Left$(text$, cch)
End If
End Function
'LBSetItemData
' Wraps SendMessage _LB_SETITEMDATA.
Sub LBSetItemData hWnd, Index, dwData
CallDLL #user32, "SendMessageA", _
hWnd As ULong, _
_LB_SETITEMDATA As ULong, _
Index As ULong, _
dwData As ULong, _
r As Long
End Sub |
FAQ
Search
Usergroups
Register
Profile
Log in to check your private messages
Log in