1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
| Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports Microsoft.DirectX.Direct3D.D3DX
Class GameClass
Private displaySettings As DisplayMode
Private deviceParameters As PresentParameters
Public device As Device
Public gameExit As Boolean
Public Sub Initialize(ByVal fullScreen As Boolean)
If fullScreen Then
displaySettings.Width = 800
displaySettings.Height = 600
displaySettings.Format = Format.X8R8G8B8
Else
displaySettings = Manager.Adapters.Default.CurrentDisplayMode
End If
deviceParameters = New PresentParameters()
deviceParameters.BackBufferWidth = displaySettings.Width
deviceParameters.BackBufferHeight = displaySettings.Height
deviceParameters.BackBufferFormat = displaySettings.Format
deviceParameters.SwapEffect = SwapEffect.Discard
deviceParameters.PresentationInterval = PresentInterval.Immediate
If fullScreen Then
deviceParameters.Windowed = False
Else
deviceParameters.Windowed = True
End If
loadContent()
End Sub
Public Sub loadContent()
device = New Device(Manager.Adapters.Default.Adapter, DeviceType.Hardware, Form1.Handle, CreateFlags.SoftwareVertexProcessing, deviceParameters)
End Sub
Public Sub Draw()
Do While Not gameExit
device.Clear(ClearFlags.Target, Color.CornFlowerBlue, 1, 0)
device.BeginScene()
device.EndScene()
device.Present() 'C'est ici que ca plante
Application.DoEvents()
Loop
thisExit()
End Sub
Public Sub thisExit()
displaySettings = Nothing
deviceParameters = Nothing
device.Dispose()
device = Nothing
Application.Exit()
End Sub
End Class |
Partager