simplepointdatasethelper.cls

COM编程接口处理方法 多个方法调用COM库函数

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

Implements ISimplePointDatasetHelper
Implements IPlugInDatasetHelper
Implements IPlugInDatasetInfo

Dim m_sDatasetName As String
Dim m_sWorkspacePath As String

Private Property Let ISimplePointDatasetHelper_DatasetName(ByVal RHS As String)
  m_sDatasetName = RHS
End Property

Private Property Let ISimplePointDatasetHelper_WorkspacePath(ByVal RHS As String)
  m_sWorkspacePath = RHS
End Property

Private Property Get IPlugInDatasetHelper_Bounds() As esriCore.IEnvelope
  ' Get an envelope for the extent of the dataset
  ' We will have to calculate the extent by opening a cursor
  ' on the dataset, and building up a minimum bounding rectangle
  
  ' Prepare to open a cursor.
  ' Make the fieldmap, with values of -1 (attributes do not need fetching)
  Dim vFieldMap As Variant
  Dim lFieldCount As Long
  lFieldCount = IPlugInDatasetHelper_Fields(0).FieldCount
  Dim aFieldMap() As Long
  ReDim aFieldMap(lFieldCount)
  Dim i As Long
  For i = 0 To lFieldCount - 1
    aFieldMap(i) = -1
  Next
  vFieldMap = aFieldMap

  ' Open the cursor
  ' FetchAll will fail if there are no records, so need to trap that error
  Dim pPlugInCursor As IPlugInCursorHelper
  Set pPlugInCursor = IPlugInDatasetHelper_FetchAll(0, "", vFieldMap)
  On Error GoTo 0
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Property
  End If
  On Error Resume Next
  
  Dim bEOF As Boolean
  bEOF = False
  Dim lLoopCount As Long
  lLoopCount = 1
  Dim pPoint As IPoint
  Set pPoint = New esriCore.Point
  Dim pPoint1 As IPoint
  Set pPoint1 = New esriCore.Point

  Dim dxMin As Double
  Dim dxMax As Double
  Dim dyMin As Double
  Dim dyMax As Double
  dxMin = 9999999#
  dxMax = -9999999#
  dyMin = 9999999#
  dyMax = -9999999#

  ' loop through the data recording min/max X and Y values.
  Do Until bEOF
    pPlugInCursor.QueryShape pPoint
    If pPoint.X < dxMin Then
      dxMin = pPoint.X
    End If
    If pPoint.X > dxMax Then
      dxMax = pPoint.X
    End If
    If pPoint.Y < dyMin Then
      dyMin = pPoint.Y
    End If
    If pPoint.Y > dyMax Then
      dyMax = pPoint.Y
    End If

    ' Get next record
    On Error Resume Next
    pPlugInCursor.NextRecord
    If Err.Number <> 0 Then
      bEOF = True
    End If
    On Error GoTo 0
    lLoopCount = lLoopCount + 1
  Loop

  ' Handle special case of single point in file
  ' - add a small amount, so that we will end up with an envelope rather than a point
  If lLoopCount = 1 Then
    Dim dDelta As Double
    dDelta = 0.01
    If dxMax <> 0# Then
      dDelta = dxMax / 1000#
    End If
    dxMax = dxMax + dDelta
    dyMax = dyMax + dDelta
  End If

  ' Make the envelope object and return it
  ' Set the spatial reference of the envelope to that of the dataset.
  Dim pEnv As IEnvelope
  Set pEnv = New Envelope
  With pEnv
   Set .SpatialReference = New UnknownCoordinateSystem
   .XMin = dxMin
   .YMin = dyMin
   .XMax = dxMax
   .YMax = dyMax
  End With

  Set IPlugInDatasetHelper_Bounds = pEnv

End Property

Private Property Get IPlugInDatasetHelper_ClassCount() As Long
  IPlugInDatasetHelper_ClassCount = 1 ' This is standalone feature class
End Property

Private Property Get IPlugInDatasetHelper_ClassIndex(ByVal Name As String) As Long
  IPlugInDatasetHelper_ClassIndex = 0 ' This is standalone feature class, so index doesnt apply
End Property

Private Property Get IPlugInDatasetHelper_ClassName(ByVal Index As Long) As String
  IPlugInDatasetHelper_ClassName = m_sDatasetName
End Property

Private Function IPlugInDatasetHelper_FetchAll(ByVal ClassIndex As Long, ByVal WhereClause As String, ByVal FieldMap As Variant) As esriCore.IPlugInCursorHelper
  
  ' Some parameters can be ignored since,
  '   ClassIndex is only relevant to feature datasets
  '   WhereClause is not appropriate since we are not supporting SQL
  Dim pSimplePointCursorHelper As ISimplePointCursorHelper
  Set pSimplePointCursorHelper = New SimplePointCursorHelper
  pSimplePointCursorHelper.FieldMap = FieldMap
  
  ' The following call will fail if there are no records to be returned.
  ' If so, pass on the error
  On Error Resume Next
  pSimplePointCursorHelper.FilePath = m_sWorkspacePath & "\" & m_sDatasetName & g_sFileExtension
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Function
  End If
  On Error GoTo 0
   
  Set IPlugInDatasetHelper_FetchAll = pSimplePointCursorHelper ' Inline QI

