鼠标滚轮操作窗体的两个问题
下面的代码和模块可以实现鼠标对窗体(非主窗体)大小进行操作,窗内控件比例不变,但会出现下面两个问题:
1,鼠标滚轮只对一个窗体起作用,即只对最后点开的窗体有效,前面点开的窗体鼠标操作就失效了
2,点开窗体后,再点最大化钮,此时使用鼠标滚轮就弹出出错提示. 那位高手能出手改进一下?(可在附件上改)
窗体上代码:
Dim x0, y0 As Long
Sub form_initialize()
x0 = Me.Width
y0 = Me.Height
End Sub
Sub Form_Load()
    Call SetSubClass(Me)
   
    Dim itemx As Object
    For Each itemx In xj1001
      itemx.Tag = itemx.Left & "," & itemx.Top & "," & itemx.Width & "," & itemx.Height
    Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Call UnSubClass
End Sub
Sub form_resize()
Dim itemx As Object
For Each itemx In xj1001
  itemx.Move Split(itemx.Tag, ",")(0) * Me.Width / x0, Split(itemx.Tag, ",")(1) * Me.Width / x0, Split(itemx.Tag, ",")(2) * Me.Width / x0, Split(itemx.Tag, ",")(3) * Me.Width / x0
Next
End Sub
模块上代码:
Option Explicit
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 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
Private Const GWL_WNDPROC = (-4)
Private Const WM_GETTEXT = &HD
Private Const WM_MOUSEWHEEL = &H20A
Dim theForm As Form
Dim PrevWndProc As Long
Public Function SubWndProc(ByVal Hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case MSG         '在这里进行过滤.如果知道其他的消息,也可以在这里过滤.
    Case WM_MOUSEWHEEL
        With theForm
            If wParam > 0 Then
                .Height = .Height + .Height * 0.2
                .Width = .Width + .Width * 0.2
            ElseIf wParam < 0 Then
                .Height = .Height - .Height * 0.2
                .Width = .Width - .Width * 0.2
            End If
        End With
End Select
SubWndProc = CallWindowProc(PrevWndProc, Hwnd, MSG, wParam, lParam)     '其它消息不管
End Function
Public Function SetSubClass(ByVal FormObject As Form)
    Set theForm = FormObject
   
    PrevWndProc = SetWindowLong(theForm.Hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End Function
Public Function UnSubClass()
    SetWindowLong theForm.Hwnd, GWL_WNDPROC, PrevWndProc
End Function