我自已找到原因了,组合框放到框架中就会出错,这是为何??
以下是我的代码,窗体上放一个按钮,一个组合框,一个框架就行了,然后把以下代码复制过去就能试出来,如果组合框不在框架中全都正常,只要把组合框放入到框架中,就会出现我说的情况,组合框立竿见影就不见了。真是怪了,不知如何是好???
????????????????????????
'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 Sub
Private Sub Command1_Click()
Call setcomboheight(Combo1, 600) '设置长度
Call SetComboWidth(Combo1, 200) '设宽度
End Sub
Private Sub Form_Load()
For i = 1 To 550
Combo1.AddItem i
Next
'Call setcomboheight(Combo1, 600)
'Call SetComboWidth(Combo1, 200)
End Sub
Private 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 = &H10
Private 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 Sub
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
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 Long
Public 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