It will not draw my sprite. What did I do Wrong.
Code:Dim DirectX As New DirectX7
Dim DirectDraw As DirectDraw7
'surfaces
Dim PrimarySurf As DirectDrawSurface7
Dim BackSurf As DirectDrawSurface7
'Surface Descriptions
Dim PrimarySDesc As DDSURFACEDESC2
'Offscreen Surface
Dim Sprt As DirectDrawSurface7
Private Sub Form_Load()
ChDir (App.Path)
Me.Show
Me.WindowState = 2
Init_DD
LoadSprite "ball.bmp"
DrawSprite
PrimarySurf.Flip Nothing, DDFLIP_WAIT
End Sub
Sub Init_DD()
Set DirectDraw = DirectX.DirectDrawCreate("")
Call DirectDraw.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or _
DDSCL_EXCLUSIVE Or _
DDSCL_ALLOWREBOOT)
Call DirectDraw.SetDisplayMode(640, 480, 8, 0, DDSDM_DEFAULT)
'Primary surface
PrimarySDesc.lFlags = DDSD_BACKBUFFERCOUNT Or DDSD_CAPS
PrimarySDesc.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or _
DDSCAPS_FLIP Or _
DDSCAPS_COMPLEX
PrimarySDesc.lBackBufferCount = 1
Set PrimarySurf = DirectDraw.CreateSurface(PrimarySDesc)
'Back buffer
Dim BackCaps As DDSCAPS2
BackCaps.lCaps = DDSCAPS_BACKBUFFER
Set BackSurf = PrimarySurf.GetAttachedSurface(BackCaps)
BackSurf.SetForeColor vbWhite 'set font collor
ClearBackBuffer
End Sub
Sub ShutDown()
Set Sprt = Nothing
Set PrimarySurf = Nothing
Set BackSurf = Nothing
Call DirectDraw.RestoreDisplayMode
Call DirectDraw.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
End Sub
Private Sub Form_Unload(Cancel As Integer)
ShutDown
End Sub
Public Sub DrawSprite()
Dim SRect As RECT
Dim DRect As RECT
With SRect
.Left = 0
.Top = 0
.Bottom = 64
.Top = 64
End With
With DRect
.Left = 0
.Top = 0
.Bottom = 64
.Top = 64
End With
BackSurf.Blt DRect, Sprt, SRect, DDBLT_KEYSRC Or DDBLT_WAIT
End Sub
Public Sub LoadSprite(Path As String)
Dim ddsd As DDSURFACEDESC2
Dim ckey As DDCOLORKEY
ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddsd.lWidth = 64
ddsd.lHeight = 64
Set Sprt = DirectDraw.CreateSurfaceFromFile(Path, ddsd)
ckey.high = vbBlack
ckey.low = vbBlack
Sprt.SetColorKey DDCKEY_SRCBLT, ckey
End Sub
Public Sub ClearBackBuffer()
Dim BackRect As RECT
With BackRect
.Left = 0
.Top = 0
.Right = 640
.Bottom = 480
End With
BackSurf.BltColorFill BackRect, 0
End Sub
