Post by microfarad on May 23, 2010 19:56:53 GMT -5
Hi, I have managed to create 3D Graphics with Visual Basic. I have here a very basic 3D graphics engine. The mesh loading subroutine is very unfinished, but other than that, this code works great. I will post later explaining how it works / how to use it. I will also post some pics of it working. I plan soon to make a simple game.
#Region "Imports"
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.Direct3D.D3DX
Imports System.Math
#End Region
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Jus' get everythin' set up
Initialize()
End Sub
#Region "Guts"
#Region "Header"
Dim D3Ddevice As Device
#End Region
#Region "Initialization"
Sub Initialize()
'Some basic settings
Dim PresentParams As New PresentParameters
'Ur capabilites
'Dim c As Caps
'Set PPs
With PresentParams
.Windowed = True
.SwapEffect = SwapEffect.Discard
.EnableAutoDepthStencil = True
.AutoDepthStencilFormat = DepthFormat.D16
End With
'Make ur device with best settings possible
Try
D3Ddevice = New Device(0, DeviceType.Hardware, Panel1, _
CreateFlags.HardwareVertexProcessing, PresentParams)
Debug.WriteLine("Hardware, HardwareVertexProcessing")
Catch
End Try
If D3Ddevice Is Nothing Then
Try
D3Ddevice = New Device(0, DeviceType.Hardware, Panel1, _
CreateFlags.SoftwareVertexProcessing, PresentParams)
Debug.WriteLine("Hardware, SoftwareVertexProcessing")
Catch
End Try
End If
If D3Ddevice Is Nothing Then
Try
D3Ddevice = New Device(0, DeviceType.Reference, Panel1, _
CreateFlags.SoftwareVertexProcessing, PresentParams)
Debug.WriteLine("Reference, SoftwareVertexProcessing")
Catch ex As Exception
'Fail LOL, try putting a CPU in your piece of shit computer
End Try
End If
'Not used ATM: MaxPrimitives = c.MaxPrimitiveCount
'Render states
With D3Ddevice.RenderState
.Lighting = True
.ZBufferEnable = True
.CullMode = Cull.None
.PointSize = 3
.FillMode = FillMode.Solid
End With
MakeLights()
End Sub
Sub MakeVertBuffer()
Dim vertices As CustomVertex.PositionNormalTextured()
Dim PtStrings As String() = IO.File.ReadAllText("C:\vb\acorn.txt").Replace(Chr(13), ",").Split(",")
Dim Points As New List(Of CustomVertex.PositionNormalTextured)
Dim D3Dvertexbuffer As VertexBuffer = Nothing
Dim Nums(UBound(PtStrings)) As Double
For n = 0 To UBound(PtStrings)
Nums(n) = Convert.ToDouble(PtStrings(n))
Next
For n = 1 To (UBound(Nums) + 1) / 8
'Points.Add(New CustomVertex.PositionNormalTextured(New Vector3(0, 1, 0), New Vector3(0, 0, -1), 0.5, 0))
'Points.Add(New CustomVertex.PositionNormalTextured(New Vector3(-1, -1, 0), New Vector3(0, 0, -1), 0, 1))
'Points.Add(New CustomVertex.PositionNormalTextured(New Vector3(1, -1, 0), New Vector3(0, 0, -1), 1, 1))
Points.Add(New CustomVertex.PositionNormalTextured(Nums(GP(n, 0)), Nums(GP(n, 1)), Nums(GP(n, 2)), Nums(GP(n, 3)), Nums(GP(n, 4)), Nums(GP(n, 5)), Nums(GP(n, 6)), Nums(GP(n, 7))))
Next
D3Dvertexbuffer = New VertexBuffer(GetType(CustomVertex.PositionNormalTextured), _
Points.Count, _
D3Ddevice, _
0, _
CustomVertex.PositionNormalTextured.Format, _
Pool.Default)
vertices = CType(D3Dvertexbuffer.Lock(0, 0), CustomVertex.PositionNormalTextured())
For i = 0 To Points.Count - 1
vertices(i) = Points(i)
Next
D3Dvertexbuffer.Unlock()
End Sub
Function GP(ByVal n As Integer, ByVal v As Integer) As Integer
GP = ((n - 1) * 8) + v
End Function
Function MakeTextures(ByVal Path As String) As Texture
Dim BMP As IO.MemoryStream
BMP = New IO.MemoryStream
Image.FromFile(Path).Save(BMP, Imaging.ImageFormat.Jpeg)
BMP.Seek(0, IO.SeekOrigin.Begin)
MakeTextures = TextureLoader.FromStream(D3Ddevice, BMP)
BMP.Close()
End Function
Function MakeMaterial(ByVal Ambient As Color, ByVal Diffuse As Color, ByVal Specular As Color) As Material
MakeMaterial.Ambient = Ambient
MakeMaterial.Diffuse = Diffuse
MakeMaterial.Specular = Specular
End Function
Sub MakeLights()
D3Ddevice.Lights(0).Type = LightType.Directional
D3Ddevice.Lights(0).Diffuse = Color.White
D3Ddevice.Lights(0).Ambient = Color.White
D3Ddevice.Lights(0).Direction = New Vector3(1, 1, -1)
D3Ddevice.Lights(0).Enabled = True
End Sub
#End Region
#Region "Rendering"
Sub RenderInit()
D3Ddevice.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.Black, 1, 0)
D3Ddevice.BeginScene()
D3Ddevice.VertexFormat = CustomVertex.PositionNormalTextured.Format
End Sub
Sub RenderMesh(ByVal Scale As Vector3, ByVal Rot As Vector3, ByVal Pos As Vector3, ByVal MaterialUsed() As Material, ByVal TextureUsed() As Texture, ByVal MeshUsed As Mesh, ByVal Subset As Integer, ByVal CamPos As Vector3, ByVal CamAt As Vector3, ByVal CamUp As Vector3)
Orient(Scale, Rot, Pos, CamPos, CamAt, CamUp)
D3Ddevice.Material = MaterialUsed(Subset)
D3Ddevice.SetTexture(0, TextureUsed(Subset))
MeshUsed.DrawSubset(Subset)
End Sub
Sub RenderEnd()
D3Ddevice.EndScene()
D3Ddevice.Present()
End Sub
Sub Orient(ByVal Scale As Vector3, ByVal Rot As Vector3, ByVal Pos As Vector3, ByVal CamPos As Vector3, ByVal CamAt As Vector3, ByVal CamUp As Vector3)
'D3Ddevice.Transform.World = Matrix.Multiply(Matrix.Scaling(Scale), Matrix.Multiply(Matrix.RotationYawPitchRoll(Rot.X, Rot.Y, Rot.Z), Matrix.Translation(Pos.X, Pos.Y, Pos.Z)))
D3Ddevice.Transform.World = Matrix.Multiply(Matrix.RotationYawPitchRoll(Rot.X, Rot.Y, Rot.Z), Matrix.Translation(Pos.X, Pos.Y, Pos.Z))
D3Ddevice.Transform.View = Matrix.LookAtLH(CamPos, CamAt, CamUp)
D3Ddevice.Transform.Projection = Matrix.PerspectiveFovLH(Math.PI / 4, Panel1.Width / Panel1.Height, 0.1, 100)
End Sub
#End Region
#Region "Meshes"
Public Sub LoadMesh(ByVal Path As String, ByRef Materials() As Material, ByRef TriMesh As Mesh, ByRef Textures() As Texture)
Dim ExtendMats() As ExtendedMaterial = Nothing
Dim Location As String
Dim a As Integer
For n = 0 To Path.Split("\").Count - 1
a = a + Path.Split("\")(n).Length
Next
Location = "C:\Program Files\Microsoft DirectX SDK (February 2010)\Samples\Media\Airplane\"
TriMesh = Mesh.FromFile(Path, MeshFlags.Managed, D3Ddevice, ExtendMats)
ReDim Textures(ExtendMats.Length - 1)
ReDim Materials(ExtendMats.Length - 1)
For n As Integer = 0 To ExtendMats.Length - 1
Dim TexturePath As String = ExtendMats(n).TextureFilename
If Not (TexturePath = Nothing) Then
If TexturePath.Length > 0 Then
Try
Textures(n) = TextureLoader.FromFile(D3Ddevice, Location + TexturePath)
Catch
End Try
End If
End If
Materials(n) = ExtendMats(n).Material3D
Next
End Sub
#End Region
#End Region
End Class
[img src="http://i25.[tinypic].com/10ygymt.png"]
