unit U_FourInARow1;
{Copyright 2002, 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
 }

 {Version one of the Four-in-a-row (also called Connect4) game.  This version
  allow human vs human play}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

const
  {some fixed constants}
  nbrcols=7; {# of columns on the board}
  nbrrows=6; {# of rows on the board}
  sidewidth:integer=10; {pixel width of row dividers}
  player1color:TColor=clred;  {Player 1's chip colors}
  player2color:TColor=clyellow;  {Player 2's chip colors}
  boardcolor:TColor=clblue;   {Row divider color}
  lookahead:integer=4;  {Levels to look ahead when scoring}
  {User instruction messages}
  player1Lbl:string='Player 1:  Drag the red token over the selected column and release';
  player2Lbl:string='Player 2:  Drag the yellow token over the selected column and release';
type

  TForm1 = class(TForm)
    ResetBtn: TButton;
    Panel1: TPanel;
    Image1: TImage;
    NewChip: TShape;
    MoveLbl: TLabel;
    RandomBtn: TButton;
    Memo1: TMemo;
    RetractBtn: TButton;
    procedure ResetBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure TokenMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TokenMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TokenMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RandomBtnClick(Sender: TObject);
    procedure RetractBtnClick(Sender: TObject);
  public
    board:array [1..nbrcols, 1..nbrrows]of integer; {the playing board,
                                     0      ==> empty
                                     1 or 2 ==> # of player whose chip is here}
    moves:array[1..nbrcols*nbrrows] of TPoint; {record of moves in this game}
    player1:boolean; {True if current player is plaer #1, false otherwise}
    chipwidth:integer; {pixel width of token}
    Dragchip:boolean;  {true ==> chip is being dragged}
    movecount:integer;  {total moves in this game}
    gameover:boolean;  {true ==> game is over}
    procedure initialize;
    Procedure DrawChip(x:integer);
    procedure DropChip(x:integer);
    function FourInARow(col,row:integer):boolean;  {check for winning condition}
    function match(col,row,dc,dr:integer):integer;  {count matching tokens in
                                                     a specified directon}
    procedure changeplayers;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
uses UMakeCaption;


{************** Initialize *********}
procedure tform1.initialize;
{set up a new game }

       {local procedure DrawNewBoard}
       procedure DrawNewBoard;
      {Draw a clear board}
      var
        i,hinc:integer;
      begin
        with image1, canvas do
        begin
          chipwidth:=(panel1.width-(nbrcols+1)*sidewidth) div nbrcols;
          panel1.width:=nbrcols*(chipwidth+sidewidth)+sidewidth+2; {round width down}
          panel1.height:=(nbrrows+1)*chipwidth+sidewidth+2;  {and adjust the height}
          {Image is alligned to planel1, so it's size adjusts automatically}
          picture.bitmap.width:=width; {must set the new size for the drawing canvas}
          picture.bitmap.height:=height;
          brush.color:=clwindow;
          fillrect(clientrect);
          brush.color:=boardcolor; pen.color:=boardcolor;
          rectangle(rect(0,height-sidewidth,width,height)); {bottom bar}
          hinc:=(width-10) div nbrcols;
          for i:= 0 to nbrcols do rectangle(rect(i*hinc,chipwidth, {vertical bars}
                                            i*hinc+sidewidth,height-sidewidth));
        end;
        newchip.width:=chipwidth;
        newchip.height:=chipwidth;
        drawchip(chipwidth div 2);

       end;{Drawnewboard}

var i,j:integer;
begin
  for i:=1 to nbrcols do  for j:=1 to nbrrows do  board[i,j]:=0;
  movecount:=0;
  player1:=false;
  changeplayers; {set up initial player as player1}
  drawnewboard;
  tag:=1;
  gameover:=false;

end;

{**************** ResetBtnClick **********}
procedure TForm1.ResetBtnClick(Sender: TObject);
begin initialize; end;

{***************** RetractBtnClick ***********}
procedure TForm1.RetractBtnClick(Sender: TObject);
var
  h,v:integer;
begin
  if movecount>0 then
  begin

    with image1.canvas, moves[movecount]  do
    begin
      board[x,y]:=0;
      brush.color:=clwindow;
      h:=sidewidth+(x-1)*(chipwidth+sidewidth);
      v:=y*chipwidth;
      fillrect(rect(h,v, h+chipwidth, v+chipwidth));
    end;
    dec(movecount);
    changeplayers;
    drawchip(chipwidth div 2);
  end;
end;


{******************* FormActivate *************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  makecaption('Fout In A Row #1',
            #169+' 2002, G. Darby, http://delphiforfun.org',self);
  Initialize;
  panel1.DoubleBuffered:=true;
  randomize;
end;

{************* ChangePlayers **********}
procedure TForm1.Changeplayers;
begin
  newchip.top:=0;
  player1:=not player1;
  if player1 then
  begin
    newchip.brush.color:=player1color;
    movelbl.caption:=Player1Lbl;
  end
  else
  begin
    newchip.brush.color:=player2color;
    movelbl.caption:=Player2Lbl;
  end;
end;


{************** DrawChip ***********}
procedure TForm1.drawchip(x:integer);
begin
  newchip.left:=x-chipwidth div 2;
  newchip.visible:=true;
end;

{********************** Match ******************}
function TForm1.match(col,row,dc,dr:integer):integer;
{Count how many match passed position moving in direction (dc,dr)}
var c,r,count, checkplayer:integer;
begin
  checkplayer:=board[col,row];
  c:=col+dc;
  r:=row+dr;
  count:=0;
  while (c>=1) and (c<=nbrcols) and (r>=1) and (r<=nbrrows) and
         (board[c,r]=checkplayer) do
  begin
    inc(c,dc); inc(r,dr);
    inc(count);
  end;
  result:=count;
end;


{********************** FourInARow *****************}
function TForm1.FourInARow(col,row:integer):boolean;
{Chck for 4 tokens in a row}
var  n:integer;
begin
  n:=1+match(col,row,-1,0)+match(col,row,+1,0);
  if n<4 then n:=1+match(col,row,0,-1)+match(col,row,0,+1);
  if n<4 then n:=1+match(col,row,-1,-1)+match(col,row,+1,+1);
  if n<4 then n:=1+match(col,row,-1,+1)+match(col,row,+1,-1);
  if n>=4 then result:=true else result:=false;
end;


{************** DropChip *************}
procedure TForm1.dropchip(x:integer);
var
  col, row, i:integer;
  msg:string;
begin
  col:=x div(chipwidth+sidewidth)+1 ;
  newchip.left:=sidewidth+(col-1)*(chipwidth+sidewidth);
  row:=1;
  while (row<=nbrrows) and (board[col,row]=0)
  do inc(row);
  if row=1 then exit; {column is full}
  dec(row);
  with newchip do
  for i:=1 to row+1 do
  begin
    top:=(i-1)*chipwidth;
    update; {show new image}
    sleep(100);
  end;
  if player1 then board[col,row]:=1
  else board[col,row]:=2;
  with image1.canvas do
  begin
    brush.color:=newchip.brush.color;
    with newchip do ellipse(left,top, left+width, top+height);
  end;
  inc(movecount);
  moves[movecount]:=point(col,row); {In case we want to allow retraction or replay later}
  if (movecount=nbrcols*nbrrows) or fourinarow(col,row) then
  begin
    if fourinarow(col,row) then
      if player1 then msg:='Player 1 is the winner!'
      else msg:='Player 2 is the winner!'
    else msg:='A draw!';
    Gameover:=true;
    newchip.visible:=false;
    Movelbl.caption:=msg+ ', Click "Reset" to start a new game';
  end;
end;

{********************** TokenMouseDown *****************}
procedure TForm1.TokenMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if gameover then exit;
  DragChip:=true;
  newchip.top:=0;
  drawchip(newchip.left+x);
end;

{*********************** TokenMouseMove ****************}
procedure TForm1.TokenMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if dragchip
  then drawchip(newchip.left+x);
end;

{******************** TakenMouseUp *****************}
procedure TForm1.TokenMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if board[(newchip.left+x) div (chipwidth+sidewidth)+1,1]<>0 then
  begin
    newchip.left:=0;
    exit;
  end;
  dropchip(newchip.left+x);
  dragchip:=false;
  changeplayers;
  if not gameover then drawchip(chipwidth div 2);

end;


{************** RandomBtnClick ***************}
procedure TForm1.RandomBtnClick(Sender: TObject);
var
  col,i:integer;
  x:integer;
  halfC:integer;
begin
  initialize;
  halfc:=chipwidth div 2;
  tag:=0;
  while (tag=0) and (not gameover) do
  begin
    col:=random(nbrcols);
    x:=halfC;
    Tokenmousedown(sender, mbLeft, [], x,0);
    for i:= 0 to col*(chipwidth+sidewidth) div 10 do
    begin
      tokenMouseMove(sender,[],HalfC+10,0);
      newchip.update;
      sleep(10);
    end;
    tokenMouseup(sender,mbleft,[],HalfC,0);
    application.processmessages;
    sleep(250);
  end;
end;



end.