Tabs in Comboboxes

[Christopher Carroll]

In answer to http://www.powerbasic.com/support/pb...ad.php?t=40451

' draw a combobox with tabbed text items

' ----------------------------------------
' documentation
' ----------------------------------------

' Definition:    add %CBS_OWNERDRAWFIXED
'
' SDK:
'    hWndChild = CreateWindowEx( _
'        %WS_EX_CLIENTEDGE, _                               
'        "Combobox", _                                      
'        "", _                                                  
'        %WS_CHILD Or %WS_VISIBLE Or %WS_VSCROLL Or %WS_BORDER Or %WS_TABSTOP Or _
'        %CBS_DROPDOWNLIST Or %CBS_OWNERDRAWFIXED Or %CBS_HASSTRINGS Or %CBS_SORT, _
'        5, 5, _                       
'        140, 120, _                      
'        hWnd, _
'        %IDC_COMBO1, _                       
'        ghInstance, _
'        ByVal %NULL)
'
'
' DDT: 
'    Control Add ComboBox, hDlg, %IDC_COMBO1, , 5, 5, 140, 120, _
'        %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %WS_VSCROLL Or %CBS_DROPDOWNLIST Or _
'        %CBS_SORT Or %CBS_HASSTRINGS Or %CBS_OWNERDRAWFIXED, _
'        %WS_EX_LEFT Or %WS_EX_LTRREADING Or %WS_EX_RIGHTSCROLLBAR


' Callback:
'
' SDK: 
'    Case %WM_DRAWITEM
'        If wParam = %IDC_COMBO1 Then
'            Function = tabcombo_DrawItem(GetDlgItem(hWnd, wParam), wParam, lParam)
'        End If
'
'
' DDT: 
'    Case %WM_DRAWITEM
'        If Cb.wParam = %IDC_COMBO1 Then
'            Function = tabcombo_DrawItem(GetDlgItem(Cb.Hndl, Cb.wParam), Cb.wParam, Cb.lParam)
'        End If


' User-defined tabs:
'    Local lngTabs As Long            ' 0-based count of number of tabs
'    Local plngTabs As Long Ptr       ' pointer to array of tabs
'
'    lngTabs = 2
'    ' allocate memory
'    plngTabs = HeapAlloc(GetProcessHeap(), %HEAP_ZERO_MEMORY, (lngTabs + 1) * 4)
'    ' assign values - in device units
'    If IsTrue plngTabs Then
'        @plngTabs[0] = 0
'        @plngTabs[1] = 120
'        @plngTabs[2] = 240
'    End If
'    ' ...
'    ' define tabs either in %WM_DRAWITEM - local vars, 
'    ' or in %WM_CREATE (SDK) or %WM_INITDIALOG (DDT) - global/static vars
'    If IsTrue plngTabs Then
'         Function = tabcombo_DrawItem(GetDlgItem(hWnd, wParam), wParam, lParam, plngTabs, lngTabs)
'    End If
'    ' ...
'    ' free memory
'    HeapFree GetProcessHeap(), 0, ByVal plngTabs


' ----------------------------------------

Function tabcombo_DrawItem( _
    ByVal hWnd As Dword, _
    ByVal wParam As Dword, _
    ByVal lParam As Long, _
    Optional ByVal vplngTab As Long Ptr, _
    Optional ByVal vlngUBTab As Long _
) As Long
' Purpose:       WM_DRAWITEM procedure for ownerdrawn combobox to draw text separated by tabs
' Parameters:    hWnd - handle of combobox window
'                wParam - control id of combobox
'                lParam - pointer to draw item structure
'                vplngTab - optional pointer to 0-based array of tab positions - in device units 
'                vlngUBTab - optional upper bound of this array (required if vplngTab used)
' Called by:     %WM_DRAWITEM
' Original:      PB Forum, Borje Hagsten, 2004-01-03. Public domain.
'                http://www.powerbasic.com/support/forums/Forum7/HTML/002194.html
' Note:          1. if no vplngTab, tabs are left-aligned using %DT_EXPANDTABS
'                2. if vplngTab, use -ve numbers (e.g. -120, -180, -240) for right-align; +ve for left-align
'                3. if vplngTab, tab stops must be sorted in increasing order
' Returns:       T: successful; F otherwise
    Local lngRtn As Long
    Local lngTabStd As Long                ' T: use left-aligned tabs; F: use array of tab positions
    Local lngXPos As Long
    Local lngYPos As Long
    Local szTxt As Asciiz * 300
    Local lpDis As DRAWITEMSTRUCT Ptr
    Local tm As TEXTMETRIC

    lpDis = lParam
    If @lpDis.itemID = &HFFFFFFFF& Then
        ' empty list
        GoTo tabcombo_DrawItem_Exit
    End If
    Select Case As Long @lpDis.itemAction
        Case %ODA_DRAWENTIRE, %ODA_SELECT
            ' clear background
            If (@lpDis.itemState And %ODS_SELECTED) = 0 Then
                ' not selected
                SetBkColor @lpDis.hDC, GetSysColor(%COLOR_WINDOW)
                SetTextColor @lpDis.hDC, GetSysColor(%COLOR_WINDOWTEXT)
                FillRect @lpDis.hDC, @lpDis.rcItem, GetSysColorBrush(%COLOR_WINDOW)
            Else
                ' selected
                SetBkColor @lpDis.hDC, GetSysColor(%COLOR_HIGHLIGHT)
                SetTextColor @lpDis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)
                FillRect @lpDis.hDC, @lpDis.rcItem, GetSysColorBrush(%COLOR_HIGHLIGHT)
            End If
            ' get text
            SendMessage hWnd, %CB_GETLBTEXT, @lpDis.itemID, VarPtr(szTxt)
            ' test if array of tab-positions is to be used
            lngTabStd = IIf&(vplngTab = 0, %TRUE, %FALSE)
            If IsFalse lngTabStd Then
                lngTabStd = IIf&(vlngUBTab < 0, %TRUE, %FALSE)
            End If
            If lngTabStd Then
                ' draw text with left-aligned tabs
                DrawText @lpDis.hDC, szTxt, Len(szTxt), @lpDis.rcItem, %DT_SINGLELINE Or %DT_LEFT Or %DT_VCENTER Or %DT_EXPANDTABS
                If (@lpDis.itemState And %ODS_SELECTED) Then
                    ' if selected, draw a focus rectangle around the item
                    Call DrawFocusRect(@lpDis.hDC, @lpDis.rcItem)
                End If
            Else
                ' draw text with tab positions taken from array
                ' .. calculate X-pos  (edit part and listbox are different)
                If (@lpDis.itemState And %ODS_COMBOBOXEDIT) Then
                    lngXPos = 6
                    ' if to draw in edit part (%ODS_COMBOBOXEDIT = &H1000)
                Else
                    ' listbox part
                    lngXPos = 3
                End If
                ' .. calculate Y-pos  (vcenter in line)
                GetTextMetrics @lpDis.hDC, tm        ' need character height
                lngYPos = @lpDis.rcItem.nTop + ((@lpDis.rcItem.nBottom - @lpDis.rcItem.nTop) - tm.tmHeight) \ 2
                ' .. set tab positions
                TabbedTextOut @lpDis.hDC, lngXPos, lngYPos, szTxt, Len(szTxt), vlngUBTab + 1, @vplngTab[0], 0
            End If
            ' success
            lngRtn = %TRUE
    End Select
tabcombo_DrawItem_Exit:
    Function = lngRtn
End Function