unit U_Mastermind;
{Copyright 2001, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved.

 Mastermind is a registered trademark of Pressman Toy Corporation
 }

interface

uses
Windows, Messages, ImgList, Controls, StdCtrls, Buttons, ExtCtrls,
  Classes, SysUtils, Graphics, Forms, Dialogs;
Const
NbrColors=6;
   maxpatterns=Nbrcolors*NbrColors*Nbrcolors*Nbrcolors;
   maxguesses=10;
type
TPattern=array[1..4] of byte; {a set of pegs}
TPatRec = record
Pattern:TPattern;
    OKFlag:Boolean;  {this pattern is available for use}
end;
  TGuessRec=record    {and guess and the resulting score}
patternNbr,nbrinpos,nbroutofpos:integer;
end;
  TMouseModes=(GetGuess,GetNbrRight);
  TRunModes=(Running,Solved,OutofGuesses,GaveUp,UserError);

  TForm1 = class(TForm)
    StartBtn: TButton;
    RoleBox: TRadioGroup;
    ImageList1: TImageList;
    OKBtn: TBitBtn;
    GiveUpBtn: TButton;
    BoardImage: TPaintBox;
    InstLbl: TLabel;
    OKBtn2: TBitBtn;
    InstLbl2: TLabel;
    SecretBox: TGroupBox;
    PaintBox1: TPaintBox;
    MsgLoc: TLabel;
    ExitBtn: TButton;
    VerboseBox: TCheckBox;
    ShowVerboseBtn: TButton;
procedure StartBtnClick(Sender: TObject);
procedure BoardImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
procedure OKBtnClick(Sender: TObject);
procedure GiveUpBtnClick(Sender: TObject);
procedure BoardImagePaint(Sender: TObject);
procedure OKBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure ExitBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure VerboseBoxClick(Sender: TObject);
procedure ShowVerboseBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
BoardPic:TPicture;
    Level:integer;  {Play level: 1=Beginner, 2=good, 3=unbeatable}
SecretPattern:TPattern;
    CurGuesses:array [1..maxguesses] of TGuessrec;
    CurGuessCount:Integer;
    Patterns:array[1..maxpatterns] of TPatRec;
    TwoPair:array[1..maxpatterns] of integer;
    nbrpairs:integer;
{nbrinpos,nbroutofPos:integer;}
offseth,offsetw,incrx,incry:integer;
    UserGuess, UserNbrRight:TPattern;
    HelpScore:boolean;
    RunMode:TRunModes;
    MouseMode:TMouseModes;
    Workimage,BigPeg,SmallPeg:TBitmap;
    verbose:boolean;
    TotOK:integer;  {# of eligible patterns - used for verbose reporting}
Procedure InitPatterns;
Function Eligible(Const guessrec:TGuessrec; const testpatnbr:Integer):boolean;
Procedure MakeGuess;
Procedure Score(Const Masterpat:TPattern; var TestGuess:TGuessrec);
Procedure GetScoreFromUser;
Procedure showBigpeg(colornbr,col,row:integer; Paintbox:TPaintBox);
Procedure ShowSmallPeg(pegcolor:TColor;col,row:integer);
Procedure ShowGuess;
Procedure ShowNbrRight;
Procedure DrawBoard;
Procedure GetUserGuess;
Function patternOK(Const pattern:TPattern):boolean;
Function makepatternstr(patnbr:integer):string;
end;

var
Form1: TForm1;

implementation

uses U_SelectPattern, U_ShowPattern, U_GetHiderOptions, U_Verbose;

{$R *.DFM}

Const
colors:array[1..NbrColors]of char=('R','B','G','V','Y','L');

{********************* TForm1.DrawBoard ******************}
Procedure TForm1.DrawBoard;
var
itop,ileft:integer;
  r:TRect;
  i,j:integer;
  bkcolor:TColor;
Begin
bkcolor:=rgb(150,150,150);
with BoardImage do
Begin
color:=bkcolor;
    canvas.rectangle(0,0,width,height);
for i:= 0 to 3 do
for j:= 0 to maxguesses-1 do
Begin
ileft:=offsetw+i*incrx+4;
      itop:=offseth+j*incry+4;
      r:=rect(ileft,itop,ileft+incrx-4,itop+incry-4);
      canvas.moveto(0,itop+incry-2);
      canvas.lineto(width,itop+incry-2);
      canvas.draw(ileft,itop,BigPeg);
end;
for i:= 0 to 3 do
for j:= 0 to maxguesses-1 do
Begin
ileft:=offsetw+5*incrx+4;
If i mod 2 >0 then ileft:= ileft+incrx div 2;
      itop:=offseth+j*incry+4;
If i>=2 then itop:=itop + incry div 2;
      r:=rect(ileft,itop,ileft+incrx div 2-4,itop+incry div 2-4);
      canvas.draw(ileft,itop,SmallPeg);
end;
end;
end;

{********************** TForm1.ShowBigPeg ******************}
Procedure TForm1.showBigpeg(colornbr,col,row:integer; Paintbox:TPaintbox);
var
itop,ileft:integer;
Begin
workimage.height:=incry;
  workimage.width:=incrx;
  Imagelist1.Getbitmap(colornbr-1,workimage);
  itop:=trunc(offseth+4+(row-1)*incry);
  ileft:=trunc(offsetw+4+(col-1)*incrx);
{r:=rect(ileft,itop,ileft+incrx-4,itop+incry-4);}
Paintbox.canvas.draw(ileft-2,itop-2,workimage) ;
End;

{********************* TForm1.ShowSmallPeg *****************}
Procedure TForm1.ShowSmallPeg(pegcolor:TColor;col,row:integer);
var
r:TRect;
  itop,ileft:integer;
Begin
workimage.width:=incrx;
  workimage.height:=incry;
  itop:=trunc(offseth+4+(row-1)*incry);
if col >2 then itop:=itop+incry div 2;
  ileft:=trunc(offsetw+4+5*incrx);
if col mod 2 = 0 then ileft:=ileft+incrx div 2;
  r:=rect(ileft,itop,ileft+incrx div 2-4,itop+incry div 2-4);
with boardimage do
if pegcolor=clBlack then
begin
canvas.brush.color:=clblack;
    canvas.Pen.color:=clteal;
    canvas.pen.width:=2;
    canvas.ellipse(r.left,r.top,r.Right,r.bottom);
end
else
begin
if pegcolor=clWhite then  Imagelist1.Getbitmap(7,workimage)
else if pegcolor=clred then Imagelist1.Getbitmap(6,workimage);
    canvas.stretchdraw(r,workimage) ;
end;
End;

{********************** TForm1.InitPatterns *****************}
Procedure TForm1.InitPatterns;
{initialize all 1296 patterns}
var
i,j,k,l,count:integer;
Begin
count:=0;
  nbrpairs:=0;
for i:= 1 to NbrColors do
for j:=1 to NbrColors do
for k:=1 to NbrColors do
for L:=1 to NbrColors do
Begin
inc(count);
          patterns[count].Pattern[1]:=i;
          patterns[count].Pattern[2]:=j;
          patterns[count].Pattern[3]:=k;
          patterns[count].Pattern[4]:=l;

          patterns[count].OKFlag:=true;
if ((i=j) and (k=L) and (i<>k))
or ((i=k) and (j=L) and (i<>j))
or ((i=L) and (j=k) and (i<>j))
then
Begin
inc(nbrpairs);
            twopair[nbrpairs]:=count;
end;
end;
  curguesscount:=0;
end;

function TForm1.makepatternstr(patnbr:integer):string;
{used for verbose displays}
var
i:integer;
    pat:TPattern;
begin
result:='';
    pat:=patterns[patnbr].pattern;
for i:=1 to 4 do
result:=result+colors[pat[i]];
end;


{********************* TForm1.Eligible *********************}
Function TForm1.Eligible(Const guessrec:TGuessrec;
Const testpatnbr:Integer):boolean;
var
i,j:integer;
  oldnbrrightpos,NewNbrRightPos:integer;
  oldnbrrightcolor, NewNbrRightColor:integer;
  Pat1,Pat2:TPattern;
  TestGuess:TGuessrec;



procedure makemsg(msg:string);
begin
with verboseform.listbox1 do
begin
items.add(msg + ', Testing '+makepatternstr(testpatnbr)
                  + ' against Guess '+makepatternstr(guessrec.patternnbr)
                  +format(' (%d,%d)',[guessrec.nbrinpos,guessrec.nbroutofpos]));
end;
end;

Begin
result:=true;
  oldnbrrightpos:=guessrec.nbrinpos;
  oldnbrrightcolor:=oldnbrrightpos+guessrec.nbroutofpos;
  pat1:=patterns[guessrec.patternnbr].Pattern;
  pat2:=patterns[testpatnbr].Pattern;

case level of
1:  {kind of dumb}
Begin
{Heuristics}
{#1 if colorcount is 0, then
          test pattern cannot have any of that color}
If result then
Begin
if oldnbrrightcolor=0 then
for i:= 1 to 4 do
if result then
begin
Begin
j:=1;
while (j<=4) and result do
if (pat1[i]<>pat2[j]) then inc(j)
else
begin
result:=false;
if verbose then makemsg('Heuristic 1 rejected ');
end;
end;
end;
end;

If result then
{#2 If all of guess is one color, there be exactly color count
          in any new guess}
Begin
j:=1;
For i:=2 to 4 do if pat1[i]=pat1[1] then inc(j);
if j=4 then
Begin
j:=0;
for i:= 1 to 4 do if pat2[i]=pat1[1] then inc(j);
if j<>oldNbrRightColor then
begin
result:=false;
if verbose then makemsg('Heuristic 2 rejected ');
end;
end;
end;

if result then
{#3 - Counts in test pattern must be at least as high as count in the guess}
Begin
NewNbrRightPos:=0;
        NewNbrRightColor:=0;
for i:=1 to 4 do if pat1[i]=pat2[i] then inc(Newnbrrightpos);
for i:=1 to 4 do
Begin
j:=1;
while (j<=4) and (pat1[i]<>pat2[j]) do inc(j);
if pat1[i]=pat2[j] then
Begin
inc(NewNbrrightcolor);
            pat2[j]:=255; {so we don;t count it twice}
end;
end;
if (NewNbrRightpos<OldNbrRightPos)
or (NewNbrRightcolor<OldNbrRightColor)
then
begin
result:=false;
If verbose then makemsg('Heuristic 3 rejected ');
end;
end;
end; {level=1}
2,3,4: {Pick a solution that has same score  prev guess.
      i.e. each of the 14 possible scores partitions the
      remaining patterns into 14 groups -- the correct solution has to be
      in the group matching the previous score.  This surpsising result
      is based on the symmetry of scores, score(secret pattern, guess patter)=
      score(guess pattern, secretpattern) }
Begin
If Patterns[testpatnbr].OKFlag then
Begin
with Testguess do
Begin
PatternNbr:=testpatnbr;
          nbrinpos:=-1;
          nbroutofpos:=-1;
end;
        Score(patterns[guessrec.Patternnbr].Pattern,TestGuess);
If (TestGuess.nbrinpos<>guessrec.nbrinpos)
or (TestGuess.nbroutofPos<>guessrec.nbroutofpos)
then
begin
result:=false;
end;
end
else
begin
result:=false;
end;
end; {level=2}
end; {case}
if result and verbose then makemsg('Accepted as eligible ');
end; {Eligible}

{******************** TForm1.MakeGuess ***********************}
Procedure TForm1.MakeGuess;
{Computer generates guesses here}

Procedure displayError;
var
s:string;
      i:integer;
Begin
s:='';
for i:=1 to 4
do s:=s+colors[patterns[curguesses[curguessCount].patternnbr].Pattern[i]];
If helpscore then
Begin
showmessage('System error, Last guess ' + s
                    +#13+'Program stopped - email Grandpa' );
        halt;
end
else
Begin
RunMode:=UserError;
end;
end; {displayerror}

var
i,j,k:integer;
  testguess:TGuessrec;
  minmax, minmaxguess, maxval:integer;
  maxscores:array[0..24] of integer;
  savecount:integer;
  nbrleft:integer;
  TestPatternNbrs: array[0..maxpatterns] of Integer;
  maxvalscore,minmaxscore:integer;
begin
if verbose then verboseform.listbox1.clear;
If curguesscount>0 then
{elminate from consideration all patterns which are not possible
   based on current guess}
begin
savecount:=totok;
{1. Make sure current does not get selected}
patterns[curguesses[curguesscount].patternnbr].okFlag:=false;
    dec(totOK);
{2. Flag all patterns that are not Eligible with the current guess}
For i := 1 to maxpatterns do
begin
{definition of "Eligible" depends on level}
if Patterns[i].OKFlag and (not Eligible(curguesses[curguessCount],i))
then
begin
Patterns[i].OKFlag:=false;
        dec(TotOK);
end;
end;
if verbose then verboseform.memo1.lines.add('Eligible patterns reduced from '
+ inttostr(savecount)+' to '
+ inttostr(TotOK));
end
else TotOK:=maxpatterns;
{3. for level 1 or 2, select the first eligible (i.e consistent) pattern
      as next guess}
If level<3 then
begin
i:=1;
while (i<=maxpatterns) and
(not patterns[i].OKFlag) do inc(i);
If not patterns[i].OKFlag then displayerror
else
begin
inc(curguessCount);
with curguesses[curguessCount] do
begin
patternnbr:=i;
        nbrinpos:=-1;
        nbroutofpos:=-1;
end;
end;
end
else {for level 3 - use min-max technique}
Begin
{for each possible guess, get the distribution of scores
     when tested against all eligibles.  Save the largest of these for each guess.
     The pattern we want for our next guess is smallest of these}

{For speed build a pruned array of just the eligible patterns,
     we can go through this list without checking for eligibility}
nbrLeft:=0;
for i:=1 to maxpatterns do
begin
if patterns[i].OKFlag then
begin
inc(NbrLeft);
        testpatternNbrs[Nbrleft]:=i;
end;
end;


    i:=1;
    minmax:=9999;
    minmaxguess:=0;
for i := 1 to nbrleft do {for all possible guesses}
Begin
for j:= 0 to 20 do maxscores[j]:=0;
      testguess.patternnbr:=TestPatternNbrs[i];
{here's the trickiest part, find out which of the 14 possible
      scoresets, each of the remaing eligible scores belongs to}
for j:= 1 to nbrleft do
begin
Score(Patterns[TestpatternNbrs[j]].pattern, testguess);
        k:=5*testguess.nbrinpos+testguess.nbroutofpos;
        inc(maxscores[k]);
end;
      maxval:=0;
{now find the largest};
for j:=0 to 20 do  {highest subscrupt will be 5*4=20}
if maxscores[j]>maxval then
begin
maxval:=maxscores[j];
        maxvalscore:=j;  {for ver bose display}
end;
if maxval<minmax then
begin
minmaxguess:=testpatternNbrs[i];
        minmax:=maxval;
        minmaxscore:=maxvalscore;
end;
if verbose then verboseform.listbox1.items.add
            ('Min-max max scoreset size for '+ makepatternstr(testpatternnbrs[i])
             +' is '+inttostr(minmax)+ '('+inttostr(minmaxscore div 5)
             +','+inttostr(minmaxscore mod 5)+')');
end; {for i}
{we've determined which pattern score contains the minimum maximum number
    of members, that's our next guess}

if minmaxguess>0 then
Begin
inc(curguessCount);
with curguesses[curguessCount] do
Begin
patternnbr:=minmaxguess;
        nbrinpos:=-1;
        nbroutofpos:=-1;
end;
end
else DisplayError;
end;
if verbose then verboseform.Memo1.lines.add(makepatternstr(curguesses[curguesscount].patternnbr)
                               + ' selected as next guess');
End;  {makeguess}

{*************** TForm1.Score *********************}
Procedure TForm1.Score(Const Masterpat:TPattern;
var TestGuess:TGuessrec);
var
i,j:Integer;
  pat1,pat2:TPattern;
Begin
with Testguess do
Begin
nbrinpos:=0;
      nbroutofpos:=0;
      pat2:=patterns[{testguess.}patternnbr].Pattern;
      pat1:=MasterPat;

for i:= 1 to 4 do if pat2[i]=pat1[i] then inc(nbrinpos);
for i:= 1 to 4 do
for j:=1 to 4 do
If (pat2[i]=pat1[j]) and (pat2[i]<>255) then
Begin
inc(nbroutofpos);
        pat2[i]:=255; {don't match this one against any more}
pat1[j]:=255; {and don't match any other pat1 againt this pat2}
end;
      nbroutofpos:=nbroutofpos-nbrinpos;
end;
end;

{*************** TForm1/GetScoreFromUser **************}
Procedure Tform1.GetScoreFromUser;
Var
i:integer;
  testguess:TGuessRec;
Begin
For i:= 1 to 4 do UserNbrRight[i]:=0;
  MouseMode:=GetNbrright;
  BoardImage.OnMouseup:=BoardimageMouseUp;
  OKBtn2.top:=offseth+incry*(curguesscount);
  OKBtn2.visible:=true;
  Instlbl2.visible:=true;
  GiveUpBtn.visible:=true;
  ExitBtn.visible:=false;
  tag:=0;

repeat
application.processmessages;
until Tag<>0;


with curguesses[curguesscount] do
Begin
nbrinpos:=0;
    nbroutofpos:=0;
end;
for i:= 1 to 4 do
if usernbrright[i]=1 then inc(curguesses[curguesscount].nbrinpos)
else if usernbrright[i]=2 then inc(curguesses[curguesscount].nbroutofpos);
If GetHiderOptions.radiogroup1.itemindex=1 then
Begin
testguess:=curguesses[curguesscount];
    Score(SecretPattern,testguess);
If curguesscount<=maxguesses then
Begin
If (testguess.nbrinpos<>curguesses[curGuessCount].nbrinpos)
or (testguess.nbroutofpos<>curguesses[curguesscount].nbroutofpos)
then messagedlgpos('Oops - you made a scoring error, I''ll correct it for you',
                    mtinformation,[mbOK],0,msgloc.left,msgloc.top);
      curguesses[curguesscount]:=testguess;
for i:= 1 to 4 do showsmallpeg(clBlack,i,curguesscount);
      shownbrright;
end;
end;

  BoardImage.OnMouseup:=nil;
  OKBtn2.visible:=false;
  Instlbl2.visible:=false;
  GiveUpBtn.visible:=false;
  ExitBtn.visible:=true;
End;

{**************** TForm1.ShowGuess ***************}
Procedure TForm1.ShowGuess;
{display a guess on the board}
var
i:integer;
Begin
with patterns[curguesses[curguesscount].patternnbr] do
for i:=1 to 4 do showbigpeg(Pattern[i],i,curguesscount,BoardImage);
end;

{****************** TForm1.ShowNbrRight *****************}
Procedure TForm1.shownbrRight;
{display nbr right pegs on the oard}
var
i:integer;
begin
with curguesses[curguesscount] do
Begin
for i:=1 to nbrinpos do showsmallpeg(clRed,i,curguesscount);
for i:= 1 to nbroutofpos do showsmallpeg(clWhite,i+nbrinpos,curguesscount);
end;

End;

{******************** TForm1.GetUserGuess **************}
Procedure Tform1.GetUserGuess;
{solicit a guess from the user}
Var
i:integer;
Begin
MouseMode:=GetGuess;
For i:= 1 to 4 do UserGuess[i]:=0;
  BoardImage.OnMouseup:=BoardimageMouseUp;
  OKBtn.top:=offseth+incry*(curguesscount+1);
  OKBtn.visible:=true;
  GiveupBtn.Visible:=true;
  Instlbl.visible:=true;
  tag:=0;
repeat
application.processmessages;
until tag<>0;
  BoardImage.OnMouseup:=nil;
  OKBtn.visible:=false;
  GiveupBtn.visible:=false;
  Instlbl.visible:=false;
End;


{***************** TForm1.PatternOK ******************}
function Tform1.PatternOK(Const pattern:TPattern):boolean;
{just check to ensure that 4 colors have been selected}
var
i:integer;
Begin
result:=true;
for i:= 1 to 4 do
if pattern[i]=0 then
begin
result:=false;
      break;
end;
end;


{********************* TForm1.StartBtnClcik **************}
procedure TForm1.StartBtnClick(Sender: TObject);
{begin the solving process}
var
i:integer;
begin
StartBtn.enabled:=false;
  drawboard;
  secretbox.visible:=false;
  InitPatterns;
  RunMode:=Running;
  verboseform.memo1.lines.clear;

case RoleBox.itemindex of
0: {Computer solves}
begin
if GetHiderOptions.showmodal = mrok then
begin
application.processmessages;
      level:=GetHiderOptions.Smartbox.itemindex+1;
      helpscore:=false;
      totOK:=maxpatterns;
case GetHiderOptions.radiogroup1.itemindex of
0:  ShowpegsDlg.showmodal;
        1,2,3:
begin
if PatternDlg.showmodal<>mrOK then  {user changed his mind}
begin
StartBtn.enabled:=true;
            exit;
end;
if GetHiderOptions.radiogroup1.itemindex=2
then helpscore:=true;
          Secretpattern:=PatternDlg.UserGuess;
          secretbox.visible:=true;
for i:=1 to 4 do showbigpeg(secretpattern[i],i,1,Paintbox1);
end;

end; {case}


curguesscount:=1;
with curguesses[1] do
case level of
1,2:  patternnbr:=random(maxpatterns)+1;
        3:  patternnbr:=twopair[random(nbrpairs)+1];
end;
      ShowGuess;
If helpscore then
Begin
Score(Secretpattern, curguesses[curGuessCount]);
        ShownbrRight;
        sleep(1000);
end
else GetScoreFromUser;
while (RunMode=running) do
Begin
makeguess;
If curguesscount<=maxguesses then ShowGuess;
If helpscore then
Begin
Score(SecretPattern,curguesses[curguesscount]);
if curguesscount<=MaxGuesses then ShowNbrRight;
          sleep(1000);
end
else GetScoreFromUser;
If curguesses[curguesscount].nbrinpos=4 then RunMode:=solved;
If (curGuessCount=maxguesses) and (runmode=running) then runMode:=Outofguesses;
end;
Case RunMode of
Solved:messagedlgpos('Solved it , I win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
         OutOfGuesses: messagedlgpos('Too many guesses, you win',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
         GaveUp: messagedlgpos('You gave up, I win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
         UserError: messagedlgpos('You scored wrong, I win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top)
end; {case}
end;
end;
  1:
Begin  {user solves}
{Make a Secret pattern}
randomize;
For i:=1 to 4 do SecretPattern[i]:=random(Nbrcolors)+1;
{Loop}
repeat
GetUserGuess;
        Score(SecretPattern,curguesses[curguesscount]);
if curguesscount<=MaxGuesses then ShowNbrRight;
If curguesses[curguesscount].nbrinpos=4 then RunMode:=solved;
until not (RunMode=running) {or (curGuessCount>MaxGuesses)};
case runmode of
Solved: messagedlgpos('You solved it, you win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
        OutOfGuesses: messagedlgpos('Too many guesses, I win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
        GaveUp:messagedlgpos('You gave up, I win!',mtInformation,[mbOK],0,msgloc.left, msgloc.top);
end; {case}
If PatternOK(Secretpattern) then {4 pegs were specified in the pattern}
Begin
secretbox.visible:=true;
for i:=1 to 4 do showbigpeg(secretpattern[i],i,1,Paintbox1);
end;
end;
end; {case}
StartBtn.enabled:=true;
end;



{******************* TForm1.BoardImageMouseUp *******************}
procedure TForm1.BoardImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{collect and display guess (bigpeg) or score (smallpeg) peg data
  depending on Mousemode flag}
var
newrow,newcol:integer;
  relx, rely:integer;
begin
newcol:= (x-offsetw) div incrx+1;
  newrow:= (y-offseth) div incry+1;
If Mousemode=GetGuess then
Begin
If (newrow=curGuesscount+1) and (newcol>=1) and (newcol<=4) then
Begin
inc(userguess[newcol]);
if userguess[newcol]>6
then userguess[newcol]:=userguess[newcol]-6;
      showbigpeg(userguess[newcol],newcol,newrow,BoardImage);
end;
end
else if Mousemode=GetNbrRight then
Begin
If (newrow=curGuesscount) and (newcol=6) then
Begin
{Convert column/row for small pegs to virtual column 5 to 9}
{just for ease of counting - actual positions are not significant}
relx:=(x-offsetw-4) - 5*incrx;
      rely:=(y - offseth-4) -(newrow-1)*incry;
      newcol:= relx div (incrx div 2) + 2*(rely div (incry div 2))+5;
      inc(usernbrright[newcol-4]);
if usernbrright[newcol-4]>2 then
Begin
usernbrright[newcol-4]:=0;
        showsmallpeg(ClBlack,newcol-4,newrow);
end
else If usernbrright[newcol-4]=1 then showsmallpeg(ClRed,newcol-4,newrow)
else If usernbrright[newcol-4]=2 then showsmallpeg(Clwhite,newcol-4,newrow);
end;
end;
end;

{******************** TForm1.OKBtnClick *************}
procedure TForm1.OKBtnClick(Sender: TObject);
{score a users guess}
var
count:integer;
  i,j:integer;
  found:boolean;
begin
if not patternOK(Userguess) then messagedlgpos('Click on pegholes to set a pattern'
+#13+'Then click this button',
                                  mtInformation,[mbOK],0,msgloc.left, msgloc.top)
else
Begin
i:=0;
    found:=false;
while (not found) and (i<MaxPatterns) do
Begin
inc(i);
      count:=0;
for  j:=1 to 4 do if userguess[j]=patterns[i].Pattern[j] then inc(count);
if count=4 then found:=true;
End;
If found then
Begin
inc(curguesscount);
      Curguesses[curguesscount].patternnbr:=i;
      tag:=1;
end
Else
Begin
Showmessage('System error 2 - Email Grandpa');
      halt;
end;
end;
end;

{***************** TForm1.GiveUpBtnClick *************}
procedure TForm1.GiveUpBtnClick(Sender: TObject);
begin
RunMode:=GaveUp;
  tag:=1;
end;

{****************** BoardImagePaint *****************}
procedure TForm1.BoardImagePaint(Sender: TObject);
var
i,j:integer;
begin
drawboard;
for j:= 1 to curguesscount do
with curguesses[j], patterns[curguesses[j].patternnbr] do
Begin
for i:=1 to 4 do showbigpeg(Pattern[i],i,j,BoardImage);
for i:=1 to nbrinpos do showsmallpeg(clRed,i,j);
for i:= 1 to nbroutofpos do showsmallpeg(clWhite,i+nbrinpos,j);
end;
end;

{************** TForm1.OKBtn2Click ***********}
procedure TForm1.OKBtn2Click(Sender: TObject);
begin
tag:=1;
end;


{*************** TForm1.PaintBox1Paint **************}
procedure TForm1.PaintBox1Paint(Sender: TObject);
{repaint the secret code box as necessary}
var
i:integer;
begin
for i:=1 to 4 do showbigpeg(secretpattern[i],i,1,Paintbox1);
end;

{****************** TForm1.ExitBtnClick *****************}
procedure TForm1.ExitBtnClick(Sender: TObject);
begin
close;
end;

{****************** TForm1.FormClose ***********************}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
close;
end;

{********************* TForm1.Create ************}
procedure TForm1.FormCreate(Sender: TObject);
begin
workimage:=TBitmap.create;
  workimage.transparent:=true;
  bigpeg:=TBitmap.create;
  bigpeg.transparent:=true;
  SmallPeg:=TBitmap.create;
  SmallPeg.transparent:=true;
  incry:=Boardimage.height div (maxguesses+1);
  incrx:=Boardimage.width div 9;
  offseth:=incry div 2;
  offsetw:=incrx div 2;
with Bigpeg do
Begin
height:=incry-4;
    width:=incrx-4;
    canvas.fillrect(rect(0,0,width,height));
    canvas.brush.color:=clblack;
    canvas.Pen.color:=clteal;
    canvas.pen.width:=4;
    canvas.ellipse(4,4,width-4,height-4);
end;
With SmallPeg do
Begin
height:=incry div 2 -4;
    width:=incrx div 2 -4;
    canvas.brush.color:=clblack;
    canvas.Pen.color:=clteal;
    canvas.pen.width:=2;
    canvas.ellipse(0,0,width,height);
end;

  giveupbtn.top:=StartBtn.top;
  giveupbtn.left:=StartBtn.left;
  randomize;
end;


procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=true;
  tag:=1;
  runmode:=gaveup;
end;

procedure TForm1.VerboseBoxClick(Sender: TObject);
begin
If verbosebox.checked then
begin
verbose:=true;
    showverbosebtn.visible:=true;
end
else verbose:=false;
  verboseform.visible:=verbose;
  showverbosebtn.visible:=verbose;
end;

procedure TForm1.ShowVerboseBtnClick(Sender: TObject);
begin
verboseform.visible:=true;
end;

end.