What the below code is (supposed to :rolleyes:) do is create an instance of my StarClass DLL, create DirectDraw7, set the display mode, and use the outputted info from 'FS' to blit things onto the backbuffer and, ultimately, onto the screen. I have attempted DDraw once (worked) but don't have the code anymore, so could anyone give a reason as to why this doesn't work? (PsychoMark, you could help here...!)
BTW: The Immediate window fills up with the BLT debug code. ("Won't do stuff in BLT")Code:Option Explicit
Dim binit As Boolean 'Used by the program to see if everythings been 'started.
Dim FS As StarClass
Dim DX As New DirectX7 'Master Object, Everything is created from this.
Dim DD As DirectDraw7 'The DirectDraw Object, this is created from the DirectX 'Object
Dim Primary As DirectDrawSurface7
Dim Bltr As DirectDrawSurface7 'The Surface that will hold our picture.
Dim BB As DirectDrawSurface7 'These are explained in the Theory section.
Dim ddPrimary As DDSURFACEDESC2 'Describes the Primary Surface
Dim ddBltr As DDSURFACEDESC2 'Describes our picture
Dim ddInfo As DDSURFACEDESC2 'holds screen information 'Descriptions: These are needed before you can create a surface. They 'describe it's initial Height, Width and other information. ddsd stands for 'Direct Draw Surface Description
Dim bRUNNING As Boolean 'Check if the program is still running
Dim CurModeActiveStatus As Boolean 'Used to check if users computer 'supports the requested display mode
Dim bRestore As Boolean 'An error handling flag
Private Sub Form_Load()
Set FS = New StarClass
Init
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' EndIt
End Sub
Private Sub Form_Paint()
BLT
End Sub
Sub Init()
On Local Error GoTo errOut
Set DD = DX.DirectDrawCreate("")
Me.Show
FS.ColourHigh = RGB(255, 255, 255)
FS.ColourLow = RGB(0, 0, 0)
FS.NumStars = 500
Call DD.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE) 'THIS IS PART OF THE ABOVE LINE. WHEN PASTING IT, MAKE SURE ITS ALL ON 'THE SAME LINE
Call DD.SetDisplayMode(640, 480, 16, 0, DDSDM_DEFAULT)
2
FS.Enabled = True
ddPrimary.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
ddPrimary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
ddPrimary.lBackBufferCount = 1
Set Primary = DD.CreateSurface(ddPrimary)
Dim caps As DDSCAPS2
caps.lCaps = DDSCAPS_BACKBUFFER
Set BB = Primary.GetAttachedSurface(caps)
BB.GetSurfaceDesc ddInfo
BB.SetFontTransparency True
BB.SetForeColor RGB(121, 55, 0)
InitSurfaces
binit = True
bRUNNING = True
Do While bRUNNING
FS.Redraw
BLT
DoEvents
Loop
Exit Sub
errOut:
EndIt
Debug.Print "It was the INIT sub"
End Sub
Function ExModeActive() As Boolean
Dim TestCoopRes As Long
TestCoopRes = DD.TestCooperativeLevel
If (TestCoopRes = DD_OK) Then
ExModeActive = True
Else
ExModeActive = False
Debug.Print "''I DID IT!'' --ExModeActive"
End If
End Function
Sub InitSurfaces()
Set Bltr = Nothing
ddBltr.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
ddBltr.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
ddBltr.lWidth = 1
ddBltr.lHeight = 1
Set Bltr = DD.CreateSurface(ddBltr)
End Sub
Sub BLT()
Dim Q
On Local Error GoTo errOut
If binit = False Then Exit Sub
Dim ddrval As Long
Dim rMain As RECT
bRestore = False
Do Until ExModeActive
DoEvents
bRestore = True
Loop
DoEvents
If bRestore Then
bRestore = False
DD.RestoreAllSurfaces
InitSurfaces
End If
rMain.Bottom = 1
rMain.Right = 1
For Q = 1 To FS.NumStars
BlitStar CLng(Q)
Next Q
Primary.Flip BB, DDFLIP_WAIT
errOut:
Debug.Print "Won't do stuff in BLT"
End Sub
Function BlitStar(NumStar As Integer)
Dim A As userStar
Dim rMain As RECT
rMain.Bottom = 1
rMain.Right = 1
FS.GetStarData NumStar
A = FS.curStarData
Bltr.BltColorFill rMain, A.Colour
BB.BltFast 0, 0, Bltr, rMain, DDBLTFAST_WAIT
End Function
Sub EndIt()
Call DD.RestoreDisplayMode
Call DD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
End
End Sub
