2000-06-11 00:04

' 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)
     DECLARE SUB FormClose

     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
      OnClose = FormClose
      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
       EXIT SUB
      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

     SUB FormClose
      PLAYWAV("", SND_ASYNC)  ''-- Stop sound
     END SUB

2000-06-11 00:04