bastrackingimport.bas

esir公司的产品MapObject的vb例子

    If OffsetProgressMSG("Importing layer tracks...", True, nMaxTracks, 0, nProgBarOwnerHWND, i) Then
      Debug.Assert 0
      If MsgBox("Abort operation?", vbYesNo, "Operation") = vbYes Then
        Debug.Assert 0
          ' return what we can:
          Set ppOutGroupLayer = pOutGroupLayer
          Set ppOutAnimationTracks = pAniTracks
        Exit Function
      End If
     End If
       
    Debug.Print "Track " & nTrackCount + 1 & " - " & varIDS(i)
    OffsetProgressMSG "Track " & nTrackCount + 1 & " - " & varIDS(i), False
    
    ' firstly, create a query of all records with the group ID:
    pQF_Group.SubFields = "*.*"
    If sEventGroupIDField2 <> "" Then
      pQF_Group.WhereClause = sEventGroupIDField2 & " = '" & varIDS(i) & "'"
    Else
      pQF_Group.WhereClause = sEventGroupIDField & " = '" & varIDS(i) & "'"
    End If
    
    ' create the new animation track:
    Set pTrack = New AnimationTrack
    pTrack.EvenTimeStamps = False
    
    ' set the name of the track:
    pTrack.name = sBaseTrackName & pAniTracks.Count + 1 & " - " & varIDS(i)
    
    ' and set the type:
    Dim pAT As IAnimationType
    Set pAT = New AnimationTypeLayer
    Set pTrack.AnimationType = pAT

    ' clone the layer and add to the group layer:
    Dim pNewSymbolLayer As ILayer
    If TypeOf pSymbolLayer Is IFeatureLayer Then
      Set pNewSymbolLayer = CloneSingleElement_FeatureLayer(pSymbolLayer)
    ElseIf TypeOf pSymbolLayer Is ICadLayer Then
      Set pNewSymbolLayer = CloneSingleElement_CadLayer(pSymbolLayer)
    ElseIf TypeOf pSymbolLayer Is IGraphicsLayer Then
      Set pNewSymbolLayer = CloneSingleElement_GraphicsLayer(pSymbolLayer)
    Else
      MsgBox "Symbol layer was not of type FeatureLayer, CADLayer, or GraphicsLayer.", vbExclamation, "Import Tracking Points"
    End If
    
    If pNewSymbolLayer Is Nothing Then
      MsgBox "There was an error cloning " & pSymbolLayer.name & ".", vbExclamation, "Import Tracking Points"
      Exit Function
    End If
    
    ' name the outgoing layer, and add to group layer:
    Set pLayerNaming = pNewSymbolLayer
    pLayerNaming.name = (nTrackCount + 1) & " - " & varIDS(i)
    'pOutGroupLayer.Add pNewSymbolLayer
    
    ' GET THE FIRST RECORD FROM A CURSOR.
    ' if requested, we will need to sort the records we are currently looking at,
    ' which will be all records with the current GroupID value...
    ' otherwise, we can just use a normal feature cursor:
    If bUseRecordsCurrentSorting Then
      If bUseSelectedEvents Then
        If bUseFeatures Then
          Set pCursorEvents = priv_GetSelectedFeatures(pLayerWithSelection, True, pQF_Group)
        Else
          Set pCursorEvents = priv_GetSelectedRecords(pORStandAloneTable, True, pQF_Group)
        End If
      Else
        If bUseFeatures Then
          Set pCursorEvents = priv_GetFeatureCursorFromLayer(pLayerWithSelection, pQF_Group)
        Else
          Set pCursorEvents = priv_GetAllRecords(pORStandAloneTable, pQF_Group)
        End If
      End If
      If bUseFeatures Then
        Set pTrackFeat = pCursorEvents.NextRow  ' just get the first record, since the table is already sorted
      Else
        Set pTrackRow = pCursorEvents.NextRow
      End If
    Else
      ' sort the table and generate a list of sorted FIDs,
      ' set the cursor to the record with the first FID:
      If bUseFeatures Then  ' end result here is the 'pSelSet'
        Set pTable = pLayerWithSelection
        If bUseSelectedEvents Then
        Set pFeatSel = pLayerWithSelection
          Set pSelSet = pFeatSel.SelectionSet
        Else
          Set pSelSet = Nothing
        End If
      Else
        Set pTable = pORStandAloneTable
        If bUseSelectedEvents Then
          Set pRowSel = pORStandAloneTable
          Set pSelSet = pRowSel.SelectionSet
        End If
      End If
      
      Set pTableSort = New esriCore.TableSort
      pTableSort.Fields = sTimeStampField2
      pTableSort.Ascending(sTimeStampField2) = True
      Set pTableSort.QueryFilter = pQF_Group
      Set pTableSort.Table = pTable
      Set pTableSort.SelectionSet = pSelSet
      pTableSort.Sort Nothing
      
      Set pIDSorted = pTableSort.IDs
      lID = pIDSorted.Next
      
      Set pQF_FID = New QueryFilter
      pQF_FID.SubFields = "*.*"
      pQF_FID.WhereClause = sIDName & lID
    
      If bUseFeatures Then
        Set pFC_FID = pFeatureLayer.Search(pQF_FID, False)
        Set pTrackFeat = pFC_FID.NextFeature ' will be only one with this FID
      Else
        Set pRC_FID = pStandAloneEventTable.Search(pQF_FID, False)
        Set pTrackRow = pRC_FID.NextRow
      End If

    End If

    ' validate that we can continue:
    If (bUseFeatures And pTrackFeat Is Nothing) Or (Not bUseFeatures And pTrackRow Is Nothing) Then
      MsgBox "Error searching records.", vbExclamation, "Import Tracking Points"
      Exit Function
    End If
    
    ' calculate track start and finish time for the new track
    ' by looking at the attribute table for the time events:
    Dim nTrackBegin As Double
    Dim nTrackEnd As Double
    Dim nBegin As Double
    Dim nEnd As Double
    Dim sTimeString As String
    Dim nTime As Double
    nBegin = 1000000000
    nEnd = -1000000000
    Dim nSec As Double
    Dim nMin As Double
    Dim nHour As Double
    Dim nKeyStart As Double
    Dim sBegin As String
    Dim sEnd As String
    Dim bUseThisEvent As Boolean
    
    If bUseFeatures Then
      Set pRow = pTrackFeat
    Else
      Set pRow = pTrackRow
    End If
    
    Do While Not pRow Is Nothing
      sTimeString = pRow.Value(nTimeFieldIndex)
      
      If Not bUseTimeFilter Then
        bUseThisEvent = True
      Else
        If (CDate(sTimeString) >= CDate(sTimeFilterStart)) And (CDate(sTimeString) <= CDate(sTimeFilterEnd)) Then
          bUseThisEvent = True
        Else
          Debug.Print "Event with timestamp " & sTimeString & " filtered out of time range."
          bUseThisEvent = False
        End If
      End If

      If bUseThisEvent Then
        nTime = TokenTime(sTimeString)
        If nTime <= nBegin Then
          nBegin = nTime
          sBegin = sTimeString
        End If
        If nTime >= nEnd Then
          nEnd = nTime
          sEnd = sTimeString
        End If
      
      End If
      
      If bUseRecordsCurrentSorting Then
        If bUseFeatures Then
          Set pTrackFeat = pCursorEvents.NextRow
          Set pRow = pTrackFeat
        Else
          Set pRow = pCursorEvents.NextRow
        End If
      Else
        lID = pIDSorted.Next
        Set pQF_FID = New QueryFilter
        pQF_FID.SubFields = "*.*"
        pQF_FID.WhereClause = sIDName & lID
        
        If bUseFeatures Then
          Set pFC_FID = pFeatureLayer.Search(pQF_FID, False)
          Set pTrackFeat = pFC_FID.NextFeature
          Set pRow = pTrackFeat
        Else
          Set pRC_FID = pStandAloneEventTable.Search(pQF_FID, False)
          Set pRow = pRC_FID.NextRow
        End If
        
      End If
      
    Loop
    
    ' store the begin and end times:
    nTrackBegin = (nBegin - nAniStartTime) / nAniTotalTime
    nTrackEnd = (nEnd - nAniStartTime) / nAniTotalTime
    pTrack.BeginTime = 0
    pTrack.EndTime = 1
    Debug.Print "Track starts at: " & sBegin & "(" & nBegin & ") - Track ends at: " & sEnd & "(" & nEnd & ")"

    ' GET THE FIRST RECORD FROM A CURSOR.
    ' if requested, we will need to sort the records we are currently looking at,
    ' which will be all records with the current GroupID value...
    ' otherwise, we can just use a normal feature cursor:
    If bUseRecordsCurrentSorting Then
      If bUseSelectedEvents Then
        If bUseFeatures Then
          Set pCursorEvents = priv_GetSelectedFeatures(pLayerWithSelection, True, pQF_Group)
        Else
          Set pCursorEvents = priv_GetSelectedRecords(pORStandAloneTable, True, pQF_Group)
        End If
      Else
        If bUseFeatures Then
          Set pCursorEvents = priv_GetFeatureCursorFromLayer(pLayerWithSelection, pQF_Group)
        Else
          Set pCursorEvents = priv_GetAllRecords(pORStandAloneTable, pQF_Group)
        End If
      End If
      If bUseFeatures Then
        Set pTrackFeat = pCursorEvents.NextRow  ' just get the first record, since the table is already sorted
      Else
        Set pTrackRow = pCursorEvents.NextRow
      End If
    Else
      ' sort the table and generate a list of sorted FIDs,
      ' set the cursor to the record with the first FID:
      If bUseFeatures Then  ' end result here is the 'pSelSet'
        Set pTable = pLayerWithSelection
        Set pFeatSel = pLayerWithSelection
        Set pSelSet = pFeatSel.SelectionSet
      Else
        Set pTable = pORStandAloneTable
        Set pRowSel = pORStandAloneTable
        Set pSelSet = pRowSel.SelectionSet
      End If
      
      Set pTableSort = New esriCore.TableSort
      pTableSort.Fields = sTimeStampField2
      pTableSort.Ascending(sTimeStampField2) = True
      Set pTableSort.QueryFilter = pQF_Group
      Set pTableSort.Table = pTable
      If bUseSelectedEvents Then Set pTableSort.SelectionSet = pSelSet
      pTableSort.Sort Nothing
      
      Set pIDSorted = pTableSort.IDs
      lID = pIDSorted.Next
      
      Set pQF_FID = New QueryFilter
      pQF_FID.SubFields = "*.*"
      pQF_FID.WhereClause = sIDName & lID
    
      If bUseFeatures Then
        Set pFC_FID = pFeatureLayer.Search(pQF_FID, False)
        Set pTrackFeat = pFC_FID.NextFeature ' will be only one with this FID
      Else
        Set pRC_FID = pStandAloneEventTable.Search(pQF_FID, False)
        Set pTrackRow = pRC_FID.NextRow
      End If

    End If
    
    ' add a invisible keyframe for the first keyframe of each track so that when
    ' the animation starts, the layer will be not visible:
    If bHideEventAtStartAndFinish Then
      Set pKeyFrame = New LayerKeyframe
      pKeyFrame.PropertyValueBoolean(0) = False
      pTrack.InsertKeyframe pKeyFrame, 0
      pKeyFrame.TimeStamp = 0
    End If
    
    nNumFeatures = 0
    dLastAzi = 0
    
    ' for each time event for this group, add to the current track
    ' as a layer keyframe:
    
    If bUseFeatures Then
      Set pRow = pTrackFeat
    Else
      Set pRow = pTrackRow
    End If
    
    Dim bUseEvent As Boolean
    
    Do While Not pRow Is Nothing  ' MAIN KEYFRAME LOOP ===============================================================
      
      ' create a new keyframe:
      Set pKeyFrame = New LayerKeyframe
      
      ' the time stamp from the attribute table:
      sTimeString = pRow.Value(nTimeFieldIndex)
      
      If Not bUseTimeFilter Then
        bUseEvent = True
      Else
        If (CDate(sTimeString) >= CDate(sTimeFilterStart)) And (CDate(sTimeString) <= CDate(sTimeFilterEnd)) Then
          bUseEvent = True
        Else
          Debug.Print "Event with timestamp " & sTimeString & " filtered out keyframe import."
          bUseEvent = False
        End If
      End If

    If bUseEvent Then
      nTime = TokenTime(sTimeString)
      
      ' DETERMINE THE LOCATION OF THE EVENT.
      ' the layer transformation is the difference between the
      ' time event location and the symbol layer location:
      If bUseFeatures And (nXFieldIndex < 1 And nYFieldIndex < 1) Then
        nTrackX = pTrackFeat.Shape.Envelope.xmin
        nTrackY = pTrackFeat.Shape.Envelope.ymin
      Else
        nTrackX = pRow.Value(nXFieldIndex)
        nTrackY = pRow.Value(nYFieldIndex)
      End If

      nTrackZ = 0
      Dim sZValue As String
      Dim sZValue2 As String
      Dim iZ As Integer
      Dim sZ1 As String
      If bUseFeatures And nZFieldIndex < 1 Then
        If Not IsNaN(pTrackFeat.Shape.Envelope.zmin) Then
          nTrackZ = (pTrackFeat.Shape.Envelope.zmin + pTrackFeat.Shape.Envelope.zmax) / 2
        End If
      ElseIf (Not bUseFeatures And nZFieldIndex <> -1) Or (bUseFeatures And nZFieldIndex <> -1) Then
        sZValue = pRow.Value(nZFieldIndex)
        sZValue2 = ""
        ' for now, remove any non-numeric values: 'todo:
        If Not IsNumeric(sZValue) Then
          For iZ = 0 To Len(sZValue) - 1
            sZ1 = Mid(sZValue, iZ + 1, 1)
            If IsNumeric(sZ1) Or sZ1 = "." Then sZValue2 = sZValue2 + sZ1
          Next
        Else
          sZValue2 = sZValue
        End If
        nTrackZ = CDbl(sZValue2)
      Else
        nTrackZ = 0
      End If
      nTrackZ = nTrackZ + nZOffset
      
      ' determine the layer transformation properties:
      nTransX = nTrackX - nSymbolLayerX
      nTransY = nTrackY - nSymbolLayerY
      nTransZ = nTrackZ - nSymbolLayerZ
      nTransZ = nTransZ * nZUnitConversion
  
      ' encapsulate the layer transformation for this keyframe into a point:
      Dim pPt As IPoint
      Set pPt = New Point
      pPt.X = nTransX
      pPt.Y = nTransY
      pPt.Z = nTransZ
      
      ' set time stamp - this is the proportionate starting time for the track in the
      ' entire event time range:
      nKeyStart = (nTime - nAniStartTime) / (nAniEndTime - nAniStartTime)