UQ Students should read the Disclaimer & Warning
Note: This page dates from 2005, and is kept for historical purposes.
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>COMP1800 - VisualBasic Project</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
<style type="text/css">
<!--
.wrong {
background: #FF9999;
}
body {
background: url(_img/DSC04989.jpg) fixed center;
font-family: "Arial Unicode MS", Arial, Helvetica, sans-serif;
}
th, td, textarea {
border: 1px solid #000000;
padding: 0 1ex;
background: transparent;
overflow: hidden;
}
table {
border: none;
}
-->
</style>
</head>
<body>
<h1>COMP1800 – Information Technology Project – VisualBasic Project</h1>
<p>I achieved 20/20.</p>
<p><a href=".//COMP1800-project-VB-SliderGame.exe" title="Downloadable application - SliderGame">Compiled
(WIN32) binary</a> (48 KB) </p>
<p>Solved <a href=".//COMP1800-project-VB-solved4x4.sgs" title="Game save file for 4 by 4 puzzle">4×4</a> and <a href=".//COMP1800-project-VB-solved3x3.sgs" title="Game save file for 3 by 3 puzzle">3×3</a>
game saves.</p>
<p>
<textarea cols="80" rows="542" readonly="readonly" title="VisualBasic Code - Copyright 2003 Ned Martin">VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmSliderGame
BorderStyle = 0 'None
Caption = "Slider Game!"
ClientHeight = 6465
ClientLeft = 3510
ClientTop = 2970
ClientWidth = 2910
Icon = "SliderGame.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6465
ScaleWidth = 2910
Begin MSComDlg.CommonDialog cmdBox
Left = 840
Top = 2880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "*.sgs"
End
Begin VB.Frame CustomFrame
Caption = "Custom Game"
Height = 2415
Left = 240
TabIndex = 3
Top = 0
Visible = 0 'False
Width = 2415
Begin VB.HScrollBar hsbSetHeight
Height = 375
Left = 120
Max = 32
Min = 3
TabIndex = 6
Top = 1440
Value = 3
Width = 2175
End
Begin VB.HScrollBar hsbSetWidth
Height = 375
Left = 120
Max = 32
Min = 3
TabIndex = 5
Top = 600
Value = 3
Width = 2175
End
Begin VB.CommandButton cmdNewCustomGame
Caption = "New Custom Game"
Height = 375
Left = 360
TabIndex = 4
Top = 1920
Width = 1695
End
Begin VB.Label lblCustomGameWidth
Caption = "Custom Width: 3"
Height = 255
Left = 360
TabIndex = 8
Top = 240
Width = 1815
End
Begin VB.Label lblCustomGameHeight
Caption = "Custom Height: 3"
Height = 255
Left = 360
TabIndex = 7
Top = 1080
Width = 1815
End
End
Begin VB.Frame GameFrame
Height = 855
Left = 0
TabIndex = 0
Top = 120
Width = 735
Begin VB.CommandButton btnSlide
Appearance = 0 'Flat
BackColor = &H00FFFFC0&
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Index = 0
Left = 0
TabIndex = 2
Top = 0
Visible = 0 'False
Width = 495
End
End
Begin VB.Label lblMoves
AutoSize = -1 'True
Caption = "You have made x Moves"
Height = 195
Left = 0
TabIndex = 1
Top = 960
Width = 1770
End
Begin VB.Menu mnuGame
Caption = "Game"
Begin VB.Menu smnuBoardWidth
Caption = "New Game"
Begin VB.Menu mnuBoardWidth
Caption = "3×3"
Checked = -1 'True
Index = 0
Shortcut = {F3}
End
Begin VB.Menu mnuBoardWidth
Caption = "4×4"
Index = 1
Shortcut = {F4}
End
Begin VB.Menu mnuBoardWidth
Caption = "5×5"
Index = 2
Shortcut = {F5}
End
Begin VB.Menu mnuBoardWidth
Caption = "6×6"
Index = 3
Shortcut = {F6}
End
Begin VB.Menu mnuBoardWidth
Caption = "7×7"
Index = 4
Shortcut = {F7}
End
Begin VB.Menu mnuBoardWidth
Caption = "8×8"
Index = 5
Shortcut = {F8}
End
Begin VB.Menu mnuBoardWidth
Caption = "Custom..."
Index = 6
End
End
Begin VB.Menu mnuLoad
Caption = "Open Game"
Shortcut = ^O
End
Begin VB.Menu mnuSave
Caption = "Save Game"
Shortcut = ^S
End
Begin VB.Menu mnuQuit
Caption = "Quit"
Shortcut = ^Q
End
End
Begin VB.Menu mnuAbout
Caption = "About"
End
End
Attribute VB_Name = "frmSliderGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Author: Ned Martin
' Student Number: 40529927
' Designed as a University of Queensland COMP1800 Student Project
' All rights reserved by the author
' Copyright 2003 Ned Martin http://copyright.the-i.org/
' variables
Dim BoardWidth As Integer
Dim BoardHeight As Integer
Dim MoveCount As Integer
Dim ButtonTitles() As Integer
Dim CurrentTileCount As Integer
' constants
Const HBorder = 8
Const VBorder = 58
Const GameFramePadding = 8 * 15
Const TileWidth = 48
' move tiles logic
Private Sub btnSlide_Click(Index As Integer)
Dim X As Integer, Y As Integer
Dim CheckTile As Integer
Dim bMoved As Boolean
X = Index Mod BoardWidth
Y = Index \ BoardWidth
' move left
If X > 0 Then
CheckTile = Y * BoardWidth + (X - 1)
bMoved = MoveTiles(Index, CheckTile)
End If
' move right
If Not bMoved And X < BoardWidth - 1 Then
CheckTile = Y * BoardWidth + (X + 1)
bMoved = MoveTiles(Index, CheckTile)
End If
' move up
If Not bMoved And Y > 0 Then
CheckTile = (Y - 1) * BoardWidth + X
bMoved = MoveTiles(Index, CheckTile)
End If
' move down
If Not bMoved And Y < BoardHeight - 1 Then
CheckTile = (Y + 1) * BoardWidth + X
bMoved = MoveTiles(Index, CheckTile)
End If
If bMoved = True Then
MoveCount = MoveCount + 1
lblMoves.Caption = "You have made" & Str(MoveCount) & " Moves."
lblMoves.Left = Me.Width / 2 - lblMoves.Width / 2
' check if solved
Call CheckForWin
Else
' cannot move
Beep
End If
End Sub
' move tiles
Private Function MoveTiles(Index As Integer, CheckTile As Integer) As Boolean
Dim tmp As String
If btnSlide(CheckTile).Caption = "" Then
tmp = btnSlide(Index).Caption
btnSlide(Index).Caption = btnSlide(CheckTile).Caption
btnSlide(CheckTile).Caption = tmp
btnSlide(CheckTile).Visible = True
' make right tiles bold
If tmp = CheckTile + 1 Then
btnSlide(CheckTile).Font.Bold = True
Else
btnSlide(CheckTile).Font.Bold = False
End If
btnSlide(CheckTile).SetFocus
btnSlide(Index).Visible = False
' return true
MoveTiles = True
End If
End Function
' make tiles and board
Private Sub CreateBoard(X As Integer, Y As Integer)
Dim iTileWidthNumber As Integer
Dim i As Integer
' set game caption
GameFrame.Caption = "Playing" + Str(X) + " ×" + Str(Y)
CurrentTileCount = BoardWidth * BoardHeight - 1
iTileWidthNumber = 0
RandomizeTiles (CurrentTileCount)
Me.Hide
' make random tiles
For i = 0 To CurrentTileCount
If i > 0 Then
Load btnSlide(i)
End If
With btnSlide(i)
.Width = TileWidth * Screen.TwipsPerPixelX
.Height = TileWidth * Screen.TwipsPerPixelY
.Visible = True
.Left = (i Mod BoardWidth) * TileWidth * Screen.TwipsPerPixelX + GameFramePadding
.Top = (i \ BoardWidth) * TileWidth * Screen.TwipsPerPixelY + GameFramePadding * 2
If ButtonTitles(i) = -1 Then
.Caption = ""
.Visible = False
Else
.Caption = Trim(Str(ButtonTitles(i)))
' make right tiles bold
If .Caption = i + 1 Then
.Font.Bold = True
Else:
.Font.Bold = False
End If
End If
End With
Next i
GameFrame.Left = 0
GameFrame.Width = BoardWidth * TileWidth * Screen.TwipsPerPixelX + GameFramePadding * 2
Me.Width = GameFrame.Width + HBorder * Screen.TwipsPerPixelX
If Me.Width < 3030 Then
Me.Width = 3030
GameFrame.Left = Me.Width / 2 - GameFrame.Width / 2
End If
GameFrame.Height = BoardHeight * TileWidth * Screen.TwipsPerPixelY + GameFramePadding * 3
lblMoves.Top = GameFrame.Top + GameFrame.Height + GameFramePadding
MoveCount = 0
lblMoves.Caption = "You have made" & Str(MoveCount) & " Moves."
lblMoves.Left = Me.Width / 2 - lblMoves.Width / 2
Me.Height = lblMoves.Top + lblMoves.Height + VBorder * Screen.TwipsPerPixelY + GameFramePadding
Me.Show
End Sub
' randomize tiles
Private Sub RandomizeTiles(TileCount As Integer)
Randomize Timer
Dim i As Integer
Dim First As Integer, Second As Integer
Dim tmp As Integer
ReDim ButtonTitles(TileCount)
For i = 0 To TileCount
ButtonTitles(i) = i
Next i
For i = 0 To Rnd() * 5000 + 1000
First = Rnd() * TileCount
Second = Rnd() * TileCount
tmp = ButtonTitles(First)
ButtonTitles(First) = ButtonTitles(Second)
ButtonTitles(Second) = tmp
Next i
For i = 0 To TileCount
If ButtonTitles(i) = 0 Then
ButtonTitles(i) = ButtonTitles(TileCount)
ButtonTitles(TileCount) = -1
End If
Next i
End Sub
' load form
Private Sub Form_Load()
' set maximum allowable number of tiles based on screen size
hsbSetWidth.Max = (Screen.Width / Screen.TwipsPerPixelX) / TileWidth - 3
hsbSetHeight.Max = (Screen.Height / Screen.TwipsPerPixelY) / TileWidth - 3
BoardWidth = 3
BoardHeight = 3
Call CreateBoard(BoardWidth, BoardHeight)
End Sub
' check if solved
Private Sub CheckForWin()
Dim bWon As Boolean
Dim i As Integer
bWon = True
For i = 0 To CurrentTileCount - 1
If btnSlide(i).Caption <> Trim(Str(i + 1)) Then
bWon = False
End If
Next i
If bWon = True Then
Call MsgBox("You have Won in" + Str(MoveCount) + " moves", vbExclamation, "Slider Game")
End If
End Sub
' set custom height label
Private Sub hsbSetHeight_Change()
lblCustomGameHeight.Caption = "Custom Height:" + Str(hsbSetHeight.Value)
End Sub
' set custom width label
Private Sub hsbSetWidth_Change()
lblCustomGameWidth.Caption = "Custom Width:" + Str(hsbSetWidth.Value)
End Sub
' about menu
Private Sub mnuAbout_Click()
frmAbout.Show
End Sub
' set new game size
Private Sub mnuBoardWidth_Click(Index As Integer)
' confirm new game wanted
If MsgBox("Begin New Game?", vbInformation + vbYesNo) = vbYes Then
Dim i As Integer
' set menu checkmarks
For i = 0 To mnuBoardWidth.UBound
mnuBoardWidth(i).Checked = False
Next i
mnuBoardWidth(Index).Checked = True
' Custom size
If (Index = 6) Then
' hide tiles
GameFrame.Visible = False
BoardWidth = 3
BoardHeight = 3
' show custom frame
CustomFrame.Visible = True
Else
' preset sizes
CustomFrame.Visible = False
GameFrame.Visible = True
BoardWidth = Index + 3
BoardHeight = Index + 3
End If
Call DestroyBoard
Call CreateBoard(BoardWidth, BoardHeight)
End If
End Sub
' create new custom sized game
Private Sub cmdNewCustomGame_Click()
BoardWidth = Trim(Str(hsbSetWidth.Value))
BoardHeight = Trim(Str(hsbSetHeight.Value))
' hide custom options
CustomFrame.Visible = False
Call DestroyBoard
Call CreateBoard(BoardWidth, BoardHeight)
' show tiles
GameFrame.Visible = True
End Sub
' destroy tiles
Private Sub DestroyBoard()
Dim i As Integer
For i = 1 To CurrentTileCount
Unload btnSlide(i)
Next i
End Sub
' quit
Private Sub mnuQuit_Click()
End
End Sub
' save game settings
Private Sub SaveGame(strFilename As String)
Dim temp() As String
Dim i As Integer
ReDim temp(btnSlide.UBound)
For i = 0 To btnSlide.UBound
temp(i) = btnSlide(i).Caption
Next i
Open strFilename For Binary As #1
Put #1, , BoardWidth
Put #1, , BoardHeight
Put #1, , MoveCount
Put #1, , temp
Close #1
End Sub
' load game settings
Private Sub LoadGame(strFilename As String)
Dim temp() As String
Dim i As Integer
Open strFilename For Binary As #1
Get #1, , BoardWidth
Get #1, , BoardHeight
DestroyBoard
Call CreateBoard(BoardWidth, BoardHeight)
Get #1, , MoveCount
ReDim temp(btnSlide.UBound)
Get #1, , temp
Close #1
For i = 0 To btnSlide.UBound
btnSlide(i).Caption = temp(i)
If btnSlide(i).Caption = "" Then
btnSlide(i).Visible = False
Else: btnSlide(i).Visible = True
End If
Next i
lblMoves.Caption = "You have made" & Str(MoveCount) & " Moves."
lblMoves.Left = Me.Width / 2 - lblMoves.Width / 2
End Sub
' save game menu
Private Sub mnuSave_Click()
Dim tmpFileName As String
cmdBox.DialogTitle = "Save Game"
cmdBox.CancelError = True
On Error GoTo Finish
cmdBox.ShowSave
If cmdBox.FileName = "" Then Exit Sub
If Right(cmdBox.FileName, 4) = ".sgs" Then
SaveGame cmdBox.FileName
Else: SaveGame cmdBox.FileName + ".sgs"
End If
Finish:
End Sub
' load game menu
Private Sub mnuLoad_Click()
cmdBox.DialogTitle = "Open Saved Game"
cmdBox.CancelError = True
On Error GoTo Finish
cmdBox.ShowOpen
If cmdBox.FileName = "" Then Exit Sub
LoadGame cmdBox.FileName
Finish:
End Sub
</textarea>
<br />
Code © Copyright 2003 Ned Martin</p>
<p>11-Sep-2003</p>
</body>
</html>