工程中有两个窗体form1 和 form2.前者是悬浮窗体,后者是个带frame框架和滚动条的窗体,按下面各组代码运行结果在form2窗体中用鼠标滚轮无法正常操作滚动条.
说明:原来的模块是面向form1设计的,现在改对form2窗体,(偶只将form1改为form2,其它的代码都没改,不知问题是否出在这里)
请哪位高手指点一下,问题出在那里?
代码如下:
模块中代码:(原是对form1设置的,现仅将代码中所有form1改为form2)
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 Long
Declare Function SetWindowLong _
Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare 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 Long
Public Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As Long
Global lpPrevWndProc As Long
Public 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 > Form2.VScroll1.max Then
WHEEL_SCROLL_LINES = Form2.VScroll1.max
End If
End Sub
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function 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 Form2.VScroll1.Value <= Form2.VScroll1.max - 100 Then
Form2.VScroll1.Value = Form2.VScroll1.Value + 100
Else
Form2.VScroll1.Value = Form2.VScroll1.max
End If
ElseIf wParam = 7864320 Then
If Form2.VScroll1.Value >= 100 Then
Form2.VScroll1.Value = Form2.VScroll1.Value - 100
Else
Form2.VScroll1.Value = 0
End If
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function
Public Function HIWORD(LongIn As Long) As Integer
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function
Public Function LOWORD(LongIn As Long) As Integer
LOWORD = LongIn And &HFFFF&
End Function
窗体form1中:(QQ式悬浮窗体,隐藏在屏幕上方,窗体内只有多个按钮控件)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty 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 Long
Private 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
Const HWND_TOPMOST = -1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Is_Move_B As Boolean
Private Is_Movestar_B As Boolean
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long
Private max As Long
Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 10745
Form1.Width = 10770
Load Form2
Form2.Show
End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 2200: Form1.Height = max '弹出窗体高度调整
Form1.Top = 0
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
Private Sub Form_Paint()
If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Form1.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub
Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 30 Then
Form1.BackColor = vbBlue
Form1.Height = max
If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
Screen.MousePointer = 15
Is_Move_B = True
Else
Screen.MousePointer = 0
Is_Move_B = False
End If
Else
If Not Is_Movestar_B Then
Form1.Height = 30
End If
End If
End Sub
在form2窗体中:(内有frame1框架,滚动条可由鼠标滚轮控制)
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 Form_Unload(Cancel As Integer)
UnHook Me.hWnd
End Sub
Private Sub HScroll1_Change()
Frame1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
Frame1.Top = -VScroll1.Value
