I'm trying to display multiple columns in a listbox. That;s no problem using SENDMESSAGE, but only if the listbox style is set to 0. If I set it to 1, I can get multiple columns, but the alignment is all out of whack.
Any suggestions?
Printable View
I'm trying to display multiple columns in a listbox. That;s no problem using SENDMESSAGE, but only if the listbox style is set to 0. If I set it to 1, I can get multiple columns, but the alignment is all out of whack.
Any suggestions?
http://www.mvps.org/vbnet/code/listapi/listboxtabs.htm
Does this help you?
I am using similiar code to get the columns to align. What Ia am syaing is that when the listbox style is set to chkbox that is when the same exact code does not work. Any suggestions?
ehrmmm... No, I'm sorry, but look at http://www.vbaccelerator.com, http://www.mvps.org/vbnet/ and http://www.allapi.com for more info. :(
I looked and could not find anything but the code to perform it. Can anyone give me any feedback on whether they have got this to work?
PROBLEM AGAIN: Added tabs in listbox, that code works fine, except when the listbox style is set to chkbox. Anyone please? ? ?
I know I'm beating this to death, but it's beating me. Has anyone figured out how correctly use tabs in listbox with style of checkbox?
Ok. My last attempt to find out:
I there a way to erform this task. I worked with the problem late into last night bu could not figure it out.
Please, please?
You could Subclass the whole Listbox then you could do pretty much anything you want, I've taken some of my code I've been playing around with and added functionality to set Column widths for a Listbox (including/excluding checkboxes)...
Add a Listbox to your Form and set the Style property to 1 - Checkbox (needs to be set to this to enable the control as Owner Drawn), then add this code:
In a Module:In the Form:Code:'>>>>>>>>>>>>>>>>>>>>>> ListBoxEx <<<<<<<<<<<<<<<<<<<<<<
' Subclassing for a Standard VB Listbox which extended it's properties
' to include the ability to set Columns/Widths,
' Multicolor list items
' and runtime Checkbox activation/deactivation
'
' Written by Aaron Young
' [email protected]
'
' **Work in progress.
'
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type DRAWITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long
hdc As Long
rcItem As RECT
itemData As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, lpBitmapName As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
Private Const COLOR_HIGHLIGHT = 13
Private Const COLOR_HIGHLIGHTTEXT = 14
Private Const COLOR_WINDOW = 5
Private Const COLOR_WINDOWTEXT = 8
Private Const GWL_WNDPROC = (-4)
Private Const OBM_CHECK = 32760
Private Const OBM_CHECKBOXES = 32759
Private Const ODS_FOCUS = &H10
Private Const ODS_CHECKED = &H8
Private Const ODS_SELECTED = &H1
Private Const ODS_DISABLED = &H4
Private Const ODS_GRAYED = &H2
Private Const ODT_LISTBOX = 2
Private Const WM_DRAWITEM = &H2B
Private Const WM_USER = &H400
Private Const LB_GETTEXT = &H189
Private Const LB_SETTABSTOPS = &H192
Private Const LB_GETITEMDATA = &H199
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const LB_GETITEMRECT = &H198
Private Const LB_GETTOPINDEX = &H18E
Private Const LB_SELITEMRANGEEX = &H183
Private Const LB_SELITEMRANGE = &H19B
Private Const LB_SETCURSEL = &H186
Private Const LB_GETCURSEL = &H188
Private Const LB_GETCOUNT = &H18B
'Create some user defined window messages
Public Const UD_SETLISTCOLS = WM_USER + 1
'Set the Columns/Widths, wParam = Listbox Hwnd, lParam = Comma Delimited String of column Widths
Public Const UD_USECHECKBOXES = WM_USER + 2
'Turn Listbox Columns on/off, wParam = Listbox Hwnd, lParam = True/False to Turn Checkboxes On/Off
'Create a UDT to track extended properties of the listbox(es)
Private Type tListBoxEx
hwnd As Long 'Listbox Window Handle
Columns As String 'Comma Delimited List of Column Widths
Checkboxes As Boolean 'Use Checkboxes?
End Type
Private lPrevWndProc As Long
Private uListBoxes() As tListBoxEx
Private lLists As Long
Function FindHwnd(ByVal lHwnd As Long) As Long
'Find a Windows Entry in the UDT Array if it exists and return the Index
Dim lItem As Long
For lItem = 1 To lLists
If uListBoxes(lItem).hwnd = lHwnd Then
FindHwnd = lItem
Exit For
End If
Next
End Function
Private Function SubClassedList(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tItem As DRAWITEMSTRUCT
Dim sBuff As String * 255
Dim lFound As Long
Dim sCols As String
Dim lLen As Long
Select Case Msg
'If we receive our User Defined Message for setting the Column Widths of a Listbox...
Case UD_SETLISTCOLS
'Retreive the Comma Delimited List of Columns Widths passed in the "lParam" parameters of the Message
lLen = lstrlen(lParam)
sCols = Space(lLen)
Call lstrcpy(ByVal sCols, ByVal lParam)
'See if this Listbox has been logged already...
lFound = FindHwnd(wParam)
If lFound Then
'If it has, update it's "Columns" Extended Property
uListBoxes(lFound).Columns = sCols
Else
'If not, add it and set its Extended Properties
lLists = lLists + 1
ReDim Preserve uListBoxes(lLists)
uListBoxes(lLists).hwnd = wParam
uListBoxes(lLists).Columns = sCols
End If
'If we receive our user Defined Message for Setting Checkboxes On/Off...
Case UD_USECHECKBOXES
'If this Listbox has been logged, update it's extended property, else add it
lFound = FindHwnd(wParam)
If lFound Then
uListBoxes(lFound).Checkboxes = lParam
Else
lLists = lLists + 1
ReDim Preserve uListBoxes(lLists)
uListBoxes(lLists).hwnd = wParam
uListBoxes(lLists).Checkboxes = lParam
End If
'Draw the Listbox/Listbox Item
Case WM_DRAWITEM
'This Message only passes the Address of the DrawItem Structure, so we need to
'use the CopyMemory API to Get a Copy into the Variable we setup:
Call CopyMemory(tItem, ByVal lParam, Len(tItem))
'Make sure we're dealing with a Listbox
If tItem.CtlType = ODT_LISTBOX Then
ReDrawListItem tItem.hwndItem, tItem.hdc, tItem.itemID, tItem.itemState
'Don't Need to Pass a Value on as we've just handled the Message ourselves
SubClassedList = 0
Exit Function
End If
End Select
SubClassedList = CallWindowProc(lPrevWndProc, hwnd, Msg, wParam, lParam)
End Function
Private Sub ReDrawListItem(ByVal hwnd As Long, ByVal lItemDC As Long, ByVal Index As Long, ByVal lItemState As Long)
Dim lFound As Long
Dim sBuff As String * 255
Dim tItemRect As RECT
Dim lItemData As Long
Dim sItemText As String
Dim lBack As Long
Dim sValues As Variant
Dim tRect As RECT
Dim vCols As Variant
Dim lCol As Long
Dim lText As Long
Dim tORIG As RECT
Dim lImage As Long
Dim lDC As Long
Dim lColor As Long
Dim lBackColor As Long
Call SendMessage(hwnd, LB_GETITEMRECT, Index, tItemRect)
Call SendMessage(hwnd, LB_GETITEMRECT, Index, tORIG)
lItemData = SendMessage(hwnd, LB_GETITEMDATA, Index, ByVal 0&)
Call SendMessage(hwnd, LB_GETTEXT, Index, ByVal sBuff)
sItemText = Left(sBuff, InStr(sBuff, Chr(0)) - 1)
lFound = FindHwnd(hwnd)
If (lItemState And ODS_FOCUS) Then
'Item has Focus, Highlight it, I'm using the Default Focus
'Colors for this example.
lBack = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
Call FillRect(lItemDC, tItemRect, lBack)
Call SetBkColor(lItemDC, GetSysColor(COLOR_HIGHLIGHT))
Call SetTextColor(lItemDC, GetSysColor(COLOR_HIGHLIGHTTEXT))
Else
'Item Doesn't Have Focus
'Create a Brush using the Color of the Listbox Window
lBack = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
'Paint the Item Area
Call FillRect(lItemDC, tItemRect, lBack)
'Set the Text Colors, using the ForeColor specified in the ItemData of the Item
Call SetBkColor(lItemDC, GetSysColor(COLOR_WINDOW))
Call SetTextColor(lItemDC, lItemData)
End If
If lFound Then
'If the Listbox is using Checkboxes, draw them...
If uListBoxes(lFound).Checkboxes Then
lBack = CreateSolidBrush(RGB(255, 255, 255))
tRect.Left = tItemRect.Left + 1
tRect.Top = tItemRect.Top + 1
tRect.Bottom = tItemRect.Bottom - 1
tRect.Right = tItemRect.Left + 16
Call FillRect(lItemDC, tRect, lBack)
Call DeleteObject(lBack)
lImage = LoadBitmap(0&, ByVal OBM_CHECKBOXES)
lBack = SelectObject(lItemDC, lImage)
lDC = CreateCompatibleDC(lItemDC)
Call SelectObject(lDC, lImage)
BitBlt lItemDC, tItemRect.Left + 1, tItemRect.Top + 1, 12, 12, lDC, 0, 0, SRCCOPY
Call DeleteDC(lDC)
Call SelectObject(lItemDC, lBack)
Call DeleteObject(lImage)
'If the Item is Checked (Selected), Draw the check mark...
If (lItemState And ODS_SELECTED) Then
lColor = SetTextColor(lItemDC, GetSysColor(COLOR_WINDOWTEXT))
lBackColor = SetBkColor(lItemDC, GetSysColor(COLOR_WINDOW))
lImage = LoadBitmap(0&, ByVal OBM_CHECK)
lBack = SelectObject(lItemDC, lImage)
lDC = CreateCompatibleDC(lItemDC)
Call SelectObject(lDC, lImage)
BitBlt lItemDC, tItemRect.Left + 2, tItemRect.Top + 1, 12, 12, lDC, 0, 0, SRCAND
Call DeleteDC(lDC)
Call SelectObject(lItemDC, lBack)
Call DeleteObject(lImage)
Call SetTextColor(lItemDC, lColor)
Call SetBkColor(lItemDC, lBackColor)
End If
tItemRect.Left = tItemRect.Left + 18
End If
'Display the Item Text
'Split the List Items Text into it's Column Values
sValues = Split(sItemText, Chr(9))
'Split the column Width String into the Column Width Values
vCols = Split(uListBoxes(lFound).Columns, ",")
'Output the 1st Item
sItemText = sValues(0)
TextOut lItemDC, tItemRect.Left, tItemRect.Top, ByVal sItemText, Len(sItemText)
'Cycle through any remaining Column Width that have been set
For lCol = 0 To UBound(vCols)
If (lCol + 1) <= UBound(sValues) Then
sItemText = sValues(lCol + 1)
Else
sItemText = Space(255)
End If
tItemRect.Left = tItemRect.Left + Val(vCols(lCol))
TextOut lItemDC, tItemRect.Left, tItemRect.Top, ByVal sItemText, Len(sItemText)
Next
'If there's still column Values and now more columns, append the values to the last Column Added
If (lCol + 1) <= UBound(sValues) Then
For lText = (lCol + 1) To UBound(sValues)
sItemText = sItemText & sValues(lText)
Next
TextOut lItemDC, tItemRect.Left, tItemRect.Top, ByVal sItemText, Len(sItemText)
End If
Else
'Standard Listbox, just output the Items Text
TextOut lItemDC, tItemRect.Left, tItemRect.Top, ByVal sItemText, Len(sItemText)
End If
'If the item is selected (has focus) draw that funky Focus Rectange around the Item
If (lItemState And ODS_FOCUS) Then DrawFocusRect lItemDC, tORIG
Call DeleteObject(lBack)
End Sub
Public Sub SubLists(ByVal hwnd As Long)
lPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassedList)
End Sub
Public Sub RemoveSubLists(ByVal hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWndProc)
End Sub
I originally created this code for making a Listbox Multi-colored so I've left that functionality in too..Code:Private Sub Form_Load()
Dim lIndex As Long
Randomize Timer
For lIndex = 1 To 10
'Add Items with 4 columns of data
List1.AddItem "Row: " & lIndex & Chr(9) & "Column2" & Chr(9) & "Column3" & Chr(9) & "Column4"
List1.itemData(List1.NewIndex) = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
'Subclass the "Form", to Capture the Listbox Notification Messages
SubLists hwnd
'Set the columns Widths for the Listbox (The Last Column needn't be set)
'Set a Column width to Zero to hide it
SendMessage hwnd, UD_SETLISTCOLS, List1.hwnd, ByVal "50,50,50"
'Tell the Listbox to use Checkboxes
SendMessage hwnd, UD_USECHECKBOXES, List1.hwnd, ByVal True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Release the SubClassing, Very Import to Prevent Crashing!
RemoveSubLists hwnd
End Sub
To Set the column widths for a Listbox use the UD_SETLISTCOLS Message, i.e.This sets 3 columns each of whom are 50 pixels wide.Code:SendMessage hwnd, UD_SETLISTCOLS, List1.hwnd, ByVal "50,50,50"
To Activate Checkboxes (as the Listbox property Style to be alwasy set to 1), use the UD_USECHECKBOXES message and pass True to Activate them and False to remove them.
To Set an Items color, assign the color value to the ItemData property.
Like I said in the Code, this is a work in progress, just something I've been fiddling with, so it can be streamlined to your specific needs. I also used some VB6 Only functions, like Split, so if you have an earlier version you'll need to write substitue functions (see other posts).
I appreciate your help Aaron. That was alot o code to share. Thanks again.