2003-05-01 00:00

'-----------------------------------------------
'MASTERMIND.BAS for RapidQ
'Freeware (c) 2003 by Dieter Folger
'
'The computer selects a row of 4 colors out of 6.
'Try to break this code (correct order of colors)
'by  clicking on the color pegs in the last row.
'There is a redo function: as long as you haven't
'clicked on the Ok-Button you can redo the last
'color choice by clicking on it. When you have made
'your choice click on the Ok-Button and you get the
'result (black peg = correct color, correct position;
'white peg = correct color, wrong position.
'A lot of informations about Mastermind are here:
'http://www.tnelson.demon.co.uk/mastermind
'-----------------------------------------------
     $INCLUDE "rapidq.inc"
     $TYPECHECK ON
     $OPTION Icon "mm.ico"
     $RESOURCE 1bmp AS "1.bmp"
     $RESOURCE 2bmp AS "2.bmp"
     $RESOURCE 3bmp AS "3.bmp"
     $RESOURCE 4bmp AS "4.bmp"
     $RESOURCE 5bmp AS "5.bmp"
     $RESOURCE 6bmp AS "6.bmp"
     $RESOURCE HelpBmp AS "help.bmp"
     $RESOURCE BlackBmp AS "black.bmp"
     $RESOURCE WhiteBmp AS "white.bmp"
     $RESOURCE Logo AS "logo.bmp"
     $RESOURCE Icon AS "mm.ico"

     DECLARE SUB NewGame
     DECLARE SUB GetCode
     DECLARE SUB ColorClick (Sender AS QCOOLBTN)
     DECLARE SUB CheckLine
     DECLARE SUB ShowCode
     DECLARE SUB Redo
     DECLARE SUB Minimize
     DECLARE SUB MessageBeep LIB "USER32" ALIAS "MessageBeep"(BYVAL Snd AS LONG)

     DIM CodeLine AS STRING, CompareLine AS STRING, Black AS BYTE
     DIM White AS BYTE, i AS INTEGER, p AS INTEGER, iLeft AS INTEGER
     DIM iTop AS INTEGER, Cell AS BYTE, Peg AS BYTE

     DIM GuessBtn(40) AS QCOOLBTN
     DIM ResultBtn(40) AS QCOOLBTN
     DIM CodeBtn(4) AS QCOOLBTN
     DIM ChoiceBtn(6) AS QCOOLBTN

     CREATE Form AS QFORM
      CAPTION = "Mastermind"
      Width = 270 : Height = 420
      Center : COLOR = &hddfafa
      delBorderIcons(biMaximize)
      IcoHandle = Icon
      onShow = NewGame
      WndProc = Minimize
      CREATE LogoBtn AS QCOOLBTN
       Left = 148 : Top = 10
       Width =  104 : Height = 30
       Bmphandle = Logo
       Hint = "Click here for a new game"
       ShowHint = 1
       onClick = NewGame
      END CREATE
      CREATE okButton AS QBUTTON
       Left = 163 : Top = 350
       CAPTION = "Ok"
       Hint = "Click when you have made your choice"
       ShowHint = 1
       onClick = CheckLine
      END CREATE
     END CREATE
     Form.SHOWMODAL
'--------------
     SUB CheckLine
'--------------
      DIM s AS STRING, Total AS BYTE, TempLine AS STRING
      IF LEN (CompareLine) < 4 THEN MessageBeep(500) : EXIT SUB
      White = 0 : Black = 0
      TempLine = CodeLine
      FOR i = 1 TO 4
       IF MID$(CompareLine,i,1) = MID$(TempLine,i,1) THEN
        CompareLine = REPLACE$(CompareLine,"§",i)
        TempLine = REPLACE$(TempLine,"%",i)
       END IF
      NEXT
      FOR i = 1 TO 4
       s = MID$(TempLine,i,1)
       p = INSTR(CompareLine,s)
       IF p THEN
        CompareLine = REPLACE$(CompareLine,"#",p)
       END IF
      NEXT
      Black = TALLY(CompareLine, "§")
      White = TALLY(CompareLine, "#")
      Total = White + Black

      INC Cell
      FOR i = 1 TO Black
       ResultBtn(Cell).BmpHandle = BlackBmp
       INC Cell
      NEXT

      FOR i = Black + 1 TO Total
       ResultBtn(Cell).BmpHandle = WhiteBmp
       INC Cell
      NEXT

      INC Cell, 3 - Total
      IF Black = 4 OR Cell = 40 THEN ShowCode
      IF Total = 0 THEN MessageBeep(500)
      CompareLine = ""
     END SUB
'------------------------------------
     SUB ColorClick (Sender AS QCOOLBTN)
'------------------------------------
 'okButton.caption = STR$(LEN(compareline))
      IF LEN(CompareLine) = 4 THEN EXIT SUB
      INC Peg
      CompareLine = CompareLine + Sender.Hint
      IF Sender.Hint = "1" THEN GuessBtn(Peg).BmpHandle = 1bmp
      IF Sender.Hint = "2" THEN GuessBtn(Peg).BmpHandle = 2bmp
      IF Sender.Hint = "3" THEN GuessBtn(Peg).BmpHandle = 3bmp
      IF Sender.Hint = "4" THEN GuessBtn(Peg).BmpHandle = 4bmp
      IF Sender.Hint = "5" THEN GuessBtn(Peg).BmpHandle = 5bmp
      IF Sender.Hint = "6" THEN GuessBtn(Peg).BmpHandle = 6bmp

     END SUB
