frmpttrackingimport.frm

esir公司的产品MapObject的vb例子

  On Error Resume Next

  If Index = 0 Then
    Me.frManualTime.Enabled = True
    Me.txtFromTime.Enabled = True
    Me.txtToTime.Enabled = True
  Else
    Me.frManualTime.Enabled = False
    Me.txtFromTime.Enabled = False
    Me.txtToTime.Enabled = False
  End If
  
End Sub
'
' gather parameters for, and run our ImportTrackingPointsToLayerKeyframes command
'
Private Function RunCommand() As Boolean

  On Error GoTo RunCommand_ERR
  
  Debug.Assert 0
  
  ' check parameters:
  If Not ValidateDialog Then
    Exit Function
  End If
  
  Me.MousePointer = vbHourglass
  
  ' point to either a layer or table as the input:
  Dim pFLayer As IFeatureLayer
  Dim pTable As IStandaloneTable
  If TypeOf m_pTrackingLayers.Item(Me.cmbTrackingLayer.ListIndex + 1) Is IFeatureLayer Then
    Set pFLayer = m_pTrackingLayers.Item(Me.cmbTrackingLayer.ListIndex + 1)
    Set pTable = Nothing
  ElseIf TypeOf m_pTrackingLayers.Item(Me.cmbTrackingLayer.ListIndex + 1) Is IStandaloneTable Then
    Set pTable = m_pTrackingLayers.Item(Me.cmbTrackingLayer.ListIndex + 1)
    Set pFLayer = Nothing
  End If
  
  ' we will use an attribute to base the Z scale of the layer during animation:
  Dim sEventField As String
  sEventField = Me.cmbEventValue.Text
  
  ' we of course need a date\time field in which to set the keyframe timestamp.
  ' the range of dates will be known and all events normalized to a 0-1 time range
  ' supported by the ArcScene animation engine:
  Dim sTimeField As String
  sTimeField = Me.cmbTimeField.Text
  
  ' we provide the option of getting the Z from an attribute, else from the geometry
  ' of the input, else 0:
  Dim sZField As String
  If Me.optHeight(0).Value Then
    sZField = cmbHeightField.Text
  Else
    sZField = ""
  End If
  
  ' the location of the event can come from the input geometry, or as in the case of
  ' a standalone table, an attribute:
  Dim sXField As String
  Dim sYField As String
  If Me.optPosition(1).Value Then
    sXField = Me.cmbLongitude.Text
    sYField = Me.cmbLatitude.Text
  End If
  
  ' a Z offset to the event:
  Dim nZOffset As Double
  nZOffset = CDbl(Me.txtZOffset)
  
  ' a Z unit conversion:
  Dim nZUnitConversion As Double
  nZUnitConversion = CDbl(Me.txtZUnitConversion)
  
  ' only input the selected events(?):
  Dim bUseSelected As Boolean
  bUseSelected = (Me.chkSelectedEvents.Value = 1) And Me.chkSelectedEvents.Enabled
  
  ' request that the command does the sort of the event input:
  Dim bSort As Boolean
  bSort = True

  ' we can have the command filter events only inside a given time range:
  Dim sTimeStart As String
  Dim sTimeEnd As String
  If Me.optTimeRange(0) Then
    sTimeStart = Me.txtFromTime
    sTimeEnd = Me.txtToTime
  Else
    sTimeStart = ""
    sTimeEnd = ""
  End If
  
  Dim nEventScale As Double
  nEventScale = Me.txtValueScale
  
  ' the layer which will be cloned and added for each layer in the group layer (and bound to a particular layer track):
  Dim pSymbolLayer As ILayer
  Set pSymbolLayer = m_pLayersToAnimate.Item(Me.cmbAnimateLayer.ListIndex + 1)
  
  ' the default name for the output group layer:
  Dim sGroupLayerName As String
  sGroupLayerName = "Tracking Import"
  
  ' the default name for the base name for each layer track:
  Dim sBaseName As String
  sBaseName = "Import Track"
  
  Dim pOutTrackCollection As Collection
  Dim pOutGroupLayer As IGroupLayer
  Dim bSuccess As Boolean
  
  Debug.Assert 0
  Dim nDuration As Double
  nDuration = Me.txtEventDuration
  
  Dim bXScale As Boolean, bYScale As Boolean, bZScale As Boolean
  bXScale = (Me.chkXScale.Value = 1)
  bYScale = (Me.chkYScale.Value = 1)
  bZScale = (Me.chkZScale.Value = 1)
  
  ' run the ImportTrackingPointsToLayerKeyframes command
  ' with the specified parameters:
  bSuccess = basTrackingImport.ImportEventValuePointsToLayerKeyframes(pFLayer, pTable, sTimeField, sEventField, pSymbolLayer, sGroupLayerName, pOutTrackCollection, pOutGroupLayer, bXScale, bYScale, bZScale, nEventScale, nZOffset, nZUnitConversion, nDuration, sTimeStart, sTimeEnd, sXField, sYField, sZField, bUseSelected, True, sBaseName, Me.hwnd)
  
  ' if a success flag and a collection was returned, then add the contents of the
  ' collection (tracks) to the scene:
  If bSuccess And Not (pOutTrackCollection Is Nothing Or pOutGroupLayer Is Nothing) Then
    Dim pAniTracks As IAnimationTracks
    Set pAniTracks = g_pSxDoc.Scene
    Dim i As Long
    Dim pTrack As IAnimationTrack
    g_pSxDoc.AddLayer pOutGroupLayer
    For i = 1 To pOutTrackCollection.Count
      Set pTrack = pOutTrackCollection.Item(i)
      pAniTracks.AddTrack pTrack
    Next
    MsgBox i - 1 & " tracks were added to the scene.", vbInformation, "Tracking Import"
    RunCommand = True
  Else
    MsgBox "The import command was not successful.", vbExclamation, "Tracking Import"
    RunCommand = False
  End If

  Me.MousePointer = vbDefault
  
  Exit Function
  
