XNA實現三維顯示-多視口

    Sub New()
        ' 此調用是設計器所必需的。
        InitializeComponent()
        ' 在 InitializeComponent() 調用之後添加任何初始化。
        mIsMeshLoaded = False
        mIsInitOK = False
        viewWidth = 2
        viewHeight = 2
        CamPosition = New Vector3(1, 2, 2)
        CamTarget = New Vector3(0, 0, 0)
        CamUp = New Vector3(0, 1, 0)
        mouseLastX = 0
        mouseLastY = 0
        mIsRotateByMouse = False
        mIsMoveByMouse = False
        mGridMode = GridModeEnum.Triangle
        _FillMode = FillModeEnum.WireFrame
        _ProjectionMode = ProjectionModeEnum.OrthoLH
        _IsShowDebugInfo = True
        _IsShowGridLine = True
        _IsShowLegend = True
        _IsShowScaleLabel = True
        _IsShowScaleValue = True
        _IsShowXYZ = True
        _IsShowPoint = False
        _IsShowPointText = False
        _PointColor = Nothing
        _ScaleTextColor = Color.Orange
        _GridLineColor = Color.Gray
        _AxisX = New Axis3D("Axis X", 1)
        _AxisY = New Axis3D("Axis Y", 1)
        _AxisZ = New Axis3D("Axis Z", 1)
    End Sub


#End Region


#Region "私有成員"
    '設備及視口
    Private gDrawing As System.Drawing.Graphics
    Private mEffect As BasicEffect
    Private mRasterize As RasterizerState
    Private mGParams As PresentationParameters
    Private WithEvents mDevice As GraphicsDevice
    Private mVPAll As Viewport
    Private mVPMain As Viewport
    Private mVPLegend As Viewport
    Private mVPIndicator As Viewport
    '字體及控制
    Private winFont As System.Drawing.Font
    Private mIsMeshLoaded As Boolean
    Private mIsInitOK As Boolean
    Dim fps As Double
    Dim fpscount As Integer
    '主攝像機
    Public CamPosition As Vector3
    Public CamTarget As Vector3
    Public CamUp As Vector3
    Private viewWidth As Single '正交投影的視景體寬度
    Private viewHeight As Single    '正交投影的視景體高度
    '鼠標
    Private mouseLastX As Integer
    Private mouseLastY As Integer
    Private mIsRotateByMouse As Boolean
    Private mIsMoveByMouse As Boolean
    Private mMousePos As Drawing.Point
    '處理的mesh3d
    Private m3d As Mesh3D
    '網格類型
    Private mGridMode As GridModeEnum
    '其他
    Private mIsLost As Boolean = False
#End Region


