' Rapid-Q Minesweeper by William Yu $TYPECHECK ON $INCLUDE "RAPIDQ.INC" $RESOURCE Flag_BMP AS "FLAG.BMP" $RESOURCE Null_BMP AS "NULL.BMP" $RESOURCE Bomb_BMP AS "MINE.BMP" $RESOURCE Wrong_BMP AS "WRONG.BMP" $RESOURCE Happy_BMP AS "HAPPY.BMP" $RESOURCE Splash_BMP AS "SPLASH.BMP" $RESOURCE Mines_ICO AS "MINES.ICO" DECLARE SUB StartButtonClick DECLARE SUB BeginnerButtonClick (Sender AS QMENUITEM) DECLARE SUB IntermediateButtonClick (Sender AS QMENUITEM) DECLARE SUB ExpertButtonClick (Sender AS QMENUITEM) DECLARE SUB ExitButtonClick DECLARE SUB MineButtonClick (Sender AS QCOOLBTN, X AS INTEGER, Y AS INTEGER) DECLARE SUB MineButtonDown (Btn%, X%, Y%, Shift%, Sender AS QCOOLBTN) DECLARE SUB MineCanvasPaint (Sender AS QCANVAS) DECLARE SUB InitMineBMP (BMP AS QBITMAP) DECLARE SUB InitMines (Mines() AS INTEGER, MineCount AS INTEGER) DECLARE SUB ShowAllMines DECLARE SUB UpdateGridSize DECLARE SUB TimerExpired (Sender AS QTIMER) DIM Font AS QFONT Font.Size = 20 DIM SplashBMP AS QBITMAP SplashBMP.BMPHandle = Splash_BMP DIM T AS DOUBLE CREATE SplashForm AS QFORM BorderStyle = bsNone Width = 299 Height = 154 Center CREATE SplashImage AS QIMAGE Align = alClient BMPHandle = Splash_BMP Width = 299 Height = 154 END CREATE Show Repaint ''-- Force immediate repaint END CREATE T = TIMER ''-- Keep track of time CREATE Form AS QFORM Caption = "Rapid-Q Minesweeper" Width = 276 Height = 365 BorderStyle = bsSingle DelBorderIcons(biMaximize) ICOHandle = Mines_ICO Center CREATE MainMenu AS QMAINMENU CREATE GameMenu AS QMENUITEM Caption = "&Game" CREATE NewItem AS QMENUITEM Caption = "&New" ShortCut = "F2" OnClick = StartButtonClick END CREATE CREATE BreakItem1 AS QMENUITEM Caption = "-" END CREATE CREATE BeginnerItem AS QMENUITEM Caption = "&Beginner" RadioItem = TRUE OnClick = BeginnerButtonClick END CREATE CREATE IntermediateItem AS QMENUITEM Caption = "&Intermediate" RadioItem = TRUE Checked = TRUE OnClick = IntermediateButtonClick END CREATE CREATE ExpertItem AS QMENUITEM Caption = "&Expert" RadioItem = TRUE OnClick = ExpertButtonClick END CREATE CREATE BreakItem2 AS QMENUITEM Caption = "-" END CREATE CREATE ExitItem AS QMENUITEM Caption = "E&xit" OnClick = ExitButtonClick END CREATE END CREATE END CREATE CREATE MainPanel AS QPANEL BevelWidth = 4 Height = Form.ClientHeight-2 Width = Form.ClientWidth-2 CREATE UpperPanel AS QPANEL Left = 10 Top = 10 Height = 40 Width = MainPanel.ClientWidth - 20 BevelOuter = bvLowered BevelWidth = 3 CREATE StartButton AS QCOOLBTN Top = 6 Left = UpperPanel.ClientWidth / 2 - 14 Width = 29 Height = 28 Hint = "New game" ShowHint = TRUE Layout = blBMPBottom BMPHandle = Happy_BMP OnClick = StartButtonClick END CREATE CREATE MineLabel AS QLABEL Align = alLeft Font = Font Caption = " 0" END CREATE CREATE TimeLabel AS QLABEL Align = alRight Font = Font Caption = "0 " END CREATE END CREATE CREATE LowerPanel AS QPANEL Left = 10 Top = 60 Height = MainPanel.ClientHeight - 70 Width = MainPanel.ClientWidth - 20 BevelOuter = bvLowered BevelWidth = 3 CREATE MineCanvas AS QCANVAS Left = 3 Top = 3 Height = LowerPanel.ClientHeight-8 Width = LowerPanel.ClientWidth-8 OnPaint = MineCanvasPaint END CREATE END CREATE END CREATE END CREATE DIM Timer1 AS QTIMER Timer1.Interval = 1000 ''-- 1 second Timer1.Enabled = FALSE Timer1.OnTimer = TimerExpired DIM MineBMP AS QBITMAP MineBMP.Width = MineCanvas.Width MineBMP.Height = MineCanvas.Height DIM Bomb AS QBITMAP Bomb.BMPHandle = Bomb_BMP DIM Wrong AS QBITMAP Wrong.BMPHandle = Wrong_BMP DIM ColTable(1 TO 8) AS INTEGER ColTable(1) = &HFF0000 ColTable(2) = &H008800 ColTable(3) = &H0000EE ColTable(4) = &H880000 ColTable(5) = &HFF00FF ColTable(6) = &H888800 ColTable(7) = &H000066 ColTable(8) = &HFFFFFF DIM MineButton(1 TO 30, 1 TO 30) AS QCOOLBTN DIM Mines(1 TO 30, 1 TO 30) AS INTEGER DIM MinesTag(1 TO 30, 1 TO 30) AS INTEGER DIM I AS INTEGER, J AS INTEGER DIM MaxX AS INTEGER, MaxY AS INTEGER, MaxMines AS INTEGER MaxX = 16: MaxY = 16: MaxMines = 40 DIM GameOver AS INTEGER GameOver = 0 DIM CellCount AS INTEGER RANDOMIZE TIMER FOR I = 1 TO 30 FOR J = 1 TO 30 MineButton(I,J).Parent = LowerPanel MineButton(I,J).Left = (J-1)*15+4 MineButton(I,J).Top = (I-1)*15+4 MineButton(I,J).Height = 15 MineButton(I,J).Width = 15 MineButton(I,J).Hint = RIGHT$(" "+STR$(I),2)+RIGHT$(" "+STR$(J),2) MineButton(I,J).OnClick = MineButtonClick MineButton(I,J).OnMouseDown = MineButtonDown IF I > MaxY OR J > MaxX THEN MineButton(I,J).Visible = FALSE END IF NEXT NEXT InitMines (Mines(), MaxMines) InitMineBMP (MineBMP) WHILE (TIMER - T < 3): WEND ''-- Splash screen will remain for 3 seconds SplashForm.Close Form.ShowModal END SUB MineButtonClick (Sender AS QCOOLBTN, X AS INTEGER, Y AS INTEGER) '-------------------------------------------------------------------- ' MineButtonClick - Called when user clicks on a button in the grid ' Purpose - Recursive routine used to reveal cells and check ' if a mine was clicked ' Input - None, X and Y are dummy parameters. '-------------------------------------------------------------------- DIM M AS INTEGER IF GameOver THEN: EXIT SUB: END IF Y = VAL(LEFT$(Sender.Hint,2)) ''-- Retrieve Y coordinate of button X = VAL(RIGHT$(Sender.Hint,2)) ''-- Retrieve X coordinate of button IF MinesTag(Y,X) <> 0 THEN: EXIT SUB: END IF ''-- Already tagged Sender.Visible = FALSE ''-- Hide button Timer1.Enabled = TRUE CellCount-- IF Mines(Y,X) = -1 THEN ''-- Clicked on Bomb Timer1.Enabled = FALSE GameOver = TRUE MineBMP.FillRect((X-1)*15+1,(Y-1)*15+1,(X-1)*15+15,(Y-1)*15+15,&H0000EE) MineBMP.Draw((X-1)*15+2,(Y-1)*15+2,Bomb.BMP) MineCanvas.Repaint PLAYWAV("BOMB.WAV", SND_ASYNC) ''-- Play sound in the background SHOWMESSAGE ("KA-BOOM!") ''-- Game over! ShowAllMines() ''-- Reveal all mines ELSE M = 0 IF Y > 1 THEN M = M + Mines(Y-1,X) IF X > 1 THEN: M = M + Mines(Y-1,X-1): END IF IF X < MaxX THEN: M = M + Mines(Y-1,X+1): END IF END IF IF Y < MaxY THEN M = M + Mines(Y+1,X) IF X > 1 THEN: M = M + Mines(Y+1,X-1): END IF IF X < MaxX THEN: M = M + Mines(Y+1,X+1): END IF END IF IF X > 1 THEN: M = M + Mines(Y,X-1): END IF IF X < MaxX THEN: M = M + Mines(Y,X+1): END IF M = ABS(M) IF M = 0 THEN IF X < MaxX THEN IF MineButton(Y,X+1).Visible THEN MineButtonClick(MineButton(Y,X+1),Y,X+1) END IF IF Y > 1 THEN IF MineButton(Y-1,X+1).Visible THEN MineButtonClick(MineButton(Y-1,X+1),Y-1,X+1) END IF END IF IF Y < MaxY THEN IF MineButton(Y+1,X+1).Visible THEN MineButtonClick(MineButton(Y+1,X+1),Y+1,X+1) END IF END IF END IF IF X > 1 THEN IF MineButton(Y,X-1).Visible THEN MineButtonClick(MineButton(Y,X-1),Y,X-1) END IF IF Y > 1 THEN IF MineButton(Y-1,X-1).Visible THEN MineButtonClick(MineButton(Y-1,X-1),Y-1,X-1) END IF END IF IF Y < MaxY THEN IF MineButton(Y+1,X-1).Visible THEN MineButtonClick(MineButton(Y+1,X-1),Y+1,X-1) END IF END IF END IF IF Y > 1 THEN IF MineButton(Y-1,X).Visible THEN MineButtonClick(MineButton(Y-1,X),Y-1,X) END IF END IF IF Y < MaxY THEN IF MineButton(Y+1,X).Visible THEN MineButtonClick(MineButton(Y+1,X),Y+1,X) END IF END IF ELSE MineBMP.TextOut((X-1)*15+4,(Y-1)*15+2,STR$(M),ColTable(M),-1) MineBMP.TextOut((X-1)*15+5,(Y-1)*15+2,STR$(M),ColTable(M),-1) END IF END IF IF CellCount = 0 THEN Timer1.Enabled = FALSE GameOver = TRUE SHOWMESSAGE ("You win!") ''-- Game over! END IF END SUB SUB MineButtonDown (Btn%, X%, Y%, Shift%, Sender AS QCOOLBTN) '-------------------------------------------------------------------- ' MineButtonDown - Called when user clicks on a button in the grid ' Purpose - Check for a right mouse button click ' Input - Btn% is the button clicked '-------------------------------------------------------------------- DIM X AS INTEGER, Y AS INTEGER DIM M AS INTEGER IF Btn% = 1 THEN '-- Right mouse button clicked Y = VAL(LEFT$(Sender.Hint,2)) X = VAL(RIGHT$(Sender.Hint,2)) IF MinesTag(Y,X) = 0 THEN Sender.BMPHandle = Flag_BMP MinesTag(Y,X) = 1 MineLabel.Caption = " "+STR$(VAL(LTRIM$(MineLabel.Caption))-1) ELSE Sender.BMPHandle = Null_BMP MinesTag(Y,X) = 0 MineLabel.Caption = " "+STR$(VAL(LTRIM$(MineLabel.Caption))+1) END IF END IF END SUB SUB MineCanvasPaint (Sender AS QCANVAS) DIM X AS INTEGER, Y AS INTEGER Sender.Draw(0,0,MineBMP.BMP) END SUB SUB InitMineBMP (BMP AS QBITMAP) DIM X AS INTEGER, Y AS INTEGER BMP.Paint(0,0,clBtnFace,clBtnFace) I = 1 FOR Y = 1 TO MaxY J = 1 FOR X = 1 TO MaxX WITH BMP .Rectangle((X-1)*15+1,(Y-1)*15+1,(X-1)*15+17,(Y-1)*15+17,&H888888) END WITH J++ NEXT I++ NEXT END SUB SUB InitMines (Mines() AS INTEGER, MineCount AS INTEGER) MineLabel.Caption = " "+STR$(MineCount) CellCount = MaxY*MaxX-MineCount FOR I = 1 TO MaxY FOR J = 1 TO MaxX Mines(I,J) = 0 MinesTag(I,J) = 0 NEXT NEXT RANDOMIZE TIMER WHILE MineCount > 0 I = RND(MaxY)+1 J = RND(MaxX)+1 IF Mines(I,J) <> -1 THEN MineCount = MineCount - 1 Mines(I,J) = -1 END IF WEND END SUB SUB ShowAllMines DIM X AS INTEGER, Y AS INTEGER FOR Y = 1 TO MaxY FOR X = 1 TO MaxX IF Mines(Y,X) = -1 THEN IF MinesTag(Y,X) = 0 THEN MineButton(Y,X).Visible = 0 MineBMP.Draw((X-1)*15+2,(Y-1)*15+2,Bomb.BMP) END IF ELSEIF MinesTag(Y,X) THEN MineButton(Y,X).Visible = 0 MineBMP.Draw((X-1)*15+2,(Y-1)*15+2,Wrong.BMP) END IF NEXT NEXT END SUB SUB StartButtonClick FOR I = 1 TO 30 FOR J = 1 TO 30 IF I <= MaxY AND J <= MaxX THEN MineButton(I,J).Visible = TRUE IF MinesTag(I,J) THEN MineButton(I,J).BMPHandle = Null_BMP END IF ELSE MineButton(I,J).Visible = FALSE END IF NEXT NEXT Timer1.Enabled = FALSE GameOver = FALSE TimeLabel.Caption = "0 " InitMines (Mines(), MaxMines) InitMineBMP (MineBMP) END SUB SUB UpdateGridSize MainPanel.Height = Form.ClientHeight-2 MainPanel.Width = Form.ClientWidth-2 LowerPanel.Width = MainPanel.ClientWidth - 20 LowerPanel.Height = MainPanel.ClientHeight - 70 UpperPanel.Width = MainPanel.ClientWidth - 20 StartButton.Left = UpperPanel.ClientWidth / 2 - 14 MineCanvas.Height = LowerPanel.ClientHeight-8 MineCanvas.Width = LowerPanel.ClientWidth-8 MineBMP.Width = MineCanvas.Width MineBMP.Height = MineCanvas.Height END SUB SUB BeginnerButtonClick (Sender AS QMENUITEM) Sender.Checked = 1 Form.Width = 8*16+29 Form.Height = 8*16+118 MaxX = 8: MaxY = 8: MaxMines = 10 UpdateGridSize StartButtonClick END SUB SUB IntermediateButtonClick (Sender AS QMENUITEM) Sender.Checked = 1 Form.Width = 16*16+20 Form.Height = 365 UpdateGridSize MaxX = 16: MaxY = 16: MaxMines = 40 StartButtonClick END SUB SUB ExpertButtonClick (Sender AS QMENUITEM) Sender.Checked = 1 Form.Width = 30*16+6 Form.Height = 365 UpdateGridSize MaxX = 30: MaxY = 16: MaxMines = 99 StartButtonClick END SUB SUB ExitButtonClick Form.Close END SUB SUB TimerExpired (Sender AS QTIMER) TimeLabel.Caption = STR$(VAL(RTRIM$(TimeLabel.Caption))+1)+" " Sender.Interval = 1000 END SUB