当窗体滚动条设置好后,还需要实现鼠标滚动轮会让窗体页面上下移动,于是引用了下面模块代码;
若窗体数量少,用起来还可以,但窗体数量多(如30个以上),因每增加一个窗体,就要加一组代码,于是
软件启动速度就变得很慢,哪位能指点一下问题所在,有什么改进的方法?或有其它更好的办法?
在模块上的代码:
Option Explicit
Public Type POINTL
    x As Long
    y As Long
End Type
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 LongDeclare Function SetWindowLong _
    Lib "USER32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As LongDeclare Function SystemParametersInfo _
    Lib "USER32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Long, _
        ByVal uParam As Long, _
        lpvParam As Any, _
        ByVal fuWinIni As Long) As Long
    
Declare Function ScreenToClient Lib "USER32" _
(ByVal hWnd As Long, xyPoint As POINTL) As LongPublic Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As Long
      
Global lpPrevWndProc As LongPublic Sub Hook(ByVal hWnd As Long)
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
    If WHEEL_SCROLL_LINES > xj1.VScroll1.Max Then '每增加一个窗体,就要加一组相应的代码
        WHEEL_SCROLL_LINES = xj1.VScroll1.Max
    End If
End SubPublic Sub UnHook(ByVal hWnd As Long)
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End SubFunction WindowProc(ByVal hw As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    Dim pt As POINTL
    Select Case uMsg
        Case WM_MOUSEWHEEL
            If wParam = -7864320 Then
                If xj1.VScroll1.Value <= xj1.VScroll1.Max - 1000 Then  '每增加一个窗体,就要加一组相应的代码                    xj1.VScroll1.Value = xj1.VScroll1.Value + 1000
                Else
                    xj1.VScroll1.Value = xj1.VScroll1.Max
                End If
            ElseIf wParam = 7864320 Then
                If xj1.VScroll1.Value >= 1000 Then  '每增加一个窗体,就要加一组相应的代码                    xj1.VScroll1.Value = xj1.VScroll1.Value - 1000
                Else
                    xj1.VScroll1.Value = 0
                End If
            End If
        Case Else
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End FunctionPublic Function HIWORD(LongIn As Long) As Integer
  HIWORD = (LongIn And &HFFFF0000) \ &H10000
End FunctionPublic Function LOWORD(LongIn As Long) As Integer
      LOWORD = LongIn And &HFFFF&
End Function在窗体上还要加上以下代码:
Private Sub Form_Load()
    Hook Me.hWnd '鼠标滚轮事件用
End Sub
Private Sub Form_Resize()
    If Frame1.Height > Me.Height Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    If Frame1.Width > Me.Width Then
        HScroll1.Visible = True
    Else
        HScroll1.Visible = False
    End If
    HScroll1.Left = 0
    HScroll1.Top = Me.ScaleHeight - HScroll1.Height
    VScroll1.Left = Me.ScaleWidth - VScroll1.Width
    VScroll1.Top = 0
    HScroll1.Width = Me.ScaleWidth
    VScroll1.Height = Me.ScaleHeight
    If VScroll1.Visible = True Then
        If HScroll1.Visible = True Then
           HScroll1.Width = Abs(Me.ScaleWidth - VScroll1.Width)
           VScroll1.Height = Abs(Me.ScaleHeight - HScroll1.Height)
        End If
    End If
    HScroll1.Max = (Frame1.Width - Me.Width) + 3 * VScroll1.Width
    VScroll1.Max = (Frame1.Height - Me.Height) + 3 * HScroll1.Height
    HScroll1.ZOrder
    VScroll1.ZOrder
End Sub
Private Sub HScroll1_Change() '滚动条用
  Frame1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change() '滚动条用
    Frame1.Top = -VScroll1.Value
End Sub