#Region "公開成員"


    ''' <summary>
    ''' 投影模式
    ''' </summary>
    Public Enum ProjectionModeEnum
        OrthoLH = 0
        PerspectiveFovLH = 1
    End Enum
    ''' <summary>
    ''' 填充模式
    ''' </summary>
    Public Enum FillModeEnum
        Solid = 0
        WireFrame = 1
    End Enum
    ''' <summary>
    ''' 網格類型
    ''' </summary>
    Public Enum GridModeEnum
        Triangle = 0
        Rectangle = 1
    End Enum
    ''' <summary>
    ''' 返回或設置是否繪製控制點
    ''' </summary>
    <Description("是否繪製原始控制點"), Category("視圖")>
    Public Property IsShowPoint As Boolean
    ''' <summary>
    ''' 返回或設置是否繪製控制點標籤
    ''' </summary>
    <Description("是否繪製控制點標籤"), Category("視圖")>
    Public Property IsShowPointText As Boolean


    ''' <summary>
    ''' 返回或設置是否顯示圖例
    ''' </summary>
    <Description("是否顯示圖例"), Category("視圖")>
    Public Property IsShowLegend As Boolean
    ''' <summary>
    ''' 返回或設置是否顯示座標軸
    ''' </summary>
    <Description("是否顯示座標軸"), Category("視圖")>
    Public Property IsShowXYZ As Boolean
    ''' <summary>
    ''' 返回或設置是否顯示座標格線
    ''' </summary>
    <Description("是否顯示座標格線"), Category("視圖")>
    Public Property IsShowGridLine As Boolean
    ''' <summary>
    ''' 返回或設置是否顯示座標軸標籤
    ''' </summary>
    <Description("是否顯示座標軸標籤"), Category("視圖")>
    Public Property IsShowScaleLabel As Boolean
    ''' <summary>
    ''' 返回或設置是否顯示Debug信息
    ''' </summary>
    <Description("是否顯示Debug信息"), Category("視圖")>
    Public Property IsShowDebugInfo As Boolean
    ''' <summary>
    ''' 返回或設置是否顯示座標值刻度
    ''' </summary>
    <Description("是否顯示座標值刻度"), Category("視圖")>
    Public Property IsShowScaleValue As Boolean
    ''' <summary>
    ''' 返回或設置投影模式
    ''' </summary>
    <Description("投影模式"), Category("視圖")>
    Public Property ProjectionMode As ProjectionModeEnum
    ''' <summary>
    ''' 返回或設置填充模式
    ''' </summary>
    <Description("填充模式"), Category("視圖")>
    Public Property FillMode As FillModeEnum
    ''' <summary>
    ''' 返回或設置網格模式
    ''' </summary>
    <Description("網格模式"), Category("視圖")>
    Public Property GridMode As GridModeEnum
        Get
            Return mGridMode
        End Get
        Set(value As GridModeEnum)
            mGridMode = value
            '設置網格後立即刷新主模型
            If mIsMeshLoaded = True Then
                V3DHelper.Main.CreateMesh3D(m3d, mGridMode)
                Render()
            End If
        End Set
    End Property


    ''' <summary>
    ''' 返回或設置座標軸標籤顏色
    ''' </summary>
    <Description("座標軸標籤顏色"), Category("視圖")>
    Public Property ScaleTextColor As Color
    ''' <summary>
    ''' 返回或設置座標軸網格顏色
    ''' </summary>
    <Description("座標軸網格顏色"), Category("視圖")>
    Public Property GridLineColor As Color
    ''' <summary>
    ''' 返回或設置控制點顏色
    ''' </summary>
    <Description("控制點顏色"), Category("視圖")>
    Public Property PointColor As Color
    ''' <summary>
    ''' X軸屬性
    ''' </summary>
    <Description("X軸屬性"), Category("視圖")>
    Public Property AxisX As Axis3D
    ''' <summary>
    ''' Y軸屬性
    ''' </summary>
    <Description("Y軸屬性"), Category("視圖")>
    Public Property AxisY As Axis3D
    ''' <summary>
    ''' Z軸屬性
    ''' </summary>
    <Description("Z軸屬性"), Category("視圖")>
    Public Property AxisZ As Axis3D


#End Region


#Region "公開方法"


    ''' <summary>
    ''' 加載數據並啓動顯示
    ''' </summary>
    Public Sub LoadData(g As Grid3D)
        m3d = New Mesh3D(g)
        m3d.DoWork()
        mIsMeshLoaded = True
        mIsInitOK = InitializeDirect3D()
        InitializeViewPort()
        CreateRenderObject()
        Run()
    End Sub
    ''' <summary>
    ''' 啓動顯示
    ''' </summary>
    Public Sub Run()
        If mIsInitOK = False Then
            mIsInitOK = InitializeDirect3D()
            InitializeViewPort()
        End If
        Render()
    End Sub


#End Region


