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
Const LB_SETITEMHEIGHT = &H1A0
Const CB_SETITEMHEIGHT = &H153
' Set the height in pixels of each entry in a ListBox or ComboBox control
Sub SetListItemHeight(ctrl As Control, ByVal newHeight As Long)
Dim uMsg As Long
If TypeOf ctrl Is ListBox Then
uMsg = LB_SETITEMHEIGHT
ElseIf TypeOf ctrl Is ComboBox Then
uMsg = CB_SETITEMHEIGHT
Else
Exit Sub
End If
' (only the low-order word of lParam can be used.)
SendMessage ctrl.hwnd, uMsg, 0, Byval CLng(newHeight And &HFFFF&)
' It is necessary to manually refresh the control.
ctrl.Refresh
End Sub
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
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const LB_SETITEMHEIGHT = &H1A0
Dim lstH As Long
Private Sub Command1_Click()
lstH = SendMessage(List1.hwnd, LB_GETITEMHEIGHT, 0, ByVal 0&)
MsgBox "列表框条目原来的高度是:" & lstH, , ""
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
End Sub
Private Sub Command2_Click()
Dim temp As Single
Dim lstHtemp As Long
temp = InputBox("请输入列表框条目的新的高度(原来高度的倍数)")
lstHtemp = CLng(temp * lstH)
SendMessage List1.hwnd, LB_SETITEMHEIGHT, 0, ByVal lstHtemp
List1.Refresh
MsgBox "列表框条目的新高度势:" & lstHtemp, , ""
End Sub
Private Sub Command3_Click()
SendMessage List1.hwnd, LB_SETITEMHEIGHT, 0, ByVal lstH
List1.Refresh
End Sub