Добрый день! Мучаюсь с непониманием алгоритма игры, а именно с функцией NewNolik. Переменные в коде названы не были, а интуитивно понять не выходит, имхо. Можете ли помоч с объяснением алгоритма?
Программа написана на Delphi, WinAPI. Константа C_CC обозначает размер поля.
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, XPMan;
type
TForm1 = class(TForm)
Image1: TImage;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
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;
function RandomNolik(var P:TPole; N:TGorVertDiag; K:byte):Boolean;
function NewNolik(var P:TPole; prevX,prevY:byte):byte;
procedure NewGame;
implementation
{$R *.dfm}
//
procedure PaintKN(S:TKrestikNolik; CellX,CellY:byte);
begin
Form1.Image1.Canvas.Pen.Width:=8; // толщина пера
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;
function RandomNolik(var P:TPole; N:TGorVertDiag; K:byte):Boolean;
var i,j:byte;
begin
Result:=False;
if N = gvAll then
begin
if P[0,0] = 0 then
begin
P[0,0]:=2;
PaintKN(knNolik,0,0);
Result:=True; Exit;
end;
if P[C_CC-1,C_CC-1] = 0 then
begin
P[C_CC-1,C_CC-1]:=2;
PaintKN(knNolik,C_CC-1,C_CC-1);
Result:=True; Exit;
end;
if P[0,C_CC-1] = 0 then
begin
P[0,C_CC-1]:=2;
PaintKN(knNolik,0,C_CC-1);
Result:=True; Exit;
end;
if P[C_CC-1,0] = 0 then
begin
P[C_CC-1,0]:=2;
PaintKN(knNolik,C_CC-1,0);
Result:=True; Exit;
end;
for i:=0 to C_CC-1 do
for j:=0 to C_CC-1 do
if P[i,j] = 0 then
begin
P[i,j]:=2;
PaintKN(knNolik,i,j);
Result:=True; Exit;
end;
end;
for i:=0 to C_CC-1 do
begin
Case N of
gvGor: begin
if P[i,K] = 0 then
begin
P[i,K] := 2;
PaintKN(knNolik,i,K);
Result:=True;
Exit;
end else Result:=False;
end;
gvVert: begin
if P[K,i] = 0 then
begin
P[K,i] := 2;
PaintKN(knNolik,K,i);
Result:=True;
Exit;
end else Result:=False;
end;
gvD1: begin
if P[i,i] = 0 then
begin
P[i,i] := 2;
PaintKN(knNolik,i,i);
Result:=True;
Exit;
end else Result:=False;
end;
gvD2: begin
if P[i,C_CC-1-i] = 0 then
begin
P[i,C_CC-1-i] := 2;
PaintKN(knNolik,i,C_CC-1-i);
Result:=True;
Exit;
end else Result:=False;
end;
End;
end;
end;
function NewNolik(var P:TPole; prevX,prevY:byte):byte;
var i,j,n:byte; KG,KV,KD1,KD2,NG,NV,ND1,ND2,RN:Boolean;
vinX,vinY:byte;
begin
Result:=0;
i:=isYes(P);
if i in [1,3] then begin Result:=i; Exit; end;
KG:=False; KV:=False; KD1:=False; KD2:=False;
NG:=False; NV:=False; ND1:=False; ND2:=False;
RN:=False;
// Анализ
for i:=0 to C_CC-1 do
begin
if i <> prevX then
Case P[i,prevY] of
1: KG:=True;
2: NG:=True;
end;
if i <> prevY then
Case P[prevX,i] of
1: KV:=True;
2: NV:=True;
end;
end;
if prevX = prevY then
for i:=0 to C_CC-1 do
if i <> prevX then
Case P[i,i] of
1: KD1:=True;
2: ND1:=True;
end;
if prevX + prevY = C_CC-1 then
for i:=0 to C_CC-1 do
if i <> prevX then
Case P[i,C_CC-1-i] of
1: KD2:=True;
2: ND2:=True;
end;
vinX:=255; vinY:=255;
for i:=0 to C_CC-1 do
begin
n:=0;
for j:=0 to C_CC-1 do if P[i,j] = 2 then Inc(n);
if n = C_CC-1 then
begin
for j:=0 to C_CC-1 do if P[i,j] = 0 then begin VinY:=j; VinX:=i; Break; end;
if (VinX <> 255) and (VinY <> 255) then Break;
end;
n:=0;
for j:=0 to C_CC-1 do if P[j,i] = 2 then Inc(n);
if n = C_CC-1 then
begin
for j:=0 to C_CC-1 do if P[j,i] = 0 then begin VinY:=i; VinX:=j; Break; end;
if (VinX <> 255) and (VinY <> 255) then Break;
end;
end;
// выбор решения
while True do
begin
if (VinX <> 255) and (VinY <> 255) then
begin
P[VinX,VinY]:=2;
PaintKN(knNolik,VinX,VinY);
RN:=true;
end;
if RN then Break;
if KG and not NG then RN := RandomNolik(P,gvGor,prevY);
if RN then Break;
if KV and not NV then RN := RandomNolik(P,gvVert,prevX);
if RN then Break;
if KD1 and not ND1 then RN := RandomNolik(P,gvD1,0);
if RN then Break;
if KD2 and not ND2 then RN := RandomNolik(P,gvD2,0);
if RN then Break;
RandomNolik(P,gvAll,0);
Break;
end;
i:=isYes(P);
if i in [2,3] then begin Result:=i; Exit; end;
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;
Case NewNolik(Pl,(X div C_CellWH),(Y div C_CellWH)) of
0: Mess:='';
1: Mess:='Крестики выиграли!';
2: Mess:='Нолики выиграли!';
3: Mess:='Ничья';
End;
if Mess <> '' then
Case MessageDlg(Mess+#13#10+'Хотите сыграть ещё раз?',mtConfirmation,[mbYes, mbNo, mbCancel],0) of
mrYes: NewGame;
mrNo: Application.Terminate;
End;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
NewGame;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Application.Terminate;
end;
end.
Последний раз редактировалось smile741, 19.11.2013 в 12:57.