Multicolumns ComboBox

[trasher]

I want to make a multicolumns comboBox with columns headings...
How can I add headings to this ???

Make it with rocker style \w/

[michi]

Hi,
You can hook the combo box to a listview. Try this sample:

'In a module
=====
Option Explicit


Public defWinProc As Long

Public Const GWL_WNDPROC As Long = -4
Private Const CBN_DROPDOWN As Long = 7
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_KEYDOWN As Long = &H100
Private Const VK_F4 As Long = &H73

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 SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Public Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long


Public Sub Unhook(hwnd As Long)

If defWinProc <> 0 Then

Call SetWindowLong(hwnd, _
GWL_WNDPROC, _
defWinProc)
defWinProc = 0
End If

End Sub


Public Sub Hook(hwnd As Long)

'Don't hook twice or you will
'be unable to unhook it.
If defWinProc = 0 Then

defWinProc = SetWindowLong(hwnd, _
GWL_WNDPROC, _
AddressOf WindowProc)

End If

End Sub


Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

'only if the window is the combo box...
If hwnd = Form1.Combo1.hwnd Then

Select Case uMsg

Case CBN_DROPDOWN 'the list box of a combo
'box is about to be made visible.

'return 1 to indicate we ate the message
WindowProc = 1

Case WM_KEYDOWN 'prevent the F4 key from showing
'the combo's list

If wParam = VK_F4 Then

'set up the parameters as though a
'mouse click occurred on the combo,
'and call this routine again
Call WindowProc(hwnd, WM_LBUTTONDOWN, 1, 1000)

Else

'there's nothing to do keyboard-wise
'with the combo, so return 1 to
'indicate we ate the message
WindowProc = 1

End If

Case WM_LBUTTONDOWN 'process mouse clicks

'if the listview is hidden, position and show it
If Form1.ListView1.Visible = False Then

With Form1
.ListView1.Left = .Combo1.Left
.ListView1.Width = .Combo1.Width
.ListView1.Top = .Combo1.Top + .Combo1.Height + 1
.ListView1.Visible = True
.ListView1.SetFocus
End With

Else

'the listview must be visible, so hide it
Form1.ListView1.Visible = False
End If

'return 1 to indicate we processed the message
WindowProc = 1

Case Else

'call the default window handler
WindowProc = CallWindowProc(defWinProc, _
hwnd, _
uMsg, _
wParam, _
lParam)

End Select

End If 'If hwnd = Form1.Combo1.hwnd

End Function

====

'In a form, add a combo box, a listview and three command buttons

=====
Option Explicit

Private bKeepOpen As Boolean

Private Sub Form_Load()

Dim c As Long
Dim chd As ColumnHeader
Dim itmx As ListItem

'Add some dummy data to the listview and hide
With ListView1

Set chd = .ColumnHeaders.Add(, , "Name", 1000)
Set chd = .ColumnHeaders.Add(, , "Col 2", 1000)
Set chd = .ColumnHeaders.Add(, , "Col 3", 1000)
Set chd = .ColumnHeaders.Add(, , "Col 4", 600)

For c = 1 To 15
Set itmx = .ListItems.Add(, , Screen.Fonts(c))
itmx.SubItems(1) = "screen"
itmx.SubItems(2) = "font"
itmx.SubItems(3) = c
Next

.View = lvwReport
.FullRowSelect = True 'vb6 only
.BorderStyle = ccNone
.Visible = False

End With

'set inital state of command buttons
Command1.Caption = "hook combo"
Command2.Caption = "unhook combo"
Command3.Caption = "unhook && end"
Command1.Enabled = True
Command2.Enabled = False
End Sub


Private Sub Command1_Click()

If defWinProc = 0 Then
Hook Combo1.hwnd
Command1.Enabled = False
Command2.Enabled = True
End If

End Sub


Private Sub Command2_Click()

'unhook the combo
If defWinProc <> 0 Then
Unhook Combo1.hwnd
defWinProc = 0
Command1.Enabled = True
Command2.Enabled = False
End If

End Sub


Private Sub Command3_Click()

Unload Me

End Sub


Private Sub Form_Unload(Cancel As Integer)

If defWinProc <> 0 Then Unhook Combo1.hwnd

End Sub


Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)

'set flag to allow arrow and enter
'keys to simulate behaviour of normal
'combo
bKeepOpen = True

End Sub


Private Sub List1_KeyPress(KeyAscii As Integer)

'set flag to allow arrow and enter
'keys to simulate behaviour of normal
'combo
If KeyAscii = vbKeyReturn Then

'simulate selecting item with enter
bKeepOpen = False
Call ListView1_Click
Else

'alpha or arrow keys being used,
'so keep open
bKeepOpen = True

End If

End Sub


Private Sub ListView1_Click()

Dim itmx As ListItem

If ListView1.ListItems.Count > 0 Then

Set itmx = ListView1.SelectedItem

'For a style 0 combo, you can not assign
'to the Text property from within the click
'event, so the selected item must be 'added'
'as the only combo item, and selected using
'its listindex property.
'
'For a style 2 combo, the text property
'can't be set unless there is an exact
'match to a list item, so again we fake it
'by adding the selection to the combo and
'selecting it.
'
'Finally, since the tabs can't be used
'in the combo's edit window, as it doesn't
'support tabstops either, on selection we'll
'display the main listview item
With Combo1
.Clear
.AddItem itmx.Text
.ListIndex = 0
End With

End If

If bKeepOpen = False Then
ListView1.Visible = False
Combo1.SetFocus
End If

End Sub
=====

Regards,

Michi

[John G Duffy]

There is a Component called "Microsoft Forms 2.0 Object Library" that contains a multi-column ComboBox complete with headings. THere is, however, almost no documentation on how to use it.
Go to Project/Components to load it.

John G

[trasher]

Thanks!
Your code seems to work perfectly !

Make it with rocker style \w/

[sleski]

This works great, except for one thing. I placed this code into an Activex Control project in VB6. I placed the ListBox, Combo, and Buttons on the active X User Control. The drop-down portion of the "unhooked" combo box can extend beyond the dimensions of the control and over-lays any other controls on a containing form. Using this code, the ListBox gets cropped at the bottom boundary of the UserControl area.

Does anyone know how to get the ListBox to drop down below the bottom boundary of my custom UserControl?