#Region "私有方法"


    '初始化3D
    Private Function InitializeDirect3D() As Boolean
        Try
            '設置呈現參數
            mGParams = New PresentationParameters
            mGParams.BackBufferWidth = Me.Width
            mGParams.BackBufferHeight = Me.Height
            mGParams.BackBufferFormat = SurfaceFormat.Color
            mGParams.DepthStencilFormat = DepthFormat.Depth16
            mGParams.DeviceWindowHandle = Me.Handle
            mGParams.PresentationInterval = PresentInterval.Immediate
            mGParams.IsFullScreen = False
            '實例化device對象
            mDevice = New GraphicsDevice(GraphicsAdapter.DefaultAdapter, GraphicsProfile.Reach, mGParams)
            'device.RasterizerState = RasterizerState.CullNone
            mRasterize = New RasterizerState
            mRasterize.CullMode = CullMode.None
            mRasterize.FillMode = Graphics.FillMode.WireFrame
            mDevice.RasterizerState = mRasterize
            '初始化視口
            InitializeViewPort()
            '初始化效果
            mEffect = New BasicEffect(mDevice)
            mEffect.View = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
            mEffect.Projection = Matrix.CreateOrthographic(viewWidth, viewHeight, 0, 100)
            mEffect.World = Matrix.CreateWorld(New Vector3(-0.5, -0.5, -0.5), Vector3.Forward, Vector3.Up)
            mEffect.VertexColorEnabled = True
            mEffect.CurrentTechnique.Passes(0).Apply()
            '創建字體
            winFont = Me.Font
            '創建helper
            V3DHelper.Device = mDevice
            V3DHelper.Effect = mEffect
            '創建渲染對象
            CreateRenderObject()
            Return True
        Catch e As Exception
            Throw
        End Try
    End Function


    '初始化視口
    Private Sub InitializeViewPort()
        Dim d As Integer = 96 '空出1英寸
        'Main
        mVPMain.MaxDepth = 1
        mVPMain.MinDepth = 0
        mVPMain.Height = Me.Height
        mVPMain.Width = Me.Width - d
        mVPMain.X = 0
        mVPMain.Y = 0
        'All
        mVPAll.MaxDepth = 1
        mVPAll.MinDepth = 0
        mVPAll.Height = Me.Height
        mVPAll.Width = Me.Width
        mVPAll.X = 0
        mVPAll.Y = 0
        'Legend
        mVPLegend.MaxDepth = 1
        mVPLegend.MinDepth = 0
        mVPLegend.Height = Me.Height - d
        mVPLegend.Width = d
        mVPLegend.X = Me.Width - d
        mVPLegend.Y = 0
        'Indicator
        mVPIndicator.MaxDepth = 1
        mVPIndicator.MinDepth = 0
        mVPIndicator.Height = d
        mVPIndicator.Width = d
        mVPIndicator.X = Me.Width - d
        mVPIndicator.Y = Me.Height - d
    End Sub
    '創建渲染對象
    Private Sub CreateRenderObject()
        V3DHelper.Scale.CreateXYZ(0.01, 0.01)
        V3DHelper.Scale.CreateGridLine(_GridLineColor)
        V3DHelper.Legend.CreateLegend(mVPLegend, m3d, mIsMeshLoaded)
        If mIsMeshLoaded = True Then
            V3DHelper.Main.CreateMesh3D(m3d, mGridMode)
            V3DHelper.Scale.CreateScaleLabelAndValue(mVPMain, m3d, _AxisX, _AxisY, _AxisZ, _IsShowScaleLabel, _IsShowScaleValue, mIsMeshLoaded)
            V3DHelper.Main.CreateMeshPoint(m3d, _PointColor)
        End If
    End Sub


    '渲染  先繪製圖形再繪製文字
    Private Sub Render()
        Try
            If mDevice Is Nothing OrElse mIsLost = True Then
                Exit Sub
            End If
            gDrawing = Me.CreateGraphics


            mDevice.Clear(ClearOptions.Target Or ClearOptions.DepthBuffer, xnaColor.Black, 3, 0)


            '繪製指示器 
            mDevice.Viewport = mVPIndicator
            '設置效果
            SetIndicatorEffect()
            If mIsMeshLoaded = True Then
                mDevice.DrawUserPrimitives(PrimitiveType.LineList, V3DHelper.Scale.XYZVerts, 0, CInt(V3DHelper.Scale.XYZVerts.Count / 2))
                Select Case mGridMode
                    Case GridModeEnum.Triangle   '三角形        
                        ' For i As Integer = 0 To V3DHelper.Main.m3DVerts.Count - 1
                        mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Main.m3DVerts, 0, CInt(V3DHelper.Main.m3DVerts.Count / 3))
                    Case GridModeEnum.Rectangle  '四角形繪製
                        ' For i As Integer = 0 To V3DHelper.Main.m3DVerts.Count - 1
                        mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Main.m3DVerts, 0, CInt(V3DHelper.Main.m3DVerts.Count - 2))
                End Select
            End If


            '繪製圖例,實時刷新
            mDevice.Viewport = mVPLegend
            '設置光柵
            mRasterize = New RasterizerState
            mRasterize.CullMode = CullMode.None
            mRasterize.FillMode = Graphics.FillMode.Solid
            mDevice.RasterizerState = mRasterize
            '設置效果
            SetLegendEffect()
            If IsShowLegend = True Then
                V3DHelper.Legend.CreateLegend(mVPLegend, m3d, mIsMeshLoaded)
                mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Legend.LegendVerts, 0, CInt(V3DHelper.Legend.LegendVerts.Count / 3))
            End If


            '繪製主視圖
            mDevice.Viewport = mVPMain
            SetMainEffect()
            SetUpCamera()
            '繪製座標軸,包括刻度
            If _IsShowXYZ = True Then
                mDevice.DrawUserPrimitives(PrimitiveType.LineList, V3DHelper.Scale.XYZVerts, 0, CInt(V3DHelper.Scale.XYZVerts.Count / 2))
            End If
            '繪製座標格線
            If _IsShowGridLine = True Then
                mDevice.DrawUserPrimitives(PrimitiveType.LineList, V3DHelper.Scale.GridLineVerts, 0, CInt(V3DHelper.Scale.GridLineVerts.Count / 2))
            End If
            '設置光柵
            mRasterize = New RasterizerState
            mRasterize.CullMode = CullMode.None
            mRasterize.FillMode = CType(FillMode, Graphics.FillMode)
            mDevice.RasterizerState = mRasterize
            If mIsMeshLoaded = True Then
                '繪製mesh
                Select Case mGridMode
                    Case GridModeEnum.Triangle   '三角形        
                        ' For i As Integer = 0 To V3DHelper.Main.m3DVerts.Count - 1
                        mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Main.m3DVerts, 0, CInt(V3DHelper.Main.m3DVerts.Count / 3))
                    Case GridModeEnum.Rectangle  '四角形繪製
                        'For i As Integer = 0 To V3DHelper.Main.m3DVerts.Count - 1
                        mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Main.m3DVerts, 0, CInt(V3DHelper.Main.m3DVerts.Count - 2))
                End Select
                '繪製控制點
                '  device.RenderState.FillMode = Direct3D.FillMode.Solid
                If IsShowPoint And m3d.BindingGrid.PointList.Count > 0 Then
                    For i As Integer = 0 To V3DHelper.Main.m3dPointVerts.Count - 1
                        mDevice.DrawUserPrimitives(PrimitiveType.TriangleList, V3DHelper.Main.m3dPointVerts(i), 0, CInt(V3DHelper.Main.m3dPointVerts(i).Count / 3))
                    Next
                End If


                '呈現D3D
                mDevice.Present()


                '文字繪製
                '繪製座標文字,實時刷新
                V3DHelper.Scale.CreateScaleLabelAndValue(mVPMain, m3d, _AxisX, _AxisY, _AxisZ, _IsShowScaleLabel, _IsShowScaleValue, mIsMeshLoaded)
                If _IsShowScaleLabel = True Or _IsShowScaleValue = True Then
                    '繪製座標文字,offset單位像素
                    Dim offset As Integer = 0
                    For i As Integer = 0 To V3DHelper.Scale.ScaleLabelPoint.Count - 1
                        Dim l As String = V3DHelper.Scale.ScaleLabelText(i)
                        Dim m As Drawing.SizeF = gDrawing.MeasureString(l, winFont)
                        gDrawing.DrawString(l, winFont, New Drawing.SolidBrush(_ScaleTextColor), V3DHelper.Scale.ScaleLabelPoint(i).X + offset - CInt(m.Width / 2), V3DHelper.Scale.ScaleLabelPoint(i).Y + offset)
                    Next
                End If
                '繪製控制點標籤,實時計算
                If IsShowPointText And m3d.BindingGrid.PointList.Count > 0 Then
                    V3DHelper.Main.CreateMeshPointText(mVPMain, m3d)
                    Dim offset As Integer = 0
                    For i As Integer = 0 To m3d.BindingGrid.PointList.Count - 1
                        Dim l As String = m3d.BindingGrid.PointList(i).Obj.ToString
                        Dim m As Drawing.SizeF = gDrawing.MeasureString(l, winFont)
                        gDrawing.DrawString(l, winFont, New Drawing.SolidBrush(Color.Black), V3DHelper.Main.m3dPointTextPoint(i).X + offset - CInt(m.Width / 2), V3DHelper.Main.m3dPointTextPoint(i).Y + offset)
                    Next
                End If
            End If


            '圖例
            SetLegendEffect()
            If IsShowLegend = True Then
                For i As Integer = 0 To V3DHelper.Legend.LegendLabelPoint.Count - 1
                    Dim l As String = V3DHelper.Legend.LegendLabelText(i)
                    Dim m As Drawing.SizeF = gDrawing.MeasureString(l, winFont)
                    gDrawing.DrawString(l, winFont, New Drawing.SolidBrush(_ScaleTextColor), V3DHelper.Legend.LegendLabelPoint(i))
                Next
            End If


            '指示器文字
            SetIndicatorEffect()
            gDrawing.DrawString("X", winFont, Drawing.Brushes.Yellow, V3DHelper.ScreenProject(mVPIndicator, 1, 0, 0))
            gDrawing.DrawString("Y", winFont, Drawing.Brushes.Yellow, V3DHelper.ScreenProject(mVPIndicator, 0, 0, 1))
            gDrawing.DrawString("Z", winFont, Drawing.Brushes.Yellow, V3DHelper.ScreenProject(mVPIndicator, 0, 1, 0))
            '繪製鏡頭信息
            If _IsShowDebugInfo = True Then
                Dim s As String = String.Format("FPS: {0}, Cam: {1:0.000},{2:0.000},{3:0.000}, Mouse: {4},{5}", fps, CamPosition.X, CamPosition.Y, CamPosition.Z, mMousePos.X, mMousePos.Y)
                gDrawing.DrawString(s, winFont, New Drawing.SolidBrush(Color.White), 1, 1)
            End If
        Catch ex As Exception
            Throw
        End Try
    End Sub


