代码名称:VB+MapX移动鼠标放大和缩小

作者/收集者:bitbytezjr

开发环境:VB + MapX

代码:

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim x1 As Double
    Dim y1 As Double
    Dim x2 As Double
    Dim y2 As Double
    Dim sngTemp As Single
    Dim tempZoom As Integer
    On Error Resume Next
    Map1.NumericCoordSys.Set miLongLat, 0    '将屏幕坐标转变为经纬度坐标
    If Button = vbLeftButton And Map1.CurrentTool = mtZoomInOut Then
        While boolButtonMove
            If Abs(Y - Map1.MapScreenHeight / 2) > Map1.MapScreenHeight / 1000 Then
                If Y > Map1.MapScreenHeight / 2 And Y >= sglY Then
                '缩小
                   tempZoom = Map1.Zoom + 10 * Abs(Y - Map1.MapScreenHeight / 2) / Map1.MapScreenHeight
                   If tempZoom < 600 And tempZoom > 0 Then
                   Map1.Zoom = tempZoom
                   End If
                   sglY = Y
                ElseIf Y < Map1.MapScreenHeight / 2 And Y <= sglY Then
                '放大\
                    tempZoom = MainForm.Map1.Zoom - 10 * Abs(Y - Map1.MapScreenHeight / 2) /Map1.MapScreenHeight
                    If tempZoom > 0 And tempZoom < 600 Then
                        Map1.Zoom = tempZoom
                    Else
                        If Map1.Zoom > 0.001 Then
                            Map1.Zoom = Map1.Zoom / 2
                        End If
                        
                    End If
                    sglY = Y
                End If
            End If
            DoEvents
        Wend
    End If
    
      
End Sub