[RESOLVED] DirectX8 and VB6 Related Problem

[David2010]

I was using DirectX and VB6 to load an image on the backbuffer.

I used a function enclosed in a method in VB6 to load the image to the backbuffer.

Then I copied the backbuffered image to the screen buffer.

However It crashes every time I try to load the program but the VB6 compiler doesn't pick up any errors.

I found out that it is having problems copying the image from the backbuffer to the screen buffer.......

I used the DirectX8 Copy.Rects function but something is going wrong.

When I use the function in the form it works great but when its in the method it crashes.

What is going on here? Sorry if its a simple mistake as I am still learning VB6 and DirectX.

Form1 Code:

Option Explicit
Option Base 0

Const SCREENWIDTH As Long = 640
Const SCREENHEIGHT As Long = 480
Const FULLSCREEN As Boolean = False
Const C_BLACK As Long = &H0
Dim surface As Direct3DSurface8
Dim backbuffer As Direct3DSurface8

Private Sub Form_Load()

'Set up form size
Form1.Width = Screen.TwipsPerPixelX * (SCREENWIDTH + 12)
Form1.Height = Screen.TwipsPerPixelY * (SCREENHEIGHT + 30)
Form1.Show

'Starts DirectX
InitDirect3D Me.hwnd, SCREENWIDTH, SCREENHEIGHT, FULLSCREEN

'get reference to the back buffer
Set backbuffer = d3ddev.GetBackBuffer(0, D3DBACKBUFFER_TYPE_MONO)

'load the bitmap file
Set surface = LoadSurface(App.Path & "\pic.bmp")

End Sub

Private Sub Form_Paint()

'copy image to backbuffer
d3ddev.CopyRects surface, ByVal 0, 0, backbuffer, ByVal 0

'draw the backbuffer to the screen
d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Shutdown

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'ESC Key
If KeyCode = 27 Then Shutdown

End Sub

INITDX Module Code:

Option Explicit
Option Base 0

Global dx As DirectX8
Global d3d As Direct3D8
Global d3dpp As D3DPRESENT_PARAMETERS
Global dispmode As D3DDISPLAYMODE
Global d3ddev As Direct3DDevice8
Global d3dx As New D3DX8

Public Sub InitDirect3D( _
ByVal hwnd As Long, _
ByVal lWidth As Long, _
ByVal lHeight As Long, _
ByVal bFullscreen As Boolean)

On Local Error GoTo fatal_error

Set dx = New DirectX8

Set d3d = dx.Direct3DCreate()

If d3d Is Nothing Then
MsgBox "Error init Direct3D!"
Shutdown
End If

d3d.GetAdapterDisplayMode D3DADAPTER_DEFAULT, dispmode

Dim d3dpp As D3DPRESENT_PARAMETERS
d3dpp.hDeviceWindow = hwnd
d3dpp.BackBufferCount = 1
d3dpp.BackBufferWidth = lWidth
d3dpp.BackBufferHeight = lHeight
d3dpp.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC
d3dpp.BackBufferFormat = dispmode.Format

If bFullscreen Then
    d3dpp.Windowed = 0
Else
    d3dpp.Windowed = 1
End If

d3dpp.MultiSampleType = D3DMULTISAMPLE_NONE
d3dpp.AutoDepthStencilFormat = D3DFMT_D32

Set d3ddev = d3d.CreateDevice( _
D3DADAPTER_DEFAULT, _
D3DDEVTYPE_HAL, _
hwnd, _
D3DCREATE_SOFTWARE_VERTEXPROCESSING, _
d3dpp)

If d3ddev Is Nothing Then
    MsgBox "Error creating the Direct3D device"
    Shutdown
End If

Exit Sub

fatal_error:
    MsgBox "Critical error in Start_Direct3D!"
    Shutdown
End Sub

Public Sub Shutdown()

Set d3ddev = Nothing
Set d3d = Nothing
Set dx = Nothing
End

End Sub

LoadImage Module Code:

Public Function LoadSurface(ByVal filename As String) As Direct3DSurface8

On Local Error GoTo fatal_error

Dim surf As Direct3DSurface8

Set LoadSurface = Nothing

Set surf = d3ddev.CreateImageSurface(SCREENWIDTH, SCREENHEIGHT, dispmode.Format)

If surf Is Nothing Then
    MsgBox "Error creating surface!"
    Exit Function
End If

d3dx.LoadSurfaceFromFile _
surf, _
ByVal 0, _
ByVal 0, _
filename, _
ByVal 0, _
D3DX_DEFAULT, _
0, _
ByVal 0

If surf Is Nothing Then
    MsgBox "Error loading " & filename & "!"
    Exit Function
End If

fatal_error:
    Exit Function
End Function

[David2010]

Seriously!!?!? No help!?!?!

[BatonHead]

