Attribute VB_Name = "modComboHeight"
Option Explicit

Declare Function SendMessageLong Lib _
   "user32" Alias "SendMessageA" _
   (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Declare Function GetWindowRect Lib "user32" _
   (ByVal hwnd As Long, lpRect As RECT) As Long

Declare Function ScreenToClient Lib "user32" _
   (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

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

Public Const CB_GETITEMHEIGHT = &H154

Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Type POINTAPI
   x As Long
   y As Long
End Type

Sub SetComboBoxHeight(FormIn As Form, _
                      ComboBoxIn As ComboBox, _
                      NumberOfItemsTall As Long)
  Dim Point As POINTAPI
  Dim Rectangle As RECT
  Dim ComboBoxWidth As Long
  Dim NewComboBoxHeight As Long
  Dim EditAreaHeight As Long
  Dim OldScaleMode As Long
  Dim ListAreaHeight As Long
  
  Dim cboLeft As Long
  Dim cboTop As Long
  
  cboLeft = ComboBoxIn.Left
  cboTop = ComboBoxIn.Top
  
  ComboBoxWidth = ComboBoxIn.Width \ Screen.TwipsPerPixelX
  ListAreaHeight = SendMessageLong(ComboBoxIn.hwnd, _
                                   CB_GETITEMHEIGHT, 0, 0)
  EditAreaHeight = SendMessageLong(ComboBoxIn.hwnd, _
                                   CB_GETITEMHEIGHT, -1, 0)
  NewComboBoxHeight = ListAreaHeight * NumberOfItemsTall + _
                      2 * EditAreaHeight
  GetWindowRect ComboBoxIn.hwnd, Rectangle
  Point.x = Rectangle.Left
  Point.y = Rectangle.Top
  ScreenToClient FormIn.hwnd, Point
  MoveWindow ComboBoxIn.hwnd, Point.x, Point.y, ComboBoxWidth, NewComboBoxHeight, True
  
  'added this element myself...
  If Not ComboBoxIn.Left = cboLeft Then ComboBoxIn.Left = cboLeft
  If Not ComboBoxIn.Top = cboTop Then ComboBoxIn.Top = cboTop
  
End Sub

