在设计时，组合框如何改变大小呀？[也就是说运行时可以拉长]

Question

在设计时，组合框如何改变大小呀？
在窗体上加上组合框，运行时总是那么大，下拉列表中的项目较多时，就要拖动滚动条，操作者说很不方便。如何变长一些呀？

Answer 1

Option ExplicitPrivate Const CB_GETITEMHEIGHT = &H154
Private Const CB_SHOWDROPDOWN = &H14FPrivate Type POINTAPI
    x As Long
    y As LongEnd TypePrivate Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As LongEnd TypePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) 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 GetParent Lib "user32" (ByVal hwnd As Long) As LongPublic Sub SetCBItemsToDisplay(cbo As ComboBox, ItemsNumber As Long)
Dim ItemHeight As Long
Dim wid As Long
Dim hgt As Long
Dim r As RECT
Dim p As POINTAPI
Dim hParent As Long    ItemHeight = SendMessage(cbo.hwnd, CB_GETITEMHEIGHT, 0&, 0&)
         
    hgt = (ItemsNumber + 2) * ItemHeight
    wid = cbo.Width / Screen.TwipsPerPixelX
   
    GetWindowRect cbo.hwnd, r
    
    p.x = r.Left
    p.y = r.Top
    
    hParent = GetParent(cbo.hwnd)
    
    ScreenToClient hParent, p
    
    MoveWindow cbo.hwnd, p.x, p.y, wid, hgt, False
End SubPrivate Sub Form_Load() '默认8 条
Dim i As Integer
For i = 1 To 50
Combo1.AddItem i
Next
End SubPrivate Sub Command1_Click() '显示所有
SetCBItemsToDisplay Combo1, Combo1.ListCount
End Sub

Answer 2

我自已找到原因了，组合框放到框架中就会出错，这是为何？？
以下是我的代码，窗体上放一个按钮，一个组合框，一个框架就行了，然后把以下代码复制过去就能试出来，如果组合框不在框架中全都正常，只要把组合框放入到框架中，就会出现我说的情况，组合框立竿见影就不见了。真是怪了，不知如何是好？？？
？？？？？？？？？？？？？？？？？？？？？？？？
'ComboBox加长加宽下拉选单
'form code:
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 Long) As Long
Const CB_SETDROPPEDWIDTH = &H160'  设置ComboBox下拉选单长度函数
Public Sub setcomboheight(combobox_obj As ComboBox, newheight As Long)
    Dim oldscalemode As Integer
    If TypeOf combobox_obj.Parent Is Frame Then Exit Sub
    ' 改变ComboBox控件的容器的坐标度量单位为象素
    oldscalemode = combobox_obj.Parent.ScaleMode
    combobox_obj.Parent.ScaleMode = vbPixels
    ' 重新定义ComboBox的尺寸
    MoveWindow combobox_obj.hwnd, combobox_obj.Left, _
    combobox_obj.Top, combobox_obj.Width, newheight, 1
    ' 恢复ComboBox控件的容器的坐标度量单位
    combobox_obj.Parent.ScaleMode = oldscalemode
End Sub'  设置ComboBox下拉选单宽度函数
Public Sub SetComboWidth(combobox_obj As ComboBox, NewWidth As Long)
    '  NewWidth 是宽度，单位是 pixels
    SendMessage combobox_obj.hwnd, CB_SETDROPPEDWIDTH, NewWidth, 0
End SubPrivate Sub Command1_Click()
    Call setcomboheight(Combo1, 600)        '设置长度
    Call SetComboWidth(Combo1, 200)         '设宽度
End SubPrivate Sub Form_Load()    
    For i = 1 To 550
        Combo1.AddItem i
    Next
    'Call setcomboheight(Combo1, 600)
    'Call SetComboWidth(Combo1, 200)
End Sub

Answer 3

Option ExplicitPrivate Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wmsg As Long, ByVal wparam As Long, lParam As Long) As Long
Const CB_SETDROPPEDWIDTH = &H160'  设置ComboBox下拉选单长度函数
Public Sub setcomboheight(combobox_obj As ComboBox, ByVal newheight As Long)
    
    Dim mscale As Single
    Dim RT As RECT
    GetWindowRect combobox_obj.hWnd, RT
    SetWindowPos combobox_obj.hWnd, 1, 0, 0, RT.Right - RT.Left, newheight, SWP_NOMOVE Or SWP_NOZORDER
End Sub'  设置ComboBox下拉选单宽度函数
Public Sub SetComboWidth(combobox_obj As ComboBox, ByVal NewWidth As Long)
    '  NewWidth 是宽度，单位是 pixels
    SendMessage combobox_obj.hWnd, CB_SETDROPPEDWIDTH, NewWidth, ByVal 0&
End SubPrivate Sub Command1_Click()
    Call setcomboheight(Combo1, 300)       '设置长度
    Call SetComboWidth(Combo1, 200)         '设宽度
    
End SubPrivate Sub Form_Load()
   Dim i As Long
    
    For i = 1 To 550
        Combo1.AddItem i
    Next
    
End Sub