CodeItBetter Programming Another VB Programming Blog

'Controls - How to determine the Number of Rows in Combo Box

Option Explicit
 
'Add two Command Buttons, a Combo Box and a Text Box.
'At Run-Time, Insert into the Text Box the number of items the Combo Box will display
'for each scroll, and press Command1 to apply; press Command2 to return to default state.

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
    ByVal nIndex 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 Const GWL_WNDPROC = (-4)
Private lpPrevWndProc As Long
Public lHookedhWnd As Long
Public iListItems As Integer
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const WM_CTLCOLORLISTBOX = &H134
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint 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 Sub Hook()
    lpPrevWndProc = SetWindowLong(lHookedhWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
Public Sub Unhook()
    Dim lRetVal As Long
    lRetVal = SetWindowLong(lHookedhWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
 
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    Select Case uMsg
    Case WM_CTLCOLORLISTBOX
        Dim rc As RECT
        Dim lItemHeight As Long, lListHeight As Long
        Static bIgnore As Boolean
        Const LIST_ITEMS As Long = 20
        If Not bIgnore Then
            With rc
                lItemHeight = SendMessage(lParam, LB_GETITEMHEIGHT, 0, ByVal 0&)
                lListHeight = lItemHeight * iListItems + 2
                Call GetWindowRect(lParam, rc)
                bIgnore = True
                Call MoveWindow(lParam, .Left, .Top, (.Right - .Left), lListHeight, True)
                bIgnore = False
            End With
        End If
    Case Else
    End Select
End Function
 
Private Sub Command1_Click()
    Command1.Enabled = Not (Command1.Enabled)
    Command2.Enabled = Not (Command2.Enabled)
    Hook
End Sub
 
Private Sub Command2_Click()
    Command1.Enabled = Not (Command1.Enabled)
    Command2.Enabled = Not (Command2.Enabled)
    Unhook
End Sub
 
Private Sub Form_Load()
    Command2.Enabled = False
    Text1 = "2"
    Command1.Caption = "Set"
    Command2.Caption = "Release"
    Dim I As Integer
    For I = 1 To 51
        Combo1.AddItem "Num " & I
    Next
    iListItems = 2
    lHookedhWnd = Combo1.hWnd
End Sub
 
Private Sub Text1_Change()
    iListItems = Val(Text1)
    If iListItems < 1 Then
        iListItems = 1
    End If
End Sub