RunCommand_ERR:
  MsgBox "RunCommand_ERR: " & err.Description
  Me.MousePointer = vbDefault
  
End Function
'
' check for valid parameters
'
Private Function ValidateDialog() As Boolean
  
  On Error Resume Next
  If Me.optTimeRange(0).Value = True And (Trim(Me.txtFromTime) = "" Or Trim(Me.txtToTime) = "") Then
    MsgBox "Please enter a start and finish range for this option.", vbExclamation, "Import Tracking Events"
    Exit Function
  End If
  
  If Me.optTimeRange(0).Value = True And (Trim(UCase(Me.txtFromTime)) = Trim(UCase(Me.txtToTime))) Then
    MsgBox "Please enter a start and finish range which are not identical for this option.", vbExclamation, "Import Tracking Events"
    Exit Function
  End If
  
  If Not ValidateTimeField Then
    If MsgBox("The time\date field does not appear to contain data in the (mm/dd/yy hh:mm:ss) format.  Do you wish to continue?", vbYesNoCancel, "Import Tracking Events") <> vbYes Then
      ValidateDialog = False
      Exit Function
    End If
  End If
  
  If Me.chkXScale.Value = 0 And Me.chkYScale.Value = 0 And Me.chkZScale.Value = 0 Then
    MsgBox "Please select at least one scale attribute to animate.", vbExclamation, "Import Tracking Events"
    ValidateDialog = False
    Exit Function
  End If
  
  ValidateDialog = True
  
End Function
'
' as a convienance, look for fieldnames for a logical default on the dialog
'
Public Sub SetFieldDefaults()
  On Error GoTo EH
  
  m_bNoEvents = True
  
  Dim i As Integer
  
  ' Event Value:
  For i = 0 To Me.cmbEventValue.ListCount - 1
    If (InStr(1, UCase(Me.cmbEventValue.List(i)), "NOISE") > 0 Or _
    InStr(1, UCase(Me.cmbEventValue.List(i)), "MAG")) > 0 Then
      Me.cmbEventValue.ListIndex = i
      Exit For
    End If
  Next
  
  ' Height:
  For i = 0 To Me.cmbHeightField.ListCount - 1
    If InStr(1, UCase(Me.cmbHeightField.List(i)), "ELEVATION") > 0 Or _
    InStr(1, UCase(Me.cmbHeightField.List(i)), "ALTITUDE") > 0 Or _
    InStr(1, UCase(Me.cmbHeightField.List(i)), "Z") > 0 Then
      Me.cmbHeightField.ListIndex = i
      Exit For
    End If
  Next
  
  ' Y:
  For i = 0 To Me.cmbLatitude.ListCount - 1
    If InStr(1, UCase(Me.cmbLatitude.List(i)), "LAT") > 0 Or _
    Me.cmbLatitude.List(i) = "LD" Then
      Me.cmbLatitude.ListIndex = i
      Exit For
    End If
  Next
  
  ' X:
  For i = 0 To Me.cmbLongitude.ListCount - 1
    If InStr(1, UCase(Me.cmbLongitude.List(i)), "LON") > 0 Or _
    Me.cmbLongitude.List(i) = "LND" Then
      Me.cmbLongitude.ListIndex = i
      Exit For
    End If
  Next
  
  ' Time:
  For i = 0 To Me.cmbTimeField.ListCount - 1
    If InStr(1, UCase(Me.cmbTimeField.List(i)), "DATE") > 0 Or _
    InStr(1, UCase(Me.cmbTimeField.List(i)), "TIME") > 0 Then
      Me.cmbTimeField.ListIndex = i
      Exit For
    End If
  Next

  m_bNoEvents = False
  
  Exit Sub
