主界面.frm

ＧＩＳ设计最基本的功能

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.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 Form1 
   Caption         =   "Form1"
   ClientHeight    =   8028
   ClientLeft      =   48
   ClientTop       =   708
   ClientWidth     =   12192
   LinkTopic       =   "Form1"
   ScaleHeight     =   8460
   ScaleWidth      =   12192
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   492
      Left            =   0
      TabIndex        =   4
      Top             =   7968
      Width           =   12192
      _ExtentX        =   21505
      _ExtentY        =   868
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   855
      Left            =   840
      TabIndex        =   3
      Top             =   960
      Width           =   1455
   End
   Begin esriMapControl.MapControl MapControl2 
      Height          =   2892
      Left            =   120
      OleObjectBlob   =   "主界面.frx":0000
      TabIndex        =   2
      Top             =   4440
      Width           =   3252
   End
   Begin esriMapControl.MapControl MapControl1 
      Height          =   6252
      Left            =   3600
      OleObjectBlob   =   "主界面.frx":06C2
      TabIndex        =   1
      Top             =   1080
      Width           =   7692
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   312
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   12192
      _ExtentX        =   21505
      _ExtentY        =   550
      ButtonWidth     =   445
      ButtonHeight    =   423
      Appearance      =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   6
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "加图层"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "属性查询"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "放大"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "缩小"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "漫游"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Description     =   "全屏"
            ImageIndex      =   6
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1080
      Top             =   3000
      _ExtentX        =   995
      _ExtentY        =   995
      BackColor       =   -2147483643
      ImageWidth      =   14
      ImageHeight     =   14
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   6
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":0D82
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":0E08
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":0F1A
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":102C
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":113E
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "主界面.frx":1250
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   360
      Top             =   3120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Index           =   0
      Begin VB.Menu open 
         Caption         =   "&打开"
         Index           =   1
      End
      Begin VB.Menu close 
         Caption         =   "&关闭"
         Index           =   2
      End
   End
   Begin VB.Menu edit 
      Caption         =   "编辑"
      Index           =   3
      Begin VB.Menu down 
         Caption         =   "&向下"
         Index           =   5
      End
      Begin VB.Menu up 
         Caption         =   "&向上"
         Index           =   4
      End
      Begin VB.Menu totop 
         Caption         =   "至顶"
         Index           =   5
      End
      Begin VB.Menu tobottom 
         Caption         =   "&至底"
         Index           =   6
      End
      Begin VB.Menu delete 
         Caption         =   "&删除"
         Index           =   7
      End
   End
   Begin VB.Menu view 
      Caption         =   "视图"
      Index           =   8
      Begin VB.Menu zoomin 
         Caption         =   "&放大"
         Index           =   9
      End
      Begin VB.Menu zoomout 
         Caption         =   "&缩小"
         Index           =   10
      End
      Begin VB.Menu goback 
         Caption         =   "&恢复原大小"
         Index           =   11
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
      Index           =   12
      Begin VB.Menu system 
         Caption         =   "&关于系统"
         Index           =   13
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub close_Click(Index As Integer)
Unload Me
End Sub


Private m_pFeedbackEnv      As INewEnvelopeFeedback
Private m_pPoint            As IPoint
Private m_bIsMouseDown      As Boolean
Private m_pActiveView       As IActiveView
Private m_pAoInitialize     As IAoInitialize
Dim aa                      As String
Private m_pArcMapAV         As IActiveView
Dim m_pExtent               As IEnvelope
Dim m_pFillSym              As IFillSymbol




Private Sub Form_Load()
  'Create a new AoInitialize object
  Set m_pAoInitialize = New aoinitialize
  If m_pAoInitialize Is Nothing Then
    MsgBox "Unable to initialize. This application cannot run!"
    Unload Form1
    Exit Sub
  End If
  'Determine if the product is available
  If m_pAoInitialize.IsProductCodeAvailable(esriLicenseProductCodeEngine) = esriLicenseAvailable Then
    If m_pAoInitialize.Initialize(esriLicenseProductCodeEngine) <> esriLicenseCheckedOut Then
      MsgBox "The initialization failed. This application cannot run!"
      Unload Form1
      Exit Sub
    End If
  Else
    MsgBox "The ArcGIS Engine product is unavailable. This application cannot run!"
    Unload Form1
    Exit Sub
  End If

  Dim sFilePath As String
  'Find sample data by navigating two folders up
  sFilePath = App.Path & "E:\新建文件夹\mo\Samples\Data\Mexico"
  
  'Add sample 'country' shapefile data
  MapControl1.AddShapeFile sFilePath, "STATES"

  Dim pGeoFeatureLayer As IGeoFeatureLayer
  'Grab hold of the IgeoFeaturelayer interface on the layer
  'in the map control in order to symbolize the data
  Set pGeoFeatureLayer = MapControl1.Layer(0)
  
  Dim pSimpleRenderer As ISimpleRenderer
  Dim pFillSymbol As ISimpleFillSymbol
  Dim pLineSymbol As ISimpleLineSymbol
  
  'Create a simple renderer and grab hold of ISimpleRenderer interface
  Set pSimpleRenderer = New SimpleRenderer
  'Create a fill symbol and grab hold of the ISimpleFillSymbol interface
  Set pFillSymbol = New SimpleFillSymbol
  'Create a line symbol and grab hold of the ISimpleLineSymbol interface
  Set pLineSymbol = New SimpleLineSymbol
  
  'Assign line symbol and fill symbol properties
  pLineSymbol.Width = 0.1
  pLineSymbol.Color = GetRGBColor(255, 0, 0) 'Red
  pFillSymbol.Outline = pLineSymbol
  pFillSymbol.Color = GetRGBColor(0, 0, 255) 'Blue
  
  'Set the symbol property of the renderer
  Set pSimpleRenderer.Symbol = pFillSymbol
  
  'Set the renderer property of the geo feature layer
  Set pGeoFeatureLayer.Renderer = pSimpleRenderer
  
End Sub


Private Sub Form_Unload(Cancel As Integer)
  On Error GoTo ErrorHandler
 'Free memory
  Set m_pExtent = Nothing
  Set m_pFillSym = Nothing
  Set m_pArcMapAV = Nothing
  Exit Sub
ErrorHandler:
  HandleError True, "Form_Unload " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 1
   m_pAoInitialize.Shutdown
End Sub


Private Sub goback_Click(Index As Integer)
 MapControl1.Extent = MapControl1.FullExtent
End Sub

Private Sub open_Click(Index As Integer)
CommonDialog1.Filter = "shapefile.|*.shp"
CommonDialog1.ShowOpen
End Sub

Private Sub MapControl1_GotFocus()
  Shape1.Visible = True
End Sub

Private Sub MapControl1_LostFocus()
  Shape1.Visible = False
End Sub


Private Sub MapControl1_OnKeyDown(ByVal KeyCode As Long, ByVal shift As Long)
  Select Case KeyCode
    Case vbKeyUp
      PanMap 0, 0.5
    Case vbKeyDown
      PanMap 0, -0.5
    Case vbKeyLeft
      PanMap -0.5, 0
    Case vbKeyRight
      PanMap 0.5, 0
  End Select
End Sub



Private Sub PanMap(ratioX As Double, ratioY As Double)
  Dim h As Double
  Dim w As Double
  Dim pEnvelope As IEnvelope
  Set pEnvelope = MapControl1.Extent
  h = pEnvelope.Width
  w = pEnvelope.Height
  
  pEnvelope.Offset h * ratioX, w * ratioY
  
  MapControl1.Extent = pEnvelope
End Sub



Private Sub CmdFullExtent_Click()
    'Get the MapContol's full extent and set the current extent to this
  Dim pEnv As IEnvelope
  Set pEnv = MapControl1.FullExtent
  MapControl1.Extent = pEnv
End Sub




Private Sub Toolbar1_ButtonClick(ByVal button As MSComctlLib.button)
If button.Index = 1 Then
aa = 1
ElseIf button.Index = 2 Then
aa = 2
MapControl1.MousePointer = esriPointerIdentify
ElseIf button.Index = 3 Then
aa = 3
MapControl1.MousePointer = esriPointerZoomIn
ElseIf button.Index = 4 Then
aa = 4
MapControl1.MousePointer = esriPointerZoomOut
ElseIf button.Index = 5 Then
aa = 5
MapControl1.MousePointer = esriPointerPan
ElseIf button.Index = 6 Then
aa = 6
Call CmdFullExtent_Click
End If
End Sub


Private Sub MapControl1_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)
  
  ' Check which button has been pressed by the user
  If aa = 3 Then
    ' Left button - Track a Rectangle and use this to set the MapControl's extent
    Dim pEnv As IEnvelope
    Set pEnv = MapControl1.TrackRectangle
    MapControl1.Extent = pEnv
  ElseIf aa = 4 Then
   m_pArcMapAV.Extent = m_pArcMapAV.FullExtent
    Set m_pExtent = m_pArcMapAV.FullExtent
  ElseIf aa = 5 Then
    MapControl1.Pan
  End If
Private Sub zoomin_Click(Index As Integer)
  Dim pEnv As IEnvelope
    Set pEnv = MapControl1.TrackRectangle
    MapControl1.Extent = pEnv
End Sub