#End Region


#Region "攝像機交互與變換"


    Private Sub SetMainEffect()
        mEffect.View = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
        mEffect.Projection = Matrix.CreateOrthographic(viewWidth, viewHeight, 0, 100)
        mEffect.World = Matrix.CreateWorld(New Vector3(-0.5, -0.5, -0.5), Vector3.Forward, Vector3.Up)
        mEffect.CurrentTechnique.Passes(0).Apply()
    End Sub


    Private Sub SetLegendEffect()
        mEffect.View = Matrix.CreateLookAt(New Vector3(0, 0, 2), New Vector3(0, 0, 0), New Vector3(0, 1, 0))
        mEffect.Projection = Matrix.CreateOrthographic(2, 2, 0, 100)
        mEffect.World = Matrix.CreateWorld(New Vector3(0, 0, 0), Vector3.Forward, Vector3.Up)
        mEffect.CurrentTechnique.Passes(0).Apply()
    End Sub
    Private Sub SetIndicatorEffect()
        mEffect.View = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
        mEffect.Projection = Matrix.CreateOrthographic(2, 2, 0, 100)
        mEffect.World = Matrix.CreateWorld(New Vector3(-0.5, -0.5, -0.5), Vector3.Forward, Vector3.Up)
        mEffect.CurrentTechnique.Passes(0).Apply()
    End Sub


    '設置攝像機
    Public Sub SetUpCamera()
        mEffect.World = Matrix.CreateWorld(New Vector3(-0.5, -0.5, -0.5), Vector3.Forward, Vector3.Up)
        mEffect.View = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
        '設置投影
        If _ProjectionMode = ProjectionModeEnum.OrthoLH Then
            mEffect.Projection = Matrix.CreateOrthographic(viewWidth, viewHeight, 0, 100)
        Else
            mEffect.Projection = Matrix.CreatePerspectiveFieldOfView(Math.PI / 4.0F, CSng(Me.Width / Me.Height), 0.3F, 500.0F)
        End If
        mEffect.CurrentTechnique.Passes(0).Apply()
    End Sub


    Private Sub View3D_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
        If mDevice Is Nothing OrElse mEffect Is Nothing Then
            Exit Sub
        End If
        If ProjectionMode = ProjectionModeEnum.OrthoLH Then
            Dim s As Single = -CSng(e.Delta / 1000)
            viewWidth += s
            viewHeight += s
            If viewWidth <= 0 Or viewHeight <= 0 Then
                viewHeight = 0
                viewWidth = 0
            End If
            mEffect.Projection = Matrix.CreateOrthographic(viewWidth, viewHeight, 0, 100)
        Else
            Dim scaleFactor As Single = -CSng(e.Delta) / 2000 + 1.0F
            CamPosition = Vector3.Subtract(CamPosition, CamTarget)
            CamPosition = Vector3.Multiply(CamPosition, New Vector3(scaleFactor, scaleFactor, scaleFactor))
            CamPosition = Vector3.Add(CamPosition, CamTarget)
            mEffect.View = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
        End If
        mEffect.CurrentTechnique.Passes(0).Apply()
        Render()
    End Sub


    Private Sub View3D_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
        If mDevice Is Nothing OrElse mEffect Is Nothing Then
            Exit Sub
        End If
        If e.Button = MouseButtons.Left Then
            mouseLastX = e.X
            mouseLastY = e.Y
            mIsRotateByMouse = True
        ElseIf e.Button = MouseButtons.Middle Then
            mouseLastX = e.X
            mouseLastY = e.Y
            mIsMoveByMouse = True
        End If
    End Sub


    Private Sub View3D_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        If mDevice Is Nothing OrElse mEffect Is Nothing Then
            Exit Sub
        End If
        mMousePos = e.Location
        If mIsRotateByMouse Then
            Dim currentView As Matrix = mEffect.View
            '當前攝像機的視圖矩陣
            Dim tempAngleY As Single = -2 * CSng(e.X - mouseLastX) / Me.Width
            CamPosition = Vector3.Subtract(CamPosition, CamTarget)
            Dim tempV4 As Vector4 = Vector4.Transform(CamPosition, Matrix.CreateFromQuaternion(Quaternion.CreateFromAxisAngle(New Vector3(currentView.M12, currentView.M22, currentView.M32), tempAngleY)))
            CamPosition.X = tempV4.X
            CamPosition.Y = tempV4.Y
            CamPosition.Z = tempV4.Z
            Dim tempAngleX As Single = -2 * CSng(e.Y - mouseLastY) / Me.Height
            tempV4 = Vector4.Transform(CamPosition, Matrix.CreateFromQuaternion(Quaternion.CreateFromAxisAngle(New Vector3(currentView.M11, currentView.M21, currentView.M31), tempAngleX)))
            CamPosition.X = tempV4.X + CamTarget.X
            CamPosition.Y = tempV4.Y + CamTarget.Y
            CamPosition.Z = tempV4.Z + CamTarget.Z
            Dim viewMatrix As Matrix = Matrix.CreateLookAt(CamPosition, CamTarget, New Vector3(0, 1, 0))
            mEffect.View = viewMatrix
            mouseLastX = e.X
            mouseLastY = e.Y
        ElseIf mIsMoveByMouse Then
            Dim currentView As Matrix = mEffect.View
            '當前攝像機的視圖矩陣
            Dim moveFactor As Single = 0.002
            CamTarget.X += -moveFactor * ((e.X - mouseLastX) * currentView.M11 - (e.Y - mouseLastY) * currentView.M12)
            CamTarget.Y += -moveFactor * ((e.X - mouseLastX) * currentView.M21 - (e.Y - mouseLastY) * currentView.M22)
            CamTarget.Z += -moveFactor * ((e.X - mouseLastX) * currentView.M31 - (e.Y - mouseLastY) * currentView.M32)
            CamPosition.X += -moveFactor * ((e.X - mouseLastX) * currentView.M11 - (e.Y - mouseLastY) * currentView.M12)
            CamPosition.Y += -moveFactor * ((e.X - mouseLastX) * currentView.M21 - (e.Y - mouseLastY) * currentView.M22)
            CamPosition.Z += -moveFactor * ((e.X - mouseLastX) * currentView.M31 - (e.Y - mouseLastY) * currentView.M32)
            Dim viewMatrix As Matrix = Matrix.CreateLookAt(CamPosition, CamTarget, CamUp)
            mEffect.View = viewMatrix
            mouseLastX = e.X
            mouseLastY = e.Y
        End If
        If mIsMoveByMouse Or mIsRotateByMouse Then
            mEffect.CurrentTechnique.Passes(0).Apply()
            Render()
        End If
    End Sub


    Private Sub View3D_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
        mIsRotateByMouse = False
        mIsMoveByMouse = False
    End Sub


    Private Sub View3D_MouseEnter(sender As Object, e As EventArgs) Handles Me.MouseEnter
        If mDevice Is Nothing OrElse mEffect Is Nothing Then
            Exit Sub
        End If
        Render()
    End Sub


    Private Sub View3D_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
        If mGParams IsNot Nothing And Me.Focused Then
            InitializeDirect3D()
            mGParams.BackBufferWidth = Me.Width
            mGParams.BackBufferHeight = Me.Height
            mDevice.Reset(mGParams)
            winFont = Me.Font
            InitializeViewPort()
            CreateRenderObject()
            Render()
        End If
    End Sub


