Visual Basic Subclassing Routines
WM_LBUTTONDOWN: Substitute a Tabbed List for a Combo's Dropdown List
     
Posted:   Friday March 16, 2001
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows 2000
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

VBnet CoolTabs
GetTextExtentPoint32: Right-Align List Box Data
SetWindowLong: Right-Align List Box Data and/or the Scrollbar
SetWindowLong: Right-Align List Contents in a Combo
SendMessage: Align Text Box Contents Using Tabstops

SendMessage: Align List Box Contents Using Tabstops
WM_LBUTTONDOWN: Substitute a Tabbed List for a Combo's Dropdown List
WM_LBUTTONDOWN: Substitute a ListView for a Combo's Dropdown List
     
 Prerequisites
VB5 or VB6.

Creating a tabbed list is a painless procedure when dealing with VB's intrinsic ListBox control. However when using a ComboBox, the ability to format both the list and portions of the control is lost, as is shown in illustration 1.

List boxes have the LBS_USETABSTOPS style bit set, whereas combo box lists do not. And like the list and combo Sorted property (LBS_SORT style bit), LBS_USETABSTOPS can not be applied to a combo's list once the combo has been created.

To overcome this limitation to create a combo display list that shown in illustration 2, this demo shows how to subclass a combo control to trap the display of the combo's normal dropdown list, allowing us to substitute instead a standard list control which provides the needed tabstop ability.

Using subclassing to substituting a list control for the combo's dropdown list is a fairly trivial task. However, in order to provide the user with the feel of a real combo, some additional effort is required. The new list needs to be shown when the user presses F4, the keyboard shortcut for displaying the combo dropdown list. The substituted list must also respond to the keyboard as a combo does ... the arrow keys navigate the list, the alpha or numeric keys jump to list items, and the enter key selects and closes the combo. The code presented incorporates all these features. The only default ComboBox behaviour that the substituted list can not mimic is floating outside the combo's form.

Finally, because the edit portion of the combo does not support tabstops either, a determination must be made as to what text to display in the edit control on selection. The code presented parses the selected list item to display the second "column" data, in this demo the selected font name. Setting the list to display multiple tabbed columns is straightforward using the SendMessage API and LB_SETTABSTOPS message (see the related links above ), and the parsing code in the list click event can be easily modified to  display any "column" in the list.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
      
        'SEE COMMENTS SECTION RE: THIS NOTIFICATION
	'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 list is hidden, position and show it
            If Form1.List1.Visible = False Then
            
               With Form1
                  .List1.Left = .Combo1.Left
                  .List1.Width = .Combo1.Width
                  .List1.Top = .Combo1.Top + .Combo1.Height + 1
                  .List1.Visible = True
                  .List1.SetFocus
               End With
               
            Else
                 
              'the list must be visible, so hide it
               Form1.List1.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
 Form Code
To a form add a combo (Combo1), a list (List1), and three command buttons (Command1, Command2, Command3). Set the Style property of the Combo to Style 2, and add the following code to the form:

Option Explicit
Private bKeepOpen As Boolean

Private Sub Form_Load()

   Dim c As Long
     
  'toss some data into the
  'list and hide it
   With List1
      For c = 1 To 15
         .AddItem "font " & CStr(c) & vbTab & Screen.Fonts(c)
      Next
      .Visible = False
   End With
   
  'and into the combo for comparison
   With Combo1
      For c = 1 To 15
         .AddItem "font " & CStr(c) & vbTab & Screen.Fonts(c)
      Next
   End With

  'set initial 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 List1_Click
   Else
   
     'alpha or arrow keys being used,
     'so keep open
      bKeepOpen = True
      
   End If
      
End Sub


Private Sub List1_Click()

   Dim pos As Long
   Dim tmp As String
   
   If List1.ListCount > -1 Then
            
     'rule of thumb -- if you are going to
     'refer to a property three or more times
     'in a call, its more efficient to cast
     'the property to a variable.
      tmp = List1.List(List1.ListIndex)
      
     '-----------------------------------------
     '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 data from the 'second column'
     'of the selected list item - the font name.
      With Combo1
         .Clear
          
         'extract data to display (in this
         'case the second column data)
          pos = InStr(tmp, vbTab)
         .AddItem Mid$(tmp, pos + 1)
         
         'select the added item
         .ListIndex = 0
      End With
      
   End If
   
  'if the list can close, do so and 
  'set focus to the combo 
   If bKeepOpen = False Then
      List1.Visible = False
      Combo1.SetFocus
   End If
   
End Sub
 Comments
Save the project before running, and use Start with Full Compile to catch any errors that might crash the app when subclassing is enabled. With the app running, look at the data in the combo's normal list -- it will appear as illustration 1 above. Enable the hook, and try using the new list as you would the default combo list.

Note: In my testing code, I had populated the combo's normal list with a few items to see when the windowproc handled the notifications correctly. I found that when subclassed, the code would occasionally allow the display of this intrinsic list even when subclassed - some times instead of the substituted list, and sometimes in addition to it - as long as a subclassed list item had not been selected (clearing the intrinsic list and adding only the selected item to it). To prevent this 'error' from occurring, I added a trap for the CBN_DROPDOWN notification, ate the message, and this worked.

However there is a side effect to trapping this notification. Because it shares the same value as WM_SETFOCUS (&H7), including the trap prevents the user from tabbing between controls on the form when subclassing is enabled. In re-testing this, I've found the duplicate or erroneous display of the intrinsic list does not appear to occur when the intrinsic list is empty or only contains the single item from the previous selection. Therefore, when providing the user with the ability to tab between controls is required, leave the CBN_DROPDOWN code commented out. Thanks go to Forrest Cavalier III for pointing this out.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter