frmmain.frm

基于arcengine 开发实例

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 = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.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    =   7995
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10215
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7995
   ScaleWidth      =   10215
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "设置地图比例尺"
      Height          =   375
      Left            =   8280
      TabIndex        =   8
      Top             =   6840
      Width           =   1815
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   5520
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   6840
      Width           =   2655
   End
   Begin VB.CommandButton Command2 
      Caption         =   "导出图片"
      Height          =   375
      Left            =   4320
      TabIndex        =   6
      Top             =   120
      Width           =   1095
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   5
      Top             =   7740
      Width           =   10215
      _ExtentX        =   18018
      _ExtentY        =   450
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   2
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   12832
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   6960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开地图"
      Height          =   375
      Left            =   3120
      TabIndex        =   4
      Top             =   120
      Width           =   1095
   End
   Begin esriMapControl.MapControl MapControl2 
      Height          =   1695
      Left            =   120
      OleObjectBlob   =   "frmMain.frx":0000
      TabIndex        =   3
      Top             =   5040
      Width           =   2775
   End
   Begin esriMapControl.MapControl MapControl1 
      Height          =   6135
      Left            =   3000
      OleObjectBlob   =   "frmMain.frx":06B5
      TabIndex        =   2
      Top             =   600
      Width           =   7095
   End
   Begin esriTOCControl.TOCControl TOCControl1 
      Height          =   4335
      Left            =   120
      OleObjectBlob   =   "frmMain.frx":0D68
      TabIndex        =   1
      Top             =   600
      Width           =   2775
   End
   Begin esriToolbarControl.ToolbarControl ToolbarControl1 
      Height          =   390
      Left            =   120
      OleObjectBlob   =   "frmMain.frx":0DDD
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
   Begin VB.Label Label2 
      Caption         =   "当前比例尺："
      Height          =   255
      Left            =   720
      TabIndex        =   10
      Top             =   6960
      Width           =   1095
   End
   Begin VB.Label Label1 
      Height          =   255
      Left            =   1920
      TabIndex        =   9
      Top             =   6960
      Width           =   3495
   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
Private sMapUnits As String '显示坐标用

Private Sub Command1_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 Command2_Click()
    CommonDialog1.FileName = ""
   CommonDialog1.Filter = "JPG图片(*.JPG)|*.jpg"
   CommonDialog1.ShowSave
   If CommonDialog1.FileName <> "" Then
   
       Dim lScrRes As Long
       lScrRes = Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.Resolution
       
       
   
       Dim pExporter As IExporter
       Set pExporter = New JpegExporter
       pExporter.ExportFileName = CommonDialog1.FileName
       pExporter.Resolution = lScrRes
   
       Dim deviceRECT As tagRECT
       deviceRECT = Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.DeviceFrame
   
       Dim pDriverBounds As IEnvelope
       Set pDriverBounds = New Envelope
   
       pDriverBounds.PutCoords deviceRECT.Left, deviceRECT.bottom, deviceRECT.Right, deviceRECT.Top
   
       pExporter.PixelBounds = pDriverBounds
       Dim pCancel As ITrackCancel
       Set pCancel = New CancelTracker
       Me.MapControl1.ActiveView.Output pExporter.StartExporting, lScrRes, deviceRECT, Me.MapControl1.ActiveView.Extent, pCancel
       pExporter.FinishExporting
   
End If
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_OnExtentUpdated(ByVal displayTransformation As Variant, ByVal sizeChanged As Boolean, ByVal newEnvelope As Variant)
Label1.Caption = "1:" & MapControl1.MapScale   '显示比例尺
Text1.Text = MapControl1.MapScale
End Sub

Private Sub MapControl1_OnMapReplaced(ByVal newMap As Variant)


    Dim pMapUnits As esriUnits
    pMapUnits = MapControl1.MapUnits
      
      If pMapUnits = esriCentimeters Then
       sMapUnits = "Centimeters"
    ElseIf pMapUnits = esriDecimalDegrees Then
       sMapUnits = "Decimal Degrees"
    ElseIf pMapUnits = esriDecimeters Then
       sMapUnits = "Decimeters"
    ElseIf pMapUnits = esriFeet Then
       sMapUnits = "Feet"
    ElseIf pMapUnits = esriInches Then
       sMapUnits = "Inches"
    ElseIf pMapUnits = esriKilometers Then
       sMapUnits = "Kilometers"
    ElseIf pMapUnits = esriMeters Then
       sMapUnits = "Meters"
    ElseIf pMapUnits = esriMiles Then
       sMapUnits = "Miles"
    ElseIf pMapUnits = esriMillimeters Then
       sMapUnits = "Millimeters"
    ElseIf pMapUnits = esriNauticalMiles Then
       sMapUnits = "NauticalMiles"
    ElseIf pMapUnits = esriPoints Then
       sMapUnits = "Points"
    ElseIf pMapUnits = esriUnknownUnits Then
       sMapUnits = "Unknown"
    ElseIf pMapUnits = esriYards Then
       sMapUnits = "Yards"
      End If
      
      
      
      '当主地图显示控件的地图改变时，鹰眼中的地图也跟随改变
  '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 MapControl1_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
'状态栏上显示坐标
StatusBar1.Panels(2).Text = Format(mapX, ".00") & " , " & Format(mapY, ".00") & " " & sMapUnits

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 Command4_Click()
    '设置地图显示比例尺
    MapControl1.MapScale = Val(Text1.Text)
    MapControl1.Refresh
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