Find fem fejl
unit Unit1;interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
ListBox1: TListBox;
MainMenu1: TMainMenu;
Options1: TMenuItem;
Nytspil1: TMenuItem;
Quit1: TMenuItem;
About1: TMenuItem;
Marker: TTimer;
Afbryd1: TMenuItem;
Trkforslag1: TMenuItem;
ListBox2: TListBox;
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Options1Click(Sender: TObject);
procedure Nytspil1Click(Sender: TObject);
procedure Quit1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure MarkerTimer(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Afbryd1Click(Sender: TObject);
procedure Trkforslag1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Procedure SetDefaultOptions;
Procedure PrepareField;
Procedure NewGame;
Function CPUvsCPU:Boolean;
Procedure CreateValueList;
Procedure GetValueList;
Procedure SaveSettings;
Function Min(A,B:Integer):Integer;
Function Max(A,B:Integer):Integer;
Const
DefSettingsName=''4PaaStribe-DefaultSettings.DS'';
StdSizes:Array[0..4] of TPoint=//Benyttes i form2
((X:7; Y:6),(X:7; Y:6),(X:6; Y:5),(X:9; Y:7),(X:12; Y:10));
DefaultBlink=6;//skal være lige (tænd/sluk)
MaxRekLevel=20;
BegynderenTabte=2;
IngenVinder=3;
BegynderenVandt=4;
KunX=240;//Pos and KunX
KunY=15;//Pos and KunY
IsDebugging=True;
TomOrCP:Integer=3;
Farver:Array[0..5] of Integer=(ClBlue,ClGreen,ClYellow,ClWhite,ClRed,ClBlack);
//Størrelser på spillepladen...
Ln2MaxSize=4;
PPMaxSize=14;
PMaxSize=15;
MaxSize=16;
SMaxSize=17;
PMaxSize4=60;
MaxSize4=64;
SMaxSize4=68;
SqrPPMaxS=196;
PSqrMaxS=255;
//Player types
Menneske=0;
CPULNem=1;
CPUNem=2;
CPUMiddel=3;
CPUHalvSvaer=4;
CPUSvaer=5;
CPULangsom=6;
//Værdier til celle...
Udenfor:Integer=0;
Tom:Integer=1;
FriTom:Integer=3;
Pl1:Integer=2;
SelfPl:Integer=2;
Pl2:Integer=4;
//$1 Computerens intelligens er baseret på 9 konstanter...
SimpleTrap:Integer=$4000;
Save4S=$200000; LSave4S=$100000;
Prevent4S=$40000; LPrevent4S=$20000;
SaveTrap=$8000; LSaveTrap=$4000;
PreventTrap=$1000; LPreventTrap=$800;
//Hvis fx Værdi>LSave4S er der med SIKKERHED mulighed for 4 på stribe.
MaxOrdValue=$7FF;//Value and OrdMaxValue=SaveTrap,PreventTrap, osv. siet fra
Straight:Array[5..8] of Integer=(Save4S+150,Save4S+170,Save4S+190,Save4S+210);
Values:Array[1..3,0..3] of Integer=((60,49,0,0),(40,0,90,55),(20,0,0,35));
//0:umulig situation
//49:Her kommer bonussen også fra SecuredBonus og Shifterbonus
SecuredBonus:Integer=100;
ShifterBonus:Integer=100;
DestroyTrapPenalty:Integer=200;
Type
TMap=Array[0..PSqrMaxS] of Integer;
TStdListe=Array[1..PPMaxSize] of Integer;
TBlk=Record
Antal:Integer;
Pos:Array[1..6] of Integer;
end;
Var
Form1:TForm1;
Map:TMap;
PlMap:Array[2..4] of TMap;
TopP:TStdListe;
GameOver:Boolean=False;
IsPlaying:Boolean=False;
GameStart:Boolean;//True=Et spil er startet, men ingen brikker er endnu placeret.
StandardSize:Boolean=True;
Pause:Boolean=False;
PauseCPU:Boolean=False;
CPUMoving:Boolean=False;
FitResize:Boolean=True;
ManglerAtGentegne:Boolean=False;
ErrorTjek:Integer=0;
CellSize,CellsLeft,ErrorVar,AntalMarkerede,SidsteVinder:Integer;
SizeX:Integer=7;
SizeY:Integer=6;
HvemBegynder:Integer=4;
BlinkTilbage:Integer=0;
HvisTurMark:Integer;
HvemBegyndteSidst:Integer=4;
ProposeMove:Integer;//Trækforslag fra CPU med P.M. i sværhedsgræd
Marks:Array[1..22] of Integer;
CP:Integer=2;//Spiller1=2, spiller2=4
Farve:Array[2..4] of Integer=(3,0,4);
PlT:Array[2..4] of Integer=(Menneske,0,CPUHalvSvaer);
//Boolean(PlT[X]) er true hvis computer
LastNow:Double=0;
SortL:TStdListe;
ValueL:Array[0..4095] of Integer;
AntalPP:Array[0..4095] of Integer;
PP:Array[0..4095,1..2] of Integer;
//Der vil højst være 2 frie felter med vinderpotentiale pr ValueL[x]
Blk:Array[1..MaxRekLevel,1..14] of TBlk;
//Blk=Blokeringer Blk[CellsLeft,RækkeNr]
Games:Array[0..1376255] of byte;
Vindere:Array[0..32767] of byte;
//PrevGames[(RykNr ShL 15) or SpilNr]=PrevGames[SpilNr,RykNr]
//RykNr tilhører intervallet [0..41]
AntalGames:Integer;//PAntalGames=n <=> n+1 spil gemt
CurrentGame:Array[0..41] of byte;
implementation
{$R *.DFM}
Uses Unit2;
Procedure LoadGames;//Kun standardsize
Var I,J:Integer;
begin
If FileExists(''Games.txt'') then With Form1.ListBox2 do begin
Items.Clear;
Items.LoadFromFile(''Games.txt'');
AntalGames:=Pred(Items.Count);//+1
For J:=0 to AntalGames do begin
Vindere[J]:=Ord(Items[J][1]) Xor 48;
For I:=0 to 41 do Games[(J ShL 15) or I]:=Ord(Items[J][I+3]) Xor 48;
end;
end else AntalGames:=-1;
end;
Procedure AddGame;//Kun standardsize
Var
I:Integer;
S:String;
begin
Inc(AntalGames);
Vindere[AntalGames]:=SidsteVinder;
With Form1.ListBox2 do begin
S:=Char(SidsteVinder or 48)+''- '';
For I:=0 to 41 do begin
Games[(I ShL 15) or AntalGames]:=CurrentGame[I];
S[I+3]:=Char(48 or CurrentGame[I]);
end;
Items.Add(S);
Items.SaveToFile(''Games.txt'');
end;
end;
Procedure CompareWithPreviouslyGames(Var Liste:TStdListe);//Kun standardsize
Var
I,J,Move,Pl:Integer;
Ens,Spejling:Boolean;
L,Antal,Sum:Array[1..7] of Integer;
//L: Bruges til at genkende stillingen.
//Antal: Antal gange der er spillet videre på hvert næste træk.
//Sum: Antal point der er opnået ved at spille videre på hvert næste træk.
//Sum/Antal er et mål for hvor godt trækket er.
begin
If CellsLeft>42 then begin
ShowMessage(''Compare kan kun benyttes til standardstørrelsen.'');
Exit;
end;
If Not Boolean(CellsLeft) then begin
ShowMessage(''Alle brikker er placeret.'');
Exit;
end;
For I:=1 to 7 do begin
Antal[I]:=0;
Sum[I]:=0;
end;
For J:=0 to AntalGames do begin
Spejling:=True;
Repeat
For I:=1 to 7 do L[I]:=6;
Pl:=HvemBegyndteSidst;
Ens:=True;
For I:=1 to 43-CellsLeft do begin
Move:=Games[(I ShL 15) or J];
If Spejling then Move:=8-Move;
If Map[(Move ShL Ln2MaxSize) or L[Move]]<>Pl then begin
Ens:=False;
Break;
end;
Pl:=Pl Xor 6;
end;
If Ens then begin
Move:=Games[(I ShL 15) or J];//Efter for-løkken er I=(43-CellsLeft)+1
If Spejling then Move:=8-Move;
Inc(Antal[Move]);
If Vindere[J]<>IngenVinder then begin
If (CP=HvemBegyndteSidst) Xor (Vindere[J]=BegynderenTabte) then
//Svarer til at CP vil vinde.
Inc(Sum[Move]) else Dec(Sum[Move]);
end;
end;
Spejling:=Not Spejling;
Until Spejling;
end;
For I:=1 to 7 do If Boolean(Antal[I]) then Inc(Liste[I],(Sum[I]*10000) div Antal[I]);
end;
Function Min(A,B:Integer):Integer;
begin
If A>B then Min:=B else Min:=A;
end;
Function Max(A,B:Integer):Integer;
begin
If A>B then Max:=A else Max:=B;
end;
Function CPUvsCPU:Boolean;
begin
CPUvsCPU:=Boolean(PlT[Pl1]) and Boolean(PlT[Pl2]);
end;
Procedure Convert(Var X:Integer);
begin
X:=Succ(Pred(X) Div CellSize);
If X<1 then X:=1 else If X>SizeX then X:=SizeX;
end;
Procedure DrawM(Pos:Integer; Invert:Boolean);
Var X,Y,Margin:Integer;
begin
X:=Pos ShR Ln2MaxSize;
Y:=Pos and PMaxSize;
With Form1.Canvas do begin
Brush.Style:=bsSolid;
If Invert then Pen.Mode:=pmNot;
Margin:=CellSize ShR 2;
Ellipse(CellSize*Pred(X)+2+Margin,CellSize*Pred(Y)+2+Margin,
CellSize*X-Margin,CellSize*Y-Margin);
Pen.Mode:=pmCopy;
end;
end;
Procedure RemoveBlink;
Var I:Integer;
begin
If Boolean(BlinkTilbage and 1) then
For I:=1 to AntalMarkerede do DrawM(Marks[I],True);
Form1.Marker.Enabled:=False;
BlinkTilBage:=0;
end;
Procedure ShowError(Error:String);
begin
Form1.Canvas.Brush.Style:=BsClear;
Form1.Canvas.TextOut(5,Form1.ClientHeight-30,Error);
end;
Procedure SaveSettings;
Var
Fil:File;
Temp:Integer;
begin
AssignFile(Fil,''4PaaStribe-DefaultSettings.DS'');
ReWrite(Fil,1);
BlockWrite(Fil,SizeX,SizeOf(SizeX));
BlockWrite(Fil,SizeY,SizeOf(SizeY));
StandardSize:=(SizeX=7) and (SizeY=6);
BlockWrite(Fil,PlT,SizeOf(PlT));
BlockWrite(Fil,ProposeMove,SizeOf(ProposeMove));
BlockWrite(Fil,Farve,SizeOf(Farve));
BlockWrite(Fil,HvemBegynder,SizeOf(HvemBegynder));
//Gem form1''s placering på skærmen
Form1.FormResize(Form1);
Temp:=Form1.Left;
BlockWrite(Fil,Temp,SizeOf(Temp));
Temp:=Form1.Top;
BlockWrite(Fil,Temp,SizeOf(Temp));
Temp:=Form1.Width;
BlockWrite(Fil,Temp,SizeOf(Temp));
Temp:=Form1.Height;
BlockWrite(Fil,Temp,SizeOf(Temp));
CloseFile(Fil);
end;
Procedure SetDefaultOptions;
Var
Fil:File;
Temp:Integer;
begin
If FileExists(DefSettingsName) then begin
AssignFile(Fil,DefSettingsName);
Reset(Fil,1);
BlockRead(Fil,SizeX,SizeOf(SizeX));
BlockRead(Fil,SizeY,SizeOf(SizeY));
BlockRead(Fil,PlT,SizeOf(PlT));
BlockRead(Fil,ProposeMove,SizeOf(ProposeMove));
BlockRead(Fil,Farve,SizeOf(Farve));
BlockRead(Fil,HvemBegynder,SizeOf(HvemBegynder));
//Hent form1''s placering på skærmen
FitResize:=False;
BlockRead(Fil,Temp,SizeOf(Temp));
Form1.Left:=Temp;
BlockRead(Fil,Temp,SizeOf(Temp));
Form1.Top:=Temp;
BlockRead(Fil,Temp,SizeOf(Temp));
Form1.Width:=Temp;
BlockRead(Fil,Temp,SizeOf(Temp));
FitResize:=True;
Form1.Height:=Temp;
CloseFile(Fil);
end;//else har SizeX,Farve,osv. default-værdier.
end;
Function AntalKolonner:Integer;
Var Antal,I:Integer;
begin
Antal:=0;
For I:=1 to SizeX do If Boolean(TopP[I]) then Inc(Antal);
AntalKolonner:=Antal;
end;
Procedure DrawCell(CellNr:Integer);
Var X,Y,Margin:Integer;
begin
X:=CellNr ShR Ln2MaxSize;
Y:=CellNr and PMaxSize;
If Map[CellNr]<>Tom then With Form1.Canvas do begin
Brush.Style:=bsSolid;
Brush.Color:=Farver[Farve[Map[CellNr]]];
Pen.Color:=Farver[Farve[Map[CellNr]]];
Margin:=CellSize ShR 4;
Ellipse(CellSize*Pred(X)+2+Margin,CellSize*Pred(Y)+2+Margin,
CellSize*X-Margin,CellSize*Y-Margin);
end;
end;
Procedure Gentegn;
Var I,J:Integer;
begin
If CPUMoving then begin
ManglerAtGentegne:=True;
Exit;
end;
With Form1.Canvas do begin
Brush.Color:=ClBtnFace;
FillRect(Rect(0,0,Form1.ClientWidth,Form1.ClientHeight));
Brush.Color:=ClBlack;
FrameRect(Rect(0,0,Form1.ClientWidth,Form1.ClientHeight));
For I:=1 to SizeX do begin
For J:=1 to SizeY do begin
Brush.Color:=ClBlack;
FrameRect(Rect(Succ(CellSize*Pred(I)),Succ(CellSize*Pred(J)),
Succ(CellSize*I),Succ(CellSize*J)));
DrawCell((I ShL Ln2MaxSize) or J);
end;
end;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Timer2.Enabled:=True;
end;
Procedure PrepareField;
Var I,J:Integer;
begin
For I:=0 to Succ(SizeX) do begin
Map[I ShL Ln2MaxSize]:=Udenfor;
Map[(I ShL Ln2MaxSize) or Succ(SizeY)]:=Udenfor;
end;
For J:=0 to Succ(SizeY) do begin
Map[J]:=Udenfor;
Map[(Succ(SizeX) ShL Ln2MaxSize) or J]:=Udenfor;
end;
For I:=1 to SizeX do begin
TopP[I]:=SizeY;
For J:=1 to SizeY do Map[(I ShL Ln2MaxSize) or J]:=Tom;
end;
PlMap[2]:=Map;
PlMap[4]:=Map;
end;
Procedure NewGame;
begin
Randomize;
RemoveBlink;
PrepareField;
CellsLeft:=SizeX*SizeY;
If GameStart then CP:=HvemBegyndteSidst Xor 6 else
Case HvemBegynder of
0 :CP:=HvemBegyndteSidst Xor 6;
1 :CP:=Succ(Random(2)) ShL 1;
4 :;//CP:=CP;
5 :CP:=CP Xor 6;
else CP:=(HvemBegynder ShL 1)-2;//Hvembegynder=2 eller 3
end;
GameOver:=False;
HvemBegyndteSidst:=CP;
IsPlaying:=False;
GameStart:=True;
Gentegn;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadGames;
SetDefaultOptions;
GetValueList;
PrepareField;
If (Screen.Height-50<Top) or (Screen.Width-50<Left) then begin
//Formen skal ikke placeres udenfor skærmen, hvis der køres i en lav opløsning
Top:=(Screen.Height-Height) ShR 1;
Left:=(Screen.Width-Width) ShR 1;
end;
Randomize;
NewGame;
end;
procedure TForm1.FormResize(Sender: TObject);
Var Y:Integer;
begin
Timer2.Enabled:=True;
If FitResize then begin
CellSize:=(ClientWidth-2) Div SizeX;
Y:=(ClientHeight-2) Div SizeY;
If Y<CellSize then CellSize:=Y;
ClientWidth:=SizeX*CellSize+2;
ClientHeight:=SizeY*CellSize+2;
end;
end;
Function ExitGame:Boolean;
begin
NewGame;
Gentegn;
ExitGame:=False;
end;
Procedure AddMark(Pos:Integer);
begin
Inc(AntalMarkerede);
Marks[AntalMarkerede]:=Pos;
end;
Procedure SetOneBlink(Pos:Integer);
begin
RemoveBlink;
Form1.Marker.Enabled:=True;
BlinkTilBage:=DefaultBlink;
AntalMarkerede:=0;
AddMark(Pos);
end;
Function New4S(Pos:Integer; VisMarkerede:Boolean):Boolean;
Var Antal,F,T,P:Integer;//Fra,Til,Player
begin
P:=Map[Pos];
If VisMarkerede then SetOneBlink(Pos);
New4S:=False;
//Tjek lodret...
Antal:=1;
F:=Pred(Pos);
While Map[F]=P do begin
Inc(Antal);
Dec(F);
end;
T:=Succ(Pos);
While Map[T]=P do begin
Inc(Antal);
Inc(T);
end;
If Antal>3 then begin
New4S:=True;
If VisMarkerede then begin
Inc(F);
Repeat
If F<>Pos then AddMark(F);
Inc(F);
Until F=T;
end;
end;
//Tjek Vandret...
Antal:=1;
F:=Pos-MaxSize;
While Map[F]=P do begin
Inc(Antal);
Dec(F,MaxSize);
end;
T:=Pos+MaxSize;
While Map[T]=P do begin
Inc(Antal);
Inc(T,MaxSize);
end;
If Antal>3 then begin
New4S:=True;
If VisMarkerede then begin
Inc(F,MaxSize);
Repeat
If F<>Pos then AddMark(F);
Inc(F,MaxSize);
Until F=T;
end;
end;
//Tjek skrå \-retning...
Antal:=1;
F:=Pos-SMaxSize;
While Map[F]=P do begin
Inc(Antal);
Dec(F,SMaxSize);
end;
T:=Pos+SMaxSize;
While Map[T]=P do begin
Inc(Antal);
Inc(T,SMaxSize);
end;
If Antal>3 then begin
New4S:=True;
If VisMarkerede then begin
Inc(F,SMaxSize);
Repeat
If F<>Pos then AddMark(F);
Inc(F,SMaxSize);
Until F=T;
end;
end;
//Tjek skrå /-retning...
Antal:=1;
F:=Pos-PMaxSize;
While Map[F]=P do begin
Inc(Antal);
Dec(F,PMaxSize);
end;
T:=Pos+PMaxSize;
While Map[T]=P do begin
Inc(Antal);
Inc(T,PMaxSize);
end;
If Antal>3 then begin
New4S:=True;
If VisMarkerede then begin
Inc(F,PMaxSize);
Repeat
If F<>Pos then AddMark(F);
Inc(F,PMaxSize);
Until F=T;
end;
end;
end;
Procedure PlacePiece(X:Integer);
Var
Pos,Y:Integer;
begin
If StandardSize then CurrentGame[43-CellsLeft]:=X;
GameStart:=False;
PauseCPU:=True;//Undgå at computeren spiller videre under showmessages;
Y:=TopP[X];
Pos:=(X ShL Ln2MaxSize) or Y;
If Y<1 then showError(''Error. CPU forsøger at placere på fyldt kolonne.'');
Dec(TopP[X]);
Map[Pos]:=CP;
DrawCell(Pos);
Dec(CellsLeft);
HvisTurMark:=0;
If New4S(Pos,True) then begin
GameOver:=True;
If CP=HvemBegyndteSidst then SidsteVinder:=BegynderenVandt
else SidsteVinder:=BegynderenTabte;
end;
If Not(GameOver or Boolean(CellsLeft)) then begin
GameOver:=True;
SidsteVinder:=IngenVinder;
CPUMoving:=False;//Så der atter kan gentegnes, hvis showmessages flyttes
ShowMessage(''Spillet Endte uafgjort!'');
end;
IsPlaying:=Not GameOver;
CP:=CP Xor 6;
PauseCPU:=False;
end;
Function WeakCPUThink:Integer;
Var I,Pos:Integer;
begin
//Kan der placeres 4 på stribe. Bloker kun muligvis (50%)
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
Pos:=(I ShL Ln2MaxSize) or TopP[I];
Map[Pos]:=CP;
If Boolean(Random(2)) and New4S(Pos,False) then begin
WeakCPUThink:=I;
Exit;
end;
Map[Pos]:=Tom;
end;
//Kan modstanderen forhindres i at sætte 4 på stribe. Bloker kun muligvis (50%)
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
Pos:=(I ShL Ln2MaxSize) or TopP[I];
Map[Pos]:=CP Xor 6;
If Boolean(Random(2)) and New4S(Pos,False) then begin
WeakCPUThink:=I;
Exit;
end;
Map[Pos]:=Tom;
end;
//Placer brikken tilfældigt
I:=Succ(Random(SizeX));
Repeat
I:=Succ(I mod SizeX);
Until Boolean(TopP[I]);
WeakCPUThink:=I;
end;
Function CPUThink:Integer;
Var
I,J,Pos:Integer;
Avoid:Array[1..PPMaxSize] of Boolean;
begin
//Kan der placeres 4 på stribe?
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
Pos:=(I ShL Ln2MaxSize) or TopP[I];
Map[Pos]:=CP;
If New4S(Pos,False) then begin
CPUThink:=I;
Exit;
end;
Map[Pos]:=Tom;
end;
//Kan modstanderen forhindres i at sætte 4 på stribe?
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
Pos:=(I ShL Ln2MaxSize) or TopP[I];
Map[Pos]:=CP Xor 6;
If New4S(Pos,False) then begin
CPUThink:=I;
Exit;
end;
Map[Pos]:=Tom;
end;
//Prøv at placere brikker så modst. ikke får 4 på stribe ved at placere ovenover...
For I:=1 to SizeX do if TopP[I]>1 then begin//Skal være plads til 2 brikker
Pos:=(I ShL Ln2MaxSize) or TopP[I];
Map[Pos]:=CP;
Map[Pred(Pos)]:=CP Xor 6;
Avoid[I]:=New4S(Pred(Pos),False);
Map[Pred(Pos)]:=Tom;
Map[Pos]:=Tom;
end else Avoid[I]:=Not Boolean(TopP[I]);
For I:=1 to SizeX do If not Avoid[I] then begin
Repeat
J:=Succ(Random(SizeX));//Vælg tilfældigt felt
Until not Avoid[J];
CPUThink:=J;
Exit;
end;
//Placer brikken tilfældigt - modstanderen vil vinde
I:=Random(SizeX);
Repeat
I:=Succ(I mod SizeX);
Until Boolean(TopP[I]);
CPUThink:=I;
end;
Procedure TjekError(Pos:Integer);
Var I:Integer;
begin
DrawM(Pos,True);
{Inc(ErrorTjek);
Form1.Caption:=IntToStr(ErrorTjek);}
{Pause:=True;
Repeat
Application.ProcessMessages;
Until Not Pause;}
For I:=0 to 4000000 do;
DrawM(Pos,True);
end;
Procedure CreateValueList;//Virker
Type
TMyType=Record
AntalZ,Value:Integer;
BrugtTomme:Array[1..3] of Integer;
end;
Var
A,B,I,J,F,T,Y,Z,BonusFelter,Current,AntalX,AntalDirect:Integer;
WhereIsP4S:Array[1..7] of Integer;//Where Is Possible 4 Straight. Fri/FriTom
AntalY:Array[1..6] of Integer;
Fil:File;
Bonus:Boolean;
L:Array[0..8] of Integer;
Fyldte:Array[1..7] of Boolean;
Komb:Array[1..6,1..3] of TMyType;
S:String;
Function MakeS:String;
Const Chars:Array[0..3] of Char=(''#'',''_'',''x'','' '');
Var
I:Integer;
S:String;
begin
SetLength(S,7);
For I:=1 to 7 do S[I]:=Chars[L[I]];
S[4]:=''X'';
MakeS:=S;
end;
Function PossiblePos(J:Integer):String;
begin
Case AntalPP[J] of
0:PossiblePos:='''';
1:PossiblePos:='' P1=''+IntToStr(PP[J,1]);
2:PossiblePos:='' P1=''+IntToStr(PP[J,1])+'' P2=''+IntToStr(PP[J,2]);
end;
end;
Function Call(XNr:Integer):Integer;//Returnerer MaxSum
Var I,Max,Temp:Integer;
Function PladsTil(Var New:TMyType):Boolean;
Var I:Integer;
begin
PladsTil:=True;
For I:=1 to New.AntalZ do If Fyldte[New.BrugtTomme[I]] then begin
PladsTil:=False;
Break;
end;
end;
Procedure Invert(Var Inv:TMyType);
Var I:Integer;
begin
For I:=1 to Inv.AntalZ do
Fyldte[Inv.BrugtTomme[I]]:=Not Fyldte[Inv.BrugtTomme[I]];
end;
begin
If Boolean(XNr) then begin//Ellers returneres 0
Max:=Call(Pred(XNr));//=Mulighed 1: Der tilføres ikke nogen fra denne x-værdi
For I:=1 to AntalY[XNr] do If PladsTil(Komb[XNr,I]) then begin
Invert(Komb[XNr,I]);
Temp:=Call(Pred(XNr))+Komb[XNr,I].Value;
If Temp>Max then Max:=Temp;
Invert(Komb[XNr,I]);
end;
Call:=Max;
end else Call:=0;
end;
begin
Form1.ListBox1.Clear;
L[0]:=Udenfor;
L[4]:=SelfPl;
L[8]:=Udenfor;
For I:=1 to 7 do Fyldte[I]:=False;
For J:=0 to 4095 do begin
L[1]:=J and 3;
L[2]:=(J ShR 2) and 3;
L[3]:=(J ShR 4) and 3;
L[5]:=(J ShR 6) and 3;
L[6]:=(J ShR 8) and 3;
L[7]:=J ShR 10;
For I:=1 to 7 do WhereIsP4S[I]:=0;
F:=3;
While Boolean(L[F] and TomOrCP) do Dec(F);
Inc(F);
T:=5;
While Boolean(L[T] and TomOrCP) do Inc(T);
Dec(T);
If T-F>2 then begin//Plads til 4 på stribe
A:=3;
While L[A]=SelfPl do Dec(A);
B:=5;
While L[B]=SelfPl do Inc(B);
If B-A>4 then ValueL[J]:=Straight[B-A] else begin
AntalX:=0;
For I:=F to T do If Boolean(L[I] and Tom) then begin
Inc(AntalX);
Y:=0;
For A:=Max(I-3,F) to Min(I+3,T)-3 do begin
//Kører de intervaller [A..A+3] igennem, som det tomme felt L[I] er en del af.
Inc(Y);
Bonus:=True;//indtil modsat er bevist
BonusFelter:=0;//Antal felter der hænger
//Hvis der findes 4 på stribe vil Bonus=True men BonusL=0, hvorfor bonussen
//bliver 0, og ikke laver ravage.
Current:=4;//Antal aktuelt manglende brikker+1
Z:=0;
For B:=A to A+3 do begin
If Boolean(L[B] and Tom) then begin
Inc(Z);
Komb[AntalX,Y].BrugtTomme[Z]:=B;
If Bonus then If L[B]=1 then Bonus:=False//Et felt der ikke "hænger"
else Inc(BonusFelter);
end else Dec(Current);
end;//For B
Komb[AntalX,Y].AntalZ:=Z;
If Not Bonus then BonusFelter:=0;
Komb[AntalX,Y].Value:=Values[Current,BonusFelter];
If Current=1 then//Kun én brik mangler
For B:=A to A+3 do If Boolean(L[B] and Tom) then //Find denne
WhereIsP4S[B]:=L[B];
end;//For A
AntalY[AntalX]:=Y;
end;//For I
//Nu skal den bedste kombination findes. Undersøg først om der eksempelvist
//er lavet en fælde.
AntalDirect:=0;
AntalPP[J]:=0;
For I:=1 to 7 do If Boolean(WhereIsP4S[I]) then
If WhereIsP4S[I]=FriTom then begin
Inc(AntalPP[J]);
PP[J,AntalPP[J]]:=I-4;
end else Inc(AntalDirect);
If AntalDirect>1 then ValueL[J]:=5000 else ValueL[J]:=Call(AntalX);
end;//Ikke 4 på stribe
end;//Plads til 4 på stribe
Form1.ListBox1.Items.Add(MakeS+'' || Nr=''+IntToStr(J)+'' Værdi=''
+IntToStr(ValueL[J])+PossiblePos(J));
end;//For J
Form1.ListBox1.Items.SaveToFile(''Konstanter.txt'');
Form1.ListBox1.Clear;
While InputQuery(''d'',''d'',S) do begin
For I:=0 to Pred(Form1.ListBox1.Items.Count) do
If Copy(Form1.ListBox1.Items[I],1,7)=S then begin
ShowMessage(Form1.ListBox1.Items[I]);
Break;
end;
end;
//Gem i fil til brug for programmet
If Not FileExists(''Konstanter.cpu'') then
Form1.ListBox1.Items.SaveToFile(''Konstanter.cpu'');//Sørg for at filen eksisterer
AssignFile(Fil,''Konstanter.cpu'');
Rewrite(Fil,1);
BlockWrite(Fil,ValueL,SizeOf(ValueL));
BlockWrite(Fil,AntalPP,SizeOf(AntalPP));
BlockWrite(Fil,PP,SizeOf(PP));
CloseFile(Fil);
end;
Procedure GetValueList;//Virker
Var Fil:File;
begin
If FileExists(''Konstanter.cpu'') then begin
AssignFile(Fil,''Konstanter.cpu'');
Reset(Fil,1);
BlockRead(Fil,ValueL,SizeOf(ValueL));
BlockRead(Fil,AntalPP,SizeOf(AntalPP));
BlockRead(Fil,PP,SizeOf(PP));
CloseFile(Fil);
end else CreateValueList;
end;
Function TjekValue(PTurn,X,RekLevel:Integer):Integer;
// Returnerer en af følgende muligheder
// >$200000: Kan få 4 på stribe
// >$040000: Skal forhindre 4 på stribe
// >$008000: Kan lave fælde
// >$001000: Skal forhindre modstanderen i at lave fælde
// ellers : Kun feltets værdi.
// Hvis x>$000800 da vil (x and $7FF) være selve feltets værdi.
Var
F,T,Y,MinF,MaxT,Potens2,Pos,Index,Sum,Temp,TrapY,Straf:Integer;
SelfMoving:Boolean;
Function Tjek(CPlTjek:Integer; Var Map:TMap):Integer;
begin
Sum:=0;
SelfMoving:=PTurn=CPlTjek;
//$2 Tjek Vandret...
Index:=0;
Potens2:=4;
F:=Pos-MaxSize;
MinF:=Pos-MaxSize4;
While Boolean(Map[F] and TomOrCP) and (F<>MinF) do begin
//Boolean(Map[X,J] and TomOrCP) er sand hvis feltet enten er tomt eller
//indeholder CP. Hvis Fra/Til>3 så er de resterende mulige felter
//uden betydning, da disse ikke kan danne 4 på stribe med det aktuelle felt.
If Map[Succ(F)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[F] ShL Potens2);
Dec(F,MaxSize);
Dec(Potens2,2);
end;
T:=Pos+MaxSize;
MaxT:=Pos+MaxSize4;
Potens2:=6;
While Boolean(Map[T] and TomOrCP) and (T<>MaxT) do begin
If Map[Succ(T)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[T] ShL Potens2);
Inc(T,MaxSize);
Inc(Potens2,2);
end;
Inc(Sum,ValueL[Index]);
While Boolean(AntalPP[Index]) do begin//Trap
//Her er PP[AntalPP[Index]] uden betydning, da der undersøges vandret
//Secured:=Boolean((CellsLeft Xor Y) and 1) Xor SelfMoving;//Xor i stedet for -
//Skifter:=Boolean(Y and 1);
//TrapPos:=Pos+(PP[Index,AntalPP[Index]] ShL Ln2MaxSize);
If Boolean((CellsLeft Xor Y) and 1) Xor SelfMoving then Inc(Sum,SecuredBonus);
If Boolean(Y and 1) then Inc(Sum,ShifterBonus);
If Boolean(RekLevel) then Begin
//Reklevel=0 i langt størstedelen af de gange, tjekvalue kaldes.
Inc(Blk[RekLevel,Y].Antal);
Blk[RekLevel,Y].Pos[Blk[RekLevel,Y].Antal]:=
Pos+(PP[Index,AntalPP[Index]] ShL Ln2MaxSize);//Gem pos
end;
Dec(AntalPP[Index]);
end;
//Tjek lodret...(ingen fritsvævende)
Index:=0;
F:=Pred(Pos);
MinF:=Pos-4;
Potens2:=4;
While Boolean(Map[F] and TomOrCP) and (F<>MinF) do begin
Inc(Index,Map[F] ShL Potens2);
Dec(F);
Dec(Potens2,2);
end;
T:=Succ(Pos);
MaxT:=Pos+4;
Potens2:=6;
While Boolean(Map[T] and TomOrCP) and (T<>MaxT) do begin
Inc(Index,Map[T] ShL Potens2);
Inc(T);
Inc(Potens2,2);
end;
Inc(Sum,ValueL[Index]);
//Tjek skrå \-retning...
Index:=0;
F:=Pos-SMaxSize;
MinF:=Pos-SMaxSize4;
Potens2:=4;
While Boolean(Map[F] and TomOrCP) and (F<>MinF) do begin
If Map[Succ(F)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[F] ShL Potens2);
Dec(F,SMaxSize);
Dec(Potens2,2);
end;
T:=Pos+SMaxSize;
MaxT:=Pos+SMaxSize4;
Potens2:=6;
While Boolean(Map[T] and TomOrCP) and (T<>MaxT) do begin
If Map[Succ(T)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[T] ShL Potens2);
Inc(T,SMaxSize);
Inc(Potens2,2);
end;
Inc(Sum,ValueL[Index]);
While Boolean(AntalPP[Index]) do begin//Trap
Temp:=PP[Index,AntalPP[Index]];
TrapY:=Y Xor Temp;//Xor i stedet for +, da kun sidste ciffer skal bruges
If Boolean((CellsLeft Xor TrapY) and 1) Xor SelfMoving then Inc(Sum,SecuredBonus);
If Boolean(TrapY and 1) then Inc(Sum,ShifterBonus);
If Boolean(RekLevel) then begin
Inc(Blk[RekLevel,Y].Antal);
Blk[RekLevel,Y].Pos[Blk[RekLevel,Y].Antal]:=
Pos+((Temp ShL Ln2MaxSize) or Temp);//Gem pos
end;
Dec(AntalPP[Index]);
end;
//Tjek skrå /-retning...
Index:=0;
F:=Pos-PMaxSize;
MinF:=Pos-PMaxSize4;
Potens2:=4;
While Boolean(Map[F] and TomOrCP) and (F<>MinF) do begin
If Map[Succ(F)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[F] ShL Potens2);
Dec(F,PMaxSize);
Dec(Potens2,2);
end;
T:=Pos+PMaxSize;
MaxT:=Pos+PMaxSize4;
Potens2:=6;
While Boolean(Map[T] and TomOrCP) and (T<>MaxT) do begin
If Map[Succ(T)]=Tom then//Ovenstående felt frit
Inc(Index,FriTom ShL Potens2)
else Inc(Index,Map[T] ShL Potens2);
Inc(T,PMaxSize);
Inc(Potens2,2);
end;
Inc(Sum,ValueL[Index]);
While Boolean(AntalPP[Index]) do begin//Trap
Temp:=PP[Index,AntalPP[Index]];
TrapY:=Y Xor Temp;
If Boolean((CellsLeft Xor TrapY) and 1) Xor SelfMoving then Inc(Sum,SecuredBonus);
If Boolean(TrapY and 1) then Inc(Sum,ShifterBonus);
If Boolean(RekLevel) then begin
Inc(Blk[RekLevel,Y].Antal);
Blk[RekLevel,Y].Pos[Blk[RekLevel,Y].Antal]:=Pos+(Temp ShL Ln2MaxSize)-Temp;
end;
Dec(AntalPP[Index]);
end;
//Tjek retninger færdig
//Modstanderens 4 på striber/fælder skal tælle mindre end ens egne...
If SelfMoving then Tjek:=Sum else Tjek:=(Sum and $7FF) or ((Sum and $FFF800) ShR 3);
end;
begin//Selve proceduren
Y:=TopP[X];
Pos:=(X ShL Ln2MaxSize) or Y;
Straf:=0;
If Not Boolean(PlMap[PTurn,Pos]) then Straf:=DestroyTrapPenalty;
//Ens egen fælde vil blive ødelagt
If Not Boolean(PlMap[PTurn Xor 6,Pos]) then Inc(Straf,Prevent4S);
//Modstanderen kan vinde i næste ryk. Der kan godt modtages begge straffe.
Blk[RekLevel,Y].Antal:=0;
//ShowMessage(IntToStr(Tjek(PTurn Xor 6,PlMap[PTurn Xor 6])));
TjekValue:=Tjek(PTurn,PlMap[PTurn])+Tjek(PTurn Xor 6,PlMap[PTurn Xor 6])-Straf;
end;
Procedure PlaceTrap(Pl,Pos:Integer);
Var MinY,NPl:Integer;
begin
//Placer nedefra og op
MinY:=Pos and KunX;//MinY skal der ikke placeres på
NPl:=Pl Xor 6;
Repeat
PlMap[Pl,Pos]:=Udenfor;
Dec(Pos);
If Pos=MinY then Break;
PlMap[NPl,Pos]:=Udenfor;
Dec(Pos);
Until Pos=MinY;
end;
Procedure RemoveTrap(Pl,Pos:Integer);
Var MinY,NPl:Integer;
begin
//Fjern nedefra og op
MinY:=Pos and KunX;//MinY skal ikke medtages
NPl:=Pl Xor 6;
Repeat
PlMap[Pl,Pos]:=Udenfor;
Dec(Pos);
If (Pos=MinY) or Not Boolean(PlMap[NPl,Pos]) then Break;
PlMap[NPl,Pos]:=Udenfor;
Dec(Pos);
Until (Pos=MinY) or Not Boolean(PlMap[Pl,Pos]);
end;
Function TjekLevel(Turn,RekLevel,PX:Integer):Integer;//Tilhører NextGenCPU2
//Functionen placerer og fjerner selv brikken (Placeret ved x=PX) samt traps.
Var
I,Max,MaxPos,NTurn,PPos:Integer;
L:TStdListe;
Procedure PlaceTraps(Var Blk:TBlk);
Var I:Integer;
begin
For I:=1 to Blk.Antal do PlaceTrap(NTurn,Blk.Pos[I]);
//NTurn: De fælde, der placeres, er lavet af modstanderen i forrige træk.
end;
Procedure RemoveTraps(Var Blk:TBlk);
Var I:Integer;
begin
For I:=1 to Blk.Antal do RemoveTrap(NTurn,Blk.Pos[I]);
end;
Procedure UndoOpdate;
begin
RemoveTraps(Blk[Succ(RekLevel),PX]);
//Pred(RekLevel): Fælderne er lavet trækket før, da RekLevel var en større.
Inc(TopP[PX]);
PlMap[Turn,PPos]:=Tom;
PlMap[NTurn,PPos]:=Tom;
end;
begin
NTurn:=Turn Xor 6;
PPos:=(PX ShL Ln2MaxSize) or TopP[PX];
//Opdater PlMap...
PlMap[Turn,PPos]:=Turn;
PlMap[NTurn,PPos]:=NTurn;
Dec(TopP[PX]);
PlaceTraps(Blk[Succ(RekLevel),PX]);
//Opdatering slut.
MaxPos:=0;//Undgå warning
Max:=-999999999;
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
L[I]:=TjekValue(Turn,I,RekLevel);
If L[I]>Max then begin
Max:=L[I];
MaxPos:=I;
end;
end else L[I]:=-999999999;
If Max>LSave4S then begin
TjekLevel:=Save4S;
UndoOpdate;
Exit;
end;
If Max>LPrevent4S then begin
For I:=1 to SizeX do if L[I]>LPrevent4S then If I<>MaxPos then begin
//En fælde. modstanderen har vundet
TjekLevel:=-Save4S;
UndoOpdate;
Exit;
end;
end else If Max>LSaveTrap then begin
//Sikker sejr. Der kan laves en fælde, og modstanderen har ingen modtræk.
TjekLevel:=Save4S;
UndoOpdate;
Exit;
end;
If Boolean(RekLevel) then begin//Not final RekLevel
If Max>LPrevent4S then begin
//Computeren har kun én mulighed for at placere sin brik, idet den skal
//forhindre modstanderen i at få 4 på stribe.
Max:=Max and MaxOrdValue;//Computeren skal ikke favourisere en situation,
//hvor den kan forhindre modstanderen i at få 4 på stribe.
//Max er ikke-negativ.
If Max<0 then showmessage(''Error: Max<0'');
Dec(Max,TjekLevel(NTurn,Pred(RekLevel),MaxPos));//Dec fordi modst. pot. fraregnes
end else begin//Placer mest værdifulde sted. Der er kun tale om ordinære værdier.
Max:=-MaxOrdValue;
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
L[I]:=L[I] and MaxOrdValue;//PreventTrap skal sies fra.
Dec(L[I],TjekLevel(NTurn,Pred(RekLevel),I));//Dec fordi modst. pot. fraregnes
If L[I]>Max then Max:=L[I];
end;
end;
end;
UndoOpdate;
TjekLevel:=Max;
end;
Procedure CreateMaps;
Var I,J,Player,Pos:Integer;
begin
For J:=1 to SizeY do For I:=1 to SizeX do begin//Ajourfør PlMap
Pos:=(I ShL Ln2MaxSize) or J;
PlMap[Pl1,Pos]:=Map[Pos];
If Map[Pos]<Pl1 then PlMap[Pl2,Pos]:=Map[Pos] else PlMap[Pl2,Pos]:=Map[Pos] Xor 6;
end;
Player:=Pl1;
Repeat
For I:=1 to SizeX do For J:=1 to Pred(TopP[I]) do begin
//Pred:En fælde kan ikke befinde sig umiddelbart over et ikke-tomt felt.
Pos:=(I ShL Ln2MaxSize) or J;
Map[Pos]:=Player;
If New4S(Pos,False) then PlaceTrap(Player,Pos);
Map[Pos]:=Tom;
end;
Inc(Player,2);
Until Player>Pl2;
end;
Function NextGenCPU2:Integer;
Const RekLevels:Array[3..6,2..PPMaxSize] of Integer=
//der udregnes 2 halvtræk længere frem, end der står i listen.
//Hvis der kun er én kolonne fri, placeres der straks
((0,0,0,0,0,0,0,0,0,0,0,0,0),
// ((1,1,1,1,1,1,1,1,1,1,1,1,1),//Max 2744 træk
(10,6,4,3,3,2,2,2,2,1,1,1,1),//Max 10000 træk
(10,8,6,5,4,4,3,3,3,2,2,2,2),//Max 120000 træk
(10,10,8,6,5,5,4,4,4,3,3,3,3));//Max 1100000 træk
Var
I,Max,MaxPos,RekLevel:Integer;
L:TStdListe;
begin
NextGenCPU2:=0;//Undgå warning
MaxPos:=0;//Undgå warning
If AntalKolonner=1 then begin//Kun en mulighed - placer straks
For I:=1 to SizeX do if Boolean(TopP[I]) then NextGenCPU2:=I;
Exit;
end;
CreateMaps;
RekLevel:=Min(CellsLeft-2,RekLevels[PlT[CP],AntalKolonner]);
//CellsLeft-2 fordi den første brik placeres af denne procedure, og fordi
//TjekLevel først stopper ved RekLevel=0
Max:=-999999999;//Mindre end nogen værdi TjekLevel vil returnere
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
L[I]:=TjekValue(CP,I,RekLevel);
If L[I]>Max then begin
Max:=L[I];
MaxPos:=I;
end;
end else L[I]:=-999999999;
If Max>LSaveTrap then begin//Udfør nødtvunget træk
NextGenCPU2:=MaxPos;
Exit;
end;
For I:=1 to SizeX do if L[I]>0 then L[I]:=L[I] and MaxOrdValue;
//PreventTrap skal fratrækkes.
Max:=-999999999;
For I:=1 to SizeX do if Boolean(TopP[I]) then begin
Application.ProcessMessages;//Tillad blink ved CPU vs CPU
L[I]:=(L[I]-TjekLevel(CP Xor 6,RekLevel,I))*(56+Random(17));
//Dec fordi modst. potentiale skal fraregnes
If L[I]>Max then begin
Max:=L[I];
MaxPos:=I;
end;
end;
//Showmessage(inttostr(max));
NextGenCPU2:=MaxPos;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Pause then begin
Pause:=False;
Exit;
end;
If CPUMoving then Exit;
If GameOver then begin
GameOver:=False;
If Button=mbRight then AddGame;
NewGame;
Exit;
end;
If Button=mbLeft then begin
If Not Boolean(PlT[CP]) then begin
Convert(X);
If Boolean(TopP[X]) then PlacePiece(X);
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
If Boolean(PlT[CP]) and Not(PauseCPU or GameOver or CPUMoving) then begin
If CPUvsCPU then If Now<LastNow+0.00002 then Exit;
LastNow:=Now;
CPUMoving:=True;
Case PlT[CP] of
1:PlacePiece(WeakCPUThink);
2:PlacePiece(CPUThink);
else PlacePiece(NextGenCPU2);
end;
CPUMoving:=False;
If ManglerAtGentegne then begin
Gentegn;
ManglerAtGentegne:=False;
end;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
Gentegn;
Timer2.Enabled:=False;
end;
procedure TForm1.Options1Click(Sender: TObject);
begin
If CPUMoving then Exit;
GameStart:=False;
PauseCPU:=True;
Application.CreateForm(TForm2, Form2);
Enabled:=False;
Form2.Show;
end;
procedure TForm1.Nytspil1Click(Sender: TObject);
begin
If CPUMoving then Exit;
NewGame;
end;
procedure TForm1.Quit1Click(Sender: TObject);
begin
If CPUMoving then Exit;
Close;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
If CPUMoving then Exit;
Timer2.Enabled:=False;
ShowMessage(''4 på stribe version 1.5 (10 juni 1999). Lavet af Jesper Torp Kristensen ''+
''(JesperTK@Hotmail.com) v.h.a. Borland Delphi 3. Spillet gælder om at få ''+
''4 af ens egne brikker til at ligge på stribe (skrå tæller også). ''+
''Hvis der trykkes nyt spil, uden at et er i gang, starter den anden spiller. ''+
''Resten af teksten er en beskrivelse af de hidtidige versioner. ''+
''Version 1.0 - omkr. 20 maj 99: Programmet omfatter kun selve spillepladen med valgfri størrelse. ''+
''Det eneste computeren tjekker er, om den kan få eller forhindre 4 på stribe. ''+
''Version 1.1 - omkr. 23 maj 99: Computeren placerer ikke længere en brik, så modstanderen kan få ''+
''4 på stribe ved at placere ovenover. Der eksperimenteres med nye algoritmer ''+
''til at forbedre computerens intelligens, mens de spiller elendigt. ''+
''Computeren kan nu tildele de enkelte trækmuligheder point ud fra deres potentiale. ''+
''Version 1.2 - 27 maj: Ny computer-intelligens. Computeren kan ''+
''nu tænke 3 træk frem, og er i stand til at slå selv garvede spillere. ''+
''Version 1.3 - omkr. 31 maj: Bruger-menuer tilføjes, valgfri spilstørrelse, ''+
''Sværhedsgrader fra latterlig nem til halvsvær. ''+
''Version 1.4 - 5 juni: Større brugervenlighed (foreslå træk, gem settings, osv.). Ny ''+
''Sværhedsgrad:Langsom. Væsentlig hastighedsoptimering (32% hurtigere). ''+
''Version 1.5 - 10 juni: Endnu en hastighedsoptimering (40% hurtigere). ''+
''Compuren er samtidig blevet klogere, idet den tager højde for flere ''+
''stillingsmæssige detajler.'');
Timer2.Enabled:=True;
end;
procedure TForm1.MarkerTimer(Sender: TObject);
Var I:Integer;
begin
Dec(BlinkTilbage);
For I:=1 to AntalMarkerede do DrawM(Marks[I],True);
If Not Boolean(BlinkTilbage) then Marker.Enabled:=False;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If CPUMoving or Boolean(PlT[CP]) or GameOver then Exit;
Convert(X);
If X<>(HvisTurMark ShR Ln2MaxSize) then begin
If Boolean(HvisTurMark and PMaxSize) then begin
Canvas.Brush.Color:=ClBtnFace;
Canvas.Pen.Color:=ClBtnFace;
DrawM(HvisTurMark,False);
end;
HvisTurMark:=(X ShL Ln2MaxSize) or TopP[X];
If Boolean(HvisTurMark and PMaxSize) then begin
Canvas.Brush.Color:=Farver[Farve[CP]];
Canvas.Pen.Color:=Canvas.Brush.Color;
DrawM(HvisTurMark,False);
end;
end;
end;
procedure TForm1.Afbryd1Click(Sender: TObject);
begin
GameOver:=True;
IsPlaying:=False;
end;
procedure TForm1.Trkforslag1Click(Sender: TObject);
Var Move:Integer;
begin
If Boolean(PlT[CP]) then Exit;
CPUMoving:=True;
Trkforslag1.Caption:=''Tænker...'';
PlT[CP]:=ProposeMove;
Case ProposeMove of
1:Move:=WeakCPUThink;
2:Move:=CPUThink;
else Move:=NextGenCPU2;
end;
PlT[CP]:=Menneske;
DrawM((Move ShL Ln2MaxSize) or TopP[Move],True);
Trkforslag1.Caption:=''Trækforslag'';
CPUMoving:=False;
end;
end.
