⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.vb

📁 VB开发的基于mo控件的例子
💻 VB
字号:
Option Strict Off
Option Explicit On
Friend Class frmMain
	Inherits System.Windows.Forms.Form
	'
	'  Module Name:  frmMain
	'
	'  Description:  Overview and Magnifier Demo interface
	'
	'     Requires:  frmMagnifier, frmOverview
	'
	'      Methods:  (none)
	'
	'      History:  Peter Girard, ESRI - 9/99 - original coding
	'
	'=============================================================================
	
	
	Dim mFullRedraw As Boolean
	
	Private Sub cmdFullView_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdFullView.Click
		
		mapMain.Extent = mapMain.FullExtent
		
	End Sub
	
	Private Sub cmdMagnifier_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdMagnifier.Click
		
		Dim overVis As Boolean
		
		' -- if the magnifier is starting and the overview is already on top of the
		' -- main form, send the overview to the back so it does not appear in the
		' -- magnifier's snapshot, start the magnifier, then restore the overview
		
		If Not frmMagnifier.Visible Then
			overVis = frmOverview.Visible
			If overVis Then
				'UPGRADE_WARNING: Form 方法 frmOverview.ZOrder 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"”
				frmOverview.SendToBack()
				Me.Refresh()
			End If
			frmMagnifier.Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(Me.Left) + 600)
			frmMagnifier.Top = VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(Me.Top) + 1200)
			frmMagnifier.SetFormAndMap(Me, mapMain)
			frmMagnifier.Show()
			If overVis Then
				frmOverview.StayOnTop(True)
			End If
		End If
		
	End Sub
	
	Private Sub cmdOverview_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdOverview.Click
		
		If Not frmOverview.Visible Then
			frmOverview.Left = VB6.TwipsToPixelsX(VB6.PixelsToTwipsX(Me.Left) + 600)
			frmOverview.Top = VB6.TwipsToPixelsY(VB6.PixelsToTwipsY(Me.Top) + 1200)
			'UPGRADE_WARNING: 未能解析对象 mapMain.Layers() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"”
			frmOverview.AddLayer(mapMain.Layers._Item("States"))
			frmOverview.AddMap(mapMain)
			frmOverview.SetFullExtent((mapMain.FullExtent))
			frmOverview.Show()
		End If
		
	End Sub
	
	Private Sub frmMain_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		
		Dim dc As New MapObjects2.DataConnection
		Dim ml As MapObjects2.MapLayer
		Dim e As MapObjects2.Rectangle
		
		' -- connect to the data
		
		dc.Database = My.Application.Info.DirectoryPath & "\shapes"
		If Not dc.Connect Then
			MsgBox("Could not find data")
			End
		End If
		
		' -- load the map layers
		
		ml = New MapObjects2.MapLayer
		ml.GeoDataset = dc.FindGeoDataset("states")
		ml.Name = "States"
		ml.Symbol.Color = System.Convert.ToUInt32(RGB(230, 255, 230))
		ml.Symbol.Outline = True
		ml.Symbol.OutlineColor = System.Convert.ToUInt32(RGB(120, 180, 120))
		mapMain.Layers.Add(ml)
		
		' -- set the map extent
		
		e = ml.Extent
		e.ScaleRectangle(1.1)
		mapMain.FullExtent = e
		mapMain.Extent = mapMain.FullExtent
		
	End Sub
	
	Private Sub frmMain_FormClosed(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
		
		frmOverview.Close()
		frmMagnifier.Close()
		
	End Sub
	
	Private Sub mapMain_AfterTrackingLayerDraw(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_AfterTrackingLayerDrawEvent) Handles mapMain.AfterTrackingLayerDraw
		
		Dim overVis As Boolean
		Dim e As MapObjects2.Rectangle
		Dim p As MapObjects2.Point
		
		If mFullRedraw Then
			mFullRedraw = False
			overVis = frmOverview.Visible
			
			' -- if the magnifier is visible, send it to the back so it does not appear
			' -- in the snapshot, take the snapshot, then restore the magnifer; do the
			' -- same thing for the overview is necessary
			
			If frmMagnifier.Visible Then
				'UPGRADE_WARNING: Form 方法 frmMagnifier.ZOrder 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"”
				frmMagnifier.SendToBack()
				If overVis Then
					'UPGRADE_WARNING: Form 方法 frmOverview.ZOrder 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6BA9B8D2-2A32-4B6E-8D36-44949974A5B4"”
					frmOverview.SendToBack()
				End If
				
				Me.Refresh()
				frmMagnifier.Update_Renamed()
				
				If overVis Then
					frmOverview.StayOnTop(True)
				End If
				frmMagnifier.StayOnTop(True)
			End If
			
			' -- set the new extent in the overview
			
			If overVis Then
				e = New MapObjects2.Rectangle
				p = mapMain.ToMapPoint(0, 0)
				e.Left = p.X
				e.Top = p.Y
				p = mapMain.ToMapPoint(VB6.PixelsToTwipsX(mapMain.Width), VB6.PixelsToTwipsY(mapMain.Height))
				e.Right = p.X
				e.Bottom = p.Y
				frmOverview.SetExtent(e)
			End If
		End If
		
		
	End Sub
	
	Private Sub mapMain_BeforeLayerDraw(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_BeforeLayerDrawEvent) Handles mapMain.BeforeLayerDraw
		
		' -- tell AfterLayerDraw that a full redraw has occurred
		
		If eventArgs.index = mapMain.Layers.Count - 1 Then
			mFullRedraw = True
		End If
		
	End Sub
	
	Private Sub mapMain_MouseDownEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMapObjects2._DMapEvents_MouseDownEvent) Handles mapMain.MouseDownEvent
		
		If eventArgs.Button = 1 Then
			mapMain.Extent = mapMain.TrackRectangle
		Else
			mapMain.Pan()
		End If
		
	End Sub
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -