maptips.frm

ArcEngine开发地图提示条控件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{033364CA-47F9-4251-98A5-C88CD8D3C808}#1.0#0"; "esriControls.olb"
Begin VB.Form Form1 
   Caption         =   "Map Tips"
   ClientHeight    =   6840
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   5172
   LinkTopic       =   "Form1"
   ScaleHeight     =   6840
   ScaleWidth      =   5172
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox chkTransparent 
      Caption         =   "Transparent Tips"
      Height          =   372
      Left            =   120
      TabIndex        =   9
      Top             =   960
      Width           =   1932
   End
   Begin esriControls.LicenseControl LicenseControl1 
      Left            =   360
      OleObjectBlob   =   "MapTips.frx":0000
      Top             =   1680
   End
   Begin esriControls.MapControl MapControl1 
      Height          =   4812
      Left            =   120
      OleObjectBlob   =   "MapTips.frx":0039
      TabIndex        =   8
      Top             =   1440
      Width           =   4932
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1560
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdFullExtent 
      Caption         =   "Zoom to Full Extent"
      Height          =   375
      Left            =   3360
      TabIndex        =   6
      Top             =   6360
      Width           =   1695
   End
   Begin VB.CheckBox chkShowTips 
      Caption         =   "Show Map Tips"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   1935
   End
   Begin VB.CommandButton cmdLoadData 
      Caption         =   "Load Document..."
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1695
   End
   Begin VB.ComboBox cboDataField 
      Height          =   315
      Left            =   2640
      TabIndex        =   1
      Top             =   600
      Width           =   2415
   End
   Begin VB.ComboBox cboDataLayer 
      Height          =   315
      Left            =   2640
      TabIndex        =   0
      Top             =   240
      Width           =   2415
   End
   Begin VB.Label Label3 
      Caption         =   "Left mouse button to zoomin, right to pan"
      Height          =   252
      Left            =   120
      TabIndex        =   7
      Top             =   6360
      Width           =   3132
   End
   Begin VB.Label Label2 
      Caption         =   "Fields:"
      Height          =   255
      Left            =   2040
      TabIndex        =   5
      Top             =   630
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "Layers:"
      Height          =   255
      Left            =   2040
      TabIndex        =   4
      Top             =   270
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 2006 ESRI
' 							  
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at /arcgis/developerkit/userestrictions.

Option Explicit

Private Sub cboDataField_Click()
  
  'Get IFeatureLayer interface
  Dim pFeatureLayer As IFeatureLayer
  Set pFeatureLayer = MapControl1.Layer(cboDataLayer.ListIndex)
  'Query interface for IlayerFields
  Dim pLayerFields As ILayerFields
  Set pLayerFields = pFeatureLayer

  Dim i As Long
  Dim pField As IField
  'Loop through the fields
  For i = 0 To pLayerFields.FieldCount - 1
    'Get IField interface
    Set pField = pLayerFields.Field(i)
    'If the field name is the name selected in the control
    If pField.Name = cboDataField.Text Then
      'Set the field as the display field
      pFeatureLayer.DisplayField = pField.Name
      Exit For
    End If
  Next i
  
End Sub
Private Sub cboDataLayer_Click()
  
  'Disable field combo if feature layer is not selected and exit
  If Not TypeOf MapControl1.Layer(cboDataLayer.ListIndex) Is IFeatureLayer Then
    cboDataField.Clear
    cboDataField.Enabled = False
    Exit Sub
  End If
  
  'Get IFeatureLayer interface
  Dim pFeatureLayer As IFeatureLayer
  Set pFeatureLayer = MapControl1.Layer(cboDataLayer.ListIndex)
  'Query inteface for ILayerFields
  Dim pLayerFields As ILayerFields
  Set pLayerFields = pFeatureLayer

  Dim i As Long
  Dim j As Long
  j = 0
  Dim pField As IField
  cboDataField.Clear
  cboDataField.Enabled = True
  'Loop through the fields
  For i = 0 To pLayerFields.FieldCount - 1
    'Get IField interface
    Set pField = pLayerFields.Field(i)
    'If the field is not the shape field
    If pField.Type <> esriFieldTypeGeometry Then
      'Add field name to the control
      cboDataField.AddItem pField.Name, j
      'If the field name is the display field
      If pField.Name = pFeatureLayer.DisplayField Then
        'Select the field name in the control
        cboDataField.ListIndex = j
      End If
      j = j + 1
    End If
  Next i
  
  ShowLayerTips

End Sub
Private Sub chkShowTips_Click()

  If chkShowTips.Value = 1 Then
      MapControl1.ShowMapTips = True
      ShowLayerTips
  Else
      MapControl1.ShowMapTips = False
  End If

End Sub

Private Sub chkTransparent_Click()
  If chkTransparent.Value = 1 Then
      MapControl1.TipStyle = esriTipStyle.esriTipStyleTransparent
  Else
      MapControl1.TipStyle = esriTipStyle.esriTipStyleSolid
  End If
End Sub

Private Sub cmdFullExtent_Click()
  
  'Zoom to full extent of data
  MapControl1.Extent = MapControl1.FullExtent

End Sub
Private Sub cmdLoadData_Click()
  
  CommonDialog1.DialogTitle = "Browse Map Document"
  CommonDialog1.Filter = "Map Documents (*.mxd)|*.mxd"
  CommonDialog1.ShowOpen

  'Exit if no map document is selected
  Dim sFilePath As String
  sFilePath = CommonDialog1.FileName
  If sFilePath = "" Then Exit Sub

  'Validate and load map document
  If MapControl1.CheckMxFile(sFilePath) Then
    MapControl1.LoadMxFile sFilePath
    'Enabled MapControl
    MapControl1.Enabled = True
  Else
    MsgBox sFilePath & " is not a valid ArcMap document"
    Exit Sub
  End If
  
  'Add the layer names to combo
  cboDataLayer.Clear
  Dim i As Integer
  For i = 0 To MapControl1.LayerCount - 1
    cboDataLayer.AddItem MapControl1.Layer(i).Name, i
  Next i
  
  'Select first layer in control
  cboDataLayer.ListIndex = 0
  'Enable controls if disabled
  If chkTransparent.Enabled = False Then chkTransparent.Enabled = True
  If chkShowTips.Enabled = False Then chkShowTips.Enabled = True
  If cboDataLayer.Enabled = False Then cboDataLayer.Enabled = True
  If cboDataField.Enabled = False Then cboDataField.Enabled = True
  
End Sub
Private Sub Form_Load()
  
  'Disable controls
  chkShowTips.Enabled = False
  chkTransparent.Enabled = False
  cboDataLayer.Enabled = False
  cboDataField.Enabled = False
  
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)
  
  'If left mouse button zoom in
  If button = 1 Then
    MapControl1.Extent = MapControl1.TrackRectangle
  'If right mouse button pan
  ElseIf button = 2 Then
    MapControl1.Pan
  End If

End Sub

Private Sub ShowLayerTips()
  
  Dim i As Long
  Dim pLayer As ILayer
  
  'Loop through the maps layers
  For i = 0 To MapControl1.LayerCount - 1
    'Get ILayer interface
    Set pLayer = MapControl1.Layer(i)
    'If is the layer selected in the control
    If cboDataLayer.ListIndex = i Then
      'If want to show map tips
      If chkShowTips.Value = 1 Then
        pLayer.ShowTips = True
      Else
        pLayer.ShowTips = False
      End If
    Else
      pLayer.ShowTips = False
    End If
  Next i
End Sub