求助关于两个picturebox自由缩放的问题
对于单个picture自由缩放的代码是这样的：Private Sub option1_click()
Set picturenum = Me.Picture1
ohwnd = picturenum.hwnd
OldWindowProc = GetWindowLong(picturenum.hwnd, GWL_WNDPROC)
Call SetWindowLong(picturenum.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
模块中：
Public 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
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Const GWL_WNDPROC = -4&
Public Const WM_MOUSEWHEEL = &H20A
Public Type POINTAPI
x As Long
y As Long
End Type
Public OldWindowProc As Long
Public ohwnd As Long
Public scrollformname As Form
Public picturenum As PictureBox
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'On Error Resume Next
If Msg = WM_MOUSEWHEEL Then
Dim CurPoint As POINTAPI, hwndUnderCursor As Long
GetCursorPos CurPoint
hwndUnderCursor = WindowFromPoint(CurPoint.x, CurPoint.y)
If hwndUnderCursor = ohwnd Then
If wParam = 7864320 Then
If picturenum.Width < scrollformname.ScaleWidth Then picturenum.Width = picturenum.Width + 300
If picturenum.Height < scrollformname.ScaleHeight Then picturenum.Height = picturenum.Height + 240
ElseIf wParam = -7864320 Then
If picturenum.Width > 300 Then picturenum.Width = picturenum.Width - 300
If picturenum.Height > 240 Then picturenum.Height = picturenum.Height - 240
End If
End If
Else
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End If
End Function
运行是正常的。
然后我想多图片缩放：
Private Sub option1_click()
Set picturenum = Me.Picture1
ohwnd = picturenum.hwnd
OldWindowProc = GetWindowLong(picturenum.hwnd, GWL_WNDPROC)
Call SetWindowLong(picturenum.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Private Sub option2_click()
Set picturenum = Me.Picture2
ohwnd = picturenum.hwnd
OldWindowProc = GetWindowLong(picturenum.hwnd, GWL_WNDPROC)
Call SetWindowLong(picturenum.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
定义了缩放对象的选择。
按按钮1，图片1缩放正常；按按钮2，图片缩放正常。
问题来了，这时候再切换回图片1，就提示堆栈溢出（ NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)）
[此贴子已经被作者于2018-2-24 14:47编辑过]
