Let me take you on a voyage of discovery. A voyage into the deep and dark depths of the haunted hell of VB Game Programming. It’s not that bad really, but VB has never been a great game development medium due to the lack of fast graphics routines. That will not stop the intrepid programmer though, for with a little API wizardry, we can do anything!
It may cost many zillions of dollars to get a space ship into space, but all it takes is a simple API call to get our space ship onto the screen. If fact, it is only for speed that we use the API, as the lowly PaintPicture method would suffice. However, since the space ship will be zipping around, we will be using the BitBlt (pronounced ‘bitblit’) API call. It really does nothing fancy except merging two images to form one. Using a few clever tricks we will be putting the space ship onto a starry background and let it float around a bit.
Well, enough of the introduction, lets get our teeth into the API call:
Declare Function BitBlt Lib "gdi32" _ (ByVal hDestDC As Long, ByVal x As Long, _ ByVal y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal hSrcDC As _ Long, ByVal xSrc As Long, ByVal ySrc As _ Long, ByVal dwRop As Long) As Long
Phew! There’s plenty of it, but it’s pretty easy really.
At any given time when you are drawing under Windows, the area being drawn to has a number of specific characteristics, including the size, the color and the type of device. All this information is encapsulated by an object called a Device Context. Anything that you can draw to has a Device Context (referred to from now on as a DC), including printers, picture boxes and forms, although VB does its best to hide these away since they are only used with the API. All the aforementioned objects provide a handle to the DC, accessible through the hDC property. It is this property that we will be using the the hDescDC and hSrcDC parameters of the BitBlt API call.
The x and y parameters specify where the image will be painted on the destination. The nWidth and nHeight parameters specify how big the source image is. The xSrc and ySrc parameters specify whereabouts in the destination to grab the image from. Since we are using the API, you must work in pixels, so it is best to set the scalemode property to 3 – Pixels as soon as you draw any picture boxes.
The last parameter, dwRop is where the fun stuff comes in. It allows you to define the bit-wise operation that combines the pixels from the source and destination bitmaps. It uses the same constants as the PaintPicture method, which can be found in the help file. These include vbSrcCopy to make a direct copy of the source on the destination and vbSrcInvert, which we will be using later to put the ship onto the starry background.
So much for the techno-babble, lets have a look at using this call.
Start up VB and make a new ‘Standard EXE’ project. On Form1 put two picture boxes of similar size, and into Picture1, load up a picture of your pet or favourite theme park or maybe just the Windows’ clouds! Make sure that both boxes are big enough to hold this picture. Also, place two command buttons on the form.
Set the caption of the first command button to ‘Copy’. In the click event of this command button, place this code:
Private Sub Command1_Click() Picture1.ScaleMode = vbPixels Picture2.ScaleMode = vbPixels BitBlt Picture2.hDC, 0, 0, Picture2.ScaleWidth, _ Picture2.ScaleHeight, Picture1.hDC, 0, 0, _ vbSrcCopy End Sub
Set the caption of the second command button to ‘Invert’, then put this code into the click event:
Private Sub Command2_Click() BitBlt Picture2.hDC, 0, 0, Picture2.ScaleWidth, _ Picture2.ScaleHeight, Picture2.hDC, 0, 0, _ vbDstInvert End Sub
Now, fire up your program, and click on the buttons a few times….it may not quite be Paint Shop Pro, but the effect is peculiarly hypnotic! Have a play around, and see if you can get just bits of the image to invert. This is my offering:
Well, we’ve now got the basics of getting the space craft into space, it’s now time to add that extra dimension of reality…the stars. I considered making 3D-rendered burning balls of fire, but that seemed a little overkill for our Lander game, so we will just stick with yellow dots for now.
At the start of the game, we need to draw the stars onto the picture box that will eventually host the space craft. Therefore, we must loop through all of the pixels in the box and decide if we want a star at that particular point or not. We can do this with a For…Next loop, as you will see in a moment. VB provides its own function for setting a pixel’s colour, PSet, but this is extremely slow, so we will be using another API, SetPixelV.
Here’s the declaration
Declare Function SetPixelV Lib "gdi32" Alias _ "SetPixelV" (ByVal hdc As Long, _ ByVal x As Long, ByVal y As Long, _ ByVal crColor As Long) As Long
This function is virtually identical to SetPixel, except that it is faster since it does not return the actual colour set to the point. As you can see, we again must use the hDC property of the picture box. x and y are the coordinates of the point, in pixels, and crColor is the RGB colour to be set.
Getting Random Numbers
The Rnd function will return a random number between 0 and 1 inclusive. However, before we start getting random numbers, it is recommended to issue the ‘Randomize Timer’ command. The timer function returns the number of seconds elapsed since midnight. The Randomize command sets the ‘seed’ for the random number generator. Without going too deep into the complicated stuff behind it, this command effectively means that we get a different set of random numbers each time, therefore a different star pattern. To demonstrate what I mean, try replacing the ‘Timer’ with an actual number, then study the star patterns. They will be the same each time round now!
Let’s try drawing some starts now. Start a new project, and place a picture box and command button on the form. In the click event of the command button, put this code:
Private Sub Command1_Click() Randomize Timer Picture1.ScaleMode = vbPixels For starx = 0 To Picture1.ScaleWidth For stary = 0 To Picture1.ScaleHeight If Rnd < 0.005 Then SetPixelV Picture1.hdc, starx, stary, vbYellow End If Next Next End Sub
Now when you run your program and click on the button, you will get a lovely star pattern. Ahhh!
The last thing that we need now is a surface for our lander craft to land on. We'll just stick with a bog-standard VB function to do this, rather than any fancy APIs. Its name is Line, which is a bit strange considering we want to draw a box, but never mind, those guys at Microsoft have done it again!
Its anatomy, according to the help file is:
object.Line [Step] (x1, y1)-[Step] (x2, y2), [color], [B[F]]
It looks rather complicated, but just think of it as drawing a line from 'x1,y1' to 'x2,y2' in 'color'. If 'B' is specified, that a box instead of a line, and if 'F' is specified additionally, then the box is filled. No prob!
Our planet is going to be just a boring flat surface for now, but you can add extra challenges if you wish. Here is the code:
Picture1.Line (0, Picture1.ScaleHeight - 30)- _ (Picture1.ScaleWidth, Picture1.ScaleHeight), _ vbWhite, BF
The results are not very spectacular, but you can add it to the star program if you would like to see them.
Since we will be using a timer to do the drawing and moving of the craft, it would seem sensible to also check to see whether any thrust to slow the craft has been used, and change the speed appropriately. Since there is no VB command to check whether a key is pressed down, we must look to the API, and the GetAsyncKeyState function. Basically, this function returns 0 if the specified key is not pressed and has not been pressed since the previous call of the function, otherwise it will return a non-zero value.
The required declares are:
Private Declare Function GetAsyncKeyState _ Lib "user32" (ByVal vKey As Long) As Integer Private Const VK_DOWN = &H28
In the vKey parameter of the function, a number is passed referring to a certain key code, called the 'Virtual Key Code'. There is a code for every key on the keyboard, including ones to differentiate between left and right shifts, ctrls and alts. All we will be using is the down key, as a thruster.
Here is a snippet of code that we could use:
If GetAsyncKeyState(VK_DOWN) <> 0 Then ' Do thrust stuff Beep End If
Although that particular piece of code will not do much, it gives the general idea.
Well, we've now got all the ingredients for a great little Lander game, but as with any recipe, we must be careful how we put them together. There is a demo that you can refer to, or you can follow the instructions through this page, then compare your result to my result at the end.
Load yourself up a new project. On Form1, draw 3 picture boxes, and call them picEarth, picLander and picSmash. Load up two suitable pictures for the lander craft (), and a crashed version () into the picLander and picSmash picture boxes respectively. For these two boxes, set the BorderStyle to 0 - None, ScaleMode to 3 - Pixels, Visible to False, AutoRedraw to True, and finally AutoSize to True. For picEarth, set BorderStyle to 0 - Nove and ScaleMode to 3 - Pixels. Make sure that it is suitably big. I used 336x568 pixels (5040x8520 twips), and that seemed to work well.
Now, also place a timer on the form. Call it tmrGravity, and set Enabled to False and Interval to 1. Also place a command button called cmdGo, and set the caption to "Start". Also draw 3 text boxes with accompanying labels, called txtFuel, txtVSpeed and txtHeight. These will be used to provide some driving assistance to the pilot.
Well, that's basically it for the form design. Now we need to code!
Firstly, we need the API declares. We need ones for GetTickCount, BitBlt, SetPixelV and GetAsyncKeyState functions and the VK_DOWN constant. Paste these into the declarations section of the form, and make sure that they are defined as 'Private' not 'Public'. We also need 3 variables to keep control of the craft, vSpeed, LandY and Fuel, all type double. So far, we have this:
Option Explicit 'API Declares Private Declare Function GetTickCount _ Lib "kernel32" () As Long
Private Declare Function BitBlt Lib "gdi32" _ (ByVal hDestDC As Long, ByVal x As Long, _ ByVal y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal hSrcDC As Long, _ ByVal xSrc As Long, ByVal ySrc As Long, _ ByVal dwRop As Long) As Long Private Declare Function SetPixelV Lib "gdi32" _ (ByVal hdc As Long, ByVal x As Long, _ ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetAsyncKeyState _ Lib "user32" (ByVal vKey As Long) As Integer Private Const VK_DOWN = &H28
' Vertical speed of the craft Private vSpeed As Double ' The y coordinate of the craft Private LandY As Double ' The amount of fuel left Private Fuel As Double
We also need to set up the default values for these variables. Therefore in the Form_Load event, set Fuel to 700, a value suitable low to make it hard, and vSpeed and LandY to 0. Since we don't want to display all the decimal places of these double numbers, we must use the format command to display the numbers. The height is also a little trick, as it must be derived from the LandY variable and displayed as the height above the ground. Here is code to display all three values to 1 decimal place:
txtvspeed.Text = Format(vSpeed, "0.0") txtfuel.Text = Format(Fuel, "0.0") txtheight.Text = Format(picEarth.ScaleHeight _ - piclander.ScaleHeight - 30 - LandY, "0.0")
Nice and easy so far. We also need some code in the command button to enable the timer, thus starting the game. It is also worth disabling the command button just for tidiness.
Now for the more tricky bit of tmrGravity. Although the timer is set to go off every millisecond, it does not really fire 1000 times every second, so we must find another way to measure the time between one call and the next. We will do this by using a static variable. This kind of variable retains its value between callings of a procedure. Therefore, if its value is set to 1 at the end of one calling, it will still be 1 next time it is called. Put these declarations into the Timer event:
Static curtime As Long Dim timenow As Long Dim timediff As Long
The GetTickCount API function returns the number of milliseconds elapsed since Windows started, so this is ideal. During each timer event, the static variable will be set with the number of milliseconds, then the next time the event is raised, we can work out how long it was since the last time the event was called and thus calculate speeds.
This static variable will be set to 0 the first time the event is called since it has not been set previously. Therefore, when it is equal to 0, we must draw the stars and the ground, using the code earlier:
If curtime = 0 Then ' Draw the earth picEarth.Line (0, picEarth.ScaleHeight - 30) _ -(picEarth.ScaleWidth, picEarth.ScaleHeight), _ vbWhite, BF Randomize Timer Dim starx As Long, stary As Long For starx = 0 To picEarth.ScaleWidth For stary = 0 To picEarth.ScaleHeight - 30 If Rnd * 1000 < 5 Then SetPixelV picEarth.hdc, starx, stary, vbYellow End If Next Next timenow = GetTickCount curtime = timenow End If
I mentioned earlier that we would be using the vbSrcInvert BitBlt operation to put the space craft onto the back ground. The operation that is being done by vbSrcInvert operation is this:
Destination = Source XOR Destination
This is just one method of pasting the craft onto the stars, but the beauty of using XOR is that it is reversible. If you repeat the operation a second time, the results of the first call will be completely undone. This means that we can call the at the end of the timer event to paint the craft onto the stars, then again at the beginning of the next one to delete the craft, ready for the new position.
Therefore, if it is not the first time the event has been called, we need to do this painting. Add this code in before the 'End If' of the previous snippet:
'etc...curtime = timenow
Else timenow = GetTickCount ' If it isn't the first time, put back the previous background BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, _ piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert
' End If...
We now have a completely blank sky of stars, and can work out the elapsed time since the event was last called:
timediff = timenow - curtime
The next thing to take into account is the speed of the craft, and the effects of gravity on it. This is the code that is needed:
' Calculate new vertical speed based on g vSpeed = vSpeed - ((timediff / 1000) * 10)
The 10 in that equation is the acceleration due to gravity, usually measured in metres per second per second. Since timediff is in milliseconds, we must convert that to seconds before we can use it. That is most of the maths out of the way now, just the thrusters to go... Two things must be true for the thrusters to work. Firstly, they player must be pressing the down key, and secondly, there must be some fuel. This little snippet does just that, and beep if there is no fuel left:
If GetAsyncKeyState(VK_DOWN) <> 0 Then If Fuel > 0 Then ' Apply thrust: 15 is the acceleration produced vSpeed = vSpeed + ((timediff / 1000) * 15) Fuel = Fuel - ((timediff / 1000) * 150) ' Check that fuel does not go below 0 If Fuel < 0 Then Fuel = 0 Else Beep End If End If
As you can see, the formulae used here are similar to the gravity, except that they act upwards not downwards (hence vSpeed = vSpeed + rather than -).
Now we are nearly there. We need to update the craft's position, update the text boxes and also the 'time last called':
LandY = LandY - vSpeed
' Update text boxes txtvspeed.Text = Format(vSpeed, "0.0") txtfuel.Text = Format(Fuel, "0.0") txtheight.Text = Format(picEarth.ScaleHeight _ - piclander.ScaleHeight - 30 - LandY, "0.0")
' Update the 'last called time' curtime = timenow
The last bit of logic to check is whether the craft has touched down. This is done by checking the LandY variable to see if we have entered the ground. If the craft has 'touched' down, we need to check the speed to make sure that it has not gone too fast and crashed! At the same time, the craft must be drawn, either in a successful or smashed up state. If the ship has not touched down, then it should just be redraw as usual:
' If it has touched down... If LandY >= picEarth.ScaleHeight - 30 - _ piclander.ScaleHeight Then ' Make sure that it is on the surface LandY = picEarth.ScaleHeight - 30 - piclander.ScaleHeight txtheight.Text = Format(picEarth.ScaleHeight _ - piclander.ScaleHeight - 30 - LandY, "0.0") ' Stop the timer and disable the pause button... ' the game is over! tmrgravity.Enabled = False ' Figure out if it was a safe landing or not, ' and paint the appropriate craft If vSpeed > -2 Then ' If it was safe, then the craft remains intact BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, _ piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert MsgBox "Congratulations! You have landed successfully!" Else ' If it was moving too fast, it blows up! BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, _ piclander.ScaleHeight, picsmash.hdc, 0, 0, vbSrcInvert MsgBox "Smash! Oooops!" End If
' paint the craft into its new position. BitBlt picEarth.hdc, 150, LandY, piclander.ScaleWidth, _ piclander.ScaleHeight, piclander.hdc, 0, 0, vbSrcInvert
And there you have it..your very own game.
Well, it may not be Quake or the latest 3D-flight sim engine with tri-linear upside down dangly bits, but it is a start, and could quite easily beat Microsoft's offering of Flight Sim on excitement. Well maybe...
I'm afraid that's all there is time for now, but no doubt I'll be back next week with lots more exciting features to add. You could try adding some sound to the demo or any other features that you want. Maybe a high score system would be a worthy addition. See if you can beat my 'score' of only using 398.0 units of fuel!
Anyway, until next time, it's goodbye from me. If you have any comments, please feel free to post them in the feedback area below, or ask your questions on the Q and A forum.