📄 form1.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "COMCTL32.OCX"
Begin VB.Form Zee
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Zee"
ClientHeight = 8445
ClientLeft = 1875
ClientTop = 420
ClientWidth = 7080
FillColor = &H00C0C0C0&
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8445
ScaleWidth = 7080
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 390
Left = 0
TabIndex = 17
Top = 0
Width = 7080
_ExtentX = 12488
_ExtentY = 688
ButtonWidth = 609
ButtonHeight = 582
ImageList = "ImageList1"
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 7
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "ZoomIn"
Object.ToolTipText = "Zoom In"
Object.Tag = ""
ImageIndex = 1
Style = 2
Value = 1
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "ZoomOut"
Object.ToolTipText = "Zoom Out"
Object.Tag = ""
ImageIndex = 2
Style = 2
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Pan"
Object.ToolTipText = "Pan"
Object.Tag = ""
ImageIndex = 3
Style = 2
EndProperty
BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Identify"
Object.ToolTipText = "Identify a Mountain"
Object.Tag = ""
ImageIndex = 4
Style = 2
EndProperty
BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Rect"
Object.ToolTipText = "Select features within a 2D or 3D rectangle"
Object.Tag = ""
ImageIndex = 5
Style = 2
EndProperty
BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.Tag = ""
Style = 3
MixedState = -1 'True
EndProperty
BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "FullExtent"
Object.ToolTipText = "Full Extent"
Object.Tag = ""
ImageIndex = 6
EndProperty
EndProperty
End
Begin VB.PictureBox PictureLeg
BackColor = &H80000009&
Height = 975
Left = 2280
ScaleHeight = 915
ScaleWidth = 2595
TabIndex = 16
Top = 5880
Width = 2655
End
Begin VB.TextBox floor
Alignment = 1 'Right Justify
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5760
TabIndex = 7
Text = "750"
Top = 6960
Width = 615
End
Begin VB.TextBox ceiling
Alignment = 1 'Right Justify
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 5760
TabIndex = 8
Text = "1000"
Top = 6600
Width = 615
End
Begin VB.CheckBox LPlacer
Caption = "Label with names"
Height = 195
Left = 3360
TabIndex = 13
Top = 6960
Value = 1 'Checked
Width = 1575
End
Begin VB.OptionButton sel3d
Caption = "3D Rectangle"
Enabled = 0 'False
Height = 255
Left = 5160
TabIndex = 6
Top = 6240
Width = 1455
End
Begin VB.OptionButton sel2d
Caption = "2D Rectangle"
Enabled = 0 'False
Height = 255
Left = 5160
TabIndex = 5
Top = 6000
Value = -1 'True
Width = 1455
End
Begin VB.Frame Frame1
Caption = "Renderer"
Height = 1215
Left = 120
TabIndex = 1
Top = 5760
Width = 2055
Begin VB.OptionButton VRen
Caption = "ValueMap by Type"
Height = 375
Left = 120
TabIndex = 4
Top = 480
Width = 1695
End
Begin VB.OptionButton Zren
Caption = "Z ( Height in Feet)"
Height = 255
Left = 120
TabIndex = 3
Top = 840
Width = 1815
End
Begin VB.OptionButton NoRen
Caption = "None"
Height = 255
Left = 120
TabIndex = 2
Top = 240
Value = -1 'True
Width = 1095
End
End
Begin MapObjects2.Map Map1
Height = 5175
Left = 120
TabIndex = 0
Top = 480
Width = 6855
_Version = 131072
_ExtentX = 12091
_ExtentY = 9128
_StockProps = 225
BackColor = 16711680
BorderStyle = 1
ScrollBars = 0 'False
BackColor = 16711680
Contents = "Form1.frx":0000
End
Begin VB.Frame Frame2
BackColor = &H00C0C0C0&
Caption = "Selection"
ForeColor = &H00000000&
Height = 1575
Left = 5040
TabIndex = 9
Top = 5760
Width = 1935
Begin VB.Label Label2
Caption = "Floor:"
Height = 255
Left = 240
TabIndex = 15
Top = 1200
Width = 375
End
Begin VB.Label Label1
Caption = "Ceiling:"
Height = 255
Left = 120
TabIndex = 14
Top = 840
Width = 495
End
End
Begin ComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 8421376
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 6
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":001A
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":012C
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":023E
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0350
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0462
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0574
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Columns
BackStyle = 0 'Transparent
Caption = "Identification results here"
Height = 1335
Left = 120
TabIndex = 11
Top = 7080
Width = 2295
End
Begin VB.Label Clue
Height = 975
Left = 3000
TabIndex = 10
Top = 7440
Width = 2295
End
Begin VB.Label values
BackStyle = 0 'Transparent
Height = 1335
Left = 1440
TabIndex = 12
Top = 7080
Width = 1455
End
End
Attribute VB_Name = "Zee"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' selected mountains recordset
Dim selRecs As MapObjects2.Recordset
' feet to meters conversion constant
Dim f_to_m As Double
Dim m_to_f As Double
Dim text_height As Double
Dim scale_width As Double
Dim theBenEasting As Long
Dim theBenNorthing As Long
Sub DrawRecordset(recs As MapObjects2.Recordset)
' draw the features of a RecordSet
If Not recs Is Nothing Then
Dim sym As New MapObjects2.Symbol
sym.SymbolType = moPointSymbol
sym.Color = moYellow
sym.Style = moTriangleMarker
sym.Size = 6
Map1.DrawShape recs, sym
End If
End Sub
Private Sub Form_Load()
' Initialise
Set selRecs = Nothing
f_to_m = 0.3048037
m_to_f = 3.2808
text_height = 2000
scale_width = 50000
theBenEasting = 216600
theBenNorthing = 771300
Load identify
' load data into the map
Dim dc As New DataConnection
dc.Database = ReturnDataPath("Scotland")
If Not dc.Connect Then End
Dim Scotcoast As New MapObjects2.MapLayer
Scotcoast.GeoDataset = dc.FindGeoDataset("Scotcoast")
Scotcoast.Symbol.Color = moLightYellow
Map1.Layers.Add Scotcoast
' Uncomment out the following line to generate 3D mountains shape-file from mountains2d
' Call Make3D
Dim Mountains As New MapObjects2.MapLayer
Mountains.GeoDataset = dc.FindGeoDataset("mountains")
Mountains.Symbol.Color = moWhite
Mountains.Symbol.Size = 6
Mountains.Symbol.Style = moTriangleMarker
Map1.Layers.Add Mountains
' In order to display the mountain shapefile with both labels (Labelplacer) and
' Symbols (Zrenderer or ClassBreaksRenderer)we can either use a grouprenderer object
' or we can simply add the layer twice.
' Here we are adding the layer twice so that the zrenderer code is less complex
Dim Mountainslp As New MapObjects2.MapLayer
Mountainslp.GeoDataset = dc.FindGeoDataset("mountains")
Mountainslp.Symbol.Size = 0
Map1.Layers.Add Mountainslp
Map1.MousePointer = moZoomIn
End Sub
Private Sub selection_enable(bool As Boolean)
' Enable / disable the selection radio buttons based on the status of the ID tool
sel2d.Enabled = bool
sel3d.Enabled = bool
If sel3d.Value Then
ceiling.Enabled = bool
floor.Enabled = bool
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
identify.Visible = False
Unload identify
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
If selRecs Is Nothing Then Exit Sub
DrawRecordset selRecs
End Sub
Private Sub Map1_BeforeLayerDraw(ByVal index As Integer, ByVal hDC As stdole.OLE_HANDLE)
If Map1.Extent.Width > scale_width Then
LPlacer.Enabled = False
Map1.Layers(0).Visible = False
Else
LPlacer.Enabled = True
make_LPlacer
Map1.Layers(0).Visible = LPlacer
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Toolbar1.Buttons("ZoomIn").Value = 1 Then
Map1.Extent = Map1.TrackRectangle
ElseIf Toolbar1.Buttons("ZoomOut").Value = 1 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -