unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, XPMan;
type
TForm1 = class(TForm)
Image1: TImage;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
const
C_CellWH = 60; // Длина и ширина одной клетки
C_CC = 5; // кол-во клеток
type
TKrestikNolik = (knKrestik,knNolik); // крестик или нолик
TGorVertDiag = (gvGor,gvVert,gvD1,gvD2,gvAll); // горизонталь или вертикаль
TPole = array [0..C_CC-1] of array [0..C_CC-1] of Byte;
var
Form1: TForm1;
Pl: TPole;
procedure PaintKN(S:TKrestikNolik; CellX,CellY:byte);
function isYes(var P:TPole):byte;
procedure NewGame;
implementation
{$R *.dfm}
procedure PaintKN(S:TKrestikNolik; CellX,CellY:byte);
begin
Form1.Image1.Canvas.Pen.Width:=3;
Case S of
knKrestik: begin
Form1.Image1.Canvas.Pen.Color:=clRed;
Form1.Image1.Canvas.MoveTo( (C_CellWH div 8) + CellX*C_CellWH,
(C_CellWH div 8) + CellY*C_CellWH );
Form1.Image1.Canvas.LineTo( 7*(C_CellWH div 8) + CellX*C_CellWH,
7*(C_CellWH div 8) + CellY*C_CellWH );
Form1.Image1.Canvas.MoveTo( (C_CellWH div 8) + CellX*C_CellWH,
7*(C_CellWH div 8) + CellY*C_CellWH );
Form1.Image1.Canvas.LineTo( 7*(C_CellWH div 8) + CellX*C_CellWH,
(C_CellWH div 8) + CellY*C_CellWH );
end;
knNolik: begin
Form1.Image1.Canvas.Pen.Color:=clBlue;
Form1.Image1.Canvas.Brush.Style:=bsClear;
Form1.Image1.Canvas.Ellipse( (C_CellWH div 8) + CellX*C_CellWH,
(C_CellWH div 8) + CellY*C_CellWH,
7*(C_CellWH div 8) + CellX*C_CellWH,
7*(C_CellWH div 8) + CellY*C_CellWH );
end;
End;
end;
function isYes(var P:TPole):byte;
var i,j:byte; A:Boolean; k,n:byte;
begin
// проверяем главную диагональ
k:=0; n:=0;
for i:=0 to C_CC-1 do
if p[i,i] = 1 then Inc(k) else if p[i,i] = 2 then Inc(n);
if k = C_CC then begin Result:=1; Exit; end;
if n = C_CC then begin Result:=2; Exit; end;
// проверяем вторую диагональ
k:=0; n:=0;
for i:=0 to C_CC-1 do
if p[i,C_CC-1-i] = 1 then Inc(k) else if p[i,C_CC-1-i] = 2 then Inc(n);
if k = C_CC then begin Result:=1; Exit; end;
if n = C_CC then begin Result:=2; Exit; end;
for i:=0 to C_CC-1 do
begin
// вертикаль
k:=0; n:=0;
for j:=0 to C_CC-1 do
if p[i,j] = 1 then Inc(k) else if p[i,j] = 2 then Inc(n);
if k = C_CC then begin Result:=1; Exit; end;
if n = C_CC then begin Result:=2; Exit; end;
// горизонталь
k:=0; n:=0;
for j:=0 to C_CC-1 do
if p[j,i] = 1 then Inc(k) else if p[j,i] = 2 then Inc(n);
if k = C_CC then begin Result:=1; Exit; end;
if n = C_CC then begin Result:=2; Exit; end;
end;
// проверяем занятость всех клеток
A:=false;
for i:=0 to C_CC-1 do
begin
for j:=0 to C_CC-1 do
if P[i,j] = 0 then begin A:=true; Break; end;
if A then Break;
end;
if not A then begin Result:=3; Exit; end;
Result:=0;
end;
procedure NewGame;
var i:integer;
begin
Form1.Image1.Picture:=nil;
Form1.Image1.Canvas.Pen.Color:=clBlack;
for i:=1 to C_CC-1 do
begin
Form1.Image1.Canvas.MoveTo(C_CellWH*i,0);
Form1.Image1.Canvas.LineTo(C_CellWH*i,Form1.Image1.Height);
Form1.Image1.Canvas.MoveTo(0,C_CellWH*i);
Form1.Image1.Canvas.LineTo(Form1.Image1.Width,C_CellWH*i);
end;
FillChar(Pl,SizeOf(pl),0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
Form1.ClientHeight:=C_CellWH*C_CC;
Form1.ClientWidth:=Form1.ClientHeight; // C_CellWH*C_CC
Image1.ClientWidth:=Form1.ClientWidth;
Image1.ClientHeight:=Image1.ClientWidth; //Form1.ClientHeight
Image1.Picture:=nil;
Image1.Canvas.Pen.Color:=clBlack;
for i:=1 to C_CC-1 do
begin
Image1.Canvas.MoveTo(C_CellWH*i,0);
Image1.Canvas.LineTo(C_CellWH*i,Image1.Height);
Image1.Canvas.MoveTo(0,C_CellWH*i);
Image1.Canvas.LineTo(Image1.Width,C_CellWH*i);
end;
FillChar(Pl,SizeOf(pl),0);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var Mess:String;
begin
if Button in [mbRight,mbMiddle] then Exit;
if Pl[(X div C_CellWH), (Y div C_CellWH)] <> 0 then Exit;
PaintKN(knKrestik,(X div C_CellWH), (Y div C_CellWH));
Pl[(X div C_CellWH),(Y div C_CellWH)]:=1;
End;
end.