Игра заключается в том что бы поставить 5 своих кружков в линию быстрее чем компьютер!
Мне нужно что бы следующий ход компьютер делал рядом с моим кружком или на 1 клетку дальше
сейчас он ставит через 2 или дальше!Помогите очень нужно! Привожу текст юнита алгоритмом и прикрепляю архив с самой игрой целиком! Помогите очень нужно очень прошу пожалуйста!
" (Показать/Скрыть)
unit Five;
interface
uses classes,sysutils,windows,math;
const
pente_oponent :integer= 1;
pente_system :integer = 2;
type
tlineDir = (tldVertical,tldHorizontal,tldSlash,tldBackSlash);
tstrategy = (stgdefensive,stgofensiveDefensive);
tpenteGame = class
private
weights:array[1..100,1..100] of double;
board:array[0..101,0..101] of integer;
fsize:integer;
flineSize:integer;
fturn:integer;
fwinningplayer:integer;
protected
lweights :array[1..2,-1..100] of integer;
function isblocked(lstop,x,y:integer):boolean;
function getCoord(x,y,delta:integer;dir:tlinedir):tpoint;
procedure setIncStop(var aInc,aStop:integer;AnOponent:boolean);
procedure initBoard(asize,alinesize:integer);
function line(x,y,size:integer;dir:tlinedir;
AnOponent,AcalcWeight:boolean):integer;
function getWeight(anOponent:boolean;PieceCount:integer):double;
procedure addValue(x,y:integer;d:double);virtual;
procedure filllweights;virtual;
function IntCalclweights(Anoponent,calc:boolean):integer;
function isfull:boolean;
procedure DiscardUsed;
procedure clearweights;
procedure calcweights(anOponent:boolean);
public
function IsGameOver:boolean;
function IsTie:boolean;
function iswinningplayer(Anoponent:boolean):boolean;
function getTurn:integer;
procedure incTurn;
function getSize:integer;
function getLineSize:integer;
function getBoard(x,y:integer):integer;
procedure setBoard(x,y,value:integer);
function getValue(x,y:integer):double;
function ChooseCell(strategy:tstrategy;var p:tpoint):boolean;
constructor create(aSize,aLineSize:integer);
end;
implementation
function tpenteGame.getCoord(x,y,delta:integer;dir:tlinedir):tpoint;
begin
result.x := x;
result.y := y;
if dir =tldVertical then begin
result.y := result.y+delta;
end
else if dir = tldHorizontal then begin
result.x := result.x+delta;
end
else if dir = tldSlash then begin
result.x := result.x+delta;
result.y := result.y+delta;
end
else if dir = tldBackSlash then begin
result.x := result.x - delta;
result.y := result.y + delta;
end;
end;
procedure tpenteGame.addValue(x,y:integer;d:double);
begin
if d > weights[x,y] then begin
weights[x,y]:=d;
end
else begin
weights[x,y]:=weights[x,y]+0.1;
end;
end;
procedure tpenteGame.setIncStop(var aInc,aStop:integer;AnOponent:boolean);
begin
if AnOponent = true then begin
ainc := pente_oponent;
astop := pente_system;
end
else begin
ainc:= pente_system;
astop:= pente_oponent;
end;
end;
function tpenteGame.getWeight(anOponent:boolean;PieceCount:integer):double;
begin
if anOponent then begin
result := lweights[pente_oponent,piececount];
end
else begin
result := lweights[pente_system,piececount];
end;
end;
procedure tpenteGame.initBoard(asize,alinesize:integer);
begin
fillchar(weights,sizeof(weights),0);
fillchar(board,sizeof(board),0);
fsize := aSize;
flineSize := aLineSize;
end;
function tpenteGame.isblocked(lstop,x,y:integer):boolean;
begin
result := false;
if (x = 0) or (y=0)then begin
result := true;
exit;
end;
if (x > fsize) or (y>fsize) then begin
result := true;
exit;
end;
if self.board[x,y] = lstop then begin
result := true;
end;
end;
function tpenteGame.line(x,y,size:integer;dir:tlinedir;
AnOponent,AcalcWeight:boolean):integer;
var
i:integer;
pieceCount:integer;
linc,lstop:integer;
n:integer;
w:double;
p:tpoint;
b1,b2:boolean;
begin
result := 1;
setIncStop(linc,lstop,anOponent);
pieceCount:= 0;
p:=self.getCoord(x,y,-1,dir);
b1:=isblocked(lstop,p.x,p.y);
p:=self.getCoord(x,y,size,dir);
b2:=isblocked(lstop,p.x,p.y);
for i := 0 to size -1 do begin
p:= self.getCoord(x,y,i,dir);
n:= board[p.x,p.y];
if n = linc then begin
inc(PieceCount);
end
else if n= lstop then begin
pieceCount := -1;
result := 0;
break;
end;
end;
if pieceCount = self.flineSize then begin
self.fwinningplayer := linc;
end;
if AcalcWeight then begin
w:=getWeight(anOponent,piececount);
if b1 or b2 then w := w -1;
for i := 0 to size -1 do begin
p:= self.getCoord(x,y,i,dir);
addValue(p.x,p.y,w);
end;
end;
end;
procedure tpenteGame.filllweights;
var
cont:integer;
base:integer;
begin
base := flinesize *4;
for cont := self.flineSize-1 downto 1 do begin
lweights[pente_oponent,cont] := base;
if base >=(cont*2) then begin
base := base div 2;
end
else begin
base := cont;
end;
end;
base := flinesize *3;
for cont := self.flineSize-1 downto 1 do begin
lweights[pente_system,cont] := base;
if base >(cont*2) then begin
base := base div 2;
end
else begin
base := cont;
end;
end;
lweights[pente_system,flineSize-1]:=lweights[pente_system,flineSize-1] *2;
end;
function tpenteGame.IsGameOver:boolean;
begin
result := false;
if iswinningplayer(true) or
iswinningplayer(false) then begin
result := true;
exit;
end;
if istie then result := true;
end;
function tpenteGame.IsTie:boolean;
var
n:integer;
begin
result := false;
n := IntCalclweights(true,false)
+intCalclWeights(false,false);
if (iswinningplayer(true) = false) and
(iswinningplayer(false) =false) and
(n = 0) then result := true;
end;
function tpenteGame.isfull:boolean;
var
x,y:integer;
isfull:boolean;
begin
result :=true;
for y := 1 to fsize do begin
for x := 1 to fsize do begin
if board[x,y] = 0 then begin
result := false;
break;
end;
end;
end;
end;
function tpenteGame.getTurn:integer;
begin
result := fturn;
end;
procedure tpenteGame.incTurn;
begin
inc(fturn);
end;
function tpenteGame.getSize:integer;
begin
result := fsize;
end;
function tpenteGame.getLineSize:integer;
begin
result := flineSize;
end;
function tpenteGame.getValue(x,y:integer):double;
begin
result := weights[x,y];
end;
function tpenteGame.getBoard(x,y:integer):integer;
begin
result := board[x,y];
end;
procedure tpenteGame.DiscardUsed;
var
x,y:integer;
begin
for y := 1 to fsize do begin
for x := 1 to fsize do begin
if board[x,y] > 0 then weights[x,y]:= -1;
end;
end;
end;
procedure tpenteGame.setBoard(x,y,value:integer);
begin
if board[x,y] = 0 then begin
board[x,y] := value;
end;
end;
function tpenteGame.Iswinningplayer(Anoponent:boolean):boolean;
begin
result := false;
IntCalclweights(Anoponent,false);
if fwinningplayer <> 0 then begin
result := true;
end;
end;
procedure tpenteGame.clearweights;
begin
fillchar(weights,sizeof(weights),0);
end;
function tpenteGame.IntCalclweights(Anoponent,calc:boolean):integer;
var
x,y:integer;
itop:integer;
begin
itop := (self.fsize - self.flineSize)+1;
result := 0;
for y := 1 to self.fsize do begin
for x := 1 to itop do begin
result := result+line(x,y,flinesize,tldhorizontal,anOponent,calc);
end;
end;
for y := 1 to itop do begin
for x := 1 to self.fsize do begin
result := result+line(x,y,flinesize,tldvertical,anOponent,calc);
end;
end;
for y := 1 to itop do begin
for x := 1 to itop do begin
result := result+line(x,y,flinesize,tldslash,anOponent,calc);
end;
end;
for y := 1 to itop do begin
for x := self.fsize downto (self.fsize +1 )-itop do begin
result := result+line(x,y,flinesize,tldbackslash,anOponent,calc);
end;
end;
end;
procedure tpenteGame.calcweights(anOponent:boolean);
begin
IntCalclweights(anOponent,true);
end;
function tpenteGame.ChooseCell(strategy:tstrategy;var p:tpoint):boolean;
var
value:double;
x,y:integer;
begin
clearWeights;
CalcWeights(true);
if strategy = stgofensiveDefensive then begin
CalcWeights(false);
end;
DiscardUsed;
p.x := 0;
p.y:= 0;
if self.isfull then begin
result :=false;
exit;
end;
result := true;
value := 0;
for y := 1 to fsize do begin
for x := 1 to fsize do begin
if weights[x,y] >= value then begin
value := weights[x,y];
p.x:= x;
p.y:= y;
end;
end;
end;
end;
constructor tpenteGame.create(aSize,aLineSize:integer);
begin
if aLineSize > aSize then begin
raise Exception.create('Invalid Line size > size');
end;
initBoard(asize,alinesize);
fturn := 1;
fwinningplayer:=0;
fillchar(lweights,sizeof(lweights),0);
filllweights;
end;
end.