module1.bas

来自「很好的教程原代码！」· BAS 代码 · 共 61 行

Attribute VB_Name = "Module1"
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, _
  ByVal nIndex As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
  (ByVal lpPrevWndFunc As Long, _
  ByVal hwnd As Long, _
  ByVal Msg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
   lpRect As RECT) As Long
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

Public Const WM_CTLCOLORLISTBOX = &H134
Public Const GWL_WNDPROC = (-4)

Public preWinProc As Long
Private hwndList As Long
Private EverChange As Boolean
Public AddOnWidth As Long
Public Function wndproc(ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
 '以下程序设定ListBox的大小，再将之送往原来的Window Procedure
 If Msg = WM_CTLCOLORLISTBOX Then
    '处理Mouse Move的动作
    If Not EverChange Then
       Dim rect5 As RECT
       hwndList = lParam
       '当收到WM_CTLCOLORLISTBOX时，lParam是ListBox的hwmd
       EverChange = True
       Call GetWindowRect(hwndList, rect5)
       x = rect5.Left
       y = rect5.Top
       dx = rect5.Right - rect5.Left + AddOnWidth
       dy = rect5.Bottom - rect5.Top
       Call MoveWindow(hwndList, x, y, dx, dy, 1)
    End If
 End If
 '送往原来的Window Procedure
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function