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

📄 drilldownsample.frm

📁 GIS地理信息系统开发。大名鼎鼎的MAPX+VisualBasic6.0软件开发
💻 FRM
📖 第 1 页 / 共 4 页
字号:
      Map.Layers.Layer7.LabelProperties.Style.TextFontBackColor=   13696976
      Map.Layers.Layer7.LabelProperties.Style.TextFontHalo=   -1  'True
      Map.Layers.Layer7.LabelProperties.Style.TextFontAllCaps=   -1  'True
      Map.Layers.Layer7.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer7.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer7.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer7.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer7.LabelProperties.Style.LineWidth=   1
      Map.Layers.Layer8.HasFileSpec=   -1  'True
      Map.Layers.Layer8.Skip=   0   'False
      Map.Layers.Layer8.Path=   "usa.TAB"
      Map.Layers.Layer8.Name=   "USA"
      Map.Layers.Layer8.Visible=   -1  'True
      Map.Layers.Layer8.Selectable=   -1  'True
      Map.Layers.Layer8.Editable=   0   'False
      Map.Layers.Layer8.ShowNodes=   0   'False
      Map.Layers.Layer8.ShowCentroids=   0   'False
      Map.Layers.Layer8.ShowLineDirection=   0   'False
      Map.Layers.Layer8.AutoLabel=   0   'False
      Map.Layers.Layer8.DrawLabelsAfter=   0   'False
      Map.Layers.Layer8.ZoomLayering=   0   'False
      Map.Layers.Layer8.ZoomMin=   0
      Map.Layers.Layer8.ZoomMax=   0
      Map.Layers.Layer8.DoOverrideStyle=   0   'False
      Map.Layers.Layer8.LabelProperties.LabelMax=   100
      Map.Layers.Layer8.LabelProperties.Overlap=   0   'False
      Map.Layers.Layer8.LabelProperties.Duplicate=   0   'False
      Map.Layers.Layer8.LabelProperties.Offset=   2
      Map.Layers.Layer8.LabelProperties.LineType=   0
      Map.Layers.Layer8.LabelProperties.Zoom=   -1  'True
      Map.Layers.Layer8.LabelProperties.ZoomMin=   400
      Map.Layers.Layer8.LabelProperties.ZoomMax=   3500.5
      Map.Layers.Layer8.LabelProperties.Visible=   -1  'True
      Map.Layers.Layer8.LabelProperties.Position=   0
      Map.Layers.Layer8.LabelProperties.Parellel=   -1  'True
      Map.Layers.Layer8.LabelProperties.PartialSegments=   0   'False
      Map.Layers.Layer8.LabelProperties.Style.TextFontColor=   128
      Map.Layers.Layer8.LabelProperties.Style.TextFontBackColor=   13696976
      Map.Layers.Layer8.LabelProperties.Style.TextFontHalo=   -1  'True
      Map.Layers.Layer8.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer8.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer8.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer8.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer8.LabelProperties.Style.LineWidth=   1
      Map.Layers.Layer9.HasFileSpec=   -1  'True
      Map.Layers.Layer9.Skip=   0   'False
      Map.Layers.Layer9.Path=   "ocean_ll.TAB"
      Map.Layers.Layer9.Name=   "Ocean (Lat/ Long)"
      Map.Layers.Layer9.Visible=   -1  'True
      Map.Layers.Layer9.Selectable=   0   'False
      Map.Layers.Layer9.Editable=   0   'False
      Map.Layers.Layer9.ShowNodes=   0   'False
      Map.Layers.Layer9.ShowCentroids=   0   'False
      Map.Layers.Layer9.ShowLineDirection=   0   'False
      Map.Layers.Layer9.AutoLabel=   0   'False
      Map.Layers.Layer9.DrawLabelsAfter=   0   'False
      Map.Layers.Layer9.ZoomLayering=   0   'False
      Map.Layers.Layer9.ZoomMin=   0
      Map.Layers.Layer9.ZoomMax=   0
      Map.Layers.Layer9.DoOverrideStyle=   0   'False
      Map.Layers.Layer9.LabelProperties.LabelMax=   100
      Map.Layers.Layer9.LabelProperties.Overlap=   0   'False
      Map.Layers.Layer9.LabelProperties.Duplicate=   -1  'True
      Map.Layers.Layer9.LabelProperties.Offset=   2
      Map.Layers.Layer9.LabelProperties.LineType=   0
      Map.Layers.Layer9.LabelProperties.Zoom=   -1  'True
      Map.Layers.Layer9.LabelProperties.ZoomMin=   0
      Map.Layers.Layer9.LabelProperties.ZoomMax=   10000
      Map.Layers.Layer9.LabelProperties.Visible=   -1  'True
      Map.Layers.Layer9.LabelProperties.Position=   0
      Map.Layers.Layer9.LabelProperties.Parellel=   -1  'True
      Map.Layers.Layer9.LabelProperties.PartialSegments=   0   'False
      Map.Layers.Layer9.LabelProperties.Style.TextFontBackColor=   16777215
      Map.Layers.Layer9.LabelProperties.Style.SymbolChar=   0
      BeginProperty Map.Layers.Layer9.LabelProperties.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Map.Layers.Layer9.LabelProperties.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer9.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer9.LabelProperties.Style.LineWidth=   1
      Map.NumericCoordSys.ProjectionInfo=   "DrilldownSample.frx":074C
      Map.DisplayCoordSys.ProjectionInfo=   "DrilldownSample.frx":087C
      Map.Zoom        =   3500
      Map.CenterX     =   -95.6166331624541
      Map.CenterY     =   38.2558613617277
      FeatureEditMode =   1
   End
   Begin VB.CommandButton LayerControlBtn 
      Caption         =   "&Layer Controls"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   4920
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "Reset Drilldown Level To..."
      Height          =   735
      Left            =   4320
      TabIndex        =   2
      Top             =   4680
      Width           =   2175
      Begin VB.CommandButton ResetToStates 
         Caption         =   "&States"
         Height          =   375
         Left            =   1080
         TabIndex        =   4
         Top             =   240
         Width           =   975
      End
      Begin VB.CommandButton ResetToUSA 
         Caption         =   "&USA"
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
   End
