📄 form1.frm
字号:
VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1
Caption = "SearchShape方法示例"
ClientHeight = 5340
ClientLeft = 135
ClientTop = 1500
ClientWidth = 9300
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 5340
ScaleWidth = 9300
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 390
Left = 0
TabIndex = 0
Top = 0
Width = 9300
_ExtentX = 16404
_ExtentY = 688
ButtonWidth = 609
ButtonHeight = 582
ImageList = "ImageList1"
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 10
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Points"
Description = "Find features using a point"
Object.ToolTipText = "点搜索"
Object.Tag = ""
ImageIndex = 1
Style = 2
Value = 1
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Rectangles"
Description = "Find features using a rectangle"
Object.ToolTipText = "矩形搜索"
Object.Tag = ""
ImageIndex = 2
Style = 2
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Lines"
Description = "Find features using a line"
Object.ToolTipText = "线搜索"
Object.Tag = ""
ImageIndex = 3
Style = 2
EndProperty
BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Polygons"
Description = "Find features using a polygon"
Object.ToolTipText = "多边形搜索"
Object.Tag = ""
ImageIndex = 4
Style = 2
EndProperty
BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "ZoomIn"
Description = "Zoom In"
Object.ToolTipText = "放大"
Object.Tag = ""
ImageIndex = 5
Style = 2
EndProperty
BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "ZoomOut"
Description = "Zoom Out"
Object.ToolTipText = "缩小"
Object.Tag = ""
ImageIndex = 6
Style = 2
EndProperty
BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Pan"
Description = "Pan"
Object.ToolTipText = "平移地图"
Object.Tag = ""
ImageIndex = 7
Style = 2
EndProperty
BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.Tag = ""
Style = 3
MixedState = -1 'True
EndProperty
BeginProperty Button9 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "FullExtent"
Description = "Zoom to Full Extent"
Object.ToolTipText = "全图显示"
Object.Tag = ""
ImageIndex = 8
EndProperty
BeginProperty Button10 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "ClearSelection"
Description = "Clear selection"
Object.ToolTipText = "清除选择"
Object.Tag = ""
ImageIndex = 9
EndProperty
EndProperty
End
Begin VB.ComboBox Combo2
Height = 300
Left = 1065
Style = 2 'Dropdown List
TabIndex = 7
Top = 480
Width = 3135
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1065
Style = 2 'Dropdown List
TabIndex = 4
Top = 960
Width = 3135
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 285
Left = 3240
TabIndex = 2
Text = "0.5"
Top = 5040
Width = 975
End
Begin VB.ListBox List1
Height = 2940
Left = 105
TabIndex = 1
Top = 1575
Width = 4095
End
Begin MapObjects2.Map Map1
Height = 4815
Left = 4440
TabIndex = 9
Top = 480
Width = 4935
_Version = 131072
_ExtentX = 8705
_ExtentY = 8493
_StockProps = 225
BackColor = 16777215
BorderStyle = 1
Contents = "Form1.frx":0000
End
Begin ComctlLib.ImageList ImageList1
Left = 4800
Top = 1680
_ExtentX = 1005
_ExtentY = 1005
BackColor = 16776960
ImageWidth = 16
ImageHeight = 16
MaskColor = 16776960
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 9
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":056C
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0676
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":0780
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form1.frx":088A
Key = ""
EndProperty
EndProperty
End
Begin VB.Label Label3
Caption = "搜索方式:"
Height = 255
Left = 105
TabIndex = 8
Top = 1320
Width = 975
End
Begin VB.Label Label4
Caption = "选择:"
Height = 255
Left = 105
TabIndex = 6
Top = 480
Width = 615
End
Begin VB.Label Label2
Caption = "搜索工具:"
Height = 255
Left = 105
TabIndex = 5
Top = 960
Width = 855
End
Begin VB.Label Label1
Caption = "搜索距离:"
Height = 255
Left = 1920
TabIndex = 3
Top = 5040
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'搜索结果
Dim g_selectedFeatures As MapObjects2.Recordset
Dim g_searchSet As MapObjects2.Recordset
'搜索所依据的几何对象
Dim g_searchShape As Object
Dim g_selectedBounds As MapObjects2.Rectangle
Dim g_searchBounds As MapObjects2.Rectangle
Sub DrawRecordset(recs As MapObjects2.Recordset, color, style)
'显示Recordset中的地理对象
If Not recs Is Nothing Then
Dim sym As New Symbol
sym.color = color
If style = moTransparentFill Then sym.OutlineColor = color
sym.style = style
Map1.DrawShape recs, sym
End If
End Sub
Private Function GetRecordsetBounds(recs As MapObjects2.Recordset) As MapObjects2.Rectangle
'获取Recordset中地理对象的边界
Set GetRecordsetBounds = Nothing
If Not recs Is Nothing Then
Dim bounds As MapObjects2.Rectangle
Set bounds = Nothing
Set fld = recs("Shape")
'遍历Recordset中的地理对象
recs.MoveFirst
Do While Not recs.EOF
'获取地理对象边界
Dim shapeBounds As MapObjects2.Rectangle
If fld.Type = moPoint Then
Dim pt As MapObjects2.Point
Set pt = fld.Value
Dim ptBounds As New MapObjects2.Rectangle
ptBounds.Left = pt.x
ptBounds.Top = pt.y
ptBounds.Right = pt.x
ptBounds.Bottom = pt.y
Set shapeBounds = ptBounds
ElseIf fld.Type = moLine Then
Dim l As MapObjects2.Line
Set l = fld.Value
Set shapeBounds = l.Extent
ElseIf fld.Type = moPolygon Then
Dim p As MapObjects2.Polygon
Set p = fld.Value
Set shapeBounds = p.Extent
Else
MsgBox "Invalid shape in GetRecordsetBounds!"
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -