SmoothScrolling
April 21, 2008
Option Explicit
‘Function calls
Declare Sub CopyMemory Lib “kernel32″ Alias “RtlMoveMemory” (ByRef pDst As Any, ByRef pSrc As Any, ByVal ByteLen As Long)
‘DirectDraw Declarations
Public Dx As New DirectX7
Public DD As DirectDraw7
‘Primary Surface
Public ddsFront As DirectDrawSurface7
‘Backbuffer
Public ddsBack As DirectDrawSurface7
‘Types
Public Type RGBMask
rgbRed As Long
rgbBlue As Long
rgbGreen As Long
End Type
Public Type RGBQuad
rgbBlue As Byte
rgbRed As Byte
rgbGreen As Byte
rgbReserved As Byte
End Type
Public Type RGB16
Position As RGBQuad
Depth As RGBQuad
Amount As RGBQuad
Mask As RGBMask
End Type
Public RGB16Desc As RGB16
‘Blt FX
Dim ddfx As DDBLTFX
‘Font
Public MoCFont As New StdFont
‘Surface descriptions
Public ddsd1 As DDSURFACEDESC2
Public Ddsd2 As DDSURFACEDESC2
Public Function ddInit(ByRef myForm As Form, ByVal nWidth As Long, ByVal nHeight As Long, ByVal BPP As Integer, Optional UseSystemMemory As Boolean = False)
‘This subroutine initializes DirectDraw 7. myForm is the name of
‘the form to be used by DirectDraw.
‘Height and Width are screen dimensions, BPP is
‘the colour depth.
On Error Resume Next
Set DD = Dx.DirectDrawCreate(”")
myForm.Show
‘Full screen exclusive mode always
Call DD.SetCooperativeLevel(myForm.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
DD.SetDisplayMode nWidth, nHeight, BPP, 0, DDSDM_DEFAULT
‘Fill out primary surface description
ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
If UseSystemMemory = True Then
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
Else
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
End If
ddsd1.lBackBufferCount = 1 ‘One backbuffer
‘ddsFront is the primary surface
Set ddsFront = DD.CreateSurface(ddsd1)
‘Attach the backbuffer
Dim Caps As DDSCAPS2
If UseSystemMemory = True Then
Caps.lCaps = DDSCAPS_BACKBUFFER Or DDSCAPS_SYSTEMMEMORY
Else
Caps.lCaps = DDSCAPS_BACKBUFFER
End If
Set ddsBack = ddsFront.GetAttachedSurface(Caps)
ddsBack.GetSurfaceDesc Ddsd2
With ddfx
.ddckDestColorKey_high = RGB(0, 0, 0)
.ddckDestColorKey_low = RGB(0, 0, 0)
End With
‘Create an easily readable surface
‘Set the default font
DDSetFont “Calligraphic 421 BT”, RGB(255, 255, 255)
ddsBack.SetFontTransparency True
End Function
Public Sub DDSetFont(FontName As String, Optional FontColour As Long)
‘Changes the font of a surface
MoCFont.Name = FontName
MoCFont.Size = 12
ddsBack.SetForeColor FontColour
ddsBack.SetFont MoCFont
End Sub
Public Sub DDSurface16Setup(surface As DirectDrawSurface7)
‘This sub sets up a surface for alpha-blending.
‘It creates RGB masks.
Dim Ddsd As DDSURFACEDESC2
Dim nCount As Byte
‘Surface description
Ddsd.lWidth = Len(Ddsd.lWidth)
Ddsd.lHeight = Len(Ddsd.lHeight)
Ddsd.lFlags = DDSD_PIXELFORMAT
surface.GetSurfaceDesc Ddsd
‘Set up masks
RGB16Desc.Mask.rgbRed = Ddsd.ddpfPixelFormat.lRBitMask
RGB16Desc.Mask.rgbGreen = Ddsd.ddpfPixelFormat.lGBitMask
RGB16Desc.Mask.rgbBlue = Ddsd.ddpfPixelFormat.lBBitMask
‘Red
nCount = 0
While Not ((Ddsd.ddpfPixelFormat.lRBitMask And &H1) = &H1)
Ddsd.ddpfPixelFormat.lRBitMask = BitShiftRight(Ddsd.ddpfPixelFormat.lRBitMask, 1)
nCount = nCount + 1
Wend
RGB16Desc.Depth.rgbRed = BitShiftRight(Ddsd.ddpfPixelFormat.lRBitMask, 12)
RGB16Desc.Position.rgbRed = nCount
If Ddsd.ddpfPixelFormat.lRBitMask = &H1F Then
RGB16Desc.Amount.rgbRed = 3
Else
RGB16Desc.Amount.rgbRed = 2
End If
‘Green
nCount = 0
While Not ((Ddsd.ddpfPixelFormat.lGBitMask And &H1) = &H1)
Ddsd.ddpfPixelFormat.lGBitMask = BitShiftRight(Ddsd.ddpfPixelFormat.lGBitMask, 1)
nCount = nCount + 1
Wend
RGB16Desc.Depth.rgbGreen = BitShiftRight(Ddsd.ddpfPixelFormat.lGBitMask, 12)
RGB16Desc.Position.rgbGreen = nCount
If Ddsd.ddpfPixelFormat.lGBitMask = &H1F Then
RGB16Desc.Amount.rgbGreen = 3
Else
RGB16Desc.Amount.rgbGreen = 2
End If
‘Blue
nCount = 0
While Not ((Ddsd.ddpfPixelFormat.lBBitMask And &H1) = &H1)
Ddsd.ddpfPixelFormat.lBBitMask = BitShiftRight(Ddsd.ddpfPixelFormat.lBBitMask, 1)
nCount = nCount + 1
Wend
RGB16Desc.Depth.rgbBlue = BitShiftRight(Ddsd.ddpfPixelFormat.lBBitMask, 12)
RGB16Desc.Position.rgbBlue = nCount
If Ddsd.ddpfPixelFormat.lBBitMask = &H1F Then
RGB16Desc.Amount.rgbBlue = 3
Else
RGB16Desc.Amount.rgbBlue = 2
End If
End Sub
Public Sub DDCreateSurface(surface As DirectDrawSurface7, BmpPath As String, RECTvar As RECT, Optional TransCol As Integer = 0, Optional UseSystemMemory As Boolean = True)
‘This sub will load a bitmap from a file
‘into a specified dd surface. Transparent
‘colour is black (0) by default.
Dim tempddsd As DDSURFACEDESC2
Set surface = Nothing
‘Load sprite
tempddsd.lFlags = DDSD_CAPS
If UseSystemMemory = True Then
tempddsd.ddsCaps.lCaps = DDSCAPS_SYSTEMMEMORY Or DDSCAPS_OFFSCREENPLAIN
Else
tempddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
End If
Set surface = DD.CreateSurfaceFromFile(BmpPath, tempddsd)
’set the RECT dimensions
RECTvar.Right = tempddsd.lWidth
RECTvar.Bottom = tempddsd.lHeight
‘Colour key
Dim ddckColourKey As DDCOLORKEY
ddckColourKey.low = TransCol
ddckColourKey.high = TransCol
surface.SetColorKey DDCKEY_SRCBLT, ddckColourKey
End Sub
Public Sub DDColorFill(surface As DirectDrawSurface7, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color As Long)
‘Fills a surface with a specified colour
Dim FillRECT As RECT
With FillRECT
.Top = y1
.Left = x1
.Right = x2
.Bottom = y2
End With
surface.BltColorFill FillRECT, color
End Sub
Public Sub DDBltFast(surface As DirectDrawSurface7, RECTvar As RECT, x As Integer, y As Integer, Optional transparent As Boolean = True, Optional Clip As Boolean = True)
‘This subroutine will BltFast a surface to the
‘backbuffer. This wont work with clipper.
‘CLIPPING
‘Temporary rect
Dim RectTEMP As RECT
RectTEMP = RECTvar
If Clip = True Then
‘Set up screen rect for clipping
Dim ScreenRECT As RECT
With ScreenRECT
.Top = y
.Left = x
.Bottom = y + RECTvar.Bottom
.Right = x + RECTvar.Right
End With
‘Clip surface
With ScreenRECT
If .Bottom > 600 Then
RectTEMP.Bottom = RectTEMP.Bottom - (.Bottom - 600)
.Bottom = 590
End If
If .Left < 0 Then
RectTEMP.Left = RectTEMP.Left - .Left
.Left = 0
x = 0
End If
If .Right > 800 Then
RectTEMP.Right = RectTEMP.Right - (.Right - 800)
.Right = 800
End If
If .Top < 0 Then
RectTEMP.Top = RectTEMP.Top - .Top
.Top = 0
y = 0
End If
End With
End If
If transparent = False Then
Call ddsBack.BltFast(x, y, surface, RectTEMP, DDBLTFAST_WAIT)
Else
Call ddsBack.BltFast(x, y, surface, RectTEMP, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
End If
End Sub
Public Sub DDBlt(surface As DirectDrawSurface7, RECTvar As RECT, CoorX As Integer, CoorY As Integer, Optional transparent As Boolean = True, Optional Clip As Boolean = True)
‘This sub will Blt a surface to the backbuffer.
‘This is for use with Clipper
Dim DestRECT As RECT
DestRECT.Top = CoorY
DestRECT.Left = CoorX
DestRECT.Right = CoorX + RECTvar.Right
DestRECT.Bottom = CoorY + RECTvar.Bottom
‘CLIPPING
‘Temporary rect
Dim RectTEMP As RECT
RectTEMP = RECTvar
If Clip = True Then
‘Set up screen rect for clipping
Dim ScreenRECT As RECT
With ScreenRECT
.Top = CoorY
.Left = CoorX
.Bottom = CoorY + RECTvar.Bottom
.Right = CoorX + RECTvar.Right
End With
‘Clip surface
With ScreenRECT
If .Bottom > 600 Then
RectTEMP.Bottom = RectTEMP.Bottom - (.Bottom - 600)
.Bottom = 590
End If
If .Left < 0 Then
RectTEMP.Left = RectTEMP.Left - .Left
.Left = 0
CoorX = 0
End If
If .Right > 800 Then
RectTEMP.Right = RectTEMP.Right - (.Right - 800)
.Right = 800
End If
If .Top < 0 Then
RectTEMP.Top = RectTEMP.Top - .Top
.Top = 0
CoorY = 0
End If
End With
End If
If transparent = True Then
Call ddsBack.BltFx(DestRECT, surface, RectTEMP, DDBLT_WAIT Or DDBLT_KEYSRCOVERRIDE, ddfx)
Else
Call ddsBack.Blt(DestRECT, surface, RectTEMP, DDBLT_WAIT)
End If
End Sub
Public Sub DDBltTranslucent(surface As DirectDrawSurface7, RECTvar As RECT, CoorX As Integer, CoorY As Integer, Optional transparent As Boolean = True)
‘This sub will use SrcPaint to draw a semi-transparent
‘image. Typically for use with shadows, etc.
Dim DestRECT As RECT
With DestRECT
.Top = 0
.Left = 0
.Right = 54
.Bottom = 50
End With
Dim fx As DDBLTFX
‘With fx
‘.lROP = SRCPAINT
‘ .ddckDestColorKey_high = RGB(0, 0, 0)
‘ .ddckDestColorKey_low = RGB(0, 0, 0)
‘End With
fx.lROP = vbSrcPaint
Call ddsBack.BltFx(DestRECT, surface, RECTvar, DDBLT_WAIT Or DDBLT_ROP, fx)
End Sub
Public Sub DDBltFastAnim(surface As DirectDrawSurface7, RECTvar As RECT, x As Integer, y As Integer, FrameNumber As Integer, FrameWidth As Integer, Optional transparent As Boolean = True, Optional Clip As Boolean = True)
‘This sub will draw animations. Meaning that the
‘part of the picture will be drawn according to the
‘frame number. The pics in the file have to be in
‘1 strip. Wont work with clipper.
RECTvar.Left = FrameWidth * FrameNumber - FrameWidth
RECTvar.Right = FrameWidth * FrameNumber
‘CLIPPING
‘Temporary rect
Dim RectTEMP As RECT
RectTEMP = RECTvar
If Clip = True Then
‘Set up screen rect for clipping
Dim ScreenRECT As RECT
With ScreenRECT
.Top = y
.Left = x
.Bottom = y + RectTEMP.Bottom
.Right = x + FrameWidth
End With
‘Clip surface
With ScreenRECT
If .Bottom > 600 Then
RectTEMP.Bottom = RectTEMP.Bottom - (.Bottom - 600)
.Bottom = 600
End If
If .Left < 0 Then
RectTEMP.Left = RectTEMP.Left - .Left
.Left = 0
x = 0
End If
If .Right > 800 Then
RectTEMP.Right = RectTEMP.Right - (.Right - 800)
.Right = 800
End If
If .Top < 0 Then
RectTEMP.Top = RectTEMP.Top - .Top
.Top = 0
y = 0
End If
End With
End If
If transparent = True Then
Call ddsBack.BltFast(x, y, surface, RectTEMP, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY)
Else
Call ddsBack.BltFast(x, y, surface, RectTEMP, DDBLTFAST_WAIT)
End If
End Sub
Public Sub DDBltAnim(surface As DirectDrawSurface7, RECTvar As RECT, CoorX As Integer, CoorY As Integer, FrameNumber As Integer, FrameWidth As Integer, Optional transparent As Boolean = True, Optional Clip As Boolean = True)
‘This sub will draw animations. This is the same as the sub above
‘but will work with clipper.
RECTvar.Left = FrameWidth * FrameNumber - FrameWidth
RECTvar.Right = FrameWidth * FrameNumber
Dim DestRECT As RECT
DestRECT.Top = CoorY
DestRECT.Left = CoorX
DestRECT.Right = CoorX + FrameWidth
DestRECT.Bottom = CoorY + RECTvar.Bottom
If transparent = True Then
Call ddsBack.BltFx(DestRECT, surface, RECTvar, DDBLT_WAIT Or DDBLT_KEYSRCOVERRIDE, ddfx)
Else
Call ddsBack.Blt(DestRECT, surface, RECTvar, DDBLT_WAIT)
End If
End Sub
Public Sub DDDrawBox(surface As DirectDrawSurface7, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Width As Integer, Col As Long)
‘Draws a box on a specified surface
Dim x As Integer
‘Get the previous colour of the surface
Dim PrevColour As Long
PrevColour = surface.GetForeColor
surface.SetForeColor Col
For x = 1 To Width
surface.DrawBox x1 + x, y1 + x, x2 - x, y2 - x
Next
‘Reset
surface.SetForeColor PrevColour
End Sub
Public Sub DDLock(surface As DirectDrawSurface7, x As Integer, y As Integer, picWidth As Integer, picHeight As Integer, Ddsd As DDSURFACEDESC2)
‘Locks a surface and gets the memory pointer.
Dim tempRECT As RECT
With tempRECT
.Top = y
.Left = x
.Right = x + picWidth
.Bottom = y + picHeight
End With
surface.Lock tempRECT, Ddsd, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
End Sub
Public Sub DDAlphaBlend1(destSurface As DirectDrawSurface7, srcSurface As DirectDrawSurface7, CoorX As Integer, CoorY As Integer, srcRECT As RECT, Alphavalue As Integer)
‘This subroutine will alpha-blend two surfaces.
‘This is the slower version using SetLockedPixel
Dim DestRECT As RECT
With DestRECT
.Top = CoorY
.Bottom = CoorY + srcRECT.Bottom
.Left = CoorX
.Right = CoorX + srcRECT.Right
End With
Dim Alpha As Integer ‘alpha value
Dim ddsdTEMP1 As DDSURFACEDESC2
Dim ddsdTEMP2 As DDSURFACEDESC2
Dim SrcCol1 As Long, SrcCol2 As Long
Dim RMask&, GMask&, BMask&
Dim FinalCol As Long
Dim x%, y%
‘Dim PixelNum As Integer
‘Dim nOffset As Long
‘Dim nColor16 As Long
Dim PixelColor As Long
Alpha = (256 - Alphavalue)
‘Destination surface description
ddsdTEMP1.lWidth = DestRECT.Right
ddsdTEMP1.lHeight = DestRECT.Bottom
‘Source surface description
ddsdTEMP2.lWidth = srcRECT.Right
ddsdTEMP2.lHeight = srcRECT.Bottom
‘Lock the surfaces
destSurface.Lock DestRECT, ddsdTEMP1, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
srcSurface.Lock srcRECT, ddsdTEMP2, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
For x = DestRECT.Left To DestRECT.Right
For y = DestRECT.Top To DestRECT.Bottom
‘Get the colour for the dest surface
SrcCol1 = destSurface.GetLockedPixel(x, y)
‘Get colour for src surface
SrcCol2 = srcSurface.GetLockedPixel(x, y)
If SrcCol2 = 0 Then GoTo endit
‘Get RGB Masks
RMask = RGB16Desc.Mask.rgbRed
GMask = RGB16Desc.Mask.rgbGreen
BMask = RGB16Desc.Mask.rgbBlue
‘Blending algorithm
FinalCol = (RMask And (((SrcCol1 And RMask) * Alpha + (SrcCol2 And RMask) * Alphavalue) / 256)) _
Or (GMask And (((SrcCol1 And GMask) * Alpha + (SrcCol2 And GMask) * Alphavalue) / 256)) _
Or (BMask And (((SrcCol1 And BMask) * Alpha + (SrcCol2 And BMask) * Alphavalue) / 256))
‘Draw the final pixel
destSurface.SetLockedPixel x, y, FinalCol
endit:
Next
Next
‘Unlock
destSurface.Unlock DestRECT
srcSurface.Unlock srcRECT
End Sub
Public Sub DDAlphaBlend3(destSurface As DirectDrawSurface7, srcSurface As DirectDrawSurface7, CoorX As Integer, CoorY As Integer, srcRECT As RECT, Alphavalue As Integer)
‘This sub will alpha-blend two images. Uses CopyMemory!
Dim DestRECT As RECT
With DestRECT
.Top = CoorY
.Bottom = CoorY + srcRECT.Bottom
.Left = CoorX
.Right = CoorX + srcRECT.Right
End With
Dim Alpha As Integer ‘alpha value
Dim ddsdTEMP1 As DDSURFACEDESC2
Dim ddsdTEMP2 As DDSURFACEDESC2
Dim SrcCol1 As Long, SrcCol2 As Long
Dim RMask&, GMask&, BMask&
Dim FinalCol As Long
Dim x%, y%
‘Dim PixelNum As Integer
‘Dim nOffset As Long
‘Dim nColor16 As Long
Dim PixelColor As Long
Alpha = (256 - Alphavalue)
‘Destination surface description
ddsdTEMP1.lWidth = DestRECT.Right
ddsdTEMP1.lHeight = DestRECT.Bottom
‘Source surface description
ddsdTEMP2.lWidth = srcRECT.Right
ddsdTEMP2.lHeight = srcRECT.Bottom
‘Lock the surfaces
destSurface.Lock DestRECT, ddsdTEMP1, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
srcSurface.Lock srcRECT, ddsdTEMP2, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
For x = DestRECT.Left To DestRECT.Right
For y = DestRECT.Top To DestRECT.Bottom
‘Get the colour for the dest surface
SrcCol1 = DDGetPixel(destSurface, x, y)
‘Get colour for src surface
SrcCol2 = DDGetPixel(srcSurface, x, y)
If SrcCol2 = 0 Then GoTo endit
‘Get RGB Masks
RMask = RGB16Desc.Mask.rgbRed
GMask = RGB16Desc.Mask.rgbGreen
BMask = RGB16Desc.Mask.rgbBlue
‘Blending algorithm
FinalCol = (RMask And (((SrcCol1 And RMask) * Alpha + (SrcCol2 And RMask) * Alphavalue) / 256)) _
Or (GMask And (((SrcCol1 And GMask) * Alpha + (SrcCol2 And GMask) * Alphavalue) / 256)) _
Or (BMask And (((SrcCol1 And BMask) * Alpha + (SrcCol2 And BMask) * Alphavalue) / 256))
‘Draw the final pixel
DDSetPixel destSurface, x, y, FinalCol
endit:
Next
Next
‘Unlock
destSurface.Unlock DestRECT
srcSurface.Unlock srcRECT
End Sub
Public Sub DDAlphaBlend2(destSurface As DirectDrawSurface7, srcSurface As DirectDrawSurface7, CoorX As Integer, CoorY As Integer, srcRECT As RECT, Alphavalue As Integer)
‘This sub will alpha-blend two images. This is faster than
‘DDAlphaBlend1 because it uses GetLockedArray instead of sloppy
‘direct pixel editing.
Dim DestAlphaArray() As Byte
Dim DestRECT As RECT
With DestRECT
.Top = CoorY
.Left = CoorX
.Right = CoorX + srcRECT.Right
.Bottom = CoorY + srcRECT.Bottom
End With
Dim ddsdTEMP1 As DDSURFACEDESC2
Dim ddsdTEMP2 As DDSURFACEDESC2
Dim x As Integer, y As Integer
Dim Alpha
Alpha = (256 - Alphavalue)
Dim srcBlue As Byte
Dim srcGreen As Byte
Dim srcRed As Byte
Dim destBlue As Byte
Dim destGreen As Byte
Dim destRed As Byte
Dim FinalBlue As Byte
Dim FinalGreen As Byte
Dim FinalRed As Byte
‘Destination surface description
ddsdTEMP1.lWidth = DestRECT.Right
ddsdTEMP1.lHeight = DestRECT.Bottom
‘Source surface description
ddsdTEMP2.lWidth = srcRECT.Right
ddsdTEMP2.lHeight = srcRECT.Bottom
Dim SrcArray() As Byte
destSurface.Lock DestRECT, ddsdTEMP1, DDLOCK_WAIT, 0
destSurface.GetLockedArray DestAlphaArray()
srcSurface.Lock srcRECT, ddsdTEMP2, DDLOCK_WAIT, 0
srcSurface.GetLockedArray SrcArray()
‘alpha blending
For y = 0 To UBound(SrcArray(), 2)
For x = 0 To UBound(SrcArray(), 1) Step 3
srcBlue = SrcArray(x, y)
srcGreen = SrcArray(x + 1, y)
srcRed = SrcArray(x + 2, y)
destBlue = DestAlphaArray(x + (CoorX * 3), y + CoorY)
destGreen = DestAlphaArray(x + (CoorX * 3) + 1, y + CoorY)
destRed = DestAlphaArray(x + (CoorX * 3) + 2, y + CoorY)
FinalBlue = CByte(destBlue * (256 - Alphavalue) / 256 + srcBlue * Alphavalue / 256)
FinalGreen = CByte(destGreen * (256 - Alphavalue) / 256 + srcGreen * Alphavalue / 256)
FinalRed = CByte(destRed * (256 - Alphavalue) / 256 * srcRed * Alphavalue / 256)
DestAlphaArray(x + (CoorX * 3), y + CoorY) = FinalBlue
DestAlphaArray(x + (CoorX * 3) + 1, y + CoorY) = FinalGreen
DestAlphaArray(x + (CoorX * 3) + 2, y + CoorY) = FinalRed
Next x
Next y
destSurface.Unlock DestRECT
srcSurface.Unlock srcRECT
End Sub
Public Sub DDSetPixel(surface As DirectDrawSurface7, x As Integer, y As Integer, Col As Long)
‘This sub plots a pixel to a surface.
‘NOTE: Surface must be locked. This is slower than CopyMemory
surface.SetLockedPixel x, y, Col
End Sub
Public Function DDGetPixel(surface As DirectDrawSurface7, x As Integer, y As Integer)
‘This function returns the colour of a pixel on a surface.
‘NOTE: Surface must be locked. Slower than using CopyMemory
DDGetPixel = surface.GetLockedPixel(x, y)
End Function
Public Sub DDGetPixel2(surface As DirectDrawSurface7, x As Integer, y As Integer, Col As Long)
‘Gets the colour of a pixel using CopyMemory
Dim nOffset As Long
Dim nColor16 As Long
Dim PixelColor As Long
Dim SrcArray() As Byte
End Sub
Public Sub DDUnlock(surface As DirectDrawSurface7, x As Integer, y As Integer, picWidth As Integer, picHeight As Integer)
‘Unlocks a previously locked surface
Dim tempRECT As RECT
With tempRECT
.Top = y
.Left = x
.Right = x + picWidth
.Bottom = y + picHeight
End With
surface.Unlock tempRECT
End Sub
Public Sub DDFlip()
On Error Resume Next
‘This sub flips the backbuffer onto the primary surface
ddsFront.Flip Nothing, DDFLIP_WAIT
End Sub
Public Function BitShiftRight(ByVal intValue As Long, ByVal intShiftBy As Byte) As Variant
‘Bit shifts a value to the right
Dim lngShiftVal As Long
lngShiftVal = 2 ^ intShiftBy
BitShiftRight = Fix(intValue / lngShiftVal)
End Function
Public Function BitShiftLeft(ByVal intValue As Long, ByVal intShiftBy As Byte) As Variant
‘Bit shift a value to the left
Dim lngShiftVal As Long
lngShiftVal = 2 ^ intShiftBy
BitShiftLeft = Fix(intValue * lngShiftVal)
End Function
Public Sub DDUnload(myForm As Form)
Set ddsFront = Nothing
Set ddsBack = Nothing
‘This subroutine unloads DirectDraw.
Call DD.RestoreDisplayMode
Call DD.SetCooperativeLevel(myForm.hWnd, DDSCL_NORMAL)
End
End Sub
