3D

VERSION 5.00
Begin VB.UserControl DEX3D
   BackColor       =   &H00000000&
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.PictureBox Picture3
      Height          =   495
      Left            =   2880
      ScaleHeight     =   435
      ScaleWidth      =   1155
      TabIndex        =   2
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox Picture2
      Height          =   495
      Left            =   1440
      ScaleHeight     =   435
      ScaleWidth      =   1155
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox Picture1
      Height          =   495
      Left            =   120
      ScaleHeight     =   435
      ScaleWidth      =   1155
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuNew
         Caption         =   "New"
      End
      Begin VB.Menu mnuBar1
         Caption         =   "-"
      End
      Begin VB.Menu mnuLoad
         Caption         =   "Load"
      End
      Begin VB.Menu mnuSave
         Caption         =   "Save"
      End
      Begin VB.Menu mnuBar2
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "Edit"
      Begin VB.Menu mnuRename
         Caption         =   "Rename"
      End
      Begin VB.Menu mnuBar3
         Caption         =   "-"
      End
      Begin VB.Menu mnuColorOption
         Caption         =   "Color White"
         Index           =   0
      End
      Begin VB.Menu mnuColorOption
         Caption         =   "Color Random"
         Index           =   1
      End
      Begin VB.Menu mnuColorOption
         Caption         =   "Color Gradient"
         Index           =   2
      End
      Begin VB.Menu mnuBar4
         Caption         =   "-"
      End
      Begin VB.Menu mnuTessellationOption
         Caption         =   "Tessellate By Face"
         Index           =   0
      End
      Begin VB.Menu mnuTessellationOption
         Caption         =   "Tessellate By Edge"
         Index           =   1
      End
   End
   Begin VB.Menu mnuView
      Caption         =   "View"
      Begin VB.Menu mnuLight
         Caption         =   "Light"
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuOrthographic
         Caption         =   "Orthographic"
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuBar5
         Caption         =   "-"
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Wireframe"
         Index           =   0
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Solid"
         Index           =   1
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Shaded"
         Index           =   2
         Shortcut        =   {F3}
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Transparent"
         Index           =   3
         Shortcut        =   {F4}
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Outlined"
         Index           =   4
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuDrawStyleOption
         Caption         =   "Gradient"
         Index           =   5
         Shortcut        =   {F6}
      End
      Begin VB.Menu mnuBar6
         Caption         =   "-"
      End
      Begin VB.Menu mnuDrawModeOption
         Caption         =   "Double-Sided"
         Index           =   0
         Shortcut        =   ^D
      End
      Begin VB.Menu mnuDrawModeOption
         Caption         =   "Metallic"
         Index           =   1
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuDrawModeOption
         Caption         =   "Atmosphere"
         Index           =   2
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuDrawModeOption
         Caption         =   "Color-Correct"
         Index           =   3
         Shortcut        =   ^C
      End
   End
   Begin VB.Menu mnuObject
      Caption         =   "Object"
      Begin VB.Menu mnuBasicOption
         Caption         =   "Box"
         Index           =   0
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Grid"
         Index           =   1
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Sphere"
         Index           =   2
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Hemisphere"
         Index           =   3
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Cone"
         Index           =   4
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Cylinder"
         Index           =   5
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Pie"
         Index           =   6
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Tetrahedron"
         Index           =   7
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Octahedron"
         Index           =   8
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Geo-Sphere"
         Index           =   9
      End
      Begin VB.Menu mnuBasicOption
         Caption         =   "Torus"
         Index           =   10
      End
      Begin VB.Menu mnuBar7
         Caption         =   "-"
      End
      Begin VB.Menu mnuSpecialOption
         Caption         =   "Pixel"
         Index           =   0
      End
      Begin VB.Menu mnuSpecialOption
         Caption         =   "Line"
         Index           =   1
      End
      Begin VB.Menu mnuSpecialOption
         Caption         =   "Text"
         Index           =   2
      End
      Begin VB.Menu mnuSpecialOption
         Caption         =   "Curve"
         Index           =   3
      End
      Begin VB.Menu mnuBar8
         Caption         =   "-"
      End
      Begin VB.Menu mnuComboOption
         Caption         =   "Bar Graph"
         Index           =   0
      End
      Begin VB.Menu mnuComboOption
         Caption         =   "Grid Graph"
         Index           =   1
      End
      Begin VB.Menu mnuComboOption
         Caption         =   "Pie Graph"
         Index           =   2
      End
      Begin VB.Menu mnuBar9
         Caption         =   "-"
      End
      Begin VB.Menu mnuOtherOption
         Caption         =   "Ripple"
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "Help"
      Begin VB.Menu mnuAbout
         Caption         =   "About"
      End
   End
