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




Reply With Quote