controls.frm

arcEngine开发globe动画控件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{033364CA-47F9-4251-98A5-C88CD8D3C808}#1.0#0"; "esriControls.olb"
Begin VB.Form frmGlbCntrl 
   Caption         =   "GobeControlAnimation"
   ClientHeight    =   7410
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9135
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   7410
   ScaleWidth      =   9135
   StartUpPosition =   3  'Windows Default
   Begin esriControls.LicenseControl LicenseControl1 
      Left            =   480
      OleObjectBlob   =   "Controls.frx":0000
      Top             =   1680
   End
   Begin esriControls.TOCControl TOCControl1 
      Height          =   5895
      Left            =   120
      OleObjectBlob   =   "Controls.frx":003D
      TabIndex        =   11
      Top             =   600
      Width           =   2055
   End
   Begin esriControls.GlobeControl GlobeControl 
      Height          =   5895
      Left            =   2160
      OleObjectBlob   =   "Controls.frx":00D6
      TabIndex        =   10
      Top             =   600
      Width           =   6855
   End
   Begin esriControls.ToolbarControl ToolbarControl 
      Height          =   420
      Left            =   120
      OleObjectBlob   =   "Controls.frx":015F
      TabIndex        =   9
      Top             =   120
      Width           =   8895
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3120
      Top             =   7035
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame FrmAnim 
      Height          =   660
      Left            =   2145
      TabIndex        =   0
      Top             =   6495
      Width           =   6915
      Begin VB.CommandButton CmdPlay 
         Caption         =   "Play Animation"
         Height          =   390
         Left            =   3990
         TabIndex        =   6
         Top             =   150
         Width           =   1215
      End
      Begin VB.TextBox txtDuration 
         Height          =   285
         Left            =   3300
         TabIndex        =   5
         Text            =   "10"
         Top             =   195
         Width           =   600
      End
      Begin VB.TextBox TxtFrequency 
         Height          =   285
         Left            =   6000
         TabIndex        =   4
         Text            =   "2"
         Top             =   195
         Width           =   600
      End
      Begin VB.OptionButton OptDuration 
         Caption         =   "Duration (secs)"
         Height          =   255
         Left            =   1830
         TabIndex        =   3
         Top             =   120
         Value           =   -1  'True
         Width           =   1470
      End
      Begin VB.OptionButton OptIteration 
         Caption         =   "No. Iterations"
         Height          =   285
         Left            =   1830
         TabIndex        =   2
         Top             =   330
         Width           =   1410
      End
      Begin VB.CommandButton CmdLoad 
         Caption         =   "Load Animation  File (*.aga)"
         Height          =   465
         Left            =   135
         TabIndex        =   1
         Top             =   150
         Width           =   1410
      End
      Begin VB.Label Label1 
         Caption         =   "Cycles:"
         Height          =   255
         Left            =   5310
         TabIndex        =   7
         Top             =   210
         Width           =   540
      End
   End
   Begin VB.Label lblStatus 
      Height          =   810
      Left            =   90
      TabIndex        =   8
      Top             =   6585
      Width           =   1935
   End
End
Attribute VB_Name = "frmGlbCntrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 2006 ESRI
' 							  
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at /arcgis/developerkit/userestrictions.

 Option Explicit
'The following libraries need to refrenced to run this VB project
'esriGlobeCoreObject.olb
'esri3DAnalyst.olb
'esriSystem.olb
'ErrorHandlerUI.dll 'from \Developerkit\Addins\
'Microsoft ScriptingRuntime Windows\System32\sccrun.dll
 Private m_sAnimFilePath As String
' Variables used by the Error handler function - DO NOT REMOVE
Const c_sModuleFileName As String = "C:\Program Files\arcgis\DeveloperKit\samples\Controls\GlobeControl\GlobeControlAnimation\Visual_Basic\Controls.frm"


Private Sub CmdLoad_Click()
  On Error GoTo ErrorHandler

    CommonDialog1.DialogTitle = "Open ArcGlobe Animation Files"
    CommonDialog1.FileName = "*.aga"
    CommonDialog1.Filter = "ArcGlobe Animation Files (*.aga)"
    CommonDialog1.CancelError = True
    'set ArcGlobeAnimaton path folder as defaultpath...
    If Not m_sAnimFilePath = "" Then
    CommonDialog1.InitDir = m_sAnimFilePath
    Else
    CommonDialog1.InitDir = App.Path
    End If
    
    CommonDialog1.ShowOpen
    Dim sAnimFilePath As String
    'if the user selected an animation file
    sAnimFilePath = CommonDialog1.FileName
    'reset cancelerror if file open suceeded...
    CommonDialog1.CancelError = False

    'sAnimFilePath
    Dim pBasicScene As IBasicScene
    Dim pglobe As IGlobe
    Set pglobe = frmGlbCntrl.GlobeControl.Globe
    Set pBasicScene = pglobe
    pBasicScene.LoadAnimation sAnimFilePath
    
    'if loading of the animation suceeded, enable player controls...
    'Enable Animation Player controls...
    OptDuration.Enabled = True
    OptIteration.Enabled = True
    txtDuration.Enabled = True
    TxtFrequency.Enabled = True
    TxtFrequency.Enabled = True
    CmdPlay.Enabled = True
    

  Exit Sub