End
Attribute VB_Name = "DEx3D"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public Enum Color
    White = 0
    Random = 1
    Gradient = 2
End Enum
Public Enum Obj3D
    Box = 0
    Grid = 1
    CircleSphare = 2
    Hemisphere = 3
    Cone = 4
    Cylinder = 5
    Pie = 6
    Tetrahedron = 7
    Sphere = 8
    GeoSphere = 9
    Torus = 10
End Enum
Public Enum Combo
    Bar = 0
    Grid = 1
    OPie = 2
End Enum
Public Enum DrawStyle
    Wireframe = 0
    Solid = 1
    Shaded = 2
    Transparent = 3
    Outlined = 4
    Super = 5
End Enum
Public Enum DrawMode
    DoubleSided = 0
    Metallic = 1
    Atmosphere = 2
    ColorCorrect = 3
End Enum
Public Enum Tessellation
    Face = 0
    Edge = 1
End Enum
Public Enum Special
Pixel = 0
Line = 1
Text = 2
Curve = 3
End Enum
Dim Info As String
Public MH, MW
Dim exits
Public Sub Activate()

    Dim FrameRate As Single
   
    If BeginRenderLoop = True Then
        BeginRenderLoop = False
        Do
            If RefreshScene = True Then
                RefreshScene = False
                If TickCount < 10 Then
                    TickCount = TickCount + 1
                Else
                    FinishTime = Timer
                    If FinishTime <> BeginTime Then
                        FrameRate = TickCount / (FinishTime - BeginTime)
                        'UserControl1.Caption = App.Title & " - " & Format(FrameRate, "0.00") & " fps"
                        TickCount = 0
                        BeginTime = Timer
                    End If
                End If
                LastFaceOver = 0
                If LockCamera = True Then
                    VLight(MyLight).Origin = _
                        VectorAdd( _
                            VectorNull, _
                            VectorScale( _
                                OrientationToVector(OrientationInput(0, OrbitLatitude, -OrbitLongitude)), _
                                -OrbitRadius _
                            ) _
                        )
                    If CameraModel <> 0 Then
                        VMesh(CameraModel).Origin = VLight(MyLight).Origin
                        VMesh(CameraModel).Angles.Pitch = OrbitLatitude
                        VMesh(CameraModel).Angles.Yaw = -OrbitLongitude
                        VMesh(CameraModel).UpdateTransformation = True
                    End If
                Else
                    Call OrbitCamera(MyCamera, VectorNull, OrbitRadius, OrbitLongitude, OrbitLatitude)
                    VLight(MyLight).Origin = VCamera(MyCamera).Origin
                End If
                Picture1.Cls
                Call RenderImage(Picture1, MyCamera)
                Picture1.ForeColor = vbWhite
                Picture1.Print "Longitude: " & Int(RadianToDegree(OrbitLongitude))
                Picture1.Print "Latitude: " & Int(RadianToDegree(OrbitLatitude))
                Picture1.Print "Radius: " & Int(OrbitRadius)
                Picture1.Print
                Picture1.Print "Name: " & VMesh(MyMesh).Tag
                Picture1.Print "Vertices: " & VMesh(MyMesh).Vertices.Length
                Picture1.Print "Faces: " & VMesh(MyMesh).Faces.Length
                Info = "Longitude: " & Int(RadianToDegree(OrbitLongitude)) & vbCrLf & _
