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