featureselection.cls

ao开发指南的东西 源码 希望大家好好学习ao

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FeatureSelection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit

'Windows API functions to capture mouse and keyboard
'input to a window when the mouse is outside the window
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private m_bInUse As Boolean
Private m_pBitmap As IPictureDisp
Private m_pCursor As IPictureDisp
Private m_pCursorMove As IPictureDisp
Private m_pPoint As esriGeometry.IPoint
Private m_pHookHelper As esriControlCommands.IHookHelper
Private m_pFeedback As esriDisplay.INewEnvelopeFeedback

Implements esriSystemUI.ICommand
Implements esriSystemUI.ITool

Private Sub Class_Initialize()
  Set m_pHookHelper = New HookHelper
  Set m_pBitmap = LoadResPicture("Select", vbResBitmap)
  Set m_pCursorMove = LoadResPicture("SelectMove", vbResCursor)
  Set m_pCursor = LoadResPicture("Select", vbResCursor)
End Sub

Private Sub Class_Terminate()
  Set m_pHookHelper = Nothing
  Set m_pBitmap = Nothing
  Set m_pCursor = Nothing
  Set m_pCursorMove = Nothing
End Sub

Private Property Get ICommand_Enabled() As Boolean
  If (m_pHookHelper.FocusMap Is Nothing) Then Exit Property
  ICommand_Enabled = (m_pHookHelper.FocusMap.LayerCount > 0)
End Property
 
Private Property Get ICommand_Checked() As Boolean
  ICommand_Checked = False
End Property
 
Private Property Get ICommand_Name() As String
  ICommand_Name = "Sample_Select(VB6)_Select Features"
End Property

Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Select Features"
End Property
 
Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Select Features"
End Property
 
Private Property Get ICommand_Message() As String
  ICommand_Message = "Selects Features By Rectangle Or Single Click"
End Property
 
Private Property Get ICommand_HelpFile() As String
  ' Not used
End Property
 
Private Property Get ICommand_HelpContextID() As Long
  ' Not used
End Property
 
Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
  ICommand_Bitmap = m_pBitmap
End Property
 
Private Property Get ICommand_Category() As String
  ICommand_Category = "Sample_Select(VB6)"
End Property
 
Private Sub ICommand_OnCreate(ByVal hook As Object)
  Set m_pHookHelper.hook = hook
End Sub
 
Private Sub ICommand_OnClick()
  ' Not used
End Sub

Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE

  If (m_bInUse) Then
    ITool_Cursor = m_pCursorMove
  Else
    ITool_Cursor = m_pCursor
  End If

End Property
 
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  
  'If the ActiveView is a PageLayout
  If TypeOf m_pHookHelper.ActiveView Is esriCarto.IPageLayout Then
    Dim pPoint As esriGeometry.IPoint
    Set pPoint = m_pHookHelper.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    
    'See whether the mouse has been clicked over a Map
    Dim pMap As esriCarto.IMap
    Set pMap = m_pHookHelper.ActiveView.HitTestMap(pPoint)
    'If mouse click isn't over a Map exit
    If pMap Is Nothing Then Exit Sub
    'Ensure the Map is the FocusMap
    If Not pMap Is m_pHookHelper.FocusMap Then
      Set m_pHookHelper.ActiveView.FocusMap = pMap
      m_pHookHelper.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
    End If
  End If

  'Get the focus map
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Get the point to start the feedback with
  Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)

  m_bInUse = True
  SetCapture m_pHookHelper.ActiveView.ScreenDisplay.hwnd

End Sub
 
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

  If (Not m_bInUse) Then Exit Sub
  
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Start the feedback if this is the first mouse move event
  If (m_pFeedback Is Nothing) Then
    Set m_pFeedback = New NewEnvelopeFeedback
    Set m_pFeedback.Display = pActiveView.ScreenDisplay
    m_pFeedback.Start m_pPoint
  End If
  'Move the feedback to the new mouse coordinates
  m_pFeedback.MoveTo pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)

End Sub
 
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

  If (Not m_bInUse) Then Exit Sub
    
  If GetCapture = m_pHookHelper.ActiveView.ScreenDisplay.hwnd Then
    ReleaseCapture
  End If
    
  ' Get the search geometry
  Dim pGeom As esriGeometry.IGeometry
  If (m_pFeedback Is Nothing) Then
    Set pGeom = m_pPoint
  Else
    Set pGeom = m_pFeedback.Stop
    If (pGeom.IsEmpty) Then Set pGeom = m_pPoint
  End If
  
  ' Set the spatial reference of the search geometry to that of the Map
  Dim pMap As esriCarto.IMap
  Set pMap = m_pHookHelper.FocusMap
  Dim pSpatialReference As esriGeometry.ISpatialReference
  Set pSpatialReference = pMap.SpatialReference
  Set pGeom.SpatialReference = pSpatialReference
  
  ' Refresh the active view
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = pMap
  pMap.SelectByShape pGeom, Nothing, False
  pActiveView.PartialRefresh esriViewGeoSelection, Nothing, pActiveView.Extent
  
  Set m_pFeedback = Nothing
  m_bInUse = False

End Sub
 
Private Sub ITool_OnDblClick()
  ' Not used
End Sub
 
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)

  If m_bInUse = True Then
    If keyCode = 27 Then  'ESC key
      ReleaseCapture
      Set m_pFeedback = Nothing
      m_bInUse = False
      m_pHookHelper.ActiveView.PartialRefresh esriViewForeground, Nothing, Nothing
    End If
  End If

End Sub
 
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)
  ' Not used
End Sub
 
Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean
  ' Not used
End Function
 
Private Sub ITool_Refresh(ByVal hDC As esriSystem.OLE_HANDLE)
  ' Not used
End Sub
 
Private Function ITool_Deactivate() As Boolean
  ITool_Deactivate = True
End Function