UQ Students should read the Disclaimer & Warning

Note: This page dates from 2005, and is kept for historical purposes.

COMP1800 – Information Technology Project – VisualBasic Project

I achieved 20/20.

Compiled (WIN32) binary (48 KB)

Solved 4×4 and 3×3 game saves.

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
Code © Copyright 2003 Ned Martin

11-Sep-2003