SCROLL DE CAMERA DANS LE VIEWPORT

Imports System.Windows.Media.Media3D

Module Main '....... Affiche un MeshGeometry sur un plateau.(Viewport et scrollbars......)

    Dim Projection As New Plateau3D(MeshCube(New Point3D(-0.5, -0.5, -0.5), 1, 1, 1))

    Dim WithEvents Cadre As New Window With {.Height = 300, .Width = 300}
    Dim WithEvents Appli As New Application() 'Systeme

    Sub Main()
        Cadre.Content = Projection.Pupitre.Panneau
        Appli.Run(Cadre)
    End Sub      '.............................................................    END Main


    'Mise en place...............

    ''' <summary>
    ''' retourne un cube de garniture.. a essais.
    ''' </summary>
    ''' <param name="Pos"></param>
    ''' <param name="Prof"></param>
    ''' <param name="Haut"></param>
    ''' <param name="Larg"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function MeshCube(ByVal Pos As Point3D, _
                  ByVal Prof As Integer, _
                  ByVal Haut As Integer, _
                  ByVal Larg As Integer) As MeshGeometry3D 'Resille_Cube_Test

        Dim Demi_Profondeur As Integer = Prof
        Dim Demi_Largeur As Integer = Larg
        Dim Demi_Hauteur As Integer = Haut

        'Face inférieure
        Dim Pos_1 As New Point3D(Pos.X, Pos.Y, Pos.Z + Demi_Largeur)
        Dim Pos_2 As New Point3D(Pos.X + Demi_Profondeur, Pos.Y, Pos.Z)
        Dim Pos_3 As New Point3D(Pos.X + Demi_Profondeur, Pos.Y, Pos.Z + Demi_Largeur)

        'Face supérieure
        Dim Pos_4 As New Point3D(Pos.X, Pos.Y + Demi_Hauteur, Pos.Z)
        Dim Pos_5 As New Point3D(Pos.X + Demi_Profondeur, Pos.Y + Demi_Hauteur, Pos.Z)
        Dim Pos_6 As New Point3D(Pos.X, Pos.Y + Demi_Hauteur, Pos.Z + Demi_Largeur)
        Dim Pos_7 As New Point3D(Pos.X + Demi_Profondeur, Pos.Y + Demi_Hauteur, Pos.Z + Demi_Largeur)
        'et les 4 dernières faces
        Dim Triangles() As Integer = {4, 5, 6, 5, 6, 7, 0, 1, 2, 1, 2, _
        3, 0, 2, 4, 2, 4, 5, 1, 3, 6, 3, 6, 7, 0, 1, 4, 1, 4, 6, 2, 3, 5, 3, 5, 7}
        Dim M As New MeshGeometry3D
        M.Positions.Add(Pos)
        M.Positions.Add(Pos_1)
        M.Positions.Add(Pos_2)
        M.Positions.Add(Pos_3)
        M.Positions.Add(Pos_4)
        M.Positions.Add(Pos_5)
        M.Positions.Add(Pos_6)
        M.Positions.Add(Pos_7)
        For i = 0 To 35
            M.TriangleIndices.Add(Triangles(i))
        Next i
        Return M
    End Function


    ''' <summary>
    ''' Génére un Viewport .. à garnir.
    ''' </summary>
    ''' <param name="Resille"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function Maille_Test(ByVal Resille As MeshGeometry3D) _
           As Viewport3D
        Dim Essai As New Viewport3D

        Dim Lumiere As New AmbientLight(Colors.White)
        Dim Eclairage As New ModelVisual3D
        Eclairage.Content = Lumiere
        Essai.Children.Add(Eclairage)

        Dim Cam As New PerspectiveCamera
        With Cam
            .Position = New Point3D(0, 0, 10)
            .LookDirection = New Vector3D(0, 0, -1)
            .UpDirection = New Vector3D(0, 1, 0)
            .FieldOfView = 45
        End With
        Essai.Camera = Cam

        Dim Volume As New ModelVisual3D
        Dim Rectangle As New GeometryModel3D
        Dim Color As New DiffuseMaterial(Brushes.Cyan)
        Dim Colorback As New DiffuseMaterial(Brushes.Red)

        Rectangle.Geometry = Resille '_Cube _
        '(New Point3D(-0.5, -0.5, -0.5), 1, 1, 1)
        Rectangle.Material = Color
        Rectangle.BackMaterial = Colorback
        Volume.Content = Rectangle
        Essai.Children.Add(Volume)

        Return Essai
    End Function


    ''' <summary>
    ''' lie trois curseurs (Scroll3D) et un Viewport.
    ''' </summary>
    ''' <remarks></remarks>
    Public Class Plateau3D
        Friend Vision As Viewport3D
        Friend WithEvents Pupitre As New Scroll3D

        Dim Origine As New Point3D(0, 0, 0)
        Dim Eloignement As Integer = 1
        Dim Latitude As Integer = 0
        Dim Longitude As Integer = 0


        Friend Sub ValueChanged() Handles Pupitre.ValueChanged '(ByVal NewValue As Point3D)
            Dim Cam As PerspectiveCamera = Vision.Camera
            REM ' Position de la caméra.
            Dim Position_Camera As Point3D = Euclide(Pupitre.Hbar.Value, Pupitre.Vbar.Value, Pupitre.Zbar.Value)
            Cam.Position = New Point3D(Position_Camera.X, Position_Camera.Y, Position_Camera.Z)
            Cam.LookDirection = New Vector3D(Origine.X - Position_Camera.X, _
                                             Origine.Y - Position_Camera.Y, _
                                             Origine.Z - Position_Camera.Z)
        End Sub

        Friend Sub New(ByVal Filet As MeshGeometry3D)
            Vision = Maille_Test(Filet)
            Pupitre.Panneau.Children.Add(Vision)
            Dim Matrice As Matrix3D = Vision.Camera.Transform.Value
            ValueChanged()
        End Sub
    End Class


    ''' <summary>
    ''' Scrolls circulaires et éloignement.
    ''' </summary>
    ''' <remarks>User control composé de trois scrollBars</remarks>
    Public Class Scroll3D

        Friend Panneau As New Grid
        Event ValueChanged() '(ByVal NewValue As Media3D.Point3D)

        'Rotation Horizontale
        Friend WithEvents Hbar As New Primitives.ScrollBar With { _
        .ToolTip = "Latitude", _
           .Orientation = Orientation.Horizontal, _
        .Margin = New Thickness(0, 180, 0, 0), _
            .Minimum = -90, _
            .Maximum = 90, _
            .LargeChange = 10, _
            .Value = 0}

        'Rotation Verticale
        Friend WithEvents Vbar As New Primitives.ScrollBar With { _
         .ToolTip = "Longitude", _
            .Orientation = Orientation.Horizontal, _
          .Margin = New Thickness(0, 210, 0, 0), _
             .Minimum = 0, _
             .Maximum = 24, _
          .LargeChange = 3, _
             .Value = 12}

        Friend WithEvents Zbar As New Primitives.ScrollBar With { _
         .ToolTip = "Eloignement", _
            .Orientation = Orientation.Horizontal, _
          .Margin = New Thickness(0, 240, 0, 0), _
            .Minimum = 5, _
             .Maximum = 10, _
             .LargeChange = 1, _
             .Value = 5} 'Min

        Friend Sub New()
            Panneau.Children.Add(Hbar)
            Panneau.Children.Add(Vbar)
            Panneau.Children.Add(Zbar)
        End Sub

        Friend Sub HBar_VC(ByVal sender As Object, _
                ByVal e As RoutedPropertyChangedEventArgs(Of Double)) _
                Handles Hbar.ValueChanged
            RaiseEvent ValueChanged() '(New Media3D.Point3D(e.NewValue, 0, 0))
        End Sub
        Friend Sub VBar_VC(ByVal sender As Object, _
                ByVal e As RoutedPropertyChangedEventArgs(Of Double)) _
                Handles Vbar.ValueChanged
            RaiseEvent ValueChanged() '(New Media3D.Point3D(0, e.NewValue, 0))
        End Sub
        Friend Sub ZBar_VC(ByVal sender As Object, _
                 ByVal e As RoutedPropertyChangedEventArgs(Of Double)) _
                 Handles Zbar.ValueChanged
            RaiseEvent ValueChanged() '(New Media3D.Point3D(0, 0, e.NewValue))
        End Sub

    End Class

    Function Euclide(ByVal Longitude As Integer, _
                  ByVal Latitude As Integer, _
                  ByVal Eloignement As Integer, _
                     Optional ByVal OrigineX As Integer = 0, _
                     Optional ByVal OrigineY As Integer = 0, _
                     Optional ByVal OrigineZ As Integer = 0)

        Dim P As New Point3D(Eloignement * (Math.Cos(Longitude) * Math.Cos(Latitude) + OrigineX), _
                             Eloignement * (Math.Sin(Longitude) + OrigineY), _
                             Eloignement * (Math.Cos(Longitude) * Math.Sin(Latitude) + OrigineZ))
        Return P
    End Function


End Module