simplepointcursorhelper.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 = "SimplePointCursorHelper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements IPlugInCursorHelper
Implements ISimplePointCursorHelper

' Following class level variables are passed in by the dataset helper
' with properties on ISimplePointCursorHelper
Dim m_sFilePath As String ' Full name of file, including path
Dim m_vFieldMap As Variant
Dim m_lOID As Long ' Object ID defining single row to be returned
Dim m_pQueryEnv As esriCore.IEnvelope ' Envelope defining spatial search

' Remaining class level variables are defined within this class
Dim m_pStream As Object ' File opened for reading
Dim m_pWorkPoint As esriCore.IPoint ' Working point object
Dim m_lFreeFile As Long ' File number
Dim m_sCurrentRow As String ' Current line of text

Private Sub Class_Initialize()
  m_lOID = -1
  Set m_pQueryEnv = Nothing
  Set m_pWorkPoint = New esriCore.Point
  Set m_pWorkPoint.SpatialReference = New UnknownCoordinateSystem
  m_sCurrentRow = ""
End Sub

Private Sub Class_Terminate()
  Close m_lFreeFile
  Set m_pQueryEnv = Nothing
  Set m_pWorkPoint = Nothing
End Sub

Private Function IPlugInCursorHelper_IsFinished() As Boolean
  If m_pStream.AtEndOfStream Then
    IPlugInCursorHelper_IsFinished = True
  Else
    IPlugInCursorHelper_IsFinished = False
  End If
End Function

Private Sub IPlugInCursorHelper_NextRecord()
  ' We will take the line number in the file to be the OID of the feature
  ' E_FAIL is returned if there are no more records
  
  ' If we are searching by OID, skip to the correct line
  If m_lOID <> -1 Then
    Do Until m_lOID = m_pStream.Line
      If m_pStream.AtEndOfStream Then
        m_sCurrentRow = ""
        Err.Raise E_FAIL
      Else
        m_pStream.SkipLine
      End If
    Loop
  End If
  
  ' Read the line
  If m_pStream.AtEndOfStream Then
    m_sCurrentRow = ""
    Err.Raise E_FAIL
  Else
    m_sCurrentRow = m_pStream.ReadLine
  End If
    
  ' If we are finding by envelope, check the current record
  '   if its not in the envelope, make a recursive call to move on to the next record
  If Not m_pQueryEnv Is Nothing Then
    Call IPlugInCursorHelper_QueryShape(m_pWorkPoint)
    Dim pRelOp As IRelationalOperator
    Set pRelOp = m_pWorkPoint
    If Not pRelOp.Within(m_pQueryEnv) Then
      On Error Resume Next
      Call IPlugInCursorHelper_NextRecord
      If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description
        Exit Sub
      End If
      On Error GoTo 0
    End If
  End If
  
End Sub

Private Sub IPlugInCursorHelper_QueryShape(ByVal pGeometry As IGeometry)

  ' If there is no current row, set the geometry to be empty
  If Len(m_sCurrentRow) = 0 Then
    pGeometry.SetEmpty
    Exit Sub
  End If

  ' The passed geometry should already be pointing to a fully instantiated object
  ' we just need to fill in the contents
  Dim pPoint As IPoint
  Set pPoint = pGeometry

  ' Parse the X and Y values out of the current row and into the geometry
  pPoint.X = CDbl(Left(m_sCurrentRow, 6))
  pPoint.Y = CDbl(Mid(m_sCurrentRow, 7, 6))
  
  ' Note - in our case there is no need to handle the strictSearch test for a cursor
  ' created with FetchByEnvelope. We have already tested that the feature is within
  ' the envelope on the NextRecord call, so there is no possibility of the test
  ' failing here.

End Sub


Private Function IPlugInCursorHelper_QueryValues(ByVal Row As esriCore.IRowBuffer) As Long
  
  ' At end of file, return -1
  If Len(m_sCurrentRow) = 0 Then
    IPlugInCursorHelper_QueryValues = -1
    Exit Function
  End If
  
  ' First, parse the attribute out of the current row.
  ' We know this data source has just one attribute, which is one char wide.
  Dim sAtt As String
  sAtt = Right(m_sCurrentRow, 1)

  Dim pField As IField
  Dim pFields As IFields
  Set pFields = Row.Fields
  
  ' Check field map has same number of elements as there are fields
  If (UBound(m_vFieldMap) - LBound(m_vFieldMap) + 1) <> pFields.FieldCount Then
    Err.Raise E_FAIL, , "SimplePoint Data Source: Unexepected situation: Number of elements in Fieldmap does not match number of fields"
    Exit Function
  End If
  
  ' For each field, copy its value into the row object.
  ' (don't copy shape, object ID or where the field map indicates no values required)
  ' Note, although we know there is only one attribute in the data source,
  ' this loop has been coded generically in case support needs to be added for more attributes
  Dim i As Long
  For i = 0 To pFields.FieldCount - 1
    Set pField = pFields.Field(i)
    If (Not pField.Type = esriFieldTypeGeometry) And _
       (Not pField.Type = esriFieldTypeOID) And _
       (m_vFieldMap(i) <> -1) Then
      Row.Value(i) = sAtt
    End If
  Next i

  ' Return value is taken as the OID.
  ' Use the line number (stream will currently be pointing at next line)
  IPlugInCursorHelper_QueryValues = m_pStream.Line - 1
End Function

Private Property Let ISimplePointCursorHelper_FieldMap(ByVal RHS As Variant)
  m_vFieldMap = RHS
  
  ' Check the field map is an array of Longs
  If VarType(m_vFieldMap) <> vbArray + vbLong Then
    Err.Raise E_FAIL, , "SimplePoint Data Source: Unexepected situation: FieldMap received not an array of longs"
    Exit Property
  End If

  ' Check the fieldmap array is zero-based
  If LBound(m_vFieldMap) <> 0 Then
    Err.Raise E_FAIL, , "SimplePoint Data Source: Unexepected situation: FieldMap array not based on zero"
    Exit Property
  End If

End Property

Private Property Let ISimplePointCursorHelper_FilePath(ByVal RHS As Variant)
  m_sFilePath = RHS
  ' Open text file for reading
  Dim pFSO As Object
  Dim pFile As Object
  Set pFSO = CreateObject("Scripting.FileSystemObject")
  Set pFile = pFSO.GetFile(m_sFilePath)
  Set m_pStream = pFile.OpenAsTextStream(1)
  
  ' First record should be fetched on creation
  On Error Resume Next
  Call IPlugInCursorHelper_NextRecord
  If Err.Number <> 0 Then
    Err.Raise Err.Number, Err.Source, Err.Description
    Exit Property
  End If
  On Error GoTo 0
  
End Property

Private Property Let ISimplePointCursorHelper_OID(ByVal RHS As Variant)
  m_lOID = RHS
End Property

Private Property Set ISimplePointCursorHelper_QueryEnvelope(ByVal RHS As Variant)
  Set m_pQueryEnv = RHS
  ' At this point it would be useful to project the envelope
  ' to the spatial reference of the data source.
  ' As our data source uses an UnknownCoordinateSystem,
  ' this is not necessary since the IGeometry::Project would have no effect.
  
End Property