"Latitude: " & Int(RadianToDegree(OrbitLatitude)) & vbCrLf & _
"Radius: " & Int(OrbitRadius) & vbCrLf & vbCrLf & _
"Name: " & VMesh(MyMesh).Tag & vbCrLf & _
"Vertices: " & VMesh(MyMesh).Vertices.Length & vbCrLf & _
"Faces: " & VMesh(MyMesh).Faces.Length
            End If
            If exits = True Then Exit Do Else DoEvents
        Loop
    End If
   
End Sub
Public Sub Load()
exits = False
    Dim Extension As String
   
   ' CommonDialog1.CancelError = True
   
    Call InitializeScene(Picture1)
    Call InitializeCanvas(Picture2)
    Call InitializeCanvas(Picture3)
    Picture1.BorderStyle = 0
    Picture2.BorderStyle = 0
    Picture3.BorderStyle = 0
    Picture1.BackColor = vbBlack
    Picture2.BackColor = vbBlack
    Picture3.BackColor = vbBlack
   
    TickCount = 10
   
    MyCamera = AddCamera
    VCamera(MyCamera).Zoom = 1
    VCamera(MyCamera).DrawStyle = 2
    mnuDrawStyleOption(2).Checked = True
   
    MyLight = AddLight
    mnuLight.Checked = True
   
    OrbitRadius = 200
    OrbitSpeed = 0.01
    DollySpeed = 1
   
    If Command <> "" Then
        Extension = LCase(Right(Command, 3))
        If Extension = "dex" Then MyMesh = LoadDexMesh(Command)
        If Extension = "3ds" Then
            MyMesh = 0
            Call Load3dsFile(Command)
            Call SetSceneColor(ColorLongToRGB(vbWhite), 0.5)
        End If
        Call CenterMesh(MyMesh)
        RefreshScene = True
    End If
   
    BeginRenderLoop = True
   
End Sub

Public Sub Resize()

    Dim PaletteWidth As Integer
   
    PaletteWidth = MH / 20
   
    Picture1.Move 0, 0, MW - PaletteWidth, MH - PaletteWidth
    Picture2.Move MW - PaletteWidth, 0, PaletteWidth, MH - PaletteWidth
    Picture3.Move 0, MH - PaletteWidth, MW, PaletteWidth
   
    RefreshScene = True
   
End Sub

'===================================================================

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = CShift Then
        LockCamera = True
        If CameraModel = 0 Then
            CameraModel = AddMeshCone(10, 20, 4)
            Call CenterMesh(CameraModel)
            Call TransformMesh(CameraModel, TransformationTranslate(VectorInput(0, 20, 0)))
            Call TransformMesh(CameraModel, TransformationRotate(1, -Pi / 2))
            Call TransformMesh(CameraModel, TransformationRotate(3, Pi / 4))
            Call SetMeshColor(CameraModel, ColorLongToRGB(vbRed), 0.5)
            UserControl1.mnuFile.Enabled = False
            UserControl1.mnuEdit.Enabled = False
            UserControl1.mnuView.Enabled = False
            UserControl1.mnuObject.Enabled = False
            UserControl1.mnuHelp.Enabled = False
        End If
    End If
   
