Change listbox selected color?

[pablosl]

I would like to change the color for selected items inside one listbox without having to change the windows default settings (and then changing all the listboxes used).
Like the Run BASIC Console does when you select "Run BASIC Personal Server, port 8008".
Background color white Foreground color black but when selected a nice Background cyan.

If possible, can somebody code a sample?

Thx.

- Pablo

[metro]

Not sure if this will help

'* Multi-colored List Box Demo
'* By Brent Thorn, May 2004
'* E-Mail <b6sw at yahoo dot com> or <lbgui at aol dot com>
'*
'* Demonstrates an owner-drawn list box in the form
'* of a "color picker."

   NoMainWin

   '** Open DLLs
   Open "WMLiberty" For DLL As #wmlib

   '** Begin window #demo
   ' List items and associated color values for #demo.lstColors
   demo.lstColors.Data(1) = RGB(  0,   0,   0)
   demo.lstColors.Data(2) = RGB(  0,   0, 255)
   demo.lstColors.Data(3) = RGB(  0, 255,   0)
   demo.lstColors.Data(4) = RGB(  0, 255, 255)
   demo.lstColors.Data(5) = RGB(255,   0,   0)
   demo.lstColors.Data(6) = RGB(255,   0, 255)
   demo.lstColors.Data(7) = RGB(255, 255,   0)
   ddemo.lstColors.Data(8) = RGB(255, 255, 255)

   demo.lstColors.List$(1)="Black"
   demo.lstColors.List$(2)="Blue"
   demo.lstColors.List$(3)="Green"
   demo.lstColors.List$(4)="Cyan"
   demo.lstColors.List$(5)="Red"
   demo.lstColors.List$(6)="Pink"
   demo.lstColors.List$(7)="Yellow"
   demo.lstColors.List$(8)="White"

   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", _
       50 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 )
   ' Declare and initialize a struct that holds all
   ' we need to know to draw our listbox items.
   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
   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
       ' Get the background color for the item.
       bg = dis.itemData.struct
       ' Create a brush with the background color.
       CallDLL #gdi32, "CreateSolidBrush", _
           bg As ULong, _
           hbr As ULong
       ' Prepare to paint the background.
       Struct rc, _ ' RECT
           left As Long, top As Long, _
           right As Long, bottom As Long
       rc.left.struct = dis.rcItemLeft.struct
       rc.top.struct = dis.rcItemTop.struct
       rc.right.struct = dis.rcItemRight.struct
       rc.bottom.struct = dis.rcItemBottom.struct
       ' 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
       ' Pick a foreground color (black or white) that
       ' contrasts well with the background color.
       fg = ContrastWithColor(bg)
       ' 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
       ' Move down and right two pixels to accommodate a selection border.
       x = rc.left.struct + 2
       y = rc.top.struct + 2
       text$ = LBGetText$(dis.hwndItem.struct, i0)
       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

       ' Which state is the item in?

       ' Selected state: Draw a border.
       If (_ODS_SELECTED And dis.itemState.struct) Then
           ' Create pen in the solid foreground color, 2 pixels wide.
           CallDLL #gdi32, "CreatePen", _
               _PS_SOLID As Long, _
               2 As Long, _
               fg As ULong, _
               hpen As ULong
           ' Select the new pen and save the old one.
           CallDLL #gdi32, "SelectObject", _
               hdc As ULong, _
               hpen As ULong, _
               hold As ULong
           ' Prepare to draw a border.
           ' Start at the top-right corner.
           x = rc.right.struct - 1
           y = rc.top.struct + 1
           CallDLL #gdi32, "MoveToEx", _
               hdc As ULong, _
               x As Long, _
               y As Long, _
               _NULL As ULong, _
               r As Long
           ' Surround the entire item.
           Call LineTo hdc, rc.left.struct + 1, rc.top.struct + 1
           Call LineTo hdc, rc.left.struct + 1, rc.bottom.struct - 1
           Call LineTo hdc, rc.right.struct - 1, rc.bottom.struct - 1
           Call LineTo hdc, rc.right.struct - 1, rc.top.struct + 1
           ' Restore the old pen.
           CallDLL #gdi32, "SelectObject", _
               hdc As ULong, _
               hold As ULong, _
               r As ULong
           ' Destroy the foreground pen.
           CallDLL #gdi32, "DeleteObject", _
               hpen As ULong, _
               r As Long
       End If
       ' These'r 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

Sub LineTo hDC, nXEnd, nYEnd
   CallDLL #gdi32, "LineTo", _
       hDC As ULong, _
       nXEnd As Long, _
       nYEnd As Long, _
       r As Long
End Sub




Attachments:

WMLiberty.dll (48 KB)

[pablosl]

Thank you metro!.

Perhaps modifying this code. What I really want is to change the Selection color, not the listbox color itself.

Regards,

- Pablo

[cundo]

Interesting... changing the background color... maybe having two ListBoxes, two different colors, need to think this...