chess.pas

source code for caro game on Java

unit Chess;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls, StdCtrls, Buttons, Menus, ToolWin, ComCtrls, ImgList;

type
  TMainForm = class(TForm)
    ChessBoard: TDrawGrid;
    ComTimer: TTimer;
    BackGroundPanel: TPanel;
    ColPB: TPaintBox;
    RowPB: TPaintBox;
    Panel1: TPanel;
    Panel2: TPanel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    lblMove: TLabel;
    lblSide: TLabel;
    lblGameTime: TLabel;
    lblXTime: TLabel;
    lblOTime: TLabel;
    Label1: TLabel;
    Panel3: TPanel;
    ListBox: TListBox;
    OptionPanel: TPanel;
    grpPlayer1: TGroupBox;
    grpPlayer2: TGroupBox;
    cboPlayer1: TComboBox;
    cboPlayer2: TComboBox;
    MainMenu: TMainMenu;
    PopupMenu: TPopupMenu;
    mnuFile: TMenuItem;
    subNewGame: TMenuItem;
    subExit: TMenuItem;
    N1: TMenuItem;
    mnuTime: TMenuItem;
    subT5s: TMenuItem;
    subT10s: TMenuItem;
    subT15s: TMenuItem;
    subT20s: TMenuItem;
    subT30s: TMenuItem;
    subT60s: TMenuItem;
    mnuDepth: TMenuItem;
    subDepth12: TMenuItem;
    subDepth13: TMenuItem;
    subDepth14: TMenuItem;
    subDepth15: TMenuItem;
    subDepth16: TMenuItem;
    subDepth17: TMenuItem;
    procedure ChessBoardDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure RowPBPaint(Sender: TObject);
    procedure ColPBPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ChessBoardMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ComTimerTimer(Sender: TObject);
    procedure subNewGameClick(Sender: TObject);
    procedure subExitClick(Sender: TObject);
    procedure subT5sClick(Sender: TObject);
    procedure subT10sClick(Sender: TObject);
    procedure subT15sClick(Sender: TObject);
    procedure subT20sClick(Sender: TObject);
    procedure subT30sClick(Sender: TObject);
    procedure subT60sClick(Sender: TObject);
    procedure subDepth12Click(Sender: TObject);
    procedure subDepth13Click(Sender: TObject);
    procedure subDepth14Click(Sender: TObject);
    procedure subDepth15Click(Sender: TObject);
    procedure subDepth16Click(Sender: TObject);
    procedure subDepth17Click(Sender: TObject);
  private
    procedure PrintTurnInfo(N:Integer);
    procedure TimeItemCheck(subMenuItem:TMenuItem);
    procedure DepthItemCheck(subMenuItem:TMenuItem);

  public
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

{$R-,Q-}

const
  SIZE_X	=	19;
  SIZE_Y	=	19;
  BOARD_SIZE	= 	SIZE_X*SIZE_Y;

  EMPTY		=	0;

  KukoX         =       120;
  KukoO         =       111;

  XSide         =       1;
  OSide         =       -1;

  PLAYER_HUMAN  =       0;
  KUKO_COM      =       1;
  SHASHIN_COM   =       2;
  MARS_COM      =       3;
  BLACK_ANGEL   =       4;

type

  BoardArray = array[1..SIZE_Y,1..SIZE_X] of Integer;

  Move = record
           Row, Col : Integer;
         end;

var
  Piece,KukoPiece    : BoardArray;
  SidePlay,Winner,SoNuoc : Integer;
  NewMove     : Move;
  CurrentDir  : String;
  LuotNguoidi : Boolean;
  COMvsCOM    : Boolean;
  MayDangnghi : Boolean;
  GameTime,XTime,OTime    : LongInt;
  GameStart,XStart,OStart : LongInt;

{---------------------------------------------------------}
procedure DrawCell(CRow,CCol:Integer);
var
  r,c : Integer;
  tR  : TRect;
begin
  with MainForm.ChessBoard do
    begin
      r:=CRow-1;
      c:=CCol-1;
      tR:=CellRect(c,r);
      with MainForm.ChessBoard.Canvas do
        begin
          Brush.Color:=RGB(112,159,111);
          FillRect(tR);
          Brush.Color:=clBlack;
          Dec(tR.Left,1);
          Dec(tR.Top,1);
          Inc(tR.Bottom,1);
          Inc(tR.Right,1);
          FrameRect(tR);
          if Piece[CRow,CCol]<>EMPTY then
            begin
              if Piece[CRow,CCol]=XSide then Brush.Color:=clBlue else Brush.Color:=clRed;
              Ellipse(tR.Left+3,tR.Top+3,tR.Right-3,tR.Bottom-3);
            end;
        end;
    end;
