robot313
02-05-2002, 10:17 PM
I have this code frame for a DX8 Direct3D app. I got it from DirectX 4 VB (http://64.23.12.52//Tutorials/DirectX8/GR_Lesson01.asp) I pretty much understand it but when I run it, it just stays up for no more than 2 seconds then quits. Can anyone tell me what's wrong? I'm thinking it is supposed to keep running until bRunning = False
'//The variables Required
Dim Dx As DirectX8 'The master Object, everything comes from here
Dim D3D As Direct3D8 'This controls all things 3D
Dim D3DDevice As Direct3DDevice8 'This actually represents the hardware doing the rendering
Dim bRunning As Boolean 'Controls whether the program is running or not...
'//These aren't really required - they'll just show us what the frame rate is...
Private Declare Function GetTickCount Lib "kernel32" () As Long '//This is used to get the frame rate.
Dim LastTimeCheckFPS As Long '//When did we last check the frame rate?
Dim FramesDrawn As Long '//How many frames have been drawn
Dim FrameRate As Long '//What the current frame rate is.....
'// Initialise : This procedure kick starts the whole process.
'// It'll return true for success, false if there was an error.
Public Function Initialise() As Boolean
On Error Goto ErrHandler:
Dim DispMode As D3DDISPLAYMODE '//Describes our Display Mode
Dim D3DWindow As D3DPRESENT_PARAMETERS '//Describes our Viewport
Set Dx = New DirectX8 '//Create our Master Object
Set D3D = Dx.Direct3DCreate() '//Make our Master Object create the Direct3D Interface
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode '//Retrieve the current display Mode
D3DWindow.Windowed = 1 '//Tell it we're using Windowed Mode
D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC '//We'll refresh when the monitor does
D3DWindow.BackBufferFormat = DispMode.Format '//We'll use the format we just retrieved...
'//This line will be explained in detail in a minute...
Set D3DDevice = D3D.CreateDevice _
(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, _
D3DCREATE_HARDWARE_VERTEXPROCESSING, D3DWindow)
Initialise = True '//We succeeded
Exit Function
ErrHandler:
'//We failed; for now we wont worry about why.
Initialise = False
End Function
Public Sub Render()
'//1. We need to clear the render device before we can draw anything
' This must always happen before you start rendering stuff...
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HCCCCFF, 1#, 0
'the hexidecimal value in the middle is the same as when you're using colours in HTML - if you're familiar
'with that.
'//2. Next we would render everything. This lesson doesn't do this, but if it did it'd look something
' like this:
D3DDevice.BeginScene
'All rendering calls go between these two lines
D3DDevice.EndScene
'//3. Update the frame to the screen...
' This is the same as the Primary.Flip method as used in DirectX 7
' These values below should work for almost all cases...
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Private Sub Form_Load()
Me.Show '//Make sure our window is visible
bRunning = Initialise()
Debug.Print "Device Creation Return Code : ", bRunning 'So you can see what happens...
Do While bRunning
Render '//Update the frame...
DoEvents '//Allow windows time to think; otherwise you'll get into a really tight (and bad) loop...
'Calculate the frame rate; how this is done isn't greatly important
'So dont worry about understanding it yet...
If GetTickCount - LastTimeCheckFPS >= 1000 Then
LastTimeCheckFPS = GetTickCount
FrameRate = FramesDrawn '//Store the frame count
FramesDrawn = 0 '//Reset the counter
Me.Caption = "DirectX-Graphics: Lesson 01 {" & FrameRate & "fps}" '//Display it on screen
End If
FramesDrawn = FramesDrawn + 1
Loop
'//If we've gotten to this point the loop must have been terminated
' So we need to clean up after ourselves. This isn't essential, but it'
' good coding practise.
On Error Resume Next 'If the objects were never created;
' (the initialisation failed) we might get an
' error when freeing them... which we need to
' handle, but as we're closing anyway...
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
Debug.Print "All Objects Destroyed"
'//Final termination:
Unload Me
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
Debug.Print "All Objects Destroyed"
Unload Me
End Sub
'//The variables Required
Dim Dx As DirectX8 'The master Object, everything comes from here
Dim D3D As Direct3D8 'This controls all things 3D
Dim D3DDevice As Direct3DDevice8 'This actually represents the hardware doing the rendering
Dim bRunning As Boolean 'Controls whether the program is running or not...
'//These aren't really required - they'll just show us what the frame rate is...
Private Declare Function GetTickCount Lib "kernel32" () As Long '//This is used to get the frame rate.
Dim LastTimeCheckFPS As Long '//When did we last check the frame rate?
Dim FramesDrawn As Long '//How many frames have been drawn
Dim FrameRate As Long '//What the current frame rate is.....
'// Initialise : This procedure kick starts the whole process.
'// It'll return true for success, false if there was an error.
Public Function Initialise() As Boolean
On Error Goto ErrHandler:
Dim DispMode As D3DDISPLAYMODE '//Describes our Display Mode
Dim D3DWindow As D3DPRESENT_PARAMETERS '//Describes our Viewport
Set Dx = New DirectX8 '//Create our Master Object
Set D3D = Dx.Direct3DCreate() '//Make our Master Object create the Direct3D Interface
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode '//Retrieve the current display Mode
D3DWindow.Windowed = 1 '//Tell it we're using Windowed Mode
D3DWindow.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC '//We'll refresh when the monitor does
D3DWindow.BackBufferFormat = DispMode.Format '//We'll use the format we just retrieved...
'//This line will be explained in detail in a minute...
Set D3DDevice = D3D.CreateDevice _
(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, _
D3DCREATE_HARDWARE_VERTEXPROCESSING, D3DWindow)
Initialise = True '//We succeeded
Exit Function
ErrHandler:
'//We failed; for now we wont worry about why.
Initialise = False
End Function
Public Sub Render()
'//1. We need to clear the render device before we can draw anything
' This must always happen before you start rendering stuff...
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, &HCCCCFF, 1#, 0
'the hexidecimal value in the middle is the same as when you're using colours in HTML - if you're familiar
'with that.
'//2. Next we would render everything. This lesson doesn't do this, but if it did it'd look something
' like this:
D3DDevice.BeginScene
'All rendering calls go between these two lines
D3DDevice.EndScene
'//3. Update the frame to the screen...
' This is the same as the Primary.Flip method as used in DirectX 7
' These values below should work for almost all cases...
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub
Private Sub Form_Load()
Me.Show '//Make sure our window is visible
bRunning = Initialise()
Debug.Print "Device Creation Return Code : ", bRunning 'So you can see what happens...
Do While bRunning
Render '//Update the frame...
DoEvents '//Allow windows time to think; otherwise you'll get into a really tight (and bad) loop...
'Calculate the frame rate; how this is done isn't greatly important
'So dont worry about understanding it yet...
If GetTickCount - LastTimeCheckFPS >= 1000 Then
LastTimeCheckFPS = GetTickCount
FrameRate = FramesDrawn '//Store the frame count
FramesDrawn = 0 '//Reset the counter
Me.Caption = "DirectX-Graphics: Lesson 01 {" & FrameRate & "fps}" '//Display it on screen
End If
FramesDrawn = FramesDrawn + 1
Loop
'//If we've gotten to this point the loop must have been terminated
' So we need to clean up after ourselves. This isn't essential, but it'
' good coding practise.
On Error Resume Next 'If the objects were never created;
' (the initialisation failed) we might get an
' error when freeing them... which we need to
' handle, but as we're closing anyway...
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
Debug.Print "All Objects Destroyed"
'//Final termination:
Unload Me
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set D3DDevice = Nothing
Set D3D = Nothing
Set Dx = Nothing
Debug.Print "All Objects Destroyed"
Unload Me
End Sub