This is "The Time Waster", a game I originally saw on the Mac that up till now has been missing a .NET port of the game. I believe this is the only game Mac's were designed to play, so really a PC should have no problem with cycles to spare :-)
Step 1
Modifying your form's startup
First thing is, we need to change the way your form starts so we can control the loading procedure. This is fairly simple to accomplish. What you need to do is create a Shared Sub Main
in your main program and set that as the startup. Don't forget to name your form frmSlider
.
Shared Sub Main()
Application.Run(New frmSlider())
Application.Exit()
End Sub
This will start up the form named frmClock
. Then when it's done, exit the application. Now we need to modify the new
procedure for the form and insert a me.show
command and an initGame
command.
Public Sub New()
MyBase.New()
InitializeComponent()
initGame()
End Sub
All that's left to do now is change the project's startup properties to make it use our Shared sub Main
and not the standard startup procedure. Go to Solution Explorer and right click on your project's properties and change the Startup Object.
Step 2
Creating the class
Public Class cPieces
Public position As Integer = 0
Public number As Integer
Private image As New Bitmap(32, 32, Imaging.PixelFormat.Format32bppRgb)
Private chords As New Point
Public Sub setLocation(ByVal loc As Integer)
Dim row = Int(loc / 5)
Dim col = loc - (row * 5)
row = row * 32
col = col * 32
chords = New Point(col, row)
position = loc
End Sub
Public Sub New(ByVal thisnumber As Integer)
Dim g As Graphics = Graphics.FromImage(image)
Dim f As New Font("Impact", 15, FontStyle.Regular)
Dim sze As SizeF = g.MeasureString(thisnumber, f)
g.FillRectangle(Brushes.White, 0, 0, image.Width, image.Height)
g.DrawRectangle(Pens.Black, 0, 0, image.Width, image.Height)
g.DrawString(thisnumber, f, Brushes.Black, _
(image.Width - sze.Width) / 2, _
(image.Height - sze.Height) / 2)
number = thisnumber
f.Dispose()
g.Dispose()
End Sub
Public Sub draw(ByVal g As Graphics)
If Not number = 24 Then
g.DrawImage(image, chords)
End If
End Sub
End Class
There really shouldn't be anything you haven't seen in here before, it's a standard class that stores the information for each tile and creates a bitmap.
SetLocation |
This Sub takes a cell location (0-24) and determines the chords and sets the position |
New |
This creates the tile and sets its number |
draw |
This draws the tile |
Step 3
Controls
Go to your form, add a PictureBox
control. Set the PictureBox
to the name game with a background color of black and set it as docked with the entire form.
Step 4
Part of the code
You always have to start out initializing your variables. See the var
pieces(24)
, that's an array of 24 items just like the game board has 24 tiles. A habit I got into a while back always has me set a debug
flag. This way in your code you can say if debug then console.writeline("x = 56")
, then when you are ready to distribute your code you can just turn the var
to False
and poof...all the debug
stuff goes away.
Public debug = True
Public pieces(24) As cPieces
Public moves As Integer = 0
Public start As Date
Next the initialization sub.
Private Sub initgame()
Dim counter As Integer
Dim nextRnd As Integer
Dim rndPos(24) As Boolean
Dim randomNum As New Random
Me.ClientSize = New Size(32 * 5, 32 * 5)
moves = 0
start = Now
For counter = 0 To 24
rndPos(counter) = False
Next
For counter = 0 To 24
Do
nextRnd = randomNum.Next(0, 25)
Loop Until rndPos(nextRnd) = False
pieces(counter) = New cPieces(counter)
pieces(counter).setLocation(nextRnd)
rndPos(nextRnd) = True
Next
game.Invalidate()
End Sub
Pretty straight forward, it initializes your values as well as determines random locations for the tiles. This part:
Do
nextRnd = randomNum.Next(0, 25)
Loop Until rndPos(nextRnd) = False
Generates a random number then checks to see that it hasn't used that number before. Very handy. Then the final command is game.invalidate()
. This tells the Paint
event to fire and redraw the box.
Now the game_paint
Sub
.
Private Sub game_Paint(ByVal sender As Object, _
ByVal e As System.Windows.Forms.PaintEventArgs) Handles game.Paint
Dim counter As Integer
For counter = 0 To 24
pieces(counter).draw(e.Graphics)
Next
End Sub
Again very straight forward, asks each tile to redraw itself. Why not run your game now and marvel at the output?
Step 5
More interesting game
Your game is not very interesting now, try as you might clicking on tiles seems to do nothing! Well, perhaps we should take care of that.
Private Sub game_MouseUp(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles game.MouseUp
Dim posX As Integer = Int((e.X * 1.06) / 32)
Dim posy As Integer = Int((e.Y * 1.06) / 32)
If debug Then
Console.WriteLine("Mouse: " & posX & ", " & posy)
End If
moveTiles(posX, posy)
End Sub
This is a standard mouse event tied to the game PictureBox
. It sends its messages to a Sub
called moveTiles
with the current tile selected. So, I guess we need a movetiles
Sub
eh?
Sub moveTiles(ByVal thisCellX As Integer, ByVal thisCelly As Integer)
Dim counter As Integer
Dim thisCell = (thisCelly * 5) + thisCellX
Dim blankCellY = Int(pieces(24).position / 5)
Dim blankCellX = pieces(24).position - (blankCellY * 5)
Dim blankCell = pieces(24).position
If debug Then
Console.WriteLine("")
Console.WriteLine("Blank Cell X: " & blankCellX & ", Y: " & _
blankCellY)
Console.WriteLine(" This Cell X: " & thisCellX & ", Y: " & _
thisCelly)
End If
If blankCellY = thisCelly Then
moves += 1
If blankCell > thisCell Then
For counter = blankCell - 1 To thisCell Step -1
swaptiles(counter, counter + 1)
Next
End If
If blankCell < thisCell Then
For counter = blankCell + 1 To thisCell
swaptiles(counter, counter - 1)
Next
End If
ElseIf blankCellX = thisCellX Then
moves += 1
If blankCell > thisCell Then
For counter = blankCell To thisCell + 5 Step -5
swaptiles(counter, counter - 5)
Next
End If
If blankCell < thisCell Then
For counter = blankCell To thisCell - 5 Step 5
swaptiles(counter, counter + 5)
Next
End If
End If
Dim Winner As Boolean = True
For counter = 1 To 24
If pieces(counter).position <> counter Then Winner = False
Next
If Winner Then
MsgBox("You have won in " & moves & " moves and wasted " & _
DateDiff(DateInterval.Minute, start, Now) & _
" minutes, don't you feel productive.", &
MsgBoxStyle.Exclamation, "Time Waster")
End If
End Sub
I'm not going to explain this, it's just basic math. If the cell and the blank are in the same row then yadda yadda yadda. However, at the end of the Sub
, I have a winners message that's triggered only if all the cells are in alignment. But wait! There is a mention of swaptiles
here, so we need to address that as well.
Private Function findtile(ByVal findme As Integer)
Dim Counter As Integer
Dim tiles(24)
For Counter = 0 To 24
tiles(pieces(Counter).position) = Counter
Next
Return tiles(findme)
End Function
Private Sub swaptiles(ByVal source As Integer, _
ByVal destination As Integer)
Dim sTileNumber = findtile(source)
Dim dTileNumber = findtile(destination)
pieces(sTileNumber).setLocation(destination)
pieces(dTileNumber).setLocation(source)
If debug Then Console.WriteLine("Swapping: Number: " & _
findtile(source) & " (Position: " & source & ") and Number: " & _
findtile(destination) & " (Position: " & destination & ")")
game.Invalidate()
End Sub
Ok, I lied, you need two more Sub
s (but they are used together). swaptiles
sends information on the cell you are clicking on but it doesn't know what occupies that cell. For instance, say you clicked on cell 11 and wanted to move it to cell 10, you can't merely say cell10=cell11. You need to know what those cells represent so you can change the values accordingly. This is where findcell
comes in. findcell
takes all the cells on the board and creates an array with the cells ordered as they appear on the playing board, then returns the number of the cell in the position you are clicking. (Phew...that was a mouthful.)
Step 6
Creating a better interface
Go to your form and drag out that good ol' menubar control and create three menu entries. Call the root menu "Game Controls" with "New" and "Exit" as its menu choices. Double click on "New" and set it to regenerate the board. Double click on "Exit" and tell it me.close
.
Private Sub MenuItem2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MenuItem2.Click
initgame()
End Sub
Private Sub MenuItem3_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles MenuItem3.Click
Me.Close()
End Sub
Well, that's it. You should have a fully working tile game.