2000-02-22 00:44

' 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

2000-02-22 00:44