' Sliding puzzle game, with pictures. Use keyboard or mouse. ' Written in Rapid-Q by William Yu $TYPECHECK ON DECLARE SUB CanvasPaint (Sender AS QCANVAS) DECLARE SUB CanvasClick (Sender AS QCANVAS) DECLARE SUB SplitPicture DECLARE SUB ScrambleCanvas DECLARE SUB InitCanvas DECLARE SUB ExitItemClick DECLARE SUB OpenItemClick DECLARE SUB ScrambleItemClick DECLARE SUB CheckForWin DECLARE FUNCTION CheckValidMove (X AS INTEGER, Y AS INTEGER) AS INTEGER DECLARE SUB FormKeyDown (Key AS WORD, Shift AS INTEGER) CONST False = 0 CONST True = 1 DIM Bitmap AS QBitmap DIM Piece(1 TO 16) AS QBitmap DIM Canvas(1 TO 4, 1 TO 4) AS QCanvas DIM NumMoves AS INTEGER NumMoves = 0 Bitmap.BMP = "PIC.BMP" '-- Load a 200x200 bitmap CREATE Form AS QForm Caption = "Sliding Puzzle" Color = 0 ClientHeight = 233 ClientWidth = 197 BorderStyle = 4 '-- Tool window Center OnKeyDown = FormKeyDown CREATE MainMenu AS QMainMenu CREATE GameMenu AS QMenuItem Caption = "&Game" CREATE OpenItem AS QMenuItem Caption = "&New Picture..." OnClick = OpenItemClick END CREATE CREATE ScrambleItem AS QMenuItem Caption = "&Scramble" OnClick = ScrambleItemClick END CREATE CREATE BreakItem1 AS QMenuItem Caption = "-" END CREATE CREATE ExitItem AS QMenuItem Caption = "E&xit" OnClick = ExitItemClick END CREATE END CREATE END CREATE CREATE StatusBar AS QStatusBar SizeGrip = FALSE AddPanels "","" Panel(0).Width = 80 Panel(0).Caption = " 0 Moves" END CREATE END CREATE SplitPicture InitCanvas ScrambleCanvas Form.ShowModal END '----------------------------------------------------------------------- SUB FormKeyDown (Key AS WORD, Shift AS INTEGER) DIM X AS INTEGER, Y AS INTEGER, N AS INTEGER, Done AS INTEGER N = 0 FOR Y = 1 TO 4 FOR X = 1 TO 4 N++ IF Canvas(Y,X).Hint = "16" THEN Done = TRUE EXIT FOR END IF NEXT IF Done = TRUE THEN EXIT FOR END IF NEXT SELECT CASE Key CASE 27 '' ESC Form.Close CASE IS = 37 AND X < 4 '' Left IF CheckValidMove(X+1,Y) = TRUE THEN Canvas(Y,X+1).Repaint NumMoves++ StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" CheckForWin END IF CASE IS = 38 AND Y < 4 '' Up IF CheckValidMove(X,Y+1) = TRUE THEN Canvas(Y+1,X).Repaint NumMoves++ StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" CheckForWin END IF CASE IS = 39 AND X > 1 '' Right IF CheckValidMove(X-1,Y) = TRUE THEN Canvas(Y,X-1).Repaint NumMoves++ StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" CheckForWin END IF CASE IS = 40 AND Y > 1 '' Down IF CheckValidMove(X,Y-1) = TRUE THEN Canvas(Y-1,X).Repaint NumMoves++ StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" CheckForWin END IF END SELECT END SUB SUB ScrambleCanvas DIM I AS INTEGER, J AS INTEGER DIM N AS INTEGER, M AS INTEGER DIM K AS INTEGER '-- Scrambles picture RANDOMIZE FOR I = 1 TO 50 J = INT(RND(4)+1) K = INT(RND(4)+1) N = INT(RND(4)+1) M = INT(RND(4)+1) SWAP Canvas(J,K).Hint, Canvas(M,N).Hint NEXT NumMoves = 0 StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" END SUB SUB InitCanvas DIM I AS INTEGER, J AS INTEGER DIM N AS INTEGER N = 0 FOR I = 1 TO 4 FOR J = 1 TO 4 N++ Canvas(I,J).Parent = Form Canvas(I,J).Hint = STR$(N) Canvas(I,J).Left = (J-1)*50 Canvas(I,J).Top = (I-1)*50 Canvas(I,J).Width = 49 Canvas(I,J).Height = 49 Canvas(I,J).OnPaint = CanvasPaint Canvas(I,J).OnClick = CanvasClick NEXT NEXT END SUB SUB SplitPicture DIM DRect AS QRect, SRect AS QRect DIM A AS INTEGER, Top AS INTEGER, Left AS INTEGER DRect.Top = 0 DRect.Left = 0 DRect.Right = 50 DRect.Bottom = 50 Top = 0 Left = 0 FOR A = 1 TO 15 SRect.Top = Top SRect.Left = Left*50 SRect.Right = SRect.Left+50 SRect.Bottom = SRect.Top+50 Piece(A).Height = 50 Piece(A).Width = 50 Piece(A).CopyRect(DRect, Bitmap, SRect) Left++ IF A MOD 4 = 0 THEN Top += 50 Left = 0 END IF NEXT A END SUB SUB CanvasPaint (Sender AS QCANVAS) IF Sender.Hint <> "16" THEN Sender.Draw(0,0,Piece(VAL(Sender.Hint)).BMP) Sender.TextOut(11,11,Sender.Hint,0,-1) Sender.TextOut(10,10,Sender.Hint,&HFFFFFF,-1) END IF END SUB SUB CheckForWin DIM I AS INTEGER, J AS INTEGER, N AS INTEGER DIM Done AS INTEGER N = 0: Done = FALSE FOR I = 1 TO 4 FOR J = 1 TO 4 N++ IF Canvas(I,J).Hint <> STR$(N) THEN Done = TRUE EXIT FOR END IF NEXT IF Done = TRUE THEN EXIT FOR END IF NEXT IF Done = FALSE THEN ShowMessage("Congratulations, you win!") END IF END SUB FUNCTION CheckValidMove(X AS INTEGER, Y AS INTEGER) AS INTEGER Result = FALSE SELECT CASE X CASE 1 '-- Far Left IF Canvas(Y,X+1).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y,X+1).Hint Canvas(Y,X+1).Repaint Result = TRUE END IF IF Y > 1 THEN IF Canvas(Y-1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint Canvas(Y-1,X).Repaint Result = TRUE END IF END IF IF Y < 4 THEN IF Canvas(Y+1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint Canvas(Y+1,X).Repaint Result = TRUE END IF END IF CASE 4 '-- Far Right IF Canvas(Y,X-1).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y,X-1).Hint Canvas(Y,X-1).Repaint Result = TRUE END IF IF Y > 1 THEN IF Canvas(Y-1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint Canvas(Y-1,X).Repaint Result = TRUE END IF END IF IF Y < 4 THEN IF Canvas(Y+1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint Canvas(Y+1,X).Repaint Result = TRUE END IF END IF CASE ELSE '-- Middle IF Canvas(Y,X-1).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y,X-1).Hint Canvas(Y,X-1).Repaint Result = TRUE END IF IF Canvas(Y,X+1).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y,X+1).Hint Canvas(Y,X+1).Repaint Result = TRUE END IF IF Y = 1 THEN IF Canvas(Y+1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint Canvas(Y+1,X).Repaint Result = TRUE END IF ELSEIF Y = 4 THEN IF Canvas(Y-1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint Canvas(Y-1,X).Repaint Result = TRUE END IF ELSE IF Canvas(Y-1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y-1,X).Hint Canvas(Y-1,X).Repaint Result = TRUE END IF IF Canvas(Y+1,X).Hint = "16" THEN SWAP Canvas(Y,X).Hint, Canvas(Y+1,X).Hint Canvas(Y+1,X).Repaint Result = TRUE END IF END IF END SELECT END FUNCTION SUB CanvasClick (Sender AS QCANVAS) DIM X AS INTEGER, Y AS INTEGER '-- Determine which canvas was clicked SELECT CASE Sender.Left CASE 0 : X = 1 CASE 50 : X = 2 CASE 100: X = 3 CASE 150: X = 4 END SELECT SELECT CASE Sender.Top CASE 0 : Y = 1 CASE 50 : Y = 2 CASE 100: Y = 3 CASE 150: Y = 4 END SELECT '-- Check for a valid move... IF CheckValidMove(X,Y) = TRUE THEN Canvas(Y,X).Repaint NumMoves++ StatusBar.Panel(0).Caption = " "+STR$(NumMoves)+" Moves" CheckForWin END IF END SUB SUB OpenItemClick DIM OpenDialog AS QOpenDialog OpenDialog.Filter = "*.BMP|*.BMP" IF OpenDialog.Execute THEN Bitmap.BMP = OpenDialog.FileName SplitPicture ScrambleCanvas Form.Repaint END IF END SUB SUB ScrambleItemClick ScrambleCanvas Form.Repaint END SUB SUB ExitItemClick Form.Close END SUB