Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.DirectInput
Imports Microsoft.DirectX.DirectSound
Public Class GameEngine
Dim DispGrafico As Direct3D.Device
Dim Tastiera As DirectInput.Device
Dim Mouse As DirectInput.Device
Dim Suoni As DirectSound.Device
Dim ListaOgg As New List(Of String)
Dim Pos As New Vector3(0, 0, 0)
Dim Rot As New Vector3(0, 0, 0)
Dim MeshCorr As oggX
Dim TempoPassatoMouse As Integer
Dim Suono1 As SecondaryBuffer
Dim Suono2 As SecondaryBuffer
Private _OggCorr As Integer
Property OggCorr() As Integer
Get
Return _OggCorr
End Get
Set(ByVal value As Integer)
If value <> ListaOgg.Count And value <> -1 Then
_OggCorr = value
ElseIf value = ListaOgg.Count Then
_OggCorr = 0
ElseIf value = -1 Then
_OggCorr = ListaOgg.Count - 1
End If
MeshCorr = Me.CaricaMesh(ListaOgg.Item(_OggCorr) & "\Mesh.x", True, True, ListaOgg.Item(OggCorr), Pos, Rot)
End Set
End Property
Private Sub GameEngine_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
MsgBox("Managed DirectX Demo: esempio di utilizzo delle DirectX in VB.NET. Sviluppato da GN." & Chr(13) _
& "E' possibile aggiungere altri oggetti 3D inserendo sottocartelle con un file Mesh.x e le textures nella cartella Oggetti." & Chr(13) & Chr(13) _
& "Comandi della visualizzazzione 3D:" & Chr(13) _
& "Frecce direzionali: ruota sugli assi X e Y;" & Chr(13) _
& "PagSu\PagGiù: ruota sull'asse Z;" & Chr(13) _
& "Maiusc + Frecce direzionali: muovi sugli assi X e Y;" & Chr(13) _
& "Maiusc + PagSu\PagGiù: muovi sull'asse Z;" & Chr(13) _
& "Barra spaziatrice: resetta posizione;" & Chr(13) _
& "Clic sinistro: oggetto successivo;" & Chr(13) _
& "Clic destro: oggetto precedente;" & Chr(13) _
& "Esc: esci." & Chr(13) & Chr(13) _
& "Fare clic su OK per iniziare.")
Dim ParametriGrafici As New PresentParameters()
If MsgBox("Schermo intero?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
ParametriGrafici.BackBufferCount = 1
ParametriGrafici.AutoDepthStencilFormat = DepthFormat.D16
ParametriGrafici.EnableAutoDepthStencil = True
ParametriGrafici.DeviceWindowHandle = Me.Handle
ParametriGrafici.SwapEffect = SwapEffect.Flip
ParametriGrafici.Windowed = False
ParametriGrafici.BackBufferWidth = My.Computer.Screen.Bounds.Width
ParametriGrafici.BackBufferHeight = My.Computer.Screen.Bounds.Height
ParametriGrafici.BackBufferFormat = Format.X8R8G8B8
Else
ParametriGrafici.BackBufferCount = 1
ParametriGrafici.AutoDepthStencilFormat = DepthFormat.D16
ParametriGrafici.EnableAutoDepthStencil = True
ParametriGrafici.DeviceWindowHandle = Me.Handle
ParametriGrafici.SwapEffect = SwapEffect.Flip
ParametriGrafici.Windowed = True
End If
DispGrafico = New Direct3D.Device(0, Direct3D.DeviceType.Hardware, Me.Handle, CreateFlags.SoftwareVertexProcessing, ParametriGrafici)
Tastiera = New DirectInput.Device(SystemGuid.Keyboard)
Tastiera.SetDataFormat(DeviceDataFormat.Keyboard)
Tastiera.SetCooperativeLevel(Me, CooperativeLevelFlags.Background Or CooperativeLevelFlags.NonExclusive)
Tastiera.Acquire()
Mouse = New DirectInput.Device(SystemGuid.Mouse)
Mouse.SetCooperativeLevel(Me, CooperativeLevelFlags.Background Or CooperativeLevelFlags.NonExclusive)
Mouse.SetDataFormat(DeviceDataFormat.Mouse)
Mouse.Acquire()
Suoni = New DirectSound.Device
Suoni.SetCooperativeLevel(Me, CooperativeLevel.Priority)
Me.Show()
Me.Focus()
For Each CartellaCorr As String In My.Computer.FileSystem.GetDirectories(Application.StartupPath & "\Oggetti")
ListaOgg.Add(CartellaCorr)
Next
OggCorr = 0
Suono1 = CaricaSuono(Application.StartupPath & "\Suoni\1.wav")
Suono2 = CaricaSuono(Application.StartupPath & "\Suoni\2.wav")
Me.MainLoop()
End Sub
Sub MainLoop()
Do
Tastiera.Poll()
Mouse.Poll()
DispGrafico.Clear(ClearFlags.Target Or ClearFlags.ZBuffer, Color.Blue, 1, 0)
DispGrafico.BeginScene()
DispGrafico.SamplerState(0).MinFilter = TextureFilter.Linear
DispGrafico.Transform.View = Matrix.LookAtLH(New Vector3(10, 10, 10), New Vector3(0, 0, 0), New Vector3(0, 1, 0))
DispGrafico.Transform.Projection = Matrix.PerspectiveFovLH(CSng(Math.PI / 16), 4 / 3, 1, 2000)
DispGrafico.RenderState.Lighting = True
DispGrafico.RenderState.Ambient = Color.White
Dim Modifica As New Vector3(0, 0, 0)
If Tastiera.GetCurrentKeyboardState.Item(Key.LeftShift) = True Then
Modifica = Pos
Else
Modifica = Rot
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.Left) = True Then
Modifica.X += 0.1
ElseIf Tastiera.GetCurrentKeyboardState.Item(Key.Right) = True Then
Modifica.X -= 0.1
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.Up) = True Then
Modifica.Y += 0.1
ElseIf Tastiera.GetCurrentKeyboardState.Item(Key.Down) = True Then
Modifica.Y -= 0.1
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.PageUp) = True Then
Modifica.Z += 0.1
ElseIf Tastiera.GetCurrentKeyboardState.Item(Key.PageDown) = True Then
Modifica.Z -= 0.1
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.LeftShift) = True Then
Pos = Modifica
Else
Rot = Modifica
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.Escape) Then
Application.Exit()
End If
If Tastiera.GetCurrentKeyboardState.Item(Key.Space) = True Then
Pos = New Vector3(0, 0, 0)
Rot = New Vector3(0, 0, 0)
End If
If Mouse.CurrentMouseState.GetMouseButtons(0) > 0 Then
If TempoPassatoMouse = 20 Then
OggCorr += 1
TempoPassatoMouse = 0
Suono1.Play(0, BufferPlayFlags.Default)
End If
End If
If Mouse.CurrentMouseState.GetMouseButtons(1) > 0 Then
If TempoPassatoMouse = 20 Then
OggCorr -= 1
TempoPassatoMouse = 0
Suono2.Play(0, BufferPlayFlags.Default)
End If
End If
If TempoPassatoMouse <> 20 Then
TempoPassatoMouse += 1
End If
MeshCorr.pos = Pos
MeshCorr.rot = Rot
Me.AggiungiMesh(MeshCorr)
DispGrafico.EndScene()
DispGrafico.Present()
Application.DoEvents()
Loop
End Sub
Function CaricaMesh(ByVal fileSrc As String, ByVal materialiOn As Boolean, ByVal textureOn As Boolean, ByVal TexPath As String, ByVal pos As Vector3, ByVal rot As Vector3) As oggX
With CaricaMesh
Dim materiali() As ExtendedMaterial = Nothing
.mesh = Mesh.FromFile(fileSrc, MeshFlags.Dynamic, DispGrafico, materiali)
.numX = UBound(materiali)
ReDim .tex(.numX)
ReDim .mat(.numX)
Dim i As Integer
For i = 0 To .numX
If textureOn Then
If materiali(i).TextureFilename <> "" Then
.tex(i) = TextureLoader.FromFile(DispGrafico, TexPath & "\" & materiali(i).TextureFilename)
End If
End If
If materialiOn Then
.mat(i) = materiali(i).Material3D
.mat(i).Ambient = .mat(i).Diffuse
End If
Next
.pos = pos
.rot = rot
End With
End Function
Sub AggiungiMesh(ByVal Modello As oggX)
Dim pos As Matrix = Matrix.Translation(Modello.pos)
Dim rot As Matrix = Matrix.RotationYawPitchRoll(Modello.rot.Y, Modello.rot.X, Modello.rot.Z)
DispGrafico.Transform.World = Matrix.Multiply(pos, rot)
For i As Integer = 0 To Modello.numX
DispGrafico.Material = Modello.mat(i)
DispGrafico.SetTexture(0, Modello.tex(i))
Modello.mesh.DrawSubset(i)
Next
End Sub
Function CaricaSuono(ByVal src As String) As SecondaryBuffer
Dim d As New BufferDescription()
d.Flags = BufferDescriptionFlags.ControlPan Or BufferDescriptionFlags.ControlFrequency Or BufferDescriptionFlags.ControlVolume
Return New SecondaryBuffer(src, d, Suoni)
End Function
Private Sub GameEngine_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
End
End Sub
End Class