EH:
  m_bNoEvents = False
  
End Sub
'
' ensure (mm/dd/yy hh:mm:ss) time format
'
Private Function ValidateTimeField() As Boolean
  On Error GoTo EH
  
  Dim i As Integer
  i = cmbTrackingLayer.ListIndex
  If i < 0 Then Exit Function
  
  Dim pRow As IRow
  Dim pLayer As IFeatureLayer
  Dim pTable As ITable
  Dim pFeat As IFeature
  Dim sTime As String
  Dim sTimeField As String
  Dim pC As ICursor
  
  sTimeField = Me.cmbTimeField.List(Me.cmbTimeField.ListIndex)
  
  ' get the first time value from the input data:
  If TypeOf m_pTrackingLayers.Item(i + 1) Is ILayer Then
    Set pLayer = m_pTrackingLayers.Item(i + 1)
    Set pC = pLayer.FeatureClass.Search(Nothing, True)
    Set pRow = pC.NextRow
    sTime = pRow.Value(pRow.Fields.FindField(sTimeField))
  ElseIf TypeOf m_pTrackingLayers.Item(i + 1) Is IStandaloneTable Then
    Set pTable = m_pTrackingLayers.Item(i + 1)
    Set pC = pTable.Search(Nothing, True)
    Set pRow = pC.NextRow
    sTime = pRow.Value(pRow.Fields.FindField(sTimeField))
  End If
  
  ' if the time is in the accepted format (mm/dd/yy hh:mm:ss) then use it:
  If CDate(sTime) And InStr(1, sTime, "/") > 1 And InStr(1, sTime, ":") > 1 Then
    ValidateTimeField = True
  Else
    ValidateTimeField = False
  End If
  
  Exit Function
  
EH:
  ValidateTimeField = False
  
End Function

'
' set a default time range to the dialog based on the first record for the input
' and the field name chosen
'
Private Sub SuggestTimeRange()
  On Error Resume Next
  
  Dim i As Integer
  i = cmbTrackingLayer.ListIndex
  If i < 0 Then Exit Sub
  
  Dim pRow As IRow
  Dim pLayer As IFeatureLayer
  Dim pTable As ITable
  Dim pFeat As IFeature
  Dim sTime As String
  Dim sTimeField As String
  Dim pC As ICursor
  
  sTimeField = Me.cmbTimeField.List(Me.cmbTimeField.ListIndex)
  
  ' get the first time value from the input data:
  If TypeOf m_pTrackingLayers.Item(i + 1) Is ILayer Then
    Set pLayer = m_pTrackingLayers.Item(i + 1)
    Set pC = pLayer.FeatureClass.Search(Nothing, True)
    Set pRow = pC.NextRow
    sTime = pRow.Value(pRow.Fields.FindField(sTimeField))
  ElseIf TypeOf m_pTrackingLayers.Item(i + 1) Is IStandaloneTable Then
    Set pTable = m_pTrackingLayers.Item(i + 1)
    Set pC = pTable.Search(Nothing, True)
    Set pRow = pC.NextRow
    sTime = pRow.Value(pRow.Fields.FindField(sTimeField))
  End If
  
  ' if the time is in the accepted format (mm/dd/yy hh:mm:ss) then use it:
  If CDate(sTime) And InStr(1, sTime, "/") > 1 And InStr(1, sTime, ":") > 1 Then
    Me.txtFromTime = sTime
    Me.txtToTime = sTime
  Else
    Me.txtFromTime = ""
    Me.txtToTime = ""
  End If
  
End Sub