End Sub
Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)

    If KeyCode = CShift Then
        LockCamera = False
        If CameraModel <> 0 Then
            Call RemoveMesh(CameraModel)
            CameraModel = 0
            UserControl1.mnuFile.Enabled = True
            UserControl1.mnuEdit.Enabled = True
            UserControl1.mnuView.Enabled = True
            UserControl1.mnuObject.Enabled = True
            UserControl1.mnuHelp.Enabled = True
        End If
        RefreshScene = True
    End If
   
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If FaceOver <> 0 Then
        If CameraModel = 0 Then
            Select Case Button
                Case 1
                    VFace(FaceOver).Color = ColorLongToRGB(BrushColor)
                    VFace(FaceOver).Alpha = BrushAlpha
                    RefreshScene = True
                Case 2
                    BrushColor = ColorRGBToLong(VFace(FaceOver).Color)
                    BrushAlpha = VFace(FaceOver).Alpha
                    Call Picture3_Resize
            End Select
        End If
    End If
   
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button <> 0 Then
        Select Case Button
            Case 1 'orbit
                Picture1.MousePointer = 15
                OrbitLongitude = OrbitLongitude - (X - LastMousePosition.X) * OrbitSpeed
                OrbitLatitude = OrbitLatitude + (Y - LastMousePosition.Y) * OrbitSpeed
                If OrbitLongitude > Pi Then OrbitLongitude = OrbitLongitude - (2 * Pi)
                If OrbitLongitude < -Pi Then OrbitLongitude = OrbitLongitude + (2 * Pi)
                If OrbitLatitude > (Pi / 2) Then OrbitLatitude = (Pi / 2)
                If OrbitLatitude < -(Pi / 2) Then OrbitLatitude = -(Pi / 2)
            Case 2 'dolly
                Picture1.MousePointer = 7
                OrbitRadius = OrbitRadius + (Y - LastMousePosition.Y) * DollySpeed
                If OrbitRadius < 0 Then OrbitRadius = 0
        End Select
        RefreshScene = True
    Else
        If CameraModel = 0 Then
            FaceOver = FaceByPoint(POINTAPIInput(Int(X), Int(Y)))
            If FaceOver <> 0 Then
                Picture1.MousePointer = 2
            Else
                Picture1.MousePointer = 0
            End If
            If FaceOver <> LastFaceOver Then
                Picture1.DrawMode = 6
                Picture1.DrawStyle = 0
                Picture1.FillStyle = 1
                If LastFaceOver <> 0 Then Call DrawFace(Picture1, LastFaceOver, ColorNull)
                LastFaceOver = FaceOver
                Call DrawFace(Picture1, FaceOver, ColorNull)
                Picture1.Refresh
            End If
        Else
            Picture1.MousePointer = 0
        End If
    End If
    LastMousePosition.X = X
    LastMousePosition.Y = Y
   
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Call Picture2_MouseMove(Button, Shift, X, Y)
   
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Picture2.MousePointer = 2
    If Button <> 0 Then
        PaletteColor = GetPixel(Picture2.hdc, X, Y)
        If PaletteColor <> -1 Then BrushColor = PaletteColor
        Call Picture3_Resize
    End If
   
End Sub
Private Sub Picture2_Resize()

    Picture2.Cls
    Call DrawColorSpectrum(Picture2, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, 2)
   
End Sub
Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Call Picture3_MouseMove(Button, Shift, X, Y)
   
End Sub
Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Picture3.MousePointer = 9
    If Button <> 0 Then
        BrushAlpha = Abs(X - Picture3.ScaleWidth / 2) / (Picture3.ScaleWidth / 2)
        If BrushAlpha > 1 Then BrushAlpha = 1
        Call Picture3_Resize
    End If
   
End Sub
Private Sub Picture3_Resize()

    Picture3.Cls
    Call DrawColorShades(Picture3, 0, 0, Picture3.ScaleWidth, Picture3.ScaleHeight, 1, BrushColor)
    Call _
        DrawArrow( _
            Picture3, _
            Picture3.ScaleWidth / 2 + BrushAlpha * Picture3.ScaleWidth / 2, _
            0, _
            1, _
            Picture3.Height, _
            vbWhite, _
            5 _
        )
    Call _
        DrawArrow( _
            Picture3, _
            Picture3.ScaleWidth / 2 - BrushAlpha * Picture3.ScaleWidth / 2, _
            0, _
            1, _
            Picture3.Height, _
            vbWhite, _
            5 _
        )
       
End Sub

Public Function LoadDEX3D(Filename As String) As Boolean
    Dim Extension As String
    On Error GoTo ErrorErr
        Call ResetScene(0, MyCamera, MyLight)
        Extension = LCase(Right(Filename, 3))
        If Extension = "dex" Then MyMesh = LoadDexMesh(Filename)
        If Extension = "3ds" Then
            MyMesh = 1
            Call Load3dsFile(Filename)
            Call SetSceneColor(ColorLongToRGB(vbWhite), 0.5)
        End If
        RefreshScene = True
        LoadDEX3D = True
        Exit Function
ErrorErr:
        LoadDEX3D = False
End Function
Public Function SaveDEX3D(Filename As String) As Boolean
    On Error GoTo ErrorErr
    Call SaveDexMesh(MyMesh, Filename)
    SaveDEX3D = True
    Exit Function
