怎么能用鼠标拖动改变ListBox控件的高度？

Question

我用下面的代码可以实现鼠标拖动改变宽度，但是不知道为什么改变不了高度，我向下拉的时候反而会使高度变的更小，向上拉的时候正常。
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用户可以用鼠标重新调整车辆列表的大小
   Dim x1, y1 As Integer
   y1 = List1.height
   x1 = List1.width
  ' Text1.Text = X
   'Text2.Text = Y
   
   'ccDefault 0 （缺省）由对象决定的形状。
   'CcArrow 1 箭头。
   ' CcCross 2 十字线（十字线指针）。
   'CcIbeam 3 型标。
   'CcIcon 4 图标（正方形里的小方块）。
   'CcSize 5 尺寸线（分指东南西北的四针箭头）。
   'ccSizeNESW 6 右上-左下尺寸线（分指东北和西南双箭头）。
   'ccSizeNS 7 垂直尺寸线（分指南北方向的双箭头）。
   'ccSizeNWSE 8 左上-右下尺寸线。
   'ccSizeEW 9 水平尺寸线（分指东西方向的箭头）。
   'ccUpArrow 10 向上箭头。
   'ccHourglass 11 沙漏（等待）。
   'ccNoDrop 12 不允许放下。
   'ccArrowHourglass 13 箭头和沙漏。
   'cc ArrowQuestion 14 箭头和问号。
   'ccSizeAll 15 四向尺寸线。
   'ccCustom 99 MouseIcon 属性指定的自定义图标。
   
   '改变高度和宽度
   If Abs(X - x1) < 100 And Abs(Y - y1) < 100 Then
     List1.MousePointer = ccSizeNWSE
     If Button = 1 Then
      List1.height = Y
      List1.width = X
     End If
   ElseIf Abs(X - x1) < 100 Then‘改变宽度
     List1.MousePointer = ccSizeEW
     If Button = 1 Then
      
      List1.width = X
     End If
   ElseIf Abs(Y - y1) < 100 Then’改变高度
     List1.MousePointer = ccSizeNS
     If Button = 1 Then
       List1.height = Y
    
     End If
   Else
      List1.MousePointer = ccArrow
   End If
 
End Sub

Answer 1

這樣調啊,我沒有試過,不過要知道List是按它的字形大小Font.size來決定它的一行的高度的,一次要麼加一行或幾行

Answer 2

Option Explicit
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_DRAWFRAME = &H20Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function 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) As LongPrivate Sub ControlSize(ControlName As Control, SetTrue As Boolean)
    Dim dwStyle As Long
    dwStyle = GetWindowLong(ControlName.hwnd, GWL_STYLE)
    If SetTrue Then
      dwStyle = dwStyle Or WS_THICKFRAME
    Else
      dwStyle = dwStyle - WS_THICKFRAME
    End If
    dwStyle = SetWindowLong(ControlName.hwnd, GWL_STYLE, dwStyle)
    SetWindowPos ControlName.hwnd, ControlName.Parent.hwnd, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
End SubPrivate Sub Form_Load()
    
    Dim i As Long
    For i = 1 To 100
        Me.List1.AddItem "test " + CStr(i)
        ControlSize Me.List1, True
   Next
End Sub

Answer 3

Option ExplicitPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function 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) As LongPrivate Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000Sub ResizeControl(ctlName As Control, frmname As Form)
  Dim NewStyle As Long
  '获取控件当前的风格
  NewStyle = GetWindowLong(ctlName.hwnd, GWL_STYLE)
  NewStyle = NewStyle Or WS_THICKFRAME
  '修改控件当前的风格
  NewStyle = SetWindowLong(ctlName.hwnd, GWL_STYLE, NewStyle)
  SetWindowPos ctlName.hwnd, frmname.hwnd, 0, 0, 0, 0, SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
End SubPrivate Sub Form_Load()
  ResizeControl List1, Form1
End Sub

Answer 4

rainstormmaster(rainstormmaster) 的方法不错。
不过我还是不明白在VB为什么不能直接实现，我觉得思路好象也没有错呀