Option Explicit
Private Const COLOR_DEPTH_16_BIT As Long = D3DFMT_R5G6B5
Private Const COLOR_DEPTH_24_BIT As Long = D3DFMT_A8R8G8B8
Private Const COLOR_DEPTH_32_BIT As Long = D3DFMT_X8R8G8B8
Private DirectX8 As DirectX8
Private Direct3D As Direct3D8
Private Direct3D_Device As Direct3DDevice8
Private Running As Boolean
Private D3DParams As D3DPRESENT_PARAMETERS
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Running = False
Set Direct3D_Device = Nothing
Set Direct3D = Nothing
Set DirectX8 = Nothing
Unload Me
End If
End Sub
Private Sub Form_Load()
Me.Show
Dim Display_Mode As D3DDISPLAYMODE
Dim Direct3D_Window As D3DPRESENT_PARAMETERS
frmMain.Caption = "DirectX Tutorial"
Set DirectX8 = New DirectX8
Set Direct3D = DirectX8.Direct3DCreate()
Display_Mode.Width = 800
Display_Mode.Height = 600
Display_Mode.Format = COLOR_DEPTH_16_BIT
Direct3D_Window.Windowed = False
Direct3D_Window.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
Direct3D_Window.BackBufferCount = 1
Direct3D_Window.BackBufferFormat = Display_Mode.Format
Direct3D_Window.BackBufferWidth = Display_Mode.Width
Direct3D_Window.BackBufferHeight = Display_Mode.Height
Direct3D_Window.hDeviceWindow = frmMain.hWnd
D3DParams = Direct3D_Window
Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Direct3D_Window)
Running = True
Do While Running = True
'Check if we have the device
If Direct3D_Device.TestCooperativeLevel <> D3D_OK Then
'Do a loop while device is lost
Do While Direct3D_Device.TestCooperativeLevel = D3DERR_DEVICELOST
'Let windows do it's stuff
DoEvents
Loop
'Reset the device
Direct3D_Device.Reset D3DParams
End If
Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0
Direct3D_Device.Present ByVal 0, ByVal 0, 0, ByVal 0
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Running = False
Set Direct3D_Device = Nothing
Set Direct3D = Nothing
Set DirectX8 = Nothing
Unload Me
End Sub