Patience David, patience.
I am no directx guy but I do notice that you are using the constants SCREENWIDTH and SCREENHEIGHT in the loadimage module code. Are you re-declaring those in the module, because when you don't explicitly state Public Const it defaults to private (to where you declared them in the form). Of course this would also only compile without errors if you didn't put option explicit at the top of each module as well.
If thats not the issue then try to narrow down exactly where the error is occurring by commenting out sections until you can pinpoint closer to where it is crashing. Also please explain exactly what you mean by crashing.
EDIT: I notice you are using on local error. I had not seen that coding before and it isn't in the help file. A google search returns that it is legacy coding not used from VB4 on.

[vb5prgrmr]

Here is a site you might be interested in... http://www.jharbour.com/forum/ since he has authored a couple of books on VB and DX...



Good Luck

[David2010]

Patience David, patience.
I am no directx guy but I do notice that you are using the constants SCREENWIDTH and SCREENHEIGHT in the loadimage module code. Are you re-declaring those in the module, because when you don't explicitly state Public Const it defaults to private (to where you declared them in the form). Of course this would also only compile without errors if you didn't put option explicit at the top of each module as well.
If thats not the issue then try to narrow down exactly where the error is occurring by commenting out sections until you can pinpoint closer to where it is crashing. Also please explain exactly what you mean by crashing.
EDIT: I notice you are using on local error. I had not seen that coding before and it isn't in the help file. A google search returns that it is legacy coding not used from VB4 on.

Sorry ADHD has made me not a very patient person. :-/

Anyways I fixed the error with not declairing SCREENWIDTH and SCREENHEIGHT as public and I removed the local error section of code (Bad habit I suppose.) I also put option explicit at the top of all modules.

This line of code is causing the program to crash:

d3ddev.CopyRects surface, ByVal 0, 0, backbuffer, ByVal 0

Also I noticed that ever since I installed skype and ran a share screen session the last image sent from my computer to his is trapped on the backbuffer and I can't seem to clear it. Very strange glitch. :-/

that line of code copys the screen image to the backbuffer and then the next line of code:

d3ddev.Present ByVal 0, ByVal 0, 0, ByVal 0

Draws the backbuffer to the screen.

What is going wrong here? :-/

[David2010]

Here is a site you might be interested in... http://www.jharbour.com/forum/ since he has authored a couple of books on VB and DX...



Good Luck

Seems like a cool site. Still waiting for Admin approval for registration though.

[BatonHead]

Hi,
I have been copying your code into a project and I have found a couple of things minor that won't cause a crash. However this might:
In the function LoadSurface you have declared a variable 'surf' in which you will load the image. This surface is the one you want this function to return however you never do return it.
You see you have the line:

Set LoadSurface = Nothing

so that the function defaults to returning nothing.
However nowhere do you then set loadsurface to something.

Set surf = d3ddev.CreateImageSurface(SCREENWIDTH, SCREENHEIGHT, dispmode.Format)

If surf Is Nothing Then
    MsgBox "Error creating surface!"
    Exit Function
End If

d3dx.LoadSurfaceFromFile _
surf, _
ByVal 0, _
ByVal 0, _
filename, _
ByVal 0, _
D3DX_DEFAULT, _
0, _
ByVal 0

If surf Is Nothing Then
    MsgBox "Error loading " & filename & "!"
    Exit Function
End If
' you should add this line to the code
set LoadSurface = surf

This will return the surface you just created.
But why create the extra procedure level surface. Just pass the surface into the procedure. Declare your procedure like this:

public sub LoadSurface(byval sFile as string, byref oSurface as Direct3dSurface8)

Set oSurface = d3ddev.CreateImageSurface(SCREENWIDTH, SCREENHEIGHT, dispmode.Format)

If oSurface Is Nothing Then
    MsgBox "Error creating surface!"
    Exit sub
End If

d3dx.LoadSurfaceFromFile _
oSurface, _
ByVal 0, _
ByVal 0, _
sFile, _
ByVal 0, _
D3DX_DEFAULT, _
0, _
ByVal 0

If oSurface Is Nothing Then
    MsgBox "Error loading " & filename & "!"
    Exit sub
End If

fatal_error:
    Exit sub

So in effect you were trying to copyrect from the backbuffer onto a nothing object. You can test this in your original code by checking if surface is nothing after the call to loadsurface.
Your shutdown procedure should also set the surfaces to nothing.
Also don't copy/paste my code as I just type it in and their could be mistakes. My internet computer is not the one I code on.

[BatonHead]

I also want to recommend one more thing. This might be arguable.
I never put in error trapping until after I have working code. Errors are actually very helpful while developing your program and they are much easier to fix at that stage.

[David2010]

Cool thanks peoples you fixed my problem.

I simply used

Set LoadSurface = surf

In my LoadSurface module near the end and then did a check in my Form to make sure that surface wasn't Nothing and then everything worked out ok.

Thanks a Lot!!!

I guess I just assumed that since I used a function that it would automatically assign the value or something. hahaha