End Function

Private Function IPlugInDatasetHelper_FetchByEnvelope(ByVal ClassIndex As Long, ByVal env As esriCore.IEnvelope, ByVal strictSearch As Boolean, ByVal WhereClause As String, ByVal FieldMap As Variant) As esriCore.IPlugInCursorHelper

  Dim pSimplePointCursorHelper As ISimplePointCursorHelper
  Set pSimplePointCursorHelper = New SimplePointCursorHelper
  pSimplePointCursorHelper.FieldMap = FieldMap
  Set pSimplePointCursorHelper.QueryEnvelope = env
  
  ' The following call will fail if there are no records to be returned.
  ' If so, pass on the error
  On Error Resume Next
  pSimplePointCursorHelper.FilePath = m_sWorkspacePath & "\" & m_sDatasetName & g_sFileExtension
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Function
  End If
  On Error GoTo 0

  Set IPlugInDatasetHelper_FetchByEnvelope = pSimplePointCursorHelper ' Inline QI

End Function

Private Function IPlugInDatasetHelper_FetchByID(ByVal ClassIndex As Long, ByVal ID As Long, ByVal FieldMap As Variant) As esriCore.IPlugInCursorHelper

  Dim pSimplePointCursorHelper As ISimplePointCursorHelper
  Set pSimplePointCursorHelper = New SimplePointCursorHelper
  pSimplePointCursorHelper.OID = ID
  pSimplePointCursorHelper.FieldMap = FieldMap
  
  ' The following call will fail if there are no records to be returned.
  ' If so, pass on the error
  On Error Resume Next
  pSimplePointCursorHelper.FilePath = m_sWorkspacePath & "\" & m_sDatasetName & g_sFileExtension
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Function
  End If
  On Error GoTo 0

  Set IPlugInDatasetHelper_FetchByID = pSimplePointCursorHelper ' Inline QI
End Function

Private Property Get IPlugInDatasetHelper_Fields(ByVal ClassIndex As Long) As esriCore.IFields

  ' Start off with a default feature class fields collection
  Dim pObjectClassDescription As IObjectClassDescription
  Set pObjectClassDescription = New FeatureClassDescription
  
  Dim pFields As IFields
  Dim pFieldsEdit As IFieldsEdit
  Set pFields = pObjectClassDescription.RequiredFields
  Set pFieldsEdit = pFields
  Dim pField As IField
  Dim pFieldEdit As IFieldEdit

  ' We will have: a shape field name of "shape"
  ' an UnknownCoordinateSystem
  ' Just need to change the geometry type to Point
  Dim i As Integer
  For i = 0 To pFields.FieldCount - 1
    Set pField = pFields.Field(i)
    If pField.Type = esriFieldTypeGeometry Then
      Dim pGeomDefEdit As IGeometryDefEdit
      Set pGeomDefEdit = pField.GeometryDef
      pGeomDefEdit.GeometryType = esriGeometryPoint
      Exit For
    End If
  Next i

  ' Add the extra text field
  Set pFieldEdit = New esriCore.Field
  With pFieldEdit
      .Length = 1
      .Name = "Column1"
      .Type = esriFieldTypeString
  End With
  pFieldsEdit.AddField pFieldEdit

  Set IPlugInDatasetHelper_Fields = pFieldsEdit

End Property

Private Property Get IPlugInDatasetHelper_OIDFieldIndex(ByVal ClassIndex As Long) As Long
  IPlugInDatasetHelper_OIDFieldIndex = 0
End Property

Private Property Get IPlugInDatasetHelper_ShapeFieldIndex(ByVal ClassIndex As Long) As Long
  IPlugInDatasetHelper_ShapeFieldIndex = 1
End Property

Private Property Get IPlugInDatasetInfo_DatasetType() As esriCore.esriDatasetType
  IPlugInDatasetInfo_DatasetType = esriDTFeatureClass
End Property

Private Property Get IPlugInDatasetInfo_GeometryType() As esriCore.esriGeometryType
  IPlugInDatasetInfo_GeometryType = esriGeometryPoint
End Property

Private Property Get IPlugInDatasetInfo_LocalDatasetName() As String
  IPlugInDatasetInfo_LocalDatasetName = m_sDatasetName
End Property

Private Property Get IPlugInDatasetInfo_ShapeFieldName() As String
  IPlugInDatasetInfo_ShapeFieldName = "Shape"
End Property