我写了一个简单放大平移的小代码，希望大家完善。

Question

很简单的一个，不使用API，所以不复杂，非常稳定，几乎纯数学运算，100行左右。
就是pic里套一个pic,pic可以增加底图，可以对选择的矩形范围进行放大。平移也很流畅。只是在坐标控制上有点问题，我已经尽量将注释写的很详细了。
现在的问题是，放大操作多次后，显示的就不是选择的想要方法的范围了。
希望大家群策群力一起完善，比如“缩小功能”等功能。
目的是参与而不是有些人所谓的声称有完整的更好的代码，但却保密。
如果大家有兴趣，我就把代码贴上来，大家可以跟贴一段段的讨论、修改，
如果没兴趣也就算了，无所谓。

Answer 1

三个picturebox，最外面的是pic1，pic2放在pic1里面，pic3放到pic2里面
为了方便查看，最好把三个pic设置成不同的背景颜色
Option ExplicitDim oMouseDown As Boolean        '鼠标按下了
Dim lMouseDownX As Single, lMouseDownY As Single    '鼠标按下时的坐标
Dim lOldMouseDownX As Single, lOldMouseDownY As Single
Dim sBigScale As Single         '放大倍数Const MaxPix As Long = 5000     '最大显示的像素
Private Sub Form_Load()
        With pic2
                .Top = 20
                .Left = 20
                .Width = pic1.Width \ 15 - 4 - 40
                .Height = pic1.Height \ 15 - 4 - 40
                
        End With
        
        With pic3
                .Top = 0
                .Left = 0
                .Width = pic2.Width
                .Height = pic2.Height
                '.Visible = False
        End With
        
        Call MoNiDraw
End SubPrivate Sub optSmall_Click()
        MsgBox "尚未制作，请补充"
End SubPrivate Sub pic3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        oMouseDown = True
        lMouseDownX = X
        lMouseDownY = Y
        If optPan Then
        
        ElseIf optBig Then
                pic3.DrawMode = vbNotXorPen ' 10     '必须为10，优点是不但可以使用多种前景色，而且和背景为vbCopyPen的混合很正常
                pic3.DrawStyle = vbDot
        End If
        
        tt8 = lMouseDownX
        tt9 = lMouseDownY
        
End SubPrivate Sub pic3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        oMouseDown = False
        With pic3
                If optPan Then
                
                ElseIf optBig Then
                        '分析放大倍数，计算显示范围
                        If Abs(X - lMouseDownX) >= Abs(Y - lMouseDownY) Then
                                sBigScale = 342 / Abs(X - lMouseDownX)
                        ElseIf Abs(X - lMouseDownX) < Abs(Y - lMouseDownY) Then
                                sBigScale = 163 / Abs(Y - lMouseDownY)
                        End If
                                
                        '获取选择的矩形的中心点坐标
                        Dim lCentX As Long, lCentY As Long
                        If X >= lMouseDownX Then
                                lCentX = (X - lMouseDownX) \ 2 + lMouseDownX
                        Else
                                lCentX = (lMouseDownX - X) \ 2 + X
                        End If
                                
                        If Y >= lMouseDownY Then
                                lCentY = (Y - lMouseDownY) \ 2 + lMouseDownY
                        Else
                                lCentY = (lMouseDownY - Y) \ 2 + Y
                        End If
                        
                        '计算虚线矩形中心点位于pic2的横纵比例
                        Dim sXbili As Single, sYbili As Single
                        sXbili = lCentX / .Width
                        sYbili = lCentY / .Height
                        
                        Dim xx As Long, yy As Long
                        xx = .Width
                        yy = .Height
                        
                        
                        '//放大后的pic3最大的长宽不能超过MaxPix(5000)像素
                        Dim lMaxLimit As Long
                        '宽度限制
                        lMaxLimit = .Width * sBigScale
                        If lMaxLimit > MaxPix Then lMaxLimit = MaxPix
                        .Width = lMaxLimit
                        '高度限制
                        lMaxLimit = .Height * sBigScale
                        If lMaxLimit > MaxPix Then lMaxLimit = MaxPix
                        .Height = lMaxLimit
                        
                        
                        Dim lNewCentX As Long, lNewCentY As Long
                        '计算虚线坐标在放大后的实际像素坐标
                        lNewCentX = sXbili * .Width
                        lNewCentY = sYbili * .Height
                        
                        '将放大后的中心点位置放到pic3的中心位置，这个地方总是不准确导致多次放大后就不知道跑那去了
                        .Left = -(lNewCentX - xx \ 2)
                        .Top = -(lNewCentY - yy \ 2)
                        
                        tt1 = X
                        tt2 = Y
                        
                        tt3 = .Width
                        tt4 = .Height
                        
                        tt5 = .Left
                        tt6 = .Top
                        
                        tt7 = sBigScale
                        
                        tt12 = lCentX
                        tt13 = lCentY
                        
                        '根据数据重画曲线
                        Call MoNiDraw
                        '恢复默认起始点为0
                        lOldMouseDownX = 0
                        lOldMouseDownY = 0
                End If
        End With
End SubPrivate Sub pic3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        If oMouseDown Then
                With pic3
                        '// 如果是平移
                        If optPan Then
                                '水平方向平移
                                If .Width > pic2.Width Then
                                        .Left = X + .Left - lMouseDownX
                                End If
                                
                                '垂直方向移动
                                If .Height > pic2.Height Then
                                        .Top = Y + .Top - lMouseDownY
                                End If
                        
                        '// 放大
                        ElseIf optBig Then
                                
                                If lOldMouseDownX <> 0 And lOldMouseDownY <> 0 Then
                                        '擦拭旧虚线
                                        pic3.Line (lMouseDownX, lMouseDownY)-(lOldMouseDownX, lOldMouseDownY), QBColor(12), B
                                End If
                                
                                '画当前的虚线
                                pic3.Line (lMouseDownX, lMouseDownY)-(X, Y), QBColor(12), B
                                
                                tt10 = X - lMouseDownX
                                tt11 = Y - lMouseDownY
                                
                                
                                '保存当前坐标
                                lOldMouseDownX = X
                                lOldMouseDownY = Y
                        
                        '// 缩小
                        ElseIf optSmall Then
                        
                        End If
                End With
        End If
        
        tt1 = X
        tt2 = Y
        
        tt5 = pic3.Top
        tt6 = pic3.Left
        
End Sub'模拟画一些参考线
Private Sub MoNiDraw()
        With pic3
                .Cls
                .DrawMode = vbCopyPen '13   '使用虚线画放大范围
                .DrawStyle = vbSolid        '使用实线画曲线
        End With        Dim lxunhuan As Single
        For lxunhuan = 0.1 To 1 Step 0.1
                pic3.Line (lxunhuan * pic3.Width, 0)-(lxunhuan * pic3.Width, pic3.Height)
                pic3.CurrentX = lxunhuan * pic3.Width
                pic3.CurrentY = 0.4 * pic3.Height
                pic3.Print Int(lxunhuan * 10)
        Next
        For lxunhuan = 0.1 To 1 Step 0.1
                pic3.Line (0, lxunhuan * pic3.Height)-(pic3.Width, lxunhuan * pic3.Height)
        Next
End Sub

Answer 2

pic2和pic3必须无边框，也可以设置pic3的背景图片。
必须放大之后，选择”平移“按钮，才能进行平移操作。
大家运行一下，如何完善放大、缩小功能。