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

yuerugou 2006-01-07 10:47:47
在设计时,组合框如何改变大小呀?
在窗体上加上组合框,运行时总是那么大,下拉列表中的项目较多时,就要拖动滚动条,操作者说很不方便。如何变长一些呀?
...全文
373 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
fongzl 2006-03-19
  • 打赏
  • 举报
回复
用在datacombo中好像无效
zhouvill 2006-01-21
  • 打赏
  • 举报
回复
路过
xiaoMONKEY 2006-01-17
  • 打赏
  • 举报
回复
收藏
yuerugou 2006-01-08
  • 打赏
  • 举报
回复
我自已找到原因了,组合框放到框架中就会出错,这是为何??
以下是我的代码,窗体上放一个按钮,一个组合框,一个框架就行了,然后把以下代码复制过去就能试出来,如果组合框不在框架中全都正常,只要把组合框放入到框架中,就会出现我说的情况,组合框立竿见影就不见了。真是怪了,不知如何是好???
????????????????????????
'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
jmwtsy 2006-01-08
  • 打赏
  • 举报
回复
关注
rainstormmaster 2006-01-08
  • 打赏
  • 举报
回复
Option Explicit

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 Sub Command1_Click()
Call setcomboheight(Combo1, 300) '设置长度
Call SetComboWidth(Combo1, 200) '设宽度

End Sub

Private Sub Form_Load()
Dim i As Long

For i = 1 To 550
Combo1.AddItem i
Next

End Sub

yuerugou 2006-01-07
  • 打赏
  • 举报
回复
谢谢您,您的代码很好,就是有一点问题,好象拉长后滚动条没了,如何做到又拉长,又能保持滚动条呢?
northwolves 2006-01-07
  • 打赏
  • 举报
回复
Option Explicit

Private Const CB_GETITEMHEIGHT = &H154
Private Const CB_SHOWDROPDOWN = &H14F

Private Type POINTAPI
x As Long
y As Long

End Type

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

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 Sub



Private Sub Form_Load() '默认8 条
Dim i As Integer
For i = 1 To 50
Combo1.AddItem i
Next
End Sub

Private Sub Command1_Click() '显示所有
SetCBItemsToDisplay Combo1, Combo1.ListCount
End Sub

1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