end;
{---------------------------------------------------------}
procedure DrawBoard;
var
  i,j : Integer;
begin
  for i:=1 to SIZE_Y do
    for j:=1 to SIZE_X do DrawCell(i,j);
end;
{---------------------------------------------------------}
procedure TMainForm.ChessBoardDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
var
  r,c : Integer;
begin
  r:=Row+1;
  c:=Col+1;
  DrawCell(r,c);
end;
{---------------------------------------------------------}
procedure TMainForm.RowPBPaint(Sender: TObject);
var
  i,h : Integer;
begin
  with RowPB.Canvas do
    begin
      h:=8-TextWidth('A') div 2;
      for i:=0 to SIZE_Y-1 do TextOut(1,i*21+h,IntToStr(SIZE_Y-i));
    end;
end;
{---------------------------------------------------------}
procedure TMainForm.ColPBPaint(Sender: TObject);
var
  i,w : Integer;
begin
  with ColPB.Canvas do
    begin
      w:=10-TextWidth('A') div 2;
      for i:=0 to SIZE_X-1 do TextOut(i*21+w,0,IntToStr(i+1));
    end;
end;
{---------------------------------------------------------}
function ChainSize(r,c,dir:Integer):Integer;
var
  count,i,pcolor : Integer;
begin
  pcolor:=Piece[r,c];
  count:=1;
  case dir of
    1 : begin  {-}
          i:=1;
          while i<c do
            begin
              if Piece[r,c-i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
          i:=1;
          while c+i<=SIZE_X do
            begin
              if Piece[r,c+i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
        end;

    2 : begin  {|}
          i:=1;
          while i<r do
            begin
              if Piece[r-i,c]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
          i:=1;
          while r+i<=SIZE_Y do
            begin
              if Piece[r+i,c]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
        end;

    3 : begin  {\}
          i:=1;
          while (i<r) and (i<c) do
            begin
              if Piece[r-i,c-i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
          i:=1;
          while (r+i<=SIZE_Y) and (c+i<=SIZE_X) do
            begin
              if Piece[r+i,c+i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
        end;

    4 : begin  {/}
          i:=1;
          while (r+i<=SIZE_Y) and (i<c) do
            begin
              if Piece[r+i,c-i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
          i:=1;
          while (i<r) and (c+i<=SIZE_X) do
            begin
              if Piece[r-i,c+i]<>pcolor then Break;
              Inc(count);
              Inc(i);
            end;
        end;
  end;
  Result:=count;
end;
{---------------------------------------------------------}
function FivePointFound(r,c:Integer):Integer;
var
  i : Integer;
begin
  if Piece[r,c]<>EMPTY then
    for i:=1 to 4 do if ChainSize(r,c,i)>=5 then
      begin
        Result:=Piece[r,c];
        Exit;
      end;
  Result:=0;
end;
{---------------------------------------------------------}
procedure EndGame;
begin
  case Winner of
    XSide : ShowMessage('Player 1 (BLUE) win !');
    OSide : ShowMessage('Player 2 (RED) win !');
  end;
  LuotNguoidi:=False;
  MayDangnghi:=True;
  MainForm.ComTimer.Enabled:=False;
end;
{---------------------------------------------------------}
{$I KukoEval.pas}
{$I Strategy.pas}
{$I Mars.pas}
{---------------------------------------------------------}
function MiliSecToStr(Time:LongInt):String;
var
  t1,t2,t3 : String;
  t        : LongInt;
begin
  t := Time div 1000;
  t1:= IntToStr(t div 3600);
  if Length(t1)=1 then t1:='0'+t1;
  t2:= IntToStr(t div 60);
  if Length(t2)=1 then t2:='0'+t2;
  t3:= IntToStr(t mod 60);
  if Length(t3)=1 then t3:='0'+t3;
  MiliSecToStr:=t1+':'+t2+':'+t3;
end;
{---------------------------------------------------------}
function RStr(St:String;N:Integer):String;
var
  i : Integer;
begin
  for i:=1 to N-Length(St) do St:=' '+St;
  RStr:=St;
end;
{---------------------------------------------------------}