ErrorHandler:
If CommonDialog1.CancelError Then Exit Sub 'dont raise error when cancel is invoked...
  HandleError True, "CmdLoad_Click " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Sub



Private Sub Form_Load()
  On Error GoTo ErrorHandler
  
    ' if default Desktop's document exists use as default
    Dim sGlbData As String
    Dim f As FileSystemObject
    Set f = New FileSystemObject
    Dim sRegkeyDesktop As String
    Dim sRegkeyEngine As String
    
   
    sRegkeyDesktop = "HKEY_LOCAL_MACHINE\SOFTWARE\ESRI\ArcGIS\InstallDir"
    sGlbData = routin_ReadRegistry(sRegkeyDesktop)
    'if that fails check to see if the coreRuntime exists in registry...
    'note routin_ReadRegistry function has a fail-safe mechanism even if the registry key does not exist..
    If sGlbData = "" Then
        sRegkeyEngine = "HKEY_LOCAL_MACHINE\SOFTWARE\ESRI\CoreRuntime\InstallDir"
        sGlbData = routin_ReadRegistry(sRegkeyEngine)
    End If
    
    If Not sGlbData = "" Then
        sGlbData = sGlbData & "ArcGlobeData\Default_Document.3dd"
        If f.FileExists(sGlbData) And frmGlbCntrl.GlobeControl.Check3dFile(sGlbData) Then frmGlbCntrl.GlobeControl.Load3dFile (sGlbData)
    End If
    'check and Load if the animation file is present...
    m_sAnimFilePath = f.GetParentFolderName(App.Path)
    
    
    Do Until UCase(f.GetBaseName(m_sAnimFilePath)) = UCase("Samples")
    Dim count As Integer
    m_sAnimFilePath = f.GetParentFolderName(m_sAnimFilePath)
    If m_sAnimFilePath = "" Then Exit Do 'reached root drive exit now...
    count = count + 1

    If count > 25 Then Exit Do 'Exit do if app is not found in 25 iterations..
    Loop
    
    If Not m_sAnimFilePath = "" Then m_sAnimFilePath = m_sAnimFilePath & "\Data\ArcGlobeAnimation"
    
    If f.FolderExists(m_sAnimFilePath) Then m_sAnimFilePath = m_sAnimFilePath & "\AnimationSample.aga"
    
    If f.FileExists(m_sAnimFilePath) Then
    'Load the sample animation file into the animation file into the doc...
    Dim pBasicScene As IBasicScene
    Dim pglobe As IGlobe
    Set pglobe = frmGlbCntrl.GlobeControl.Globe
    Set pBasicScene = pglobe
    pBasicScene.LoadAnimation m_sAnimFilePath
    Else
    'Disable Animation Player controls...
    OptDuration.Enabled = False
    OptIteration.Enabled = False
    txtDuration.Enabled = False
    TxtFrequency.Enabled = False
    TxtFrequency.Enabled = False
    CmdPlay.Enabled = False
    End If
    frmGlbCntrl.Icon = Nothing

  Exit Sub
ErrorHandler:
  HandleError True, "Form_Load " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Sub

Private Function routin_ReadRegistry(sKey As String) As String
  On Error GoTo ErrorHandler


    On Error Resume Next ' safe guard if key does not exist
    Dim wscr
    Set wscr = CreateObject("WScript.Shell")
    routin_ReadRegistry = wscr.RegRead(sKey)


  Exit Function
ErrorHandler:
  HandleError False, "routin_ReadRegistry " & c_sModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 4
End Function
Private Sub CmdPlay_Click()
  On Error GoTo ErrorHandler

  
    Dim duration As Double
    Dim numcycle As Integer
    On Error Resume Next 'allows to handle when non integer character is entered in txtDuration.Text or TxtFrequency.Text
    If OptDuration.Value Then
        duration = CInt(txtDuration.Text)
        numcycle = CInt(TxtFrequency.Text)
        'play the animation via duration
        PlayAnimation duration, numcycle
    Else
        Dim iteration As Integer
        Dim cycles As Integer
        iteration = frmGlbCntrl.txtDuration.Text