| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 501 人关注过本帖, 1 人收藏
标题:求助关于两个picturebox自由缩放的问题
只看楼主 加入收藏
violahwj
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2018-2-24
结帖率:0
  已结贴   问题点数:20  回复次数:2   
求助关于两个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编辑过]

2018-02-24 14:44
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:909
专家分:5237
注 册:2015-8-10
  得分:20 
堆栈溢出的原因,一般是递归调用的次数太多
现在电脑进VB还要启动虚拟机,不方便,楼主从这个角度再研究一下
2018-02-27 17:10
violahwj
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2018-2-24
  得分:0 
回复 2楼 xiangyue0510
但是我当时试过了,如果再添加3、4、5、6图片和对应option,依次对应缩放都没有问题。只要一回调,就出错
2018-02-28 14:55







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.024016 second(s), 8 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved