frmmain.frm

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

VERSION 5.00
Object = "{370A8DDA-7915-42DC-B4A1-77662C82B046}#1.0#0"; "TOCControl.ocx"
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 frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Esri ArcGIS Engine Test(太湖流域水资源信息管理系统)"
   ClientHeight    =   9030
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   11010
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9030
   ScaleWidth      =   11010
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command5 
      Caption         =   "刷新"
      Height          =   375
      Left            =   9120
      TabIndex        =   9
      Top             =   4440
      Width           =   975
   End
   Begin VB.CommandButton Command4 
      Caption         =   "属性浏览"
      Height          =   615
      Left            =   8520
      TabIndex        =   8
      Top             =   7800
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "信息查询（按名称、属性）"
      Height          =   615
      Left            =   4560
      TabIndex        =   7
      Top             =   7800
      Width           =   2775
   End
   Begin VB.CommandButton Command2 
      Caption         =   "数据库维护及绘制过程线"
      Height          =   615
      Left            =   1320
      TabIndex        =   6
      Top             =   7800
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "目标数目"
      Height          =   495
      Left            =   9120
      TabIndex        =   5
      Top             =   3720
      Width           =   975
   End
   Begin VB.ListBox List1 
      Height          =   2595
      ItemData        =   "frmMain.frx":0000
      Left            =   8640
      List            =   "frmMain.frx":0002
      TabIndex        =   4
      Top             =   720
      Width           =   1815
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   7320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin esriMapControl.MapControl MapControl2 
      Height          =   2295
      Left            =   8400
      OleObjectBlob   =   "frmMain.frx":0004
      TabIndex        =   3
      Top             =   4920
      Width           =   2535
   End
   Begin esriMapControl.MapControl MapControl1 
      Height          =   6495
      Left            =   2760
      OleObjectBlob   =   "frmMain.frx":06C6
      TabIndex        =   2
      Top             =   720
      Width           =   5535
   End
   Begin esriTOCControl.TOCControl TOCControl1 
      Height          =   6495
      Left            =   0
      OleObjectBlob   =   "frmMain.frx":0D86
      TabIndex        =   1
      Top             =   720
      Width           =   2535
   End
   Begin esriToolbarControl.ToolbarControl ToolbarControl1 
      Height          =   390
      Left            =   120
      OleObjectBlob   =   "frmMain.frx":0E08
      TabIndex        =   0
      Top             =   120
      Width           =   4575
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Begin VB.Menu open 
         Caption         =   "打开"
      End
      Begin VB.Menu quit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'地图鹰眼
Private m_pEnvelope As IEnvelope  ' The envelope drawn on the MapControl
Private m_pFillSymbol As ISimpleFillSymbol ' The symbol used to draw the
Private WithEvents m_pTransformEvents As DisplayTransformation
Attribute m_pTransformEvents.VB_VarHelpID = -1
Option Explicit
Public pp As String
Private Sub Command2_Click()
frmMain.Hide
Frmweihu.Show
End Sub

Private Sub Command3_Click()
frmMain.Hide
frmchaxun.Show
End Sub

Private Sub Command4_Click()
  Dim button As Long
  Dim shift As Long
  Dim x As Long
  Dim y As Long
  Dim mapX As Double
  Dim mapY As Double
  Dim pmap As IMap
  Set pmap = MapControl1.Map
  Dim pIdentifyDialog As IIdentifyDialog
  Dim pIdentifyDialogProps As IIdentifyDialogProps
  Dim pEnumLayer As IEnumLayer
  Dim pLayer As ILayer
  
  Dim pPoint As IPoint
  Dim pLyr As ILayer
  Dim pIdentify As IIdentify
  Dim pIDArray As IArray
  Dim i As Long
  Dim j As Long
  For j = 0 To MapControl1.LayerCount - 1
    Set pIdentify = MapControl1.Layer(j)
    Set pPoint = MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    Set pIDArray = pIdentify.Identify(pPoint)
    If Not pIDArray Is Nothing Then
      i = i + 1
    End If
  Next
  If i = 0 Then Exit Sub
  
  Set pIdentifyDialog = New IdentifyDialog
  Set pIdentifyDialogProps = pIdentifyDialog
  Set pIdentifyDialog.Map = MapControl1.ActiveView.FocusMap
  Set pIdentifyDialog.display = MapControl1.ActiveView.ScreenDisplay
  pIdentifyDialog.ClearLayers
  Set pEnumLayer = pIdentifyDialogProps.Layers
  pEnumLayer.Reset
  Set pLayer = pEnumLayer.Next
  Do While (Not pLayer Is Nothing)
    pIdentifyDialog.AddLayerIdentifyPoint pLayer, x, y
    Set pLayer = pEnumLayer.Next
  Loop

  pIdentifyDialog.Show
End Sub