'-------------
     SUB GetCode
'-------------
      DIM Num AS INTEGER
      RANDOMIZE TIMER
      CodeLine = ""
      CompareLine = ""
      FOR i = 1 TO 4
       Num = INT(RND * 6) + 1
       CodeLine = CodeLine + LTRIM$(STR$(Num))
      NEXT
     END SUB
'-----------
     SUB ShowCode
'-----------
      FOR i = 1 TO 4
       IF MID$(CodeLine,i,1) = "1" THEN CodeBtn(i).bmpHandle = 1bmp
       IF MID$(CodeLine,i,1) = "2" THEN CodeBtn(i).bmpHandle = 2bmp
       IF MID$(CodeLine,i,1) = "3" THEN CodeBtn(i).bmpHandle = 3bmp
       IF MID$(CodeLine,i,1) = "4" THEN CodeBtn(i).bmpHandle = 4bmp
       IF MID$(CodeLine,i,1) = "5" THEN CodeBtn(i).bmpHandle = 5bmp
       IF MID$(CodeLine,i,1) = "6" THEN CodeBtn(i).bmpHandle = 6bmp
      NEXT
      MessageBeep(500)
      IF Black = 4 THEN
       IF MESSAGEDLG("You broke the hidden code." + CHR$(13) + CHR$(10)+ "New Game?",3,1 OR 2,0)  = MrNo THEN
        END
       ELSE
        NewGame
       END IF
      ELSE
       IF MESSAGEDLG("You did not break the hidden code!" + CHR$(13) + CHR$(10) + "New Game?",3,1 OR 2,0)  = MrNo THEN
        END
       ELSE
        NewGame
       END IF
      END IF
     END SUB
'---------
     SUB REDO
'---------
      IF LEN(CompareLine) AND LEN(CompareLine) < 5 THEN
       CompareLine = MID$(CompareLine,1,LEN(CompareLine)-1)
       GuessBtn(Peg).Bmp = 0
       DEC Peg
      END IF
     END SUB
'-----------
     SUB NewGame
'-----------
      GetCode
      CompareLine = ""
      Cell = 0 : Peg = 0
      iLeft = 20 : iTop = 25
      FOR i = 1 TO 4
       CodeBtn(i).PARENT = Form
       CodeBtn(i).Left = iLeft
       CodeBtn(i).Width = 30
       CodeBtn(i).Height = 30
       CodeBtn(i).Top = 10
       CodeBtn(i).BmpHandle = HelpBmp
       CodeBtn(i).Hint = "What's the hidden code?"
       CodeBtn(i).ShowHint = 1
       iLeft = iLeft + 30
      NEXT

      iLeft = 20 : iTop = 45
      FOR i = 1 TO 40
       GuessBtn(i).PARENT = Form
       GuessBtn(i).Left = iLeft
       GuessBtn(i).Top = iTop
       GuessBtn(i).Width = 30
       GuessBtn(i).Height = 30
       GuessBtn(i).Bmp = 0
       GuessBtn(i).onClick = Redo
       INC iLeft, 30
       IF i MOD 4 = 0 THEN INC iTop, 30 : iLeft = 20
      NEXT

      iLeft =160 : iTop = 50
      FOR i = 1 TO 40
       ResultBtn(i).PARENT = Form
       ResultBtn(i).Left = iLeft
       ResultBtn(i).Top = iTop
       ResultBtn(i).Width = 20
       ResultBtn(i).Height = 20
       ResultBtn(i).Bmp = 0
       INC iLeft,20
       IF i MOD 4 = 0 THEN INC iTop,30 : iLeft = 160
      NEXT
      ResultBtn(20).onClick = ShowCode 'Cheats
      ResultBtn(20).Hint = CodeLine        'for testing
      ResultBtn(20).ShowHint = 1            'purpose

      iLeft = 15
      FOR i = 1 TO 6
       ChoiceBtn(i).PARENT = Form
       ChoiceBtn(i).Left = iLeft
       ChoiceBtn(i).Top = 350
       ChoiceBtn(i).Width = 22
       ChoiceBtn(i).Height = 22
       IF i = 1 THEN ChoiceBtn(i).BmpHandle = 1bmp
       IF i = 2 THEN ChoiceBtn(i).BmpHandle = 2bmp
       IF i = 3 THEN ChoiceBtn(i).BmpHandle = 3bmp
       IF i = 4 THEN ChoiceBtn(i).BmpHandle = 4bmp
       IF i = 5 THEN ChoiceBtn(i).BmpHandle = 5bmp
       IF i = 6 THEN ChoiceBtn(i).BmpHandle = 6bmp
       ChoiceBtn(i).onClick = ColorClick
       ChoiceBtn(i).Hint = STR$(i)
       INC iLeft,22
      NEXT
     END SUB

2003-05-01 00:00