same problems, cleaner thread

I'm having a bunch of problems with some DirectDraw stuff I've written for a class project at school called Stick Fighters. At one time, I was able to draw a stick fighter guy on the screen, make him move around and punch and kick, and there was a background as well. Somehow, I have totally screwed the thing up to the point where it wont display a background or even a stick fighter. Sorry this is so vague, I had something extremely descriptive typed out before - but I went to check to make sure the link i'm about to give you worked right, and when i came back to the window it was empty :mad:

the zip (http://www.magenet.net/~jroes/StickFighters.zip)

I hope someone can help me out,
-Jonathan

The zip is to large for me to download, how did you manage to make 12.6M can you just post the critical sections.

well there are lots of images and stuff.. but sure i'll just paste as much code as i can fit into this next post

Here's my code:

in Graphics.cls:


Option Explicit

Private objDD As DirectDraw7
'Store handle for possible later use
Private hwnd As Long
Private objPrimSurf As DirectDrawSurface7
Private objBackSurf As DirectDrawSurface7
Private objBGSurf As DirectDrawSurface7

Private iErrNum As Integer

Private bShowFPS As Boolean

Private lLastTime As Long
Private iFPS As Integer

Public Function Init(objDX As DirectX7, lWndHandle As Long) As Boolean

Dim ddsdPrimSurf As DDSURFACEDESC2
Dim ddsCaps As DDSCAPS2
Dim ddsdBGSurf As DDSURFACEDESC2

On Error GoTo InitErr

Init = False

hwnd = lWndHandle

Set objDD = objDX.DirectDrawCreate("")
If Err.Number > 0 Then
iErrNum = Err.Number
Exit Function
End If

'CooperativeLevel is how this app plays with others. Here we say we are taking over the whole screen
'and no other app can be used, although the user can reboot is something bad happens
objDD.SetCooperativeLevel hwnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE Or DDSCL_ALLOWREBOOT
'The display will be 800 x 600 with 16 bit color
objDD.SetDisplayMode 800, 600, 16, 0, 0

'Set the properties of the primary surface
ddsdPrimSurf.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsdPrimSurf.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_COMPLEX Or DDSCAPS_FLIP
ddsdPrimSurf.lBackBufferCount = 1

'Create the primary surface object
Set objPrimSurf = objDD.CreateSurface(ddsdPrimSurf)

'Create the back surface
ddsCaps.lCaps = DDSCAPS_BACKBUFFER
Set objBackSurf = objPrimSurf.GetAttachedSurface(ddsCaps)

ddsdBGSurf.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
ddsdBGSurf.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsdBGSurf.lWidth = ddsdPrimSurf.lWidth
ddsdBGSurf.lHeight = ddsdPrimSurf.lHeight

Set objBGSurf = objDD.CreateSurfaceFromFile(App.Path & "\graphics\backgrounds\bmp\capricorn.bmp", ddsdBGSurf)

'Text will be drawn in white
objBackSurf.SetForeColor RGB(255, 255, 255)

Init = True

Exit Function

InitErr:
gDDraw.CleanUp
MsgBox "Initialization Error: " & Err.Description
Exit Function

End Function

Public Function RedrawScreen() As Long

Dim rectDest As RECT
Dim rBack As RECT
Dim lRet As Long
Dim lTime As Long
Static iLastTimeCalc As Integer

On Error GoTo DrawErr

'Clear out the back surface - total redraw
lRet = objBackSurf.BltColorFill(rectDest, 0)

'Calc FPS - only every 30 loops
If bShowFPS Then
If iLastTimeCalc = 30 Then
lTime = timeGetTime
If lLastTime > 0 Then
iFPS = 30 / ((lTime - lLastTime) / 1000)
End If
lLastTime = lTime
iLastTimeCalc = 0
End If
iLastTimeCalc = iLastTimeCalc + 1

objBackSurf.DrawText 10, 10, "FPS: " & Str(iFPS), False
End If

rBack.Bottom = 800
rBack.Right = 600
'Call objBackSurf.BltFast(0, 0, objBGSurf, rBack, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)

Player1.Draw objBackSurf


'Switch pointers to surfaces
If lRet = 0 Then objPrimSurf.Flip objBackSurf, DDFLIP_WAIT

RedrawScreen = 0

Exit Function

DrawErr:

RedrawScreen = lRet
MsgBox "Redraw error: " & Err.Description
gbQuit = True
Exit Function

End Function

Public Sub CleanUp()

'This is where we'll delete any created surfaces
On Error Resume Next
Set objBackSurf = Nothing
Set objPrimSurf = Nothing
Set objBGSurf = Nothing

objDD.RestoreDisplayMode
objDD.SetCooperativeLevel hwnd, DDSCL_NORMAL

End Sub

Public Property Let ShowFPS(ByVal bData As Boolean)
bShowFPS = bData
End Property

Public Function GetRGBColor(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As Long

Dim ddsurf As DDSURFACEDESC2
Dim rv As Long
Dim gv As Long
Dim bv As Long

objDD.GetDisplayMode ddsurf
With ddsurf.ddpfPixelFormat
If (.lFlags And DDPF_RGB) > 0 Then
rv = CLng(CSng(.lRBitMask) * (r / 255)) And .lRBitMask
gv = CLng(CSng(.lGBitMask) * (g / 255)) And .lGBitMask
bv = CLng(CSng(.lBBitMask) * (b / 255)) And .lBBitMask

GetRGBColor = rv Or gv Or bv
End If
End With

End Function

Public Function GetDD() As DirectDraw7
Set GetDD = objDD
End Function

in Player.cls:

'local variable(s) to hold property value(s)
Private mvarHitPoints As Integer 'local copy
Private mvarXPosition As Integer 'local copy
Private mvarPunchKey As Integer 'local copy
Private mvarKickKey As Integer 'local copy
Private mvarMLeftKey As Integer 'local copy
Private mvarMRightKey As Integer 'local copy
Private mvarState As Integer 'Alive, dead, etc.
Private mvarPhase As Integer 'which frame of alive, dead, etc.
Private objSurface(1 To 7) As DirectDrawSurface7

Public Function kick() As Integer
mvarState = 4
End Function

Public Function punch() As Integer
mvarState = 3
End Function

Public Function moveright()
If (mvarXPosition + 5) <= 795 Then 'if player is not going to be too close to the edge, increase
mvarXPosition = mvarXPosition + 5
End If
mvarState = 5
End Function

Public Function moveleft()
If (mvarXPosition - 5) >= 5 Then 'if player is not going to be too close to the edge, decrease
mvarXPosition = mvarXPosition - 5
End If
mvarState = 5
End Function

Public Property Get State() As Integer
'1: standing still
'2: dead
'3: punching
'4: kicking
'5: walking
'6: getting punched
'7: getting kicked
State = mvarState
End Property

Public Property Let MRightKey(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MRightKey = 5
mvarMRightKey = vData
End Property


Public Property Get MRightKey() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.MRightKey
MRightKey = mvarMRightKey
End Property

Public Property Let MLeftKey(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.MLeftKey = 5
mvarMLeftKey = vData
End Property

Public Property Get MLeftKey() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.MLeftKey
MLeftKey = mvarMLeftKey
End Property

Public Property Let KickKey(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.KickKey = 5
mvarKickKey = vData
End Property

Public Property Get KickKey() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.KickKey
KickKey = mvarKickKey
End Property

Public Property Let PunchKey(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.PunchKey = 5
mvarPunchKey = vData
End Property

Public Property Get PunchKey() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.PunchKey
PunchKey = mvarPunchKey
End Property

Public Property Let XPosition(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.XPosition = 5
mvarXPosition = vData
End Property

Public Property Get XPosition() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.XPosition
XPosition = mvarXPosition
End Property

Public Property Let HitPoints(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.HitPoints = 5
mvarHitPoints = vData
End Property

Public Property Get HitPoints() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.HitPoints
HitPoints = mvarHitPoints
End Property

Public Function Load(punch As Integer, kick As Integer, moveleft As Integer, moveright As Integer, color As String, objDD As DirectDraw7) As Boolean
Dim ddsd As DDSURFACEDESC2

On Error GoTo errload

Load = False

mvarXPosition = 8
mvarHitPoints = 100
mvarPunchKey = punch
mvarKickKey = kick
mvarMLeftKey = moveleft
mvarMRightKey = moveright
mvarState = 1

'fill surfaces with images of player
ddsd.lFlags = DDSD_CAPS Or DDSD_CKSRCBLT
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsd.ddckCKSrcBlt.low = gDDraw.GetRGBColor(255, 0, 255)
ddsd.ddckCKSrcBlt.high = gDDraw.GetRGBColor(255, 0, 255)
Set objSurface(1) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\dead.bmp", ddsd) 'standing still
Set objSurface(6) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\hit.bmp", ddsd) 'hit (punch)
Set objSurface(7) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\hitb.bmp", ddsd) 'hit (kick)
Set objSurface(4) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\kick.bmp", ddsd) 'kicking
Set objSurface(3) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\punch.bmp", ddsd) 'punching
Set objSurface(5) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\walk.bmp", ddsd) 'walking

Load = True
Exit Function
errload:
gDDraw.CleanUp
MsgBox "Error loading player: " & Err.Description
End Function

Public Sub still()
mvarState = 1
End Sub

Public Sub Draw(ByRef objBackSurf As DirectDrawSurface7)
Dim rectpiece As RECT

On Error GoTo errdraw

rectpiece.Top = 0
rectpiece.Left = 0
rectpiece.Right = 60
rectpiece.Bottom = 100

objBackSurf.BltFast mvarXPosition, 120, objSurface(mvarState), rectpiece, DDBLT_WAIT Or DDBLT_SRCCOLORKEY

Exit Sub

errdraw:
gbQuit = True
MsgBox "Error drawing player: " & Err.Description & " Number: " & Err.Number
End Sub

in Main.bas:

Option Explicit

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public gDX7 As New DirectX7

Public gDDraw As Graphics
Public gDSound As Sound
Public gbQuit As Boolean
Public Player1 As Player
Public Player2 As Player

Public Sub Main()
frmMain.Show
End Sub

Public Sub StartGame()

frmMain.Show

Set gDDraw = New Graphics
If Not gDDraw.Init(gDX7, frmMain.hwnd) Then
MsgBox "Error initializing DirectDraw."
Unload frmMain
frmMenu.Show
Exit Sub
End If

gDDraw.ShowFPS = True

Set Player1 = New Player
' Set Player2 = New Player
If Not Player1.Load(vbKeyF, vbKeyR, vbKeyA, vbKeyD, "blue", gDDraw.GetDD) Then
'MsgBox "Error loading Player 1: " & Err.Description
Unload frmMain
frmMenu.Show
Exit Sub
End If

Do
gDDraw.RedrawScreen
'Allow keypresses and other Windows messages to be processed
DoEvents

Loop While Not gbQuit

gDDraw.CleanUp

Set gDDraw = Nothing
Set Player1 = Nothing

Unload frmMain

frmMenu.Show

End Sub

ok, this time i'm attaching a rewritten Graphics.cls that does something odd..
maybe someone will see the problem

Always with this function i get a psychadelic screensaver and a nasty "With block or object variable not set" Can someone tell me what's not set?!?!?!?


Public Function RedrawScreen() As Long

Dim rectDest As RECT
Dim rBack As RECT
'Dim lRet As Long
Dim lTime As Long
'Static iLastTimeCalc As Integer

On Error GoTo DrawErr

'Clear out the back surface - total redraw
rectDest.Top = 800
rectDest.Bottom = 600
Call objBackSurf.BltColorFill(rectDest, 0)

'Calc FPS - only every 30 loops
'If bShowFPS Then
' If iLastTimeCalc = 30 Then
' lTime = timeGetTime
' If lLastTime > 0 Then
' iFPS = 30 / ((lTime - lLastTime) / 1000)
' End If
' lLastTime = lTime
' iLastTimeCalc = 0
' End If
' iLastTimeCalc = iLastTimeCalc + 1
'
' objBackSurf.DrawText 10, 10, "FPS: " & Str(iFPS), False
'End If

'rBack.Bottom = 480
'rBack.Right = 640
'Call objBackSurf.BltFast(0, 0, objBGSurf, rBack, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)

'Player1.Draw objBackSurf


'Switch pointers to surfaces
objPrimSurf.Flip objBackSurf, DDFLIP_WAIT

' RedrawScreen = 0

Exit Function

DrawErr:

' RedrawScreen = lRet
Debug.Print "Redraw error: " & Err.Description
gbQuit = True
Exit Function

End Function

woohoo.. so i finally got most of that stuff working... i got a stick fighter on the screen.. he moves somewhat.. but my one last small problem is:

when i change surfaces, the surface that is displayed is really weird looking - the stick fighter is like distorted oddly..

the problem is probably somewhere in this file:


Private mvarState As Integer 'Alive, dead, etc.
Private mvarPhase As Integer 'which frame of alive, dead, etc.
Private objSurface(1 To 7) As DirectDrawSurface7

Public Function kick() As Integer
mvarState = 4
End Function

Public Function punch() As Integer
mvarState = 3
End Function

Public Function moveright()
If (mvarXPosition + 5) <= 795 Then 'if player is not going to be too close to the edge, increase
mvarXPosition = mvarXPosition + 5
End If
mvarState = 5
End Function

Public Function moveleft()
If (mvarXPosition - 5) >= 5 Then 'if player is not going to be too close to the edge, decrease
mvarXPosition = mvarXPosition - 5
End If
mvarState = 5
End Function

Public Property Get State() As Integer
'1: standing still
'2: dead
'3: punching
'4: kicking
'5: walking
'6: getting punched
'7: getting kicked
State = mvarState
End Property

Public Function Load(punch As Integer, kick As Integer, moveleft As Integer, moveright As Integer, color As String, objDD As DirectDraw7) As Boolean
Dim ddsd As DDSURFACEDESC2

On Error GoTo errload

Load = False

mvarXPosition = 8
mvarHitPoints = 100
mvarPunchKey = punch
mvarKickKey = kick
mvarMLeftKey = moveleft
mvarMRightKey = moveright
mvarState = 1

'fill surfaces with images of player
ddsd.lFlags = DDSD_CAPS Or DDSD_CKSRCBLT
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsd.ddckCKSrcBlt.low = gDDraw.GetRGBColor(255, 0, 255)
ddsd.ddckCKSrcBlt.high = gDDraw.GetRGBColor(255, 0, 255)
Set objSurface(1) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\dead.bmp", ddsd) 'standing still
Set objSurface(6) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\hit.bmp", ddsd) 'hit (punch)
Set objSurface(7) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\hitb.bmp", ddsd) 'hit (kick)
Set objSurface(4) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\kick.bmp", ddsd) 'kicking
Set objSurface(3) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\punch.bmp", ddsd) 'punching
Set objSurface(5) = objDD.CreateSurfaceFromFile(App.Path & "\graphics\" & color & "SF\walk.bmp", ddsd) 'walking

Load = True
Exit Function
errload:
gbQuit = True
Debug.Print "Error loading player: " & Err.Description
End Function

Public Sub still()
mvarState = 1
End Sub

Public Sub Draw(ByRef objBackSurf As DirectDrawSurface7)
Dim rectPiece As RECT

On Error GoTo errdraw

rectPiece.Right = 60
rectPiece.Bottom = 100

objBackSurf.BltFast mvarXPosition, 120, objSurface(mvarState), rectPiece, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY

Exit Sub

errdraw:
gbQuit = True
Debug.Print "Error drawing player: " & Err.Description & " Number: " & Err.Number
End Sub


thanks
-jonathan

Try using Blt instead of BltFast because BltFast would seem to focus on speed rather then quality, I really wouldn't know because I always use Blt.


Dim r1 as RECT, r2 as RECT
r1.bottom = StickFigureDESC.lHeight
r1.right = StickfigureDESC.lWidth

r2 = r1
r2.top = PosOnScreenY
r2.Left = PosOnScreenX
r2.bottom = r2.bottom + r2.top
r2.right = r2.right + r2.left

Back.Blt r2, IBack, r1, DDBLT_WAIT
Prim.Flip Back, DDFLIP_WAIT