Private Sub Command5_Click()
 MapControl1.ActiveView.GraphicsContainer.DeleteAllElements
    MapControl1.Refresh
End Sub

Private Sub Form_Load()
   Call CreateOverviewSymbol
End Sub

Private Sub CreateOverviewSymbol()  '设置鹰眼图中的红线框
  'Get the IRgbColor interface.
  Dim pColor As IRgbColor
  Set pColor = New RgbColor
  'Set the color properties.
pColor.RGB = RGB(255, 0, 0)
  'Get the ILine symbol interface.
  Dim pOutline As ILineSymbol
  Set pOutline = New SimpleLineSymbol
    'Set the line symbol properties.
pOutline.Width = 1.5
pOutline.Color = pColor
  'Get the IFillSymbol interface.
  Set m_pFillSymbol = New SimpleFillSymbol
  'Set the fill symbol properties.
m_pFillSymbol.Outline = pOutline
m_pFillSymbol.Style = esriSFSHollow
End Sub
Private Sub m_pTransformEvents_VisibleBoundsUpdated(ByVal sender As esriDisplay.IDisplayTransformation, ByVal sizeChanged As Boolean)

  'Set the extent to the new visible extent.
  Set m_pEnvelope = sender.VisibleBounds
  'Refresh the MapControl's foreground phase.
  
  MapControl2.Refresh esriViewForeground
End Sub

Private Sub MapControl1_OnMapReplaced(ByVal newMap As Variant)


    Dim pMapUnits As esriUnits
    pMapUnits = MapControl1.MapUnits
      
      
     '当主地图显示控件的地图改变时，鹰眼中的地图也跟随改变
      
      'Get the IActiveView of the focus map in the PageLayoutControl.
  Dim pActiveview As IActiveView
  Set pActiveview = MapControl1.ActiveView.FocusMap
  'Trap the ITransformEvents of the PageLayoutControl's focus map.
  Set m_pTransformEvents = pActiveview.ScreenDisplay.DisplayTransformation
  'Get the extent of the focus map.
  Set m_pEnvelope = pActiveview.Extent
  'Load the same preauthored map document into the MapControl.
MapControl2.LoadMxFile MapControl1.DocumentFilename
  'Set the extent of the MapControl to the full extent of the data.
MapControl2.Extent = MapControl2.FullExtent

End Sub

Private Sub mapcontrol2_OnAfterDraw(ByVal display As Variant, ByVal viewDrawPhase As Long)
    If m_pEnvelope Is Nothing Then Exit Sub
  'If the foreground phase has drawn
  Dim pViewDrawPhase As esriViewDrawPhase
    pViewDrawPhase = viewDrawPhase
  If pViewDrawPhase = esriViewForeground Then
    'Draw the shape on the MapControl.
   MapControl2.DrawShape m_pEnvelope, m_pFillSymbol
  End If

End Sub
Private Sub MapControl2_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
   Dim pPt As IPoint
   Set pPt = New Point
   pPt.PutCoords mapX, mapY
'改变主控件的视图范围
MapControl1.CenterAt pPt

End Sub

Private Sub open_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
frmMain.Caption = frmMain.Caption & " - " & sfilename
End Sub

Private Sub quit_Click()
End
End Sub
Private Sub Command1_Click()
    Dim i As Integer
    Dim pmap As IMap
    Dim pfeature As IFeature
    Dim penumfeature As IEnumFeature
    
    Set pmap = frmMain.MapControl1.Map
    Set penumfeature = pmap.FeatureSelection
    Set pfeature = penumfeature.Next
    
    MsgBox "你选择了" & pmap.SelectionCount & "个对象"
       List1.Clear
   
     Do Until pfeature Is Nothing
    
        List1.AddItem pfeature.Value(pfeature.Fields.FindField("ID"))
        Set pfeature = penumfeature.Next
     
     Loop
    
End Sub





Private Sub List1_Click()
    pp = List1.List(List1.ListIndex)
   
    If pp <> "常熟" And pp <> "常州" And pp <> "大浦口" And pp <> "甘露" _
       And pp <> "杭长桥" And pp <> "夹浦" And pp <> "嘉兴" And pp <> "琳桥" _
       And pp <> "平望" And pp <> "苏州" And pp <> "太浦闸" And pp <> "望亭" _
       And pp <> "望亭(太）" And pp <> "无锡" And pp <> "西山" And pp <> "小梅山" Then
       MsgBox "对不起,暂时没有你想要的测站水文信息", 48, "提示信息"
    Else
     With frmchaxun2.Adodc1
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GIS1.mdb;Persist Security Info=False"
        .RecordSource = "select * from " & pp
        .Refresh
    End With
    Set frmchaxun2.DataGrid1.DataSource = frmchaxun2.Adodc1
   frmchaxun2.Show
  End If
      
End Sub