frmchaxun.frm

用ArcObject在VB开发环境下实现水务信息数据管理、属性查询、等量线绘制等功能

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