End
Attribute VB_Name = "DrilldownMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 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.

Option Explicit

Const customDrilldownExpandTool As Integer = 5
Const customDrilldownContractTool As Integer = 4

Dim drilldownLayer As 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 Integer

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

' 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 Integer

Private Sub LayerControlBtn_Click()
    Map1.Layers.LayersDlg
End Sub

Private Sub 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()
    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 Form_Load()
    Dim i As Integer

    ' Drilldown Expand Tool
    Map1.CreateCustomTool customDrilldownExpandTool, miToolTypePoint, miDrilldownExpandCursor, miDrilldownContractCursor, miDrilldownContractCursor
    ' Drilldown Contract tool
    Map1.CreateCustomTool customDrilldownContractTool, miToolTypePoint, miDrilldownContractCursor, miDrilldownExpandCursor, 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
    Set drilldownLayer = Map1.Layers.Add(App.Path + "\Data\DDTestUSA2.tab")
    
    ' Add the layer data to the map, and give the map some nice labels from that data.
    Dim ds As Dataset
    Set ds = Map1.Datasets.Add(miDataSetLayer, drilldownLayer)
    Set drilldownLayer.LabelProperties.Dataset = ds
    drilldownLayer.AutoLabel = True
    Set drilldownLayer.LabelProperties.DataField = ds.Fields.Item("Label")
    drilldownLayer.LabelProperties.Style.TextFontHalo = True
End Sub


Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Display the MapX property pages when the map is right-clicked on.
    If Button = 2 Then
        Map1.PropertyPage
    End If
End Sub

Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
    Dim AddKeys() As String
    Dim NewLevel As String
    Dim fs As Features
    Dim strLevel As String
    Dim DelKeys() As String
    Dim pnt As New Point

    ' ---------------------------------------------
    ' Expand
    ' ----------------------------------------------
    If (ToolNum = customDrilldownExpandTool And Ctrl = False) Or (ToolNum = customDrilldownContractTool And Ctrl = True) Then
        ' Figure out which object we have
        pnt.Set X1, Y1
        Set 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"

⌨️ 快捷键说明

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