by Muhammad Asif (3 Submissions)
Category: Games
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 7th November 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
How to draw a bitmap image using DirectX
API Declarations
Dim Caps As DDSCAPS2
Dim Dx As New DirectX7
Dim DDraw As DirectDraw7
'surfaces
'Primary Surface
Dim ddsPrimary As DirectDrawSurface7
'backbuffer surface
Dim ddsBackBuffer As DirectDrawSurface7
'Background Surfaces and RECTs
Dim Background As DirectDrawSurface7
Dim s640x480rect As RECT 'RECT Variable
'surface descriptions
Dim ddsdPrimary As DDSURFACEDESC2
Dim ddsdBackBuffer As DDSURFACEDESC2
VBcoders
End
End Sub
Private Sub Form_Load()
'Create DirectDraw
Set DDraw = Dx.DirectDrawCreate("")
'show the form
Form1.Show
DDraw.SetCooperativeLevel Form1.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE
DDraw.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
ddsdPrimary.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddsdPrimary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
ddsdPrimary.lBackBufferCount = 1 '1 back buffer
Set ddsPrimary = DDraw.CreateSurface(ddsdPrimary)
Caps.lCaps = DDSCAPS_BACKBUFFER
Set ddsBackBuffer = ddsPrimary.GetAttachedSurface(Caps)
ddsBackBuffer.GetSurfaceDesc ddsdBackBuffer
DDCreateSurface Background, App.Path & "\map.bmp", s640x480rect
ddsBackBuffer.BltColorFill s640x480rect, RGB(0, 0, 0)
ddsBackBuffer.BltFast 0, 0, Background, s640x480rect, DDBLTFAST_WAIT
ddsPrimary.Flip Nothing, DDFLIP_WAIT
End Sub
Private Sub DDCreateSurface(surface As DirectDrawSurface7, BmpPath As String, RECTVar As RECT, Optional TransCol As Integer = 0, Optional UseSystemMemory As Boolean = True)
Dim Tempddsd As DDSURFACEDESC2
Set surface = Nothing
'load sprite
Tempddsd.lFlags = DDSD_CAPS
Tempddsd.ddsCaps.lCaps = DDSCAPS_SYSTEMMEMORY Or DDSCAPS_OFFSCREENPLAIN
Set surface = DDraw.CreateSurfaceFromFile(BmpPath, Tempddsd)
'Tempddsd.ddsCaps.lCaps = DDSCAPS_SYSTEMMEMORY Or DDSCAPS_OFFSCREENPLAIN
'set the RECT dimensions
RECTVar.Right = Tempddsd.lWidth
RECTVar.Bottom = Tempddsd.lHeight
'color key
Dim ddckColourKey As DDCOLORKEY
ddckColourKey.low = TransCol
ddckColourKey.high = TransCol
surface.SetColorKey DDCKEY_SRCBLT, ddckColourKey
End Sub
