module1.bas

来自「这里有很多很实用的VB编程案例,方便大家学习VB.」· BAS 代码 · 共 45 行

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 setwidth As Long
 Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, ByVal lParam As Long) As Long
 If Msg = WM_CTLCOLORLISTBOX Then
    If Not EverChange Then
       Dim rect5 As RECT
       hwndList = lParam
       EverChange = True
       Call GetWindowRect(hwndList, rect5)
       x = rect5.Left
       y = rect5.Top
       dx = rect5.Right - rect5.Left + setwidth
       dy = rect5.Bottom - rect5.Top
       Call MoveWindow(hwndList, x, y, dx, dy, 1)
    End If
 End If
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
 End Function