form1.vb

这个是电子地图的 原程序 很好的,不错啊 侃侃 ,很有帮助

Option Strict Off
Option Explicit On
Friend Class frmMain
	Inherits System.Windows.Forms.Form
	'=======================================================================================================
	'
	'
	'实验4：    实现图形的放大、缩小、平移等功能
	'
	'      1.   实现图形显示的放大、缩小
	'
	'      2.   图形的平移
	'
	'      3.   图形充满整个窗口
	'
	'      4.   图形的定点放大和缩小
	'
	'
	'=======================================================================================================
	
	
	
	
	
	Dim FunctionID As Short
	Dim tag_pan As Boolean
	
	Private Sub frmMain_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load '初始窗口
		WX_l = -180
		WY_t = 90
		WX_r = 180
		WY_b = -90
        VX_l = VB6.PixelsToTwipsX(picturebox1.Left)
        VY_t = VB6.PixelsToTwipsY(picturebox1.Top)
        VX_r = VX_l + VB6.PixelsToTwipsX(picturebox1.Width)
        VY_b = VY_t + VB6.PixelsToTwipsY(picturebox1.Height)
        tag_pan = False
        'UPGRADE_NOTE: 在对对象 frmMain.Icon 进行垃圾回收前，不可以将其销毁。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"”
        Me.Icon = Nothing
    End Sub

    'UPGRADE_WARNING: 初始化窗体时可能激发事件 frmMain.Resize。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="88B12AE1-6DE0-48A0-86F1-60C0686C026A"”
    Private Sub frmMain_Resize(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Resize '屏幕大小放缩变换
        'UPGRADE_ISSUE: PictureBox 方法 Picview.Cls 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
        Picview.Cls()
        picturebox1.Width = VB6.TwipsToPixelsX(System.Math.Abs(VB6.PixelsToTwipsX(Me.ClientRectangle.Width) - 345))
        picturebox1.Height = VB6.TwipsToPixelsY(System.Math.Abs(VB6.PixelsToTwipsY(Me.ClientRectangle.Height) - 1600))

        'UPGRADE_ISSUE: PictureBox 属性 Picview.ScaleLeft 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
        VX_l = Picview.ScaleLeft
        'UPGRADE_ISSUE: PictureBox 属性 Picview.ScaleTop 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
        VY_t = Picview.ScaleTop
        VX_r = VX_l + VB6.PixelsToTwipsX(picturebox1.ClientRectangle.Width)
        VY_b = VY_t + VB6.PixelsToTwipsY(picturebox1.ClientRectangle.Height)
        Coodinate_Scale()
        DrawGrid()
    End Sub

    Private Sub DrawGrid() '画网格
        Dim i As Object
        Dim j As Short
        Dim draw_wx As Object
        Dim draw_wy As Single
        Dim draw_vxl, draw_vyt As Single
        Dim draw_vxr, draw_vyb As Single

        With picturebox1
            'UPGRADE_ISSUE: 常量 vbCopyPen 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"”
            'UPGRADE_ISSUE: PictureBox 属性 Picview.DrawMode 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
            .DrawMode = vbCopyPen
            'UPGRADE_ISSUE: 常量 vbSolid 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"”
            'UPGRADE_ISSUE: PictureBox 属性 Picview.DrawStyle 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
            .DrawStyle = vbSolid
            'UPGRADE_ISSUE: PictureBox 属性 Picview.DrawWidth 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
            .DrawWidth = 1
        End With

        For i = 0 To 36
            'UPGRADE_WARNING: 未能解析对象 i 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            draw_wx = -180 + 10 * i
            draw_wy = 90
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            Call WorldToScreen(draw_wx, draw_wy, draw_vxl, draw_vyt)
            draw_wy = -90
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            Call WorldToScreen(draw_wx, draw_wy, draw_vxr, draw_vyb)
            'UPGRADE_ISSUE: PictureBox 方法 Picview.Line 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			Picview.Line (draw_vxl, draw_vyt) - (draw_vxr, draw_vyb)
        Next i
        For j = 0 To 18
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            draw_wx = -180
            draw_wy = 90 - 10 * j
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            Call WorldToScreen(draw_wx, draw_wy, draw_vxl, draw_vyt)
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            draw_wx = 180
            'UPGRADE_WARNING: 未能解析对象 draw_wx 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
            Call WorldToScreen(draw_wx, draw_wy, draw_vxr, draw_vyb)
            'UPGRADE_ISSUE: PictureBox 方法 Picview.Line 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"”
			Picview.Line (draw_vxl, draw_vyt) - (draw_vxr, draw_vyb)
        Next j
    End Sub

    '==========================================   鼠标事件   ===========================================

    Private Spicturebox1iew_MouseDown(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.MouseEventArgs) Handles picturebox1.MouseDown
    Dim Button As Short = eventArgs.Button \ &H100000
    Dim Shift As Short = System.Windows.Forms.Control.ModifierKeys \ &H10000
    Dim X As Single = VB6.PixelsToTwipsX(eventArgs.X)
    Dim Y As Single = VB6.PixelsToTwipsY(eventArgs.Y)
        If tag_pan = False Then
            Select Case FunctionID
                Case 1 : ZoomIn()
                Case 2 : ZoomOut()
                Case 3 : ZoomInAt(X, Y)
                Case 4 : ZoomOutAt(X, Y)
                Case 5