#End Region


#Region "鼠標菜單"


    ''' <summary>
    ''' 轉到XY視圖
    ''' </summary>
    Private Sub GoToXYView()
        CamPosition = New Vector3(0, 0, 2)
        CamTarget = New Vector3(0, 0, 0)
        CamUp = New Vector3(0, 1, 0)
        SetUpCamera()
    End Sub
    ''' <summary>
    ''' 轉到XZ視圖
    ''' </summary>
    Private Sub GoToXZView()
        CamPosition = New Vector3(0, 2, 0)
        CamTarget = New Vector3(0, 0, 0)
        CamUp = New Vector3(0, 0, 1)
        SetUpCamera()
    End Sub
    ''' <summary>
    ''' 轉到YZ視圖
    ''' </summary>
    Private Sub GoToYZView()
        CamPosition = New Vector3(2, 0, 0)
        CamTarget = New Vector3(0, 0, 0)
        CamUp = New Vector3(0, 1, 0)
        SetUpCamera()
    End Sub
    ''' <summary>
    ''' 重置視圖
    ''' </summary>
    Private Sub ResetView()
        CamPosition = New Vector3(2, 2, 2)
        CamTarget = New Vector3(0, 0, 0)
        CamUp = New Vector3(0, 1, 0)
        viewWidth = 2
        viewHeight = 2
        SetUpCamera()
    End Sub
    Private Sub XY視圖ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles XY視圖ToolStripMenuItem.Click
        GoToXYView()
    End Sub
    Private Sub XZ視圖ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles XZ視圖ToolStripMenuItem.Click
        GoToXZView()
    End Sub
    Private Sub YZ視圖ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles YZ視圖ToolStripMenuItem.Click
        GoToYZView()
    End Sub
    Private Sub 重置視圖ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 重置視圖ToolStripMenuItem.Click
        'CreateRenderObject()   '這句會導致圖例字符漂移,原因位置
        ResetView()
    End Sub
    Private Sub 圖片另存爲ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 圖片另存爲ToolStripMenuItem.Click
        Dim sfd As New SaveFileDialog
        sfd.Filter = "*.png|*.png"
        If sfd.ShowDialog = DialogResult.OK Then
            MsgBox("This function is under developing")
            Exit Sub
            
        End If
    End Sub




#End Region


End Class

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章