ErrorErr:
    SaveDEX3D = False
End Function
Public Sub Rename(Tag)
On Error GoTo exx
    VMesh(MyMesh).Tag = Tag
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub

Public Sub New3D()
On Error GoTo exx
    Call ResetScene(0, MyCamera, MyLight)
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub

Public Sub About()
On Error GoTo exx
    Call ShowAbout
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub ColorOption(Optional ColorMode As Color = Gradient)
    On Error GoTo exx
    Select Case ColorMode
        Case 0
            Call SetMeshColor(MyMesh, ColorLongToRGB(vbWhite), 0.5)
        Case 1
            Call SetMeshColorRandom(MyMesh)
        Case 2
            Call SetMeshColorGradient(MyMesh, 2, ColorLongToRGB(vbRed), ColorLongToRGB(vbBlue), 0.5)
    End Select
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub

Public Sub ObjectOption(Optional Obj As Obj3D = Box, Optional length1 As Single = 40, Optional length2 As Single = 40, Optional length3 As Single = 40, Optional length4 As Single = 4)
    On Error GoTo exx
    Randomize
    Call ResetScene(0, MyCamera, MyLight)
    Select Case Obj
        Case 0
            MyMesh = AddMeshBox(VectorInput(length1, length2, length3))
        Case 1
            MyMesh = AddMeshGrid(length1, length2, Int(length3), Int(length4), False)
        Case 2
            MyMesh = AddMeshSphere(length1, Int(length2), Int(length3))
        Case 3
            MyMesh = AddMeshHemisphere(length1, Int(length2), Int(length3))
        Case 4
            MyMesh = AddMeshCone(length1, length2, Int(length3))
        Case 5
            MyMesh = AddMeshCylinder(length1, length2, Int(length3))
        Case 6
            MyMesh = AddMeshPie(length1, length2, 0, length3, Int(length4))
        Case 7
            MyMesh = AddMeshTetrahedron(length1)
        Case 8
            MyMesh = AddMeshSphere(length1, Int(length2), Int(length3))
        Case 9
            MyMesh = AddMeshGeoSphere(length1, Int(length2))
        Case 10
            MyMesh = AddMeshTorus(length1, length2, Int(length3), Int(length4))
    End Select
    Call CenterMesh(MyMesh)
    Call SetMeshColor(MyMesh, ColorRandom, 0.5)
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub ComboOption(Optional MyCombo As Combo = OPie, Optional Length As Single = 40)
On Error GoTo exx
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim D() As Single
    Dim E() As Long
    Randomize
    Call ResetScene(0, MyCamera, MyLight)
    Select Case MyCombo
        Case 0
            ReDim D(1 To 18)
            ReDim E(1 To 18)
            C = 1
            For A = 1 To 3
                For B = 1 To 6
                    D(C) = Rnd
                    E(C) = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
                    C = C + 1
                Next B
            Next A
            MyMesh = AddMeshBarGraph(6, 3, VectorInput(Length * 2, Length, Length), 5, D(), E())
        Case 1
            ReDim D(1 To 25)
            ReDim E(1 To 25)
            C = 1
            For A = 1 To 5
                For B = 1 To 5
                    D(C) = Rnd
                    E(C) = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
                    C = C + 1
                Next B
            Next A
            MyMesh = AddMeshGridGraph(5, 5, VectorInput(Length * 2, Length, Length * 2), D(), vbBlue, vbRed, False)
        Case 2
            ReDim D(1 To 4)
            ReDim E(1 To 4)
            For A = 1 To 4
                D(A) = Rnd
                E(A) = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
            Next A
            MyMesh = AddMeshPieGraph(Length, 10, 16, D(), E())
    End Select
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub

Public Function GetInfo() As String
On Error GoTo exx
    GetInfo = Info
Exit Function
exx:   MsgBox "Error" & Err.Number & ":" & Err.Description
End Function

