I heard there is an API that u could call to make double columns in a combobox. Can anyone tell where is that API?
Printable View
I heard there is an API that u could call to make double columns in a combobox. Can anyone tell where is that API?
You can on a listbox, I'm not sure about a combo. You can use SendMessage and set a tab length which makes it appear to have columns. Then when you add something that you want to go to the next column just use tab where the column should be.
Here is a sampel project.
I agree with Edneeis and Stanich. You can't do it even with the most complex of APIs. I spend about three hours ownerdrawing and subclassing comboboxes and the farthest i've gotten is something that LOOKS like it has 2 cols but really behaves like half of one row is for the Col1 item and half of Row2 is for the 2nd ite, (at this point, James Stanich probably already figured what I am trying to do ;)).
You could add a listbox below the combobox and hide it and use IT as the selection structure.
BTW, just in case if you're wondering, here's my currently unfinished code. Maybe someone else could use this to finish what I failed to do?
VB Code:
Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public 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 Public Type MEASUREITEMSTRUCT CtlType As Long CtlID As Long itemID As Long itemWidth As Long itemHeight As Long itemData As Long End Type Public Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName(1 To 32) As Byte End Type Public Type TEXTMETRIC tmHeight As Long tmAscent As Long tmDescent As Long tmInternalLeading As Long tmExternalLeading As Long tmAveCharWidth As Long tmMaxCharWidth As Long tmWeight As Long tmOverhang As Long tmDigitizedAspectX As Long tmDigitizedAspectY As Long tmFirstChar As Byte tmLastChar As Byte tmDefaultChar As Byte tmBreakChar As Byte tmItalic As Byte tmUnderlined As Byte tmStruckOut As Byte tmPitchAndFamily As Byte tmCharSet As Byte End Type Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public 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 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 Public Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Public Declare Function SendMessageLng Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long Public Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long '----------------------------------------------- 'TextParam Public Const DT_SINGLELINE = &H20 '----------------------------------------------- 'Combobox Styles Public Const CBS_OWNERDRAWVARIABLE = &H20& Public Const CBS_HASSTRINGS = &H200& Public Const CBS_AUTOHSCROLL = &H40& Public Const CBS_DROPDOWNLIST = &H3& '------------------------------------------ 'Window Styles Public Const WS_CHILD = &H40000000 Public Const WS_CLIPCHILDREN = &H2000000 Public Const WS_CLIPSIBLINGS = &H4000000 Public Const WS_OVERLAPPED = &H0& Public Const WS_VISIBLE = &H10000000 Public Const WS_VSCROLL = &H200000 '-------------------------------------------- 'MISC. Public Const GCL_HBRBACKGROUND = (-10) Public Const WM_CTLCOLORLISTBOX = &H134 Public Const WM_DESTROY = &H2 Public Const WM_DRAWITEM = &H2B Public Const WM_MEASUREITEM = &H2C Public Const WM_PAINT = &HF Public Const GWL_STYLE = (-16) Public Const ODS_FOCUS = &H10 Public Const ODT_COMBOBOX = 3 Public Const OBJ_FONT = 6 Public Const CB_ADDSTRING = &H143 Public Const CB_GETITEMDATA = &H150 Public Const CB_GETITEMHEIGHT = &H154 Public Const CB_GETLBTEXT = &H148 Public Const CB_GETLBTEXTLEN = &H149 Public Const CB_SETITEMDATA = &H151 Public hwndList As Long Public hdcList As Long Public wtbrush As Long Public procOld As Long Public ListHeight As Long Public ListWidth As Long Dim hfont As Long Public bolPlace As Boolean Public Function WndProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim tItem As DRAWITEMSTRUCT Dim mItem As MEASUREITEMSTRUCT Dim tmetric As TEXTMETRIC Dim sBuff As String * 255 Dim sItem As String Dim lBack As Long Dim icback As Long Dim rsct As RECT Dim temp As Long, pictop As Long Select Case iMsg Case WM_MEASUREITEM Call CopyMemory(mItem, ByVal lParam, Len(mItem)) 'If mItem.CtlType = ODT_COMBOBOX Then Call SendMessage(hwndList, CB_GETLBTEXT, mItem.itemID, ByVal sBuff) sItem = Left(sBuff, InStr(sBuff, Chr(0)) - 1) 'mItem.itemHeight = 56 mItem.itemWidth = mItem.itemWidth GetTextMetrics GetDC(hwndList), tmetric temp = tmetric.tmHeight If mItem.itemID = -1 Then mItem.itemHeight = temp Else mItem.itemHeight = temp / 2 Call CopyMemory(ByVal lParam, mItem, Len(mItem)) WndProc = True Exit Function 'End If Case WM_DRAWITEM Call CopyMemory(tItem, ByVal lParam, Len(tItem)) 'If tItem.CtlType = ODT_COMBOBOX Then Call SendMessage(tItem.hwndItem, CB_GETLBTEXT, tItem.itemID, ByVal sBuff) sItem = Left(sBuff, InStr(sBuff, Chr(0)) - 1) GetTextMetrics GetDC(hwndList), tmetric temp = tmetric.tmHeight 'If tItem.itemID = -1 Then If tItem.itemState = 4096 Or tItem.itemState = 4113 Then ElseIf tItem.itemData = 1 Then tItem.rcItem.Left = (tItem.rcItem.Left + tItem.rcItem.Right) / 2 tItem.rcItem.Top = tItem.rcItem.Top * 2 - tItem.rcItem.Bottom tItem.rcItem.Bottom = tItem.rcItem.Top + temp 'tItem.rcItem.Top = 0 Else tItem.rcItem.Right = (tItem.rcItem.Left + tItem.rcItem.Right) / 2 tItem.rcItem.Bottom = tItem.rcItem.Bottom * 2 - tItem.rcItem.Top End If If (tItem.itemState And ODS_FOCUS) Then icback = GetSysColor(&HD) lBack = CreateSolidBrush(icback) Call FillRect(tItem.hdc, tItem.rcItem, lBack) Call SetBkColor(tItem.hdc, icback) icback = GetSysColor(&HE) Call SetTextColor(tItem.hdc, icback) DrawText tItem.hdc, ByVal sItem, Len(sItem), tItem.rcItem, &H20 DrawFocusRect tItem.hdc, tItem.rcItem Else icback = GetSysColor(&H5) lBack = CreateSolidBrush(icback) Call FillRect(tItem.hdc, tItem.rcItem, lBack) Call SetBkColor(tItem.hdc, icback) icback = GetSysColor(8) Call SetTextColor(tItem.hdc, icback) DrawText tItem.hdc, ByVal sItem, Len(sItem), tItem.rcItem, &H20 End If Call DeleteObject(lBack) WndProc = True Exit Function 'End If End Select WndProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam) End Function Public Sub StrCpy(ByteArr() As Byte, ByVal Text As String) Dim i As Long For i = 1 To Len(Text) If (i + LBound(ByteArr) - 1) < UBound(ByteArr) Then ByteArr(i + LBound(ByteArr) - 1) = Asc(Mid$(Text, i, 1)) Next End Sub Public Function StrToByte(ByVal Text As String) As Variant Dim ByteArr() As Byte ReDim ByteArr(Len(Text)) Dim i As Long For i = 1 To Len(Text) If (i + LBound(ByteArr) - 1) < UBound(ByteArr) Then ByteArr(i + LBound(ByteArr) - 1) = Asc(Mid$(Text, i, 1)) Next StrToByte = ByteArr End Function Public Function Syscolor(Color As OLE_COLOR) As Long Dim icback As Long If (Color And &HFF000000) = &H80000000 Then icback = GetSysColor(Color - &H80000000) Else icback = BGColor Syscolor = icback End Function
That was the module code. here's the form code:
VB Code:
Private Sub Form_Load() Dim Lgfnt As LOGFONT Dim tmetric As TEXTMETRIC procOld = SetWindowLong(Me.hwnd, -4, AddressOf WndProc) GetTextMetrics Me.hdc, tmetric temp = tmetric.tmHeight hwndList = CreateWindowEx(&H0, "combobox", "", WS_VISIBLE Or WS_CHILD Or CBS_AUTOHSCROLL Or CBS_HASSTRINGS Or CBS_OWNERDRAWVARIABLE Or CBS_DROPDOWNLIST, 2, 2, 250, 250, Me.hwnd, 1, App.hInstance, &H0) Lgfnt.lfHeight = temp '-1 * m_ListItems.Item(mItem.itemData).Font.Size Or WS_MAXIMIZEBOX Or WS_OVERLAPPED Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Lgfnt.lfWidth = 0 Lgfnt.lfEscapement = 0 Lgfnt.lfOrientation = 0 Lgfnt.lfWeight = IIf(Me.FontBold, 700, 0) Lgfnt.lfItalic = Abs(Me.FontItalic) Lgfnt.lfUnderline = Abs(Me.FontUnderline) Lgfnt.lfStrikeOut = Abs(Me.FontStrikethru) Lgfnt.lfCharSet = Me.Font.Charset Lgfnt.lfOutPrecision = 0 Lgfnt.lfClipPrecision = 0 Lgfnt.lfQuality = 0 Lgfnt.lfPitchAndFamily = 0 StrCpy Lgfnt.lfFaceName(), Me.FontName hfont = CreateFontIndirect(Lgfnt) hfont = SelectObject(GetDC(hwndList), hfont) AddItem "Hello" AddItem "BYBY" AddItem "CRASH?" AddItem "CRASH?2" End Sub Private Sub Form_Unload(Cancel As Integer) Call SetWindowLong(Me.hwnd, -4, procOld) End Sub Public Function AddItem(Text As String) Dim place As Long place = SendMessageStr(hwndList, CB_ADDSTRING, 0, Text) Call SendMessageLng(hwndList, CB_SETITEMDATA, place, Abs(bolPlace)) bolPlace = Not bolPlace End Function
Micro : I too screwed around with tring to make a control behave in the same manner. But, after days of screwing around with it, I eventually abandoned (besides how may times do you see a combobox with multiple columns anyway?)
This is the best thing I've found for making a multicolumn combo, and it's kind of cheating.
http://www.mvps.org/vbnet/index.html...bolistview.htm
This is what I meant about using the flexgrid (no subclassing required) :D
Morning everyone!Quote:
Originally posted by James Stanich
Micro : I too screwed around with tring to make a control behave in the same manner. But, after days of screwing around with it, I eventually abandoned (besides how may times do you see a combobox with multiple columns anyway?)
Well, first i will try to check the code, second: Here, in the best place of the third rock from the sun (Dominican Republic) u have to use a combobox almost everyday, the problem is that you cannot do it, but people always ask for it.
Third: How can i use a MsFlexGrid like a combobox to have 2 columns?
Couldn't you just write your own in a usercontrol?
Subclass the combo box, when the drop down is called, cancel it and display a listview or something instead?
To make the combo look like the selected item has columns use:
Then just add the same into the listview, which has columns...???VB Code:
strEntry = Left("London" & Space(15),15) strEntry = strEntry & Left("England" & Space(15),15) 'Etc Combo1.AddItem strEntry
Understand what I'm getting at???
Woka
Thanks wokawidget!
I will do it. It is a great idea.
Errr...just realised that Edneeis posted the same thing a suggested, apart from the example it the link above doesn't use the Left comamnd to make the combo appear to have columns...:DQuote:
Originally posted by Edneeis
This is the best thing I've found for making a multicolumn combo, and it's kind of cheating.
http://www.mvps.org/vbnet/index.html...bolistview.htm
Sorry Ed, wasn't stealing your idea, just didn't read it properly...:)
Woka
Well technically its the VB.Net guy's idea so steal away. :>