Globe Fly tool
Fly.vb
' Copyright 2012 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 the use restrictions.
' 

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Drawing
Imports ESRI.ArcGIS.Analyst3D
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.ADF.BaseClasses
Imports ESRI.ArcGIS.ADF.CATIDs
Imports ESRI.ArcGIS.GlobeCore
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.SystemUI

Namespace GlobeFlyTool
  Public Class Fly
    Inherits ESRI.ArcGIS.Desktop.AddIns.Tool
    #Region "DllImport"

    <DllImport("user32")> _
    Public Shared Function SetCursor(ByVal hCursor As Integer) As Integer
    End Function
    <DllImport("user32")> _
    Public Shared Function GetClientRect(ByVal hwnd As Integer, ByRef lpRect As Rectangle) As Integer
    End Function
    <DllImport("user32")> _
    Shared Function GetCursorPos(ByRef lpPoint As System.Drawing.Point) As Boolean
    End Function
    <DllImport("user32")> _
    Public Shared Function GetWindowRect(ByVal hwnd As Integer, ByRef lpRect As Rectangle) As Integer
    End Function

    #End Region

    #Region "Member Variables"

    Private globe As IGlobe
    Private globeDisplay As IGlobeDisplay
    Private globeCamera As IGlobeCamera
    Private camera As ICamera
    Private scene As IScene
    Private inUse As Boolean
    Private bCancel As Boolean = False
    Private orbitalFly As Boolean = False
    Private mouseX As Long
    Private mouseY As Long
    Private motion As Double = 2 'speed of the scene fly through in scene units
    Private distance As Double 'distance between target and observer
    Private currentElevation As Double 'normal fly angles in radians
    Private currentAzimut As Double 'normal fly angles in radians
    Private speed As Integer
    Private flyCur As System.Windows.Forms.Cursor
    Private moveFlyCur As System.Windows.Forms.Cursor
    Private theClock As Microsoft.VisualBasic.Devices.Clock
    Private lastClock As Long
    Private observer As GlobeFlyTool.PointZ
    Private target As GlobeFlyTool.PointZ
    Private viewVec As GlobeFlyTool.PointZ

    #End Region

    #Region "Constructor/Destructor"

    Public Sub New()
      globe = ArcGlobe.Globe
      scene = TryCast(globe, IScene)
      globeDisplay = globe.GlobeDisplay
      camera = globeDisplay.ActiveViewer.Camera
      globeCamera = TryCast(camera, IGlobeCamera)
      theClock = New Microsoft.VisualBasic.Devices.Clock()
      flyCur = New System.Windows.Forms.Cursor(Me.GetType().Assembly.GetManifestResourceStream("Fly.cur"))
      moveFlyCur = New System.Windows.Forms.Cursor(Me.GetType().Assembly.GetManifestResourceStream("fly1.cur"))
      speed = 0
    End Sub

    Protected Overrides Sub Finalize()
      flyCur = Nothing
      moveFlyCur = Nothing
    End Sub

    #End Region

    Protected Overrides Sub OnUpdate()
      Enabled = ArcGlobe.Application IsNot Nothing

      If inUse Then
        Cursor = moveFlyCur
      Else
        Cursor = flyCur
      End If
    End Sub

    #Region "Tool overrides"

    Protected Overrides Sub OnMouseUp(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs)
      If arg.Button = MouseButtons.Left OrElse arg.Button = MouseButtons.Right Then
        If (Not inUse) Then
          mouseX = arg.X
          mouseY = arg.Y

          If speed = 0 Then
            StartFlight(arg.X, arg.Y)
          End If
        Else
          'Set the speed
          If arg.Button = MouseButtons.Left Then
            speed = speed + 1
          ElseIf arg.Button = MouseButtons.Right Then
            speed = speed - 1
          End If
        End If
      Else
        'EndFlight();
        inUse = False
        bCancel = True
      End If
    End Sub

    Protected Overrides Sub OnMouseMove(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs)
      If (Not inUse) Then
        Return
      End If

      mouseX = arg.X
      mouseY = arg.Y
    End Sub

    Protected Overrides Sub OnKeyUp(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.KeyEventArgs)
      If inUse = True Then
        'Slow down the speed of the fly through
        If arg.KeyCode = Keys.Down OrElse arg.KeyCode = Keys.Left Then
          motion = motion / 2
        'Speed up the speed of the fly through
        ElseIf arg.KeyCode = Keys.Up OrElse arg.KeyCode = Keys.Right Then
          motion = motion * 2
        ElseIf arg.KeyCode = Keys.Escape Then
          bCancel = True
        End If

      End If
    End Sub

    Protected Overrides Sub OnKeyDown(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.KeyEventArgs)
      If arg.KeyCode = Keys.Escape Then 'ESC is pressed
        bCancel = True
      End If
    End Sub

    #End Region

    #Region "Fly Functions"

    Public Sub StartFlight(ByVal x As Double, ByVal y As Double)
      inUse = True

      globeDisplay.IsNavigating = True
      Dim camOrientMode As ESRI.ArcGIS.GlobeCore.esriGlobeCameraOrientationMode = globeCamera.OrientationMode

      orbitalFly = If((camOrientMode = ESRI.ArcGIS.GlobeCore.esriGlobeCameraOrientationMode.esriGlobeCameraOrientationLocal), True, False)

      Dim pObs As IPoint = camera.Observer
      Dim pTar As IPoint = camera.Target

      observer = New GlobeFlyTool.PointZ(pObs.X, pObs.Y, pObs.Z)
      target = New GlobeFlyTool.PointZ(pTar.X, pTar.Y, pTar.Z)

      viewVec = target - observer
      distance = viewVec.Norm()

      'avoid center of globe
      If target.Norm() < 0.25 Then
        target = target + viewVec
        distance = distance * 2
      End If

      currentElevation = Math.Atan(viewVec.z / Math.Sqrt((viewVec.x * viewVec.x) + (viewVec.y + viewVec.y)))
      currentAzimut = Math.Atan2(viewVec.y, viewVec.x) '2.26892;//

      'Windows API call to get windows client coordinates
      Dim pt As New System.Drawing.Point()
      Dim ans As Boolean = GetCursorPos(pt)
      Dim rect As New Rectangle()
      If GetWindowRect(globeDisplay.ActiveViewer.hWnd, rect) = 0 Then
        Return
      End If

      mouseX = pt.X - rect.Left
      mouseY = pt.Y - rect.Top

      If (Not orbitalFly) Then
        globeCamera.OrientationMode = esriGlobeCameraOrientationMode.esriGlobeCameraOrientationGlobal
      Else
        globeCamera.OrientationMode = esriGlobeCameraOrientationMode.esriGlobeCameraOrientationLocal
      End If
      globeCamera.NavigationType = esriGlobeNavigationType.esriGlobeNavigationFree
      globeCamera.RollFactor = 1.0

      globeDisplay.IsNavigating = True
      globeDisplay.IsNavigating = False
      globeDisplay.IsNavigating = True

      lastClock = theClock.TickCount

      'Windows API call to set cursor
      SetCursor(moveFlyCur.Handle.ToInt32())
      'Continue the flight
      Flight()
    End Sub

    Public Sub Flight()
      'speed in scene units
      Dim motionUnit As Double = (0.000001 + Math.Abs(observer.Norm() - 1.0) / 200.0) * motion
      'Get IMessageDispatcher interface
      Dim pMessageDispatcher As IMessageDispatcher
      pMessageDispatcher = New MessageDispatcherClass()

      'Set the ESC key to be seen as a cancel action
      pMessageDispatcher.CancelOnClick = False
      pMessageDispatcher.CancelOnEscPress = True
      bCancel = False
      Do
        'Get the elapsed time
        Dim currentClock As Long = theClock.TickCount
        Dim lastFrameDuration As Double = CDbl(currentClock - lastClock) / 1000
        lastClock = currentClock

        If lastFrameDuration < 0.01 Then
          lastFrameDuration = 0.01
        End If

        If lastFrameDuration > 1 Then
          lastFrameDuration = 0.1
        End If

        System.Diagnostics.Debug.Print(lastFrameDuration.ToString())

        'Windows API call to get windows client coordinates
        Dim rect As New Rectangle()
        If GetClientRect(globeDisplay.ActiveViewer.hWnd, rect) = 0 Then
          Return
        End If

        'Get normal vectors
        Dim dXMouseNormal, dYMouseNormal As Double

        dXMouseNormal = 2 * (CDbl(mouseX) / CDbl(rect.Right - rect.Left)) - 1
        dYMouseNormal = 2 * (CDbl(mouseY) / CDbl(rect.Bottom - rect.Top)) - 1

        Dim dir As PointZ = Me.RotateNormal(lastFrameDuration, dXMouseNormal, dYMouseNormal)

        Dim visTarget As New PointZ(observer.x + distance * dir.x, observer.y + distance * dir.y, observer.z + distance * dir.z)
        target.x = visTarget.x
        target.y = visTarget.y
        target.z = visTarget.z

        If speed <> 0 Then
          Dim speedFactor As Integer = If((speed > 0), (1 << speed), -(1 << (-speed)))

          'Move the camera in the viewing directions
          observer.x = observer.x + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.x)
          observer.y = observer.y + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.y)
          observer.z = observer.z + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.z)
          target.x = target.x + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.x)
          target.y = target.y + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.y)
          target.z = target.z + (lastFrameDuration * (2 Xor speedFactor) * motionUnit * dir.z)
        End If

        Dim globeViewUtil As ESRI.ArcGIS.GlobeCore.IGlobeViewUtil = TryCast(globeCamera, ESRI.ArcGIS.GlobeCore.IGlobeViewUtil)
        Dim obsLat As Double
        Dim obsLon As Double
        Dim obsAlt As Double
        Dim tarLat As Double
        Dim tarLon As Double
        Dim tarAlt As Double

        globeViewUtil.GeocentricToGeographic(observer.x, observer.y, observer.z, obsLon, obsLat, obsAlt)
        globeViewUtil.GeocentricToGeographic(target.x, target.y, target.z, tarLon, tarLat, tarAlt)
        globeCamera.SetObserverLatLonAlt(obsLat, obsLon, obsAlt / 1000)
        globeCamera.SetTargetLatLonAlt(tarLat, tarLon, tarAlt / 1000)

        globeCamera.SetAccurateViewDirection(target.x - observer.x, target.y - observer.y, target.z - observer.z)

        Dim rollAngle As Double = 0
        If speed > 0 Then
          rollAngle = 10 * dXMouseNormal * Math.Abs(dXMouseNormal)
        End If
        camera.RollAngle = rollAngle

        'Redraw the scene viewer 
        globeDisplay.RefreshViewers()

        'Dispatch any waiting messages: OnMouseMove / OnMouseUp / OnKeyUp events
        Dim objCancel As Object = TryCast(bCancel, Object)
        pMessageDispatcher.Dispatch(globeDisplay.ActiveViewer.hWnd, False, objCancel)

        'End flight if ESC key pressed
        If bCancel = True Then
          EndFlight()
        End If

      Loop While inUse = True AndAlso bCancel = False

      bCancel = False
    End Sub

    Public Sub EndFlight()
      inUse = False
      bCancel = True
      speed = 0
      globeDisplay.IsNavigating = False

      ' reposition target
      Dim currentObs As New PointZ()
      Dim newTarget As IPoint = New PointClass()
      currentObs.x = camera.Observer.X
      currentObs.y = camera.Observer.Y
      currentObs.z = camera.Observer.Z

      Dim orX As Integer = 0
      Dim orY As Integer = 0
      Dim width As Integer = 0
      Dim height As Integer = 0
      camera.GetViewport(orX, orY, width, height)

      Dim obj1 As Object
      Dim obj2 As Object
      Try
        globeDisplay.Locate(globeDisplay.ActiveViewer, width \ 2, height \ 2, True, True, newTarget, obj1, obj2)
      Catch e As System.Exception
        MessageBox.Show(e.Message)
        MessageBox.Show(e.StackTrace.ToString())
      End Try

      If newTarget Is Nothing Then ' no intersection with globe, but don't let the target to be too far
        newTarget = camera.Target
        Dim tar As New PointZ(currentObs.x, currentObs.y, currentObs.z)

        Dim elevObs As Double = tar.Norm() - 1.0
        If elevObs <= 0.0001 Then
          elevObs = 0.0001
        End If

        Dim oldTarget As New PointZ(newTarget.X, newTarget.Y, newTarget.Z)
        Dim dir As PointZ = (oldTarget - tar)
        Dim val As Double = dir.Norm()
        If val > 0.0 Then
          dir.x = dir.x * elevObs * 10 / val
          dir.y = dir.y * elevObs * 10 / val
          dir.z = dir.z * elevObs * 10 / val
        End If

        tar = tar + dir
        newTarget.X = tar.x
        newTarget.Y = tar.y
        newTarget.Z = tar.z
      End If

      Dim globeViewUtil As ESRI.ArcGIS.GlobeCore.IGlobeViewUtil = TryCast(globeCamera, ESRI.ArcGIS.GlobeCore.IGlobeViewUtil)
      Dim obsLat As Double
      Dim obsLon As Double
      Dim obsAlt As Double
      Dim tarLat As Double
      Dim tarLon As Double
      Dim tarAlt As Double
      globeViewUtil.GeocentricToGeographic(currentObs.x, currentObs.y, currentObs.z, obsLon, obsLat, obsAlt)
      globeViewUtil.GeocentricToGeographic(newTarget.X, newTarget.Y, newTarget.Z, tarLon, tarLat, tarAlt)
      globeCamera.SetObserverLatLonAlt(obsLat, obsLon, obsAlt / 1000)
      globeCamera.SetTargetLatLonAlt(tarLat, tarLon, tarAlt / 1000)
      camera.RollAngle = 0
      camera.PropertiesChanged()
      globeDisplay.RefreshViewers()

      'Windows API call to set cursor
      SetCursor(moveFlyCur.Handle.ToInt32())
    End Sub

    Public Function RotateNormal(ByVal lastFrameDuration As Double, ByVal mouseXNorm As Double, ByVal mouseYNorm As Double) As PointZ
      currentElevation = currentElevation - (lastFrameDuration * mouseYNorm * (Math.Abs(mouseYNorm)))
      currentAzimut = currentAzimut - (lastFrameDuration * mouseXNorm * (Math.Abs(mouseXNorm)))

      If currentElevation > 0.45 * 3.141592 Then
        currentElevation = 0.45 * 3.141592
      End If
      If currentElevation < -0.45 * 3.141592 Then
        currentElevation = -0.45 * 3.141592
      End If
      Do While currentAzimut < 0
        currentAzimut = currentAzimut + (2 * 3.141592)
      Loop
      Do While currentAzimut > 2 * 3.141592
        currentAzimut = currentAzimut - (2 * 3.141592)
      Loop

      Dim x As Double = Math.Cos(currentElevation) * Math.Cos(currentAzimut)
      Dim y As Double = Math.Cos(currentElevation) * Math.Sin(currentAzimut)
      Dim z As Double = Math.Sin(currentElevation)

      Dim p As GlobeFlyTool.PointZ = New PointZ(x, y, z)
      Return p
    End Function

    #End Region
  End Class

End Namespace