Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Public Class Cube
Inherits Form
Dim vertices As VertexBuffer = Nothing
Dim indices As IndexBuffer = Nothing
Dim PP As PresentParameters = New PresentParameters()
Dim pause As Boolean = False
Dim device As Device = Nothing
Public Function InitializeGraphics() As Boolean
Try
PP.Windowed = True
PP.SwapEffect = SwapEffect.Copy
device = New Device(0, DeviceType.Hardware, Me, CreateFlags.SoftwareVertexProcessing, PP)
OnCreateVertexBuffer()
OnCreateIndexBuffer()
device.RenderState.CullMode = Cull.None
device.RenderState.Lighting = False
pause = False
Return True
Catch ex As DirectXException
Return False
End Try
End Function
Public Sub OnCreateVertexBuffer()
Dim vertex(7) As CustomVertex.PositionColored
Dim vcolor(7) As System.Drawing.Color
vertices = New VertexBuffer(GetType(CustomVertex.PositionColored), 8, device, Usage.WriteOnly, CustomVertex.PositionColored.Format, Pool.Default)
vcolor(0) = Color.AntiqueWhite
vcolor(1) = Color.Brown
vcolor(2) = Color.Blue
vcolor(3) = Color.Cyan
vcolor(4) = Color.DarkGreen
vcolor(5) = Color.MediumPurple
vcolor(6) = Color.Red
vcolor(7) = Color.Violet
vertex(0).Position = New Vector3(1.0F, 1.0F, 1.0F)
vertex(0).Color = vcolor(0).ToArgb()
vertex(1).Position = New Vector3(1.0F, 1.0F, -1.0F)
vertex(1).Color = vcolor(1).ToArgb()
vertex(2).Position = New Vector3(-1.0F, 1.0F, 1.0F)
vertex(2).Color = vcolor(2).ToArgb()
vertex(3).Position = New Vector3(-1.0F, 1.0F, -1.0F)
vertex(3).Color = vcolor(3).ToArgb()
vertex(4).Position = New Vector3(-1.0F, -1.0F, 1.0F)
vertex(4).Color = vcolor(4).ToArgb()
vertex(5).Position = New Vector3(-1.0F, -1.0F, -1.0F)
vertex(5).Color = vcolor(5).ToArgb()
vertex(6).Position = New Vector3(1.0F, -1.0F, 1.0F)
vertex(6).Color = vcolor(6).ToArgb()
vertex(7).Position = New Vector3(1.0F, -1.0F, -1.0F)
vertex(7).Color = vcolor(7).ToArgb()
vertices.SetData(vertex, 0, LockFlags.None)
End Sub
Public Sub OnCreateIndexBuffer()
Dim pointlist(35) As Integer
indices = New IndexBuffer(pointlist(0).GetType, pointlist.Length, device, Usage.WriteOnly, Pool.Default)
pointlist(0) = 0 : pointlist(1) = 1 : pointlist(2) = 2
pointlist(3) = 2 : pointlist(4) = 1 : pointlist(5) = 3
pointlist(6) = 3 : pointlist(7) = 1 : pointlist(8) = 7
pointlist(9) = 5 : pointlist(10) = 3 : pointlist(11) = 7
pointlist(12) = 2 : pointlist(13) = 3 : pointlist(14) = 5
pointlist(15) = 2 : pointlist(16) = 5 : pointlist(17) = 4
pointlist(18) = 0 : pointlist(19) = 2 : pointlist(20) = 4
pointlist(21) = 0 : pointlist(22) = 4 : pointlist(23) = 6
pointlist(24) = 0 : pointlist(25) = 6 : pointlist(26) = 1
pointlist(27) = 1 : pointlist(28) = 6 : pointlist(29) = 7
pointlist(30) = 5 : pointlist(31) = 7 : pointlist(32) = 6
pointlist(33) = 5 : pointlist(34) = 6 : pointlist(35) = 4
indices.SetData(pointlist, 0, LockFlags.None)
End Sub
Public Sub Render()
If device Is Nothing Then Return
If pause Then Return
device.Clear(ClearFlags.Target, System.Drawing.Color.Blue, 1.0F, 0)
device.BeginScene()
SetupMatrices()
device.SetStreamSource(0, vertices, 0)
device.Indices = indices
' device.VertexFormat = CustomVertex.PositionColored.Format
device.DrawIndexedPrimitives(PrimitiveType.TriangleList, 0, 0, 8, 0, 12)
device.EndScene()
device.Present()
End Sub
Private Sub SetupMatrices()
Dim time As Integer = 5000
Dim iTime As Integer = Environment.TickCount Mod time
Dim yAngle As Single = iTime * (2.0F * CSng(Math.PI)) / time
device.Transform.World = Matrix.RotationY(yAngle)
Dim etime As Integer = Environment.TickCount Mod time
Dim zangle As Single = etime * (2.0F * CSng(Math.PI)) / time
device.Transform.World = Matrix.RotationZ(zangle)
device.Transform.View = Matrix.LookAtLH(New Vector3(0.0F, 3.0F, -5.0F), New Vector3(0.0F, 0.0F, 0.0F), New Vector3(0.0F, 1.0F, 0.0F))
device.Transform.Projection = Matrix.PerspectiveFovLH(CSng(Math.PI) / 6, 1.0F, 1.0F, 100.0F)
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Me.Render()
End Sub
Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
If CInt(CByte(AscW(e.KeyChar))) = CInt(System.Windows.Forms.Keys.Escape) Then
Me.Close()
End If
End Sub
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
pause = ((Me.WindowState = FormWindowState.Minimized) Or Not Me.Visible)
End Sub
End Class
Module main
Sub Main()
Using paper As New Cube
If Not paper.InitializeGraphics() Then
MessageBox.Show("exitting with error")
Return
End If
paper.Show()
While (paper.Created)
paper.Render()
Application.DoEvents()
End While
End Using
End Sub
End Module
