?? frmchaxun.frm
字號:
VERSION 5.00
Object = "{B7D43581-3CBC-11D6-AA09-00104BB6FC1C}#1.0#0"; "ToolbarControl.ocx"
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmchaxun
Caption = "信息查詢"
ClientHeight = 7320
ClientLeft = 60
ClientTop = 450
ClientWidth = 10065
LinkTopic = "Form1"
ScaleHeight = 7320
ScaleWidth = 10065
StartUpPosition = 3 'Windows Default
Begin esriToolbarControl.ToolbarControl ToolbarControl1
Height = 390
Left = 7080
OleObjectBlob = "frmchaxun.frx":0000
TabIndex = 13
Top = 240
Width = 1695
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5880
Top = 240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command4
Caption = "導入地圖"
Height = 495
Left = 3480
TabIndex = 12
Top = 240
Width = 1575
End
Begin VB.CommandButton Command5
Caption = "返回"
Height = 495
Left = 7680
TabIndex = 11
Top = 6600
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "按屬性查詢"
Height = 375
Left = 3840
TabIndex = 10
Top = 6720
Width = 1215
End
Begin VB.ComboBox Combo3
Height = 300
Left = 3240
TabIndex = 8
Top = 6240
Width = 2895
End
Begin VB.CommandButton Command2
Caption = "清空"
Height = 375
Left = 600
TabIndex = 7
Top = 6720
Width = 1335
End
Begin VB.ListBox List1
Height = 2595
ItemData = "frmchaxun.frx":00E1
Left = 120
List = "frmchaxun.frx":00E3
TabIndex = 6
Top = 3360
Width = 2655
End
Begin VB.CommandButton Command1
Caption = "按名稱查詢"
Height = 375
Left = 480
TabIndex = 5
Top = 2880
Width = 1215
End
Begin VB.ComboBox Combo2
Height = 300
Left = 240
TabIndex = 4
Top = 2160
Width = 1815
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "frmchaxun.frx":00E5
Left = 240
List = "frmchaxun.frx":00F2
TabIndex = 2
Top = 960
Width = 1695
End
Begin esriMapControl.MapControl MapControl1
Height = 4695
Left = 3240
OleObjectBlob = "frmchaxun.frx":010E
TabIndex = 0
Top = 840
Width = 6495
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "設置屬性的條件進行查詢"
Height = 255
Left = 3240
TabIndex = 9
Top = 5760
Width = 2655
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "請輸入測站名字"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 3
Top = 1560
Width = 1935
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "測站類別"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 1
Top = 480
Width = 1575
End
End
Attribute VB_Name = "frmchaxun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_Click()
'Combo1.text為測站類別
'Combo2.text為按名稱查詢時的測站名字
'Combo3.text 為進行屬性查詢時我們在中可以進行屬性的設置
If Combo1.Text = "水文站" Then
Combo2.Clear
Combo2.AddItem "溧陽"
Combo2.AddItem "南渡"
Combo2.AddItem "沙河水庫"
Combo2.AddItem "橫山水庫"
Combo2.AddItem "宜興"
Combo2.AddItem "漕橋"
Combo2.AddItem "金壇"
Combo2.AddItem "王母觀"
Combo2.AddItem "甘露"
Combo2.AddItem "丹陽"
Combo2.AddItem "白芍山"
Combo2.AddItem "常州"
Combo2.AddItem "無錫"
Combo2.AddItem "夾浦"
Combo2.AddItem "杭長橋"
Combo2.AddItem "太浦閘(上)"
Combo2.AddItem "望亭（太）"
Combo2.AddItem "大浦口"
Combo2.AddItem "洞庭西山"
Combo2.AddItem "坊前"
Combo2.AddItem "洛社"
Combo2.AddItem "陳墅"
Combo2.AddItem "青陽"
Combo2.AddItem "甘露"
Combo2.AddItem "北國"
Combo2.AddItem "湘城"
Combo2.AddItem "瓜涇口"
Combo2.AddItem "楓橋"
Combo2.AddItem "常熟"
Combo2.AddItem "直塘"
Combo2.AddItem "昆山"
Combo2.AddItem "金家壩"
Combo2.AddItem "陳墓"
Combo3.Clear
Combo3.AddItem "OBJCTID"
Combo3.AddItem "STNM"
Combo3.AddItem "LONGTITUDE"
Combo3.AddItem "LATITYDE"
ElseIf Combo1.Text = "雨量站" Then
Combo2.Clear
Combo2.AddItem "茅東匣"
Combo2.AddItem "上沛"
Combo2.AddItem "東岳廟"
Combo2.AddItem "薛埠"
Combo2.AddItem "沙河水庫"
Combo2.AddItem "橫山水庫"
Combo2.AddItem "善卷"
Combo2.AddItem "湖父"
Combo2.AddItem "大澗"
Combo2.AddItem "錢宋水庫"
Combo2.AddItem "平橋"
Combo2.AddItem "溧陽"
Combo2.AddItem "白兔"
Combo2.AddItem "西麓"
Combo2.AddItem "諫壁"
Combo2.AddItem "河口"
Combo2.AddItem "南渡"
Combo2.AddItem "后周"
Combo3.Clear
Combo3.AddItem "OBJCTID"
Combo3.AddItem "STNM"
Combo3.AddItem "LONGTITUDE"
Combo3.AddItem "LATITYDE"
Combo3.AddItem "YULIANG"
End If
End Sub
'按名稱進行查詢
Private Sub Command1_Click()
Dim pFeatureLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
Dim pfeature As IFeature
Dim pFeatureCursor As IFeatureCursor
Dim pQueryFilter As IQueryFilter
Dim n As Integer
For n = 0 To MapControl1.LayerCount - 1
Set pFeatureLayer = MapControl1.Layer(n)
If pFeatureLayer.Name = Combo1.Text Then
Exit For
End If
Next n
If n = MapControl1.LayerCount + 1 Then
MsgBox "查詢圖層不存在！"
End If
On Error GoTo ErrorHandler:
Set pFeatureClass = pFeatureLayer.FeatureClass
Set pQueryFilter = New QueryFilter 'QI
pQueryFilter.WhereClause = "STNM = '" & Combo2.Text & "'"
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
Set pfeature = pFeatureCursor.NextFeature
Dim pFeatureSelection As IFeatureSelection
Set pFeatureSelection = pFeatureLayer
Do Until pfeature Is Nothing
Dim pGeometry As IGeometry
Set pGeometry = pfeature.Shape
Dim pPoint As IPoint
Set pPoint = pGeometry
Dim pEnvelope As IEnvelope
Set pEnvelope = MapControl1.ActiveView.Extent
pEnvelope.Height = 200
pEnvelope.Width = 200
pEnvelope.CenterAt pPoint '將查詢到的測站置中
MapControl1.ActiveView.Extent = pEnvelope
Dim pActiveview As IActiveView
Set pActiveview = MapControl1.ActiveView
pActiveview.Refresh
If Combo1.Text = "雨量站" Then
List1.Clear
List1.AddItem "OBJCTID" & " " & pfeature.Value(0)
List1.AddItem "STNM" & " " & pfeature.Value(4)
List1.AddItem "LONGTITUDE" & " " & pfeature.Value(5)
List1.AddItem "LATITYDE" & " " & pfeature.Value(6)
List1.AddItem "YULIANG" & " " & pfeature.Value(8)
ElseIf Combo1.Text = "水文站" Then
List1.Clear
List1.AddItem "OBJCTID" & " " & pfeature.Value(0)
List1.AddItem "STNM" & " " & pfeature.Value(4)
List1.AddItem "LONGTITUDE" & " " & pfeature.Value(5)
List1.AddItem "LATITYDE" & " " & pfeature.Value(6)
End If
Set pfeature = pFeatureCursor.NextFeature
Loop
pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False '將查詢到的測站高亮顯示
Exit Sub
ErrorHandler:
MsgBox Err.Description '如屬性查詢時設置的屬性錯誤,則會冒出 參數不足,期待是1 的提示
End Sub
Private Sub Command2_Click()
List1.Clear
MapControl1.ActiveView.Refresh
End Sub
'按屬性進行查詢,語句解釋和按名稱查詢一樣
Private Sub Command3_Click()
Dim pFeatureLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
Dim pfeature As IFeature
Dim pFeatureCursor As IFeatureCursor
Dim pQueryFilter As IQueryFilter
Dim n As Integer
For n = 0 To MapControl1.LayerCount - 1
Set pFeatureLayer = MapControl1.Layer(n)
If pFeatureLayer.Name = Combo1.Text Then
Exit For
End If
Next n
If n = MapControl1.LayerCount + 1 Then
MsgBox "查詢圖層不存在！"
End If
On Error GoTo ErrorHandler:
Set pFeatureClass = pFeatureLayer.FeatureClass
Set pQueryFilter = New QueryFilter
pQueryFilter.WhereClause = Combo3.Text
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
Set pfeature = pFeatureCursor.NextFeature
Dim pFeatureSelection As IFeatureSelection
Set pFeatureSelection = pFeatureLayer
Do Until pfeature Is Nothing
'Dim pGeometry As IGeometry
'Set pGeometry = pfeature.Shape
'Dim pEnvelope As IEnvelope
'Set pEnvelope = MapControl1.ActiveView.Extent
'pEnvelope.Height = 300
'pEnvelope.Width = 300
'pEnvelope = pGeometry.Envelope
'獲得查詢到的要素的外包框,并將地圖縮小到查詢到的要素區域
MapControl1.ActiveView.Extent = pfeature.Shape.Envelope
MapControl1.ActiveView.Refresh
If Combo1.Text = "雨量站" Then
List1.Clear
List1.AddItem "OBJCTID" & " " & pfeature.Value(0)
List1.AddItem "STNM" & " " & pfeature.Value(4)
List1.AddItem "LONGTITUDE" & " " & pfeature.Value(5)
List1.AddItem "LATITYDE" & " " & pfeature.Value(6)
List1.AddItem "YULIANG" & " " & pfeature.Value(8)
ElseIf Combo1.Text = "水文站" Then
List1.Clear
List1.AddItem "OBJCTID" & " " & pfeature.Value(0)
List1.AddItem "STNM" & " " & pfeature.Value(4)
List1.AddItem "LONGTITUDE" & " " & pfeature.Value(5)
List1.AddItem "LATITYDE" & " " & pfeature.Value(6)
End If
Set pfeature = pFeatureCursor.NextFeature
Loop
pFeatureSelection.SelectFeatures pQueryFilter, esriSelectionResultNew, False
Exit Sub
ErrorHandler:
MsgBox Err.Description
End Sub
Private Sub Command4_Click()
'打開地圖文檔
On Error Resume Next
Dim sfilename As String
With CommonDialog1
.DialogTitle = "Open Map Document"
.Filter = "Map Documents (*.mxd;*.pmf)|*.mxd;*.pmf"
.ShowOpen
If .FileName = "" Then Exit Sub
sfilename = .FileName
End With
If MapControl1.CheckMxFile(sfilename) Then
MapControl1.LoadMxFile sfilename
MapControl1.Extent = MapControl1.FullExtent
Else
MsgBox sfilename & " is not a valid ArcMap document"
Exit Sub
End If
frmchaxun.Caption = frmchaxun.Caption & " - " & sfilename
End Sub
Private Sub Command5_Click()
Unload Me
frmMain.Show
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -