unit U_GameBoards;
 {Copyright  © 2004, Gary Darby,  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
 }

{Here are three examples of ways to make and control the pieces on a game
 board. The sample game is Reversi}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, extctrls,
  Grids,StdCtrls, shellAPI;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StaticText1: TStaticText;
    Label1B: TLabel;
    ResetBtn1: TButton;
    ResetBtn2: TButton;
    ResetBtn3: TButton;
    Label2b: TLabel;
    Label3B: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure StaticText1Click(Sender: TObject);
    procedure ResetBtn1Click(Sender: TObject);
    procedure ResetBtn2Click(Sender: TObject);
    procedure ResetBtn3Click(Sender: TObject);
  public
    { Public declarations }
    panelsize:integer;
    offsetx,offsety:integer;
    boardcolor:TColor;

    {Board1 - an array of TPanles}
    board1:array [0..7,0..7]  of TPanel;
    turn1:integer;    {board1 currentplayer number 1 or 2}
    score1:array[1..2] of integer; {scores for board1}

    {Board2 - an array of TShapes on a TPanel}
    board2:array [0..7,0..7]  of TShape;
    turn2:integer;    {board2 currentplayer number 1 or 2}
    Board2BG:TPanel;
    score2:array[1..2] of integer; {scores for board2}

    {Board3 - a TStringgrid}
    board3:TStringgrid;
    turn3:integer;    {board3 currentplayer number 1 or 2}
    score3:array[1..2] of integer; {scores for board3}


    procedure panelclick(sender:TObject); {Board1 piece handling & drawing}
    procedure ShapeMouseUp(Sender: TObject;Button: TMouseButton;
                            Shift: TShiftState; X, Y: Integer); {Board2 piece handling & drawing}
    procedure Board3Select(Sender: TObject; ACol, ARow: Longint;  {Board3 piece handling}
                            var CanSelect: Boolean);

    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
                           Rect: TRect; State: TGridDrawState); {Board3 piece drawing}
    procedure showlabel(lbl:TLabel; turn:integer; score:array of integer);
    procedure showWinner(lbl:TLabel; score:array of integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);
var
  col,row:integer;
begin
  panelsize:=20;
  offsetx:=50;
  offsety:=100;
  boardcolor:=clsilver;

  {Make Board1}
  for col:=0 to 7 do
  for row:=0 to 7 do
  begin
    board1[col,row]:=TPanel.create(self);
    with board1[col,row] do
    begin
      left:=offsetx+panelsize*col;
      top:=offsety+panelsize*row;
      width:=panelsize;
      height:=panelsize;
      color:=boardcolor;
      parent:=self;
      onclick:=Panelclick;
    end;
  end;
  resetBtn1click(sender); {make board1}
  label1.left:=offsetx;   {align the labels}
  label1b.left:=offsetx;


  {Make Board 2 - TShapes}
  Board2Bg:=TPanel.create(self);
  with board2BG do
  begin
    left:=offsetx + 9*panelsize - 1;
    top:=offsety-1;
    width:=8*panelsize+2;
    height:=width;
    color:=clgreen;
    bevelinner:=bvnone;
    bevelouter:=bvnone;
    parent:=self;
  end;
  for col:=0 to 7 do
  for row:=0 to 7 do
  begin
    board2[col,row]:=Tshape.create(self);
    with board2[col,row] do
    begin
      left:=panelsize*col;
      top:=panelsize*row;
      width:=panelsize;
      height:=panelsize;
      brush.color:=boardcolor;
      parent:=Board2BG;
      shape:=stCircle;
      onmouseup:=ShapeMouseUp;
    end;
  end;
  ResetBtn2click(sender);
  label2.left:=offsetx+9*panelsize;
  label2b.left:=label2.left;

  {Make Board3 - TStringgrid }
  Board3:=TStringGrid.create(self);
  with board3 do
  begin
    colcount:=8;
    rowcount:=8;
    left:=offsetx+18*Panelsize; {Move over two board widths to start}
    top:=offsety;
    parent:=self;
    fixedcols:=0;
    fixedrows:=0;
    DefaultColwidth:=panelsize;
    DefaultRowheight:=panelsize;
    width:=8*(panelsize+gridlinewidth)+3*gridlinewidth;
    height:=width;
    color:=clgreen;
    scrollbars:=ssnone;
    defaultdrawing:=false;
    OnDrawCell:=StringGridDrawCell;
    OnSelectCell:=Board3Select;
  end;
  ResetBtn3click(sender);
  label3.left:=board3.left;
  label3b.left:=label3.left;

end;

var
  offsets:array[0..8] of TPoint = ((x:0;y:0),   {Offsets of the 8 directions to check}
                                   (x:1;y:1),
                                   (x:1;y:0),
                                   (x:1;y:-1),
                                   (x:0;y:1),
                                   (x:0;y:-1),
                                   (x:-1;y:1),
                                   (x:-1;y:0),
                                   (x:-1;y:-1)
                                   );

   playername:array[1..2] of string=('Red','Blue');


{************ ValidPoint **********}
function validpoint(x,y:integer):boolean;
{True if point (x,y) indexes a cell on the board, false if not}
begin
  result:= (x>=0) and (x<=7) and (y>=0) and (y<=7);
end;

{************* Showlabel ************}
procedure TForm1.showlabel(lbl:TLabel; turn:integer; score:array of integer);
{common routine ised by each board to show scores and turn}
var s:string;
begin
  if turn>0 then s:=playername[turn]+'''s turn,' else s:='';
  lbl.caption:=s+' Score: Red. '+ inttostr(score[low(score)])+', Blue. '+inttostr(score[high(score)]);
end;

{********** ShowWinner **********}
procedure Tform1.showWinner(lbl:Tlabel; score:array of integer);
{common routine to display winner }
var
  s:string;
begin
   if score[low(score)]>score[high(score)] then s:='Red' else s:='Blue';
   lbl.caption:='Game over, winner is '+s+'!!';
end;

{************* PanelClick *****************}
procedure TForm1.PanelClick(Sender: TObject);
{OnClick event exit for Board1 pieces - make the move and adjust colors, etc.}
   {look for cell adjacent to clicked square that is opponent's color
    and has cell of our color inline in one of the eight possible directions}

   function validmove(frompoint:TPoint; turn:integer):boolean;
   {is is a valid click location? return true if yes}
   var
     i,j,xx,yy:integer;
     OK:boolean;
   begin
     i:=0;
     ok:=false;
     if board1[frompoint.x, frompoint.y].tag=0 then
     begin
       while (i<8) and (not OK) do {check all directions until we find 1st valid move}
       {moving will have to checkl all directions, but here we only need to find the
        one valid direction}
       begin
         inc(i); {next direction}
         ok:=true;
         j:=0;
         while OK do
         begin
           inc(j); {move in chosen direction}
           xx:=frompoint.x+j*offsets[i].x;
           yy:=frompoint.y+j*offsets[i].y;
           if validpoint(xx,yy)then
           begin {point is on the board}
             if board1[xx,yy].tag=0 then {if unused  - not a valid move}
             begin
               ok:=false;
               break;
             end
             else if (board1[xx,yy].tag=turn{+1}) {it is out color, so may be valid}
             then
             if (j>1) then break {if we have moved more than one square - it's valid}
             else
             begin  {correct end move color, but adjacent - not a valid move}
               ok:=false;
               break;
             end;
           end
           else ok:=false; {point niot on the the board, not a valiud move}
         end;
         if OK then break;{break if we have found a valid move}
       end;
     end;
     result:=OK;
   end;

   procedure makemove(frompoint:TPoint; turn:integer);
   {make all the moves triggered by click on "frompoint" cell}
   var
     i,j,k,xx,yy:integer;
     OK:boolean;
   begin
     i:=0;
     while (i<8)  do   {check all 8 directions}
     begin
       inc(i);
       OK:=true;
       j:=0;
       while OK do
       begin
         inc(j); {index of move length in current direction}
         xx:=frompoint.x+j*offsets[i].x; {point to test}
         yy:=frompoint.y+j*offsets[i].y;
         if validpoint(xx,yy) then
         begin
           if board1[xx,yy].tag=0 then {unoccupied --> no move this direction}
           begin
             ok:=false;
             break;
           end
           else if (board1[xx,yy].tag=turn{+1}) {this is our color}
           then
           if (j>1) then break {so if we have moved more than one sqaure, valid move}
           else
           begin {other, matching color was adjacent - no move}
             ok:=false;
             break;
           end;
         end
         else ok:=false;  {point not on board - no move}
       end;
       if OK then  {we have a valid move to make}
       begin
         for k:=0 to j-1 do {from clicked cell to just before the matching cell of our color}
         begin
           xx:=frompoint.x+k*offsets[i].x;
           yy:=frompoint.y+k*offsets[i].y;
           if board1[xx,yy].tag<>turn then inc(score1[turn]); {first move from this square}
           board1[xx,yy].tag:=turn; {set turn indicator}
           if k>0 then dec(score1[(turn) mod 2 +1]); {away from the clicked cell, reduce opponents count}
           case turn of {set color}
             1: board1[xx,yy].color:=clred;
             2: board1[xx,yy].color:=clblue;
           end;
         end;
       end;
     end;
   end;

var
  col,row:integer;
  s:string;
  OK:boolean;
begin {Panel1ckick}
  with tPanel(sender) do
  begin
    col:=(left-offsetx) div panelsize ; {get coordinates from clicked panel location}
    row:=(top-offsety) div panelsize;
    if validmove(point(col,row),turn1) then
    begin  {we can move, so make all the moves}
      makemove(point(col,row),turn1);

      if score1[1]+score1[2]=64 then {game over?}
      begin   {yes}
        if score1[1]>score1[2] then s:='Red' else s:='Blue';
        label1B.caption:='Game over, winner is '+s+'!!';
        showlabel(label1,0,score1);  {show final score only}
      end
      else
      begin {Game not over yet}
        turn1:=turn1 mod 2+1;  {other player's turn}
        {check for at least one move for the other player}
        ok := false;
        for col:=0 to 7 do for row:=0 to 7 do if validmove(point(col,row),turn1) then
        begin
          ok:=true;
          break;
        end;
        If not OK then {no valid move}
        begin
          label1B.caption:='No valid moves remaining for '+ playername[turn1];
          turn1:=turn1 mod 2 +1; {switch back to the player who clicked last}
        end
        else label1b.caption:='';
        showlabel(label1,turn1,score1); {show turn and score message}
      end;
    end;
  end;
end;


{********************* ShapeMouseUp *************}
procedure TForm1.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
                            Shift: TShiftState; X, Y: Integer);
{Make moves and color pieces for Board2 clicks}


   function makemoves(col,row:integer; moveit:boolean):integer;
   {make valid moves from col,row and return the number of cells added to turn2's color}
   {The count of pieces lost for the opponent is one less than the current player's gain}
   var  i,j,k, oppturn:integer;
        xx,yy:integer;
   begin
     result:=0;
     if board2[col,row].tag=0 then
     begin
       i:=0;
       while i<8 do
       begin
         inc(i);
         oppturn:=turn2 mod 2 + 1;  {opponents turn flag}
         xx:=col+offsets[i].x;
         yy:=row+offsets[i].y;
         if validpoint(xx,yy) and (board2[xx,yy].tag=oppturn) then
         begin  {this could be a valid move - check for my color in line before we find
                  a blank cell or the edge of the board}
           j:=1;
           repeat
             inc(j);
             xx:=col+j*offsets[i].x;
             yy:=row+j*offsets[i].y;
           until  (not validpoint(xx,yy)) or (board2[xx,yy].tag<>oppturn);
           if (j>1) and validpoint(xx,yy) and (board2[xx,yy].tag=turn2) then
           begin {it is a valid move}
             if moveit then  {If actually moving, not just checking then}
             for k:=0 to  j-1 do
             with board2[col+k*offsets[i].x,row+k*offsets[i].y] do
             begin
               tag:=turn2;
               case turn2 of
                 1: brush.color:=clred;
                 2: brush.color:=clblue;
               end;
             end;
             inc(result,j-1); {add number reversed to the result score}
           end;
         end;
       end;
       if result>0 then inc(result) {if we flipped any, then add 1 for the
                                     blank cell clicked to start this move}
     end;
   end;

var
  col,row:integer;
  n:integer;
  OK:boolean;
  s:string;
begin  {ShapeMouseUp}
  with tshape(sender) do
  begin
    col:=(left) div panelsize ; {get coordinates of piece clicked}
    row:=(top) div panelsize;
    n:=makemoves(col,row,true); {Make any moves}
    if n>0 then
    begin  {yes, we did make some moves}

      case turn2 of
        1:
        begin
          inc(score2[1],n);
          dec(score2[2],n-1);
        end;
        2:
        begin
          inc(score2[2],n);
          dec(score2[1],n-1);
        end;
      end;
      if score2[1]+score2[2]=64 then
      begin  {game over!}
        if score1[1]>score1[2] then s:='Red' else s:='Blue';
        label2B.caption:='Game over, winner is '+s+'!!';
        showlabel(label2,0,score2);
      end
      else
      begin
        turn2:=(turn2) mod 2+1;  {other player's turn}
        OK:=false;
        for col:=0 to 7 do
        begin
          for row:=0 to 7 do
          begin
            n:=makemoves(col,row,false);
            if n>0 then
            begin
              OK:=true;
              break;
            end;
            if OK then break;
          end;
        end;
        If not OK then
        begin
          label2B.caption:='No valid moves remaining for '+ playername[turn1];
          turn2:=turn2 mod 2 +1;   {flip back to current player }
        end
        else label2b.caption:='';
        showlabel(label2,turn2,score2);
      end;
    end;
  end;
end;

{*****************  Board3.Select *******************}
procedure TForm1.Board3Select(Sender: TObject; ACol, ARow: Longint;  {Board3 piece handling}
                            var CanSelect: Boolean);

  function makemoves(col,row:integer; MoveIt:boolean):integer;
     {make valid moves from col,row and return the number of cells added to turn3's color}
     {The count lost for the opponent is one less than the turn3 players gain}
     var  i,j,k, oppturn:integer;
          xx,yy:integer;
     begin
       result:=0;
       if board3.cells[col,row]='0' then
       begin
         i:=0;
         while i<8 do
         begin
           inc(i);
           oppturn:=turn3 mod 2 + 1; {opponents turn indicator}
           xx:=col+offsets[i].x;
           yy:=row+offsets[i].y;
           if validpoint(xx,yy) and (board3.cells[xx,yy]=inttostr(oppturn)) then
           begin  {this could be a valid move - check for my color in line before we hit
                    a blank cell or the edge of the board}
             j:=1;
             repeat
               inc(j);  {continue in current direction}
               xx:=col+j*offsets[i].x;
               yy:=row+j*offsets[i].y;
             until  (not validpoint(xx,yy)) or (board3.cells[xx,yy]<>inttostr(oppturn));
             if (j>1) and validpoint(xx,yy) and (board3.cells[xx,yy]=inttostr(turn3)) then {it is a valid move}
             begin
               if moveit then  {make actual move, otherwise just checking}
               for k:=0 to  j-1 do
                 board3.cells[col+k*offsets[i].x,row+k*offsets[i].y]:=inttostr(turn3);
               inc(result,j-1);
             end;
           end;
         end;
         if result>0 then inc(result)
       end;
     end;

var c,r, n:integer;
    OK:boolean;
    s:string;
begin
  with TStringgrid(sender) do
  begin
    canselect:=false;
    if cells[acol,arow]='0' then {empty cell amy be eligible}
    begin
      n:=makemoves(acol,arow,true);
      if n>0 then
      begin
        canSelect:=true;
        case turn3 of
          1:
          begin
            inc(score3[1],n);
            dec(score3[2],n-1);
          end;
          2:
          begin
            inc(score3[2],n);
            dec(score3[1],n-1);
          end;
        end;

        turn3:=turn3 mod 2+1;  {other player's turn}
        if score3[1]+score3[2]=64 then {game over}
        begin
          if score3[1]>score3[2] then s:='Red' else s:='Blue';
          label3B.caption:='Game over, winner is '+s+'!!';
          showlabel(label3,0,score3);
        end
        else
        begin  {game not over}
          {check if any valid moves for other player}
          for c:=0 to 7 do
          begin
            for r:=0 to 7 do
            begin
              n:=makemoves(c,r,false);
              if n>0 then
              begin
                OK:=true;
                break;
              end;
            end;
            if OK then break;
          end;
          If not OK then
          begin
            label3b.caption:='No plays available for '+playername[turn3];
            turn3:=turn3 mod 2 +1;  {switch back to other player}
          end
          else label3b.caption:='';
          showlabel(label3,turn3,score3);
        end;
      end;
    end;
  end;
end;


procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
{Draw pieces for board3}
begin
  with Sender as TStringGrid, canvas  do
  begin
    Brush.Color := color;
    FillRect(Rect);
    case strtoint(cells[acol,arow]) of
      0: brush.color:=self.color;
      1: brush.color:=clred;
      2:brush.color:=clblue;
    end;
    pen.color:=clBlack;
    ellipse(rect.left+1,rect.top+1,rect.right-1,rect.bottom-1);
  end;
end;

procedure TForm1.StaticText1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'http://www.delphiforfun.org/',
                    nil, nil, SW_SHOWNORMAL) ;
end;

procedure TForm1.ResetBtn1Click(Sender: TObject);
{reset board1}
var col,row:integer;
begin
  {Make Board1 - TPanels}
  for col:=0 to 7 do
  for row:=0 to 7 do
  begin
    board1[col,row]:=TPanel.create(self);
    with board1[col,row] do
    begin
      left:=offsetx+panelsize*col;
      top:=offsety+panelsize*row;
      width:=panelsize;
      height:=panelsize;
      color:=boardcolor;
      parent:=self;
      onclick:=Panelclick;
    end;
  end;
  with  board1[3,3] do
  begin
    color:=clred;
    tag:=1;
  end;
  with  board1[4,4] do
  begin
    color:=clred;
    tag:=1;
  end;
  with  board1[4,3] do
  begin
    color:=clblue;
    tag:=2;
  end;
  with  board1[3,4] do
  begin
    color:=clblue;
    tag:=2;
  end;
  turn1:=1;
  score1[1]:=2;
  score1[2]:=2;
  showlabel(label1,turn1,score1);
  label1b.caption:='';
end;

procedure TForm1.ResetBtn2Click(Sender: TObject);
var  col,row:integer;
begin
  for col:=0 to 7 do for row:=0 to 7 do
  with board2[col,row] do
  begin
    brush.color:=boardcolor;
    tag:=0;
  end;
  with  board2[3,3] do
  begin
    brush.color:=clred;
    tag:=1;
  end;
  with  board2[4,4] do
  begin
    brush.color:=clred;
    tag:=1;
  end;
  with  board2[4,3] do
  begin
    brush.color:=clblue;
    tag:=2;
  end;
  with  board2[3,4] do
  begin
    brush.color:=clblue;
    tag:=2;
  end;
  score2[1]:=2;
  score2[2]:=2;
  turn2:=1;
  showlabel(label2,turn2,score2);
  label2b.caption:='';
end;

procedure TForm1.ResetBtn3Click(Sender: TObject);
var col,row:integer;
begin
  for col:=0 to 7 do for row:= 0 to 7 do board3.cells[col,row]:='0';
  board3.cells[3,3]:='1';
  board3.cells[3,4]:='2';
  board3.cells[4,4]:='1';
  board3.cells[4,3]:='2';
  score3[1]:=2; {set initial scores}
  score3[2]:=2;
  turn3:=1;
  showlabel(label3, turn3, score3);
  label3b.caption:='';
end;

end.