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

📄 drilldownsample.vb

📁 这是一个基于MapInfo的GIS软件,将地图上的图元分开或合并
💻 VB
📖 第 1 页 / 共 2 页
字号:
Option Strict Off
Option Explicit On
Friend Class DrilldownMap
	Inherits System.Windows.Forms.Form
#Region "Windows 窗体设计器生成的代码"
	Public Sub New()
		MyBase.New()
       
		InitializeComponent()
	End Sub
	'窗体重写处置,以清理组件列表。
	Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
		If Disposing Then
			If Not components Is Nothing Then
				components.Dispose()
			End If
		End If
		MyBase.Dispose(Disposing)
	End Sub
	'Windows 窗体设计器所必需的
	Private components As System.ComponentModel.IContainer
	Public ToolTip1 As System.Windows.Forms.ToolTip
	Public WithEvents Toolbar1 As AxComctlLib.AxToolbar
	Public WithEvents Map1 As AxMapXLib.AxMap
	Public WithEvents LayerControlBtn As System.Windows.Forms.Button
	Public WithEvents ResetToStates As System.Windows.Forms.Button
	Public WithEvents ResetToUSA As System.Windows.Forms.Button
	Public WithEvents Frame1 As System.Windows.Forms.GroupBox

	<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
		Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(DrilldownMap))
		Me.components = New System.ComponentModel.Container()
		Me.ToolTip1 = New System.Windows.Forms.ToolTip(components)
		Me.ToolTip1.Active = True
		Me.Toolbar1 = New AxComctlLib.AxToolbar
		Me.Map1 = New AxMapXLib.AxMap
		Me.LayerControlBtn = New System.Windows.Forms.Button
		Me.Frame1 = New System.Windows.Forms.GroupBox
		Me.ResetToStates = New System.Windows.Forms.Button
		Me.ResetToUSA = New System.Windows.Forms.Button
		CType(Me.Toolbar1, System.ComponentModel.ISupportInitialize).BeginInit()
		CType(Me.Map1, System.ComponentModel.ISupportInitialize).BeginInit()
		Me.Text = "Drilldown Example"
		Me.ClientSize = New System.Drawing.Size(433, 362)
		Me.Location = New System.Drawing.Point(11, 27)
		Me.Icon = CType(resources.GetObject("DrilldownMap.Icon"), System.Drawing.Icon)
		Me.StartPosition = System.Windows.Forms.FormStartPosition.WindowsDefaultLocation
		Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
		Me.BackColor = System.Drawing.SystemColors.Control
		Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Sizable
		Me.ControlBox = True
		Me.Enabled = True
		Me.KeyPreview = False
		Me.MaximizeBox = True
		Me.MinimizeBox = True
		Me.Cursor = System.Windows.Forms.Cursors.Default
		Me.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.ShowInTaskbar = True
		Me.HelpButton = False
		Me.WindowState = System.Windows.Forms.FormWindowState.Normal
		Me.Name = "DrilldownMap"
		Toolbar1.OcxState = CType(resources.GetObject("Toolbar1.OcxState"), System.Windows.Forms.AxHost.State)
		Me.Toolbar1.Dock = System.Windows.Forms.DockStyle.Top
		Me.Toolbar1.Size = New System.Drawing.Size(433, 42)
		Me.Toolbar1.Location = New System.Drawing.Point(0, 0)
		Me.Toolbar1.TabIndex = 1
		Me.Toolbar1.Name = "Toolbar1"
		Map1.OcxState = CType(resources.GetObject("Map1.OcxState"), System.Windows.Forms.AxHost.State)
		Me.Map1.Size = New System.Drawing.Size(433, 217)
		Me.Map1.Location = New System.Drawing.Point(0, 48)
		Me.Map1.TabIndex = 5
		Me.Map1.Name = "Map1"
		Me.LayerControlBtn.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
		Me.LayerControlBtn.Text = "&Layer Controls"
		Me.LayerControlBtn.Size = New System.Drawing.Size(97, 25)
		Me.LayerControlBtn.Location = New System.Drawing.Point(8, 328)
		Me.LayerControlBtn.TabIndex = 0
		Me.LayerControlBtn.BackColor = System.Drawing.SystemColors.Control
		Me.LayerControlBtn.CausesValidation = True
		Me.LayerControlBtn.Enabled = True
		Me.LayerControlBtn.ForeColor = System.Drawing.SystemColors.ControlText
		Me.LayerControlBtn.Cursor = System.Windows.Forms.Cursors.Default
		Me.LayerControlBtn.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.LayerControlBtn.TabStop = True
		Me.LayerControlBtn.Name = "LayerControlBtn"
		Me.Frame1.Text = "Reset Drilldown Level To..."
		Me.Frame1.Size = New System.Drawing.Size(145, 49)
		Me.Frame1.Location = New System.Drawing.Point(288, 312)
		Me.Frame1.TabIndex = 2
		Me.Frame1.BackColor = System.Drawing.SystemColors.Control
		Me.Frame1.Enabled = True
		Me.Frame1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Frame1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Frame1.Visible = True
		Me.Frame1.Name = "Frame1"
		Me.ResetToStates.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
		Me.ResetToStates.Text = "&States"
		Me.ResetToStates.Size = New System.Drawing.Size(65, 25)
		Me.ResetToStates.Location = New System.Drawing.Point(72, 16)
		Me.ResetToStates.TabIndex = 4
		Me.ResetToStates.BackColor = System.Drawing.SystemColors.Control
		Me.ResetToStates.CausesValidation = True
		Me.ResetToStates.Enabled = True
		Me.ResetToStates.ForeColor = System.Drawing.SystemColors.ControlText
		Me.ResetToStates.Cursor = System.Windows.Forms.Cursors.Default
		Me.ResetToStates.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.ResetToStates.TabStop = True
		Me.ResetToStates.Name = "ResetToStates"
		Me.ResetToUSA.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
		Me.ResetToUSA.Text = "&USA"
		Me.ResetToUSA.Size = New System.Drawing.Size(65, 25)
		Me.ResetToUSA.Location = New System.Drawing.Point(8, 16)
		Me.ResetToUSA.TabIndex = 3
		Me.ResetToUSA.BackColor = System.Drawing.SystemColors.Control
		Me.ResetToUSA.CausesValidation = True
		Me.ResetToUSA.Enabled = True
		Me.ResetToUSA.ForeColor = System.Drawing.SystemColors.ControlText
		Me.ResetToUSA.Cursor = System.Windows.Forms.Cursors.Default
		Me.ResetToUSA.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.ResetToUSA.TabStop = True
		Me.ResetToUSA.Name = "ResetToUSA"
		Me.Controls.Add(Toolbar1)
		Me.Controls.Add(Map1)
		Me.Controls.Add(LayerControlBtn)
		Me.Controls.Add(Frame1)
		Me.Frame1.Controls.Add(ResetToStates)
		Me.Frame1.Controls.Add(ResetToUSA)
		CType(Me.Map1, System.ComponentModel.ISupportInitialize).EndInit()
		CType(Me.Toolbar1, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
   
    ' This sample application and corresponding sample code is provided
    ' for example purposes only.  It has not undergone rigorous testing
    ' and as such should not be shipped as part of a final application
    ' without extensive testing on the part of the organization releasing
    ' the end-user product.


    Const customDrilldownExpandTool As Short = 5
    Const customDrilldownContractTool As Short = 4

    Dim drilldownLayer As MapXLib.Layer

    ' These next three global variables store information about the state of the
    ' drilldown layer. We need to keep track of these data in order to keep the
    ' user from doing some invalid things. For example, the user might drilldown
    ' so that the eastern half of the US is not drilled down, and the western half
    ' is drilled down to the states layer. Then, the user could try to do a
    ' drilldown contract on the eastern half. We require that the user contract
    ' the western half before contracting to the USA level. We test if the user
    ' has contracted both sides by testing if usaLevel is 0.

    ' westLevel stores the number of states which are visible in the western half
    ' of the country.
    Dim westLevel As Short

    ' eastLevel stores the number of states which are visible in the eastern half
    ' of the country.
    Dim eastLevel As Short

    ' usaLevel is 0 if neither of the halves of the country have been drilled down
    ' into, 1 if either of them have been drilled down into, and 2 if both have
    ' been drilled down into.
    Dim usaLevel As Short

    Private Sub LayerControlBtn_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles LayerControlBtn.Click
        Map1.Layers.LayersDlg()
    End Sub

    Private Sub ResetToStates_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles ResetToStates.Click
        drilldownLayer.DrilldownReset("States")
        ' Update the state information. All the states are visible in both halves, and
        ' both east and west have been expanded into.
        westLevel = 22
        eastLevel = 27
        usaLevel = 2
    End Sub

    Private Sub ResetToUSA_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles ResetToUSA.Click
        drilldownLayer.DrilldownReset("USA")
        ' Update the state information. No states are visible, and neither the east nor
        ' the west have been expanded into.
        westLevel = 0
        eastLevel = 0
        usaLevel = 0
    End Sub

    Private Sub DrilldownMap_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
        Dim i As Short

        ' Drilldown Expand Tool
        Map1.CreateCustomTool(customDrilldownExpandTool, MapXLib.ToolTypeConstants.miToolTypePoint, MapXLib.CursorConstants.miDrilldownExpandCursor, MapXLib.CursorConstants.miDrilldownContractCursor, MapXLib.CursorConstants.miDrilldownContractCursor)
        ' Drilldown Contract tool
        Map1.CreateCustomTool(customDrilldownContractTool, MapXLib.ToolTypeConstants.miToolTypePoint, MapXLib.CursorConstants.miDrilldownContractCursor, MapXLib.CursorConstants.miDrilldownExpandCursor, MapXLib.CursorConstants.miDrilldownExpandCursor)

        ' Remove all the layers from the map
        For i = 1 To Map1.Layers.Count
            Map1.Layers.Remove(1)
        Next

        ' And add our drilldown layer
        drilldownLayer = Map1.Layers.Add(VB6.GetPath & "\Data\DDTestUSA2.tab")

        ' Add the layer data to the map, and give the map some nice labels from that data.
        Dim ds As MapXLib.Dataset
        ds = Map1.DataSets.Add(MapXLib.DatasetTypeConstants.miDataSetLayer, drilldownLayer)
        drilldownLayer.LabelProperties.Dataset = ds
        drilldownLayer.AutoLabel = True
        drilldownLayer.LabelProperties.DataField = ds.Fields.Item("Label")
        drilldownLayer.LabelProperties.Style.TextFontHalo = True
    End Sub


    Private Sub Map1_MouseUpEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMapXLib.CMapXEvents_MouseUpEvent) Handles Map1.MouseUpEvent
        ' Display the MapX property pages when the map is right-clicked on.
        If eventArgs.button = 2 Then
            Map1.PropertyPage()
        End If
    End Sub

    Private Sub Map1_ToolUsed(ByVal eventSender As System.Object, ByVal eventArgs As AxMapXLib.CMapXEvents_ToolUsedEvent) Handles Map1.ToolUsed
        Dim AddKeys() As String
        Dim NewLevel As String
        Dim fs As MapXLib.Features
        Dim strLevel As String
        Dim DelKeys() As String
        Dim pnt As New MapXLib.Point

        ' ---------------------------------------------
        ' Expand
        ' ----------------------------------------------
        If (eventArgs.toolNum = customDrilldownExpandTool And eventArgs.ctrl = False) Or (eventArgs.toolNum = customDrilldownContractTool And eventArgs.ctrl = True) Then
            ' Figure out which object we have
            pnt.Set(eventArgs.x1, eventArgs.y1)
            fs = drilldownLayer.SearchAtPoint(pnt)

            If fs.Count = 1 Then
                ReDim DelKeys(0)
                drilldownLayer.KeyField = "Level"
                strLevel = fs(1).KeyValue

                drilldownLayer.KeyField = "Key"
                DelKeys(0) = fs(1).KeyValue

                If strLevel = "USA" Then
                    NewLevel = "2Region"
                    ReDim AddKeys(1)
                    AddKeys(0) = "West"
                    AddKeys(1) = "East"
                ElseIf strLevel = "2Region" Then
                    NewLevel = "MultiRegion"
                    ReDim AddKeys(3)
                    Select Case DelKeys(0)
                        Case "West"
                            usaLevel = usaLevel + 1
                            AddKeys(0) = "mrRgn1"
                            AddKeys(1) = "mrRgn2"
                            AddKeys(2) = "mrRgn3"
                            AddKeys(3) = "mrRgn4"
                        Case "East"
                            usaLevel = usaLevel + 1
                            AddKeys(0) = "mrRgn5"
                            AddKeys(1) = "mrRgn6"
                            AddKeys(2) = "mrRgn7"
                            AddKeys(3) = "mrRgn8"
                    End Select
                ElseIf strLevel = "MultiRegion" Then
                    NewLevel = "States"
                    Select Case DelKeys(0)
                        Case "mrRgn1"
                            westLevel = westLevel + 5
                            ReDim AddKeys(4)
                            AddKeys(0) = "16"
                            AddKeys(1) = "30"
                            AddKeys(2) = "41"
                            AddKeys(3) = "53"
                            AddKeys(4) = "56"
                        Case "mrRgn2"
                            westLevel = westLevel + 6
                            ReDim AddKeys(5)
                            AddKeys(0) = "04"
                            AddKeys(1) = "06"
                            AddKeys(2) = "08"
                            AddKeys(3) = "32"

⌨️ 快捷键说明

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