Public Sub DrawModeOption(Optional Mode As DrawMode = DoubleSided)
On Error GoTo exx
    mnuDrawModeOption(Mode).Checked = Not mnuDrawModeOption(Mode).Checked
    Select Case Index
        Case 0
            VCamera(MyCamera).DoubleSided = mnuDrawModeOption(Mode).Checked
        Case 1
            VCamera(MyCamera).Metallic = mnuDrawModeOption(Mode).Checked
        Case 2
            VCamera(MyCamera).Atmosphere = mnuDrawModeOption(Mode).Checked
        Case 3
            VCamera(MyCamera).ColorCorrect = mnuDrawModeOption(Mode).Checked
    End Select
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub DrawStyleOption(Optional Style As DrawStyle = Super)
On Error GoTo exx
    mnuDrawStyleOption(VCamera(MyCamera).DrawStyle).Checked = False
    mnuDrawStyleOption(Style).Checked = True
    VCamera(MyCamera).DrawStyle = Style
    RefreshScene = True
Exit Sub

exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub Light3D()
On Error GoTo exx
    mnuLight.Checked = Not mnuLight.Checked
    VLight(MyLight).Enabled = mnuLight.Checked
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub Orthographic()
On Error GoTo exx
    mnuOrthographic.Checked = Not mnuOrthographic.Checked
    VCamera(MyCamera).Orthographic = mnuOrthographic.Checked
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub OtherOption(Optional Length As Single = 40)
On Error GoTo exx
    Call ResetScene(0, MyCamera, MyLight)
    MyMesh = AddMeshGrid(Length * 2, Length * 2, 10, 10, False)
    Call CenterMesh(MyMesh)
    Call RippleMesh(MyMesh, Length, 20, 0)
    Call SetMeshColorGradient(MyMesh, 2, ColorLongToRGB(vbBlue), ColorLongToRGB(vbRed), 0.5)
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub SpecialOption(Optional Index As Special = Text, Optional Length As Single = 100, Optional Text As String = "DEX3D")
    On Error GoTo exx
    Dim A As Integer
    Randomize
    Call ResetScene(0, MyCamera, MyLight)
    Select Case Index
        Case 0
            For A = 1 To 40
                MyMesh = AddMeshPoint(VectorScale(VectorRandom, Length))
                Call SetMeshColorRandom(MyMesh)
            Next A
        Case 1
            For A = 1 To 10
                MyMesh = _
                    AddMeshLine( _
                        VectorScale(VectorRandom, Length), _
                        VectorScale(VectorRandom, Length) _
                    )
                Call SetMeshColorRandom(MyMesh)
            Next A
        Case 2
            For A = 1 To 20
                MyMesh = AddMeshText(Text, VectorScale(VectorRandom, Length))
                Call SetMeshColorRandom(MyMesh)
            Next A
        Case 3
            For A = 1 To 10
                MyMesh = _
                    AddMeshCurve( _
                        VectorScale(VectorRandom, Length), _
                        VectorScale(VectorRandom, Length), _
                        VectorScale(VectorRandom, Length), _
                        VectorScale(VectorRandom, Length) _
                    )
                Call SetMeshColorRandom(MyMesh)
            Next A
    End Select
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub
Public Sub TessellationOption(Optional Index As Tessellation = Edge)
On Error GoTo exx
    Select Case Index
        Case 0
            Call TessellateMeshByFace(MyMesh, 1)
        Case 1
            Call TessellateMeshByEdge(MyMesh, 1)
    End Select
    Call SetMeshColor(MyMesh, ColorLongToRGB(vbWhite), 0.5)
    RefreshScene = True
Exit Sub
exx: MsgBox "Error" & Err.Number & ":" & Err.Description
End Sub

Public Sub Bit2(X As Single)
Picture3_MouseDown 1, 0, X, 0
End Sub
Public Sub Bit1(Y As Single)
Picture2_MouseDown 1, 0, 2, Y
End Sub
Public Sub Quit()
exits = True
End Sub
Private Sub UserControl_Resize()

    Dim PaletteWidth As Integer

    PaletteWidth = MH / 20

    Picture1.Move 0, 0, MW - PaletteWidth, MH - PaletteWidth
    Picture2.Move MW - PaletteWidth, 0, PaletteWidth, MH - PaletteWidth
    Picture3.Move 0, MH - PaletteWidth, MW, PaletteWidth

    RefreshScene = True
End Sub