blockform.vb

清华大学出版社出版的 移动应用开发宝典 张大威（2008）的附书源代码

Imports System.Drawing
Imports Microsoft.WindowsMobile.DirectX
Imports Microsoft.WindowsMobile.DirectX.Direct3D

Module ProgramMain
    Sub Main()
        Dim frm As BlockForm = New BlockForm

        ' Initialize Direct3D
        If Not frm.Init() Then
            MessageBox.Show("Could not initialize Direct3D")
            Return
        End If

        System.Windows.Forms.Application.Run(frm)
    End Sub
End Module

Public Class BlockForm

    ''' <summary>
    ''' Direct3D device we are going to draw on.
    ''' </summary>
    Private device As Device

    Public Vertices As CustomVertex.PositionNormalColored()

    Public VertBuffer As VertexBuffer = Nothing

    Private scale1 As Matrix
    Private scale2 As Matrix

    Private rot1 As Matrix
    Private rot2 As Matrix

    Private pos1 As Matrix
    Private pos2 As Matrix

    Private box As Mesh
    Private sphere As Mesh

    Private boxMaterial As Material
    Private sphereMaterial As Material

    Public Function Init() As Boolean
        Try
            Dim presentParams As PresentParameters = New PresentParameters
            presentParams.Windowed = True
            presentParams.SwapEffect = SwapEffect.Discard
            presentParams.EnableAutoDepthStencil = True
            presentParams.AutoDepthStencilFormat = DepthFormat.D16

            device = New Device(0, DeviceType.Default, Me, CreateFlags.None, presentParams)

            AddHandler device.DeviceReset, AddressOf RestoreDeviceObjects

            RestoreDeviceObjects(device, EventArgs.Empty)

        Catch ex As Exception
            Return False
        End Try

        Return True
    End Function
    Private aspectRatio As Single

    Sub RestoreDeviceObjects(ByVal sender As System.Object, ByVal e As System.EventArgs)

        device.RenderState.Lighting = True

        device.Lights(0).Diffuse = Color.White
        device.Lights(0).Type = LightType.Directional
        device.Lights(0).Direction = New Vector3(-0.5F, -0.5F, 0.5F)
        device.Lights(0).Update()
        device.Lights(0).Enabled = True
        device.RenderState.Ambient = Color.Gray

        device.Transform.View = Matrix.LookAtLH(New Vector3(0.0F, 0.0F, -3.0F), New Vector3(0.0F, 0.0F, 0.0F), New Vector3(0.0F, 1.0F, 0.0F))

        aspectRatio = CType(device.PresentationParameters.BackBufferWidth, Single) / device.PresentationParameters.BackBufferHeight

        device.Transform.Projection = Matrix.PerspectiveFovLH(CType(Math.PI, Single) / 4, aspectRatio, 1.0F, 100.0F)

        scale1 = Matrix.Scaling(0.6F, 0.6F, 0.6F)
        scale2 = Matrix.Scaling(0.6F, 0.6F, 0.6F)

        rot1 = Matrix.RotationYawPitchRoll(0.5F, 0.5F, 0.5F)
        rot2 = Matrix.RotationYawPitchRoll(-0.5F, -0.5F, -0.5F)

        pos1 = Matrix.Translation(-0.6F, 0.6F, 0)
        pos2 = Matrix.Translation(0.6F, -0.6F, 0)

        box = Mesh.Box(device, 1, 1, 1)
        boxMaterial = New Material
        boxMaterial.Ambient = Color.Red
        boxMaterial.Diffuse = Color.Red

        sphere = Mesh.Sphere(device, 1, 18, 18)
        sphereMaterial = New Material
        sphereMaterial.Ambient = Color.Blue
        sphereMaterial.Diffuse = Color.Blue
    End Sub

    ' <summary>
    ' The yaw value for our segment to animate the tumble
    ' </summary>
    Public Yaw As Single

    ' <summary>
    ' Change value for the yaw. Set at random when the
    ' segment is constructed.
    ' </summary>
    Public YawSpeed As Single = 0.07F

    ' <summary>
    ' The pitch value for our segment to animate the tumble
    ' </summary>
    Public Pitch As Single

    ' <summary>
    ' Change value for the pitch. Set at random when the
    ' segment is constructed.
    ' </summary>    
    Public PitchSpeed As Single = 0.05F

    ' <summary>
    ' The roll value for our segment to animate the tumble
    ' </summary>
    Public Roll As Single

    ' <summary>
    ' Change value for the roll. Set at random when the
    ' segment is constructed.
    ' </summary>
    Public RollSpeed As Single = 0.1F

    Private Sub Render()
        device.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.White, 1.0F, 0)

        device.BeginScene()

        Yaw += YawSpeed
        Pitch += PitchSpeed
        Roll += RollSpeed

        Dim rrot As Matrix = Matrix.RotationYawPitchRoll(Yaw, Pitch, Roll)

        ' box
        device.Transform.World = scale1 * rot1 * rrot * pos1
        device.Material = boxMaterial
        box.DrawSubset(0)

        ' sphere
        device.Transform.World = scale2 * rot2 * rrot * pos2

        device.Material = sphereMaterial
        sphere.DrawSubset(0)

        device.EndScene()
        device.Present()
    End Sub

    Protected Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
    End Sub

    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        Render()
    End Sub

    Private Sub exitMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles exitMenuItem.Click
        Application.Exit()
    End Sub

    Private Sub updateTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles updateTimer.Tick
        Invalidate()
    End Sub
End Class