frmmditocbar.frm

ArcEngine 这是基于AE组件的源代码

VERSION 5.00
Object = "{370A8DDA-7915-42DC-B4A1-77662C82B046}#1.0#0"; "TOCControl.ocx"
Begin VB.Form frmMDITocBar 
   Caption         =   "Form1"
   ClientHeight    =   6405
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   3180
   LinkTopic       =   "Form1"
   ScaleHeight     =   6405
   ScaleWidth      =   3180
   StartUpPosition =   3  'Windows Default
   Begin esriTOCControl.TOCControl TOCControl 
      Height          =   6375
      Left            =   0
      OleObjectBlob   =   "frmMDITocBar.frx":0000
      TabIndex        =   0
      Top             =   0
      Width           =   3135
   End
   Begin VB.Menu MenuTools 
      Caption         =   "快捷菜单"
      Begin VB.Menu MenuCopy 
         Caption         =   "复制"
      End
      Begin VB.Menu MenuDelete 
         Caption         =   "删除"
      End
      Begin VB.Menu Menu1 
         Caption         =   "-"
      End
      Begin VB.Menu MenuOpenAttri 
         Caption         =   "打开属性表"
      End
      Begin VB.Menu Menu2 
         Caption         =   "-"
      End
      Begin VB.Menu MenuZoomLayer 
         Caption         =   "缩放图层"
      End
      Begin VB.Menu menu3 
         Caption         =   "-"
      End
      Begin VB.Menu MenuSacleLayer 
         Caption         =   "可视范围"
         Begin VB.Menu MenuScaleLayerMix 
            Caption         =   "最大比例"
         End
         Begin VB.Menu MenuSacleLayerMin 
            Caption         =   "最小比例"
         End
         Begin VB.Menu MenuScaleLayerClear 
            Caption         =   "清除比例"
         End
      End
      Begin VB.Menu menu4 
         Caption         =   "-"
      End
      Begin VB.Menu MenuSelect 
         Caption         =   "选择"
      End
      Begin VB.Menu menu5 
         Caption         =   "-"
      End
      Begin VB.Menu MenuData 
         Caption         =   "数据"
         Begin VB.Menu MenuDataSource 
            Caption         =   "设置数据源"
         End
         Begin VB.Menu MenuDataOut 
            Caption         =   "输出层数据"
         End
      End
      Begin VB.Menu menu6 
         Caption         =   "-"
      End
      Begin VB.Menu MenuSaveLayerFile 
         Caption         =   "保存层文件"
      End
      Begin VB.Menu menu7 
         Caption         =   "-"
      End
      Begin VB.Menu MenuSymbol 
         Caption         =   "符号标注"
      End
      Begin VB.Menu MenuProperties 
         Caption         =   "属性"
      End
   End
End
Attribute VB_Name = "frmMDITocBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Form_Resize()
    TOCControl.Width = Me.Width
    TOCControl.Height = Me.Height
    frmMDIMain.ActiveBar.ReleaseFocus
End Sub

Private Sub MenuCopy_Click()
    MsgBox "OK"
End Sub

Private Sub MenuDelete_Click()
    m_pMap.DeleteLayer m_pCurrentLayer
End Sub

Private Sub MenuOpenAttri_Click()
    frmOpenAttrible.Show 1, frmMDIMain
End Sub

Private Sub MenuProperties_Click()
    frmProperties.Show 1, Me
End Sub

Private Sub MenuSacleLayerMin_Click()
 On Error Resume Next
 Dim str_ScaleValue As String
  str_ScaleValue = InputBox("输入图层" + m_pCurrentLayer.name + "最小比例:", "设置比例", "")
  If str_ScaleValue = "" Then
    Exit Sub
  End If
  If CDbl(str_ScaleValue) <> 0 Then
     m_pCurrentLayer.MinimumScale = CDbl(str_ScaleValue)
  End If
End Sub

Private Sub MenuScaleLayerClear_Click()
    m_pCurrentLayer.MaximumScale = 0
    m_pCurrentLayer.MinimumScale = 0
End Sub

Private Sub MenuScaleLayerMix_Click()
  On Error Resume Next
  Dim str_ScaleValue As String
  str_ScaleValue = InputBox("输入图层" + m_pCurrentLayer.name + "最大比例:", "设置比例", "")
  If str_ScaleValue = "" Then
    Exit Sub
  End If
  If CDbl(str_ScaleValue) <> 0 Then
     m_pCurrentLayer.MaximumScale = CDbl(str_ScaleValue)
  End If
End Sub

Private Sub MenuSymbol_Click()
    frmSymbol.Show 1
End Sub

Private Sub MenuZoomLayer_Click()
    
    Dim player As IFeatureLayer
    Dim pFSel As IFeatureSelection
    Set player = m_pCurrentLayer
    Set pFSel = player
    
    'Get the selected features
    Dim pSelSet As ISelectionSet
    'Set pSelSet = pFSel.SelectionSet
    Set pSelSet = pFSel
    Dim pEnumGeom As IEnumGeometry
    Dim pEnumGeomBind As IEnumGeometryBind
    
    Set pEnumGeom = New EnumFeatureGeometry
    Set pEnumGeomBind = pEnumGeom
   ' pEnumGeomBind.BindGeometrySource Nothing, pSelSet
   
    pEnumGeomBind.BindGeometrySource Nothing, pSelSet
    
    Dim pGeomFactory As IGeometryFactory
    Set pGeomFactory = New GeometryEnvironment
    
    Dim pGeom As IGeometry
    Set pGeom = pGeomFactory.CreateGeometryFromEnumerator(pEnumGeom)
    
    pDoc.ActiveView.Extent = pGeom.Envelope
    pDoc.ActiveView.refresh

End Sub

Private Sub TOCControl_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Dim pMap As iMap
    Dim pOther As IUnknown
    Dim pitem As esriTOCControlItem
    Dim pIndex As Variant
    If Button = vbRightButton Then
       TOCControl.HitTest x, y, pitem, pMap, m_pCurrentLayer, pOther, pIndex
       If pitem = esriTOCControlItemLayer Then
          PopupMenu MenuTools
       End If
    End If
   
End Sub