📄 drilldownsample.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{9D6ED199-5910-11D2-98A6-00A0C9742CCA}#4.0#0"; "MAPX40.OCX"
Begin VB.Form DrilldownMap
Caption = "Drilldown Example"
ClientHeight = 5430
ClientLeft = 165
ClientTop = 405
ClientWidth = 6495
FillColor = &H00FFFFFF&
Icon = "DrilldownSample.frx":0000
LinkTopic = "Form1"
MouseIcon = "DrilldownSample.frx":0442
ScaleHeight = 5430
ScaleWidth = 6495
StartUpPosition = 3 'Windows Default
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 630
Left = 0
TabIndex = 1
Top = 0
Width = 6495
_ExtentX = 11456
_ExtentY = 1111
ButtonWidth = 1429
ButtonHeight = 953
AllowCustomize = 0 'False
Appearance = 1
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 7
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Zoom In"
Object.ToolTipText = "Zoom In Tool"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Zoom Out"
Object.ToolTipText = "Zoom Out Tool"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Pan"
Object.ToolTipText = "Pan Tool"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Select"
Object.ToolTipText = "Select Tool"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Arrow"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Expand"
Object.ToolTipText = "Drilldown Expand"
Object.Tag = ""
Style = 2
EndProperty
BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7}
Caption = "Contract"
Object.ToolTipText = "Drilldown Contract"
Object.Tag = ""
Style = 2
EndProperty
EndProperty
End
Begin MapXLib.Map Map1
Height = 3975
Left = 0
TabIndex = 2
Top = 600
Width = 6495
_Version = 400010
_ExtentX = 11456
_ExtentY = 7011
_StockProps = 1
GeoDictionary = "GeoDictionary"
GeoSet = "Empty"
GeoSetUserName = ""
CurrentTool = 1000
Zoom = 0
MaxSearchTime = 30
CenterX = 0
CenteryY = 0
Rotation = 0
TitleText = ""
DataSetGeoField = ""
DataSetTheme = 184
AutoRedraw = -1 'True
PreferCompactLegends= 0 'False
TitleVisible = 0 'False
MousePointer = 0
MouseIcon = ""
MatchThreshold = 80
WaitCursorEnabled= -1 'True
MousewheelSupport= 3
MatchNumericFields= 0 'False
RedrawInterval = 10
PanAnimationLayer= 0 'False
InfotipSupport = -1 'True
InfotipPopupDelay= 500
DefaultConversionResolution= 12
ExportSelection = 0 'False
NumLayers = 0
TitleStyle.TextFontBackColor= 16777215
TitleStyle.TextFontOpaque= -1 'True
TitleStyle.SymbolChar= 0
BeginProperty TitleStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 20.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty TitleStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 15.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DefaultStyle.TextFontBackColor= 16777215
DefaultStyle.SupportsBitmapSymbols= -1 'True
DefaultStyle.SymbolChar= 55
DefaultStyle.SymbolFontBackColor= 16777215
BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DefaultStyle.LineStyle= 1
DefaultStyle.LineWidth= 1
DefaultStyle.RegionColor= 16777215
DefaultStyle.LinePattern= 2
DefaultStyle.RegionBackColor= 16777215
DefaultStyle.RegionBorderStyle= 1
DefaultStyle.RegionBorderWidth= 1
HasProjectionInfo= -1 'True
NumericCoordsys = "DrilldownSample.frx":074C
DisplayCoordsys = "DrilldownSample.frx":087C
NumDatasets = 0
TitleX = 5000
TitleY = 1000
TitleVisible = 0 'False
TitleEditable = -1 'True
TitlePostiion = 0
TitleBorder = -1 'True
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 = 3
Top = 4680
Width = 2175
Begin VB.CommandButton ResetToStates
Caption = "&States"
Height = 375
Left = 1080
TabIndex = 5
Top = 240
Width = 975
End
Begin VB.CommandButton ResetToUSA
Caption = "&USA"
Height = 375
Left = 120
TabIndex = 4
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -