Amőba

Készítsünk programot, amely amőba játékot tud játszani. Írja képernyőre a szabályokat:

- az X gép jele, és a gép kezdi a játékot,

- az O a játékos jele,

- a gép és a játékos felváltva helyezik el jelüket a rácson,

- az nyer, akinek 5 szomszédos jele lesz,

- szomszéd: vagy lap-, vagy csúcsszomszéd.

A gép valamilyen algoritmus szerint találjon maga számára célravezető lépéseket. Legyen védekező és némi támadó stratégiája. A játék csak a megadott keretek között folytatódhat. Bármikor meg lehessen szakítani a játékot (Kilépés). Lehessen új játékot kérni. Ha véget ér a játék, az eredményt írja a képernyőre: Győztem, Győztél. A nyerő jelsorozatot vörös színnel jelenítse meg.

A program egy futtatási képe:

Ahogy az a futási képből is látható, a fmAmoba form BorderIcons tulajdonságaiból a biMinimize-t és a biMaximize-t False-ra kell állítani, hogy a látványt átméretezéssel ne lehessen elrontani.

A program listája:

unit UAmoba;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;

type
TfmAmoba = class(TForm)
lbAmoba: TLabel;
    lbSz1: TLabel;
    lbSz2: TLabel;
    lbSz3: TLabel;
    lbSz4: TLabel;
    lbSz5: TLabel;
btKilepes: TButton;
btUjJatek: TButton;
Procedure Kepre;
procedure FormPaint(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
procedure FormClick(Sender: TObject);
Procedure Gep;
Function Vege: Byte;
procedure btUjJatekClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const Max=25;
      D=16;
Dx=8;
Dy=8;
      R=5;
var
fmAmoba: TfmAmoba;
Xk, Yk, Mx, My, F: Integer;
Mezo, PMezo: Array[0..Max+1,0..Max+1] Of Byte;
LMezo: Array[0..100,1..2] Of Byte;
VegeVan: Byte;

implementation

{$R *.dfm}

procedure TfmAmoba.btKilepesClick(Sender: TObject);
begin
Close;
end;

procedure TfmAmoba.FormCreate(Sender: TObject);
begin
Canvas.Brush.Color:= clBtnFace;
end;

procedure TfmAmoba.FormPaint(Sender: TObject);
Var I, J: Integer;
begin
Xk:= ClientWidth Div 2;
Yk:= ClientHeight Div 2;
  F:= Max Div 2;
With Canvas Do
Begin
With Pen Do
Begin
Color:= clBlack;
Width:= 2;
End;
Rectangle(Xk-(F+1)*D,Yk-(F+1)*D, Xk+(F+1)*D,Yk+(F+1)*D);
For I:= -F To F Do For J:= -F To F Do
Pixels[Xk+I*D, Yk+J*D]:= 0;
End;
Mezo[F+1,F+1]:= 1;
Kepre;
end;

Procedure TfmAmoba.Kepre;
Var I, J: Integer;
Begin
For I:= -F To F Do For J:= -F To F Do With Canvas Do
Begin
With Pen Do
Case Mezo[I+F+1,J+F+1] Of
      1,2: Color:= clBlack;
      3,4: Color:= clRed;
End;
Case Mezo[I+F+1,J+F+1] Of
      1,3: Begin
MoveTo(Xk+I*D-R,Yk+J*D-R);
LineTo(Xk+I*D+R,Yk+J*D+R);
MoveTo(Xk+I*D-R,Yk+J*D+R);
LineTo(Xk+I*D+R,Yk+J*D-R);
End;
      2,4: Ellipse(Xk+I*D-R,Yk+J*D-R,Xk+I*D+R,Yk+J*D+R);
End;
End;
End;

procedure TfmAmoba.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Mx:= X; My:= Y;
end;

Function TfmAmoba.Vege: Byte;
Var M, N, P, Q, S: Byte;
Procedure Valto(M, N, D, T: Byte); Var K: Byte;
Begin
For K:=0 To 4 Do
Case D Of
1: If T=1 Then Mezo[M+K,N]:= 3 Else Mezo[M+K,N]:= 4;
      2: If T=1 Then Mezo[M+K,N+K]:= 3 Else Mezo[M+K,N+K]:= 4;
      3: If T=1 Then Mezo[M,N+K]:= 3 Else Mezo[M,N+K]:= 4;
      4: If T=1 Then Mezo[M-K,N+K]:= 3 Else Mezo[M-K,N+K]:= 4;
End;
End;
Begin
Vege:= 0; VegeVan:= 0;
For M:= 1 To Max Do For N:= 1 To Max Do If Mezo[M, N] In [1,2] Then
Begin
    S:= 1; P:= M + 1;
While Mezo[P, N]= Mezo[M, N] Do Begin Inc(S); Inc(P) End;
If S= 5 Then
Begin
Vege:= Mezo[M, N]; VegeVan:= Mezo[M, N];
Valto(M, N, 1, Mezo[M, N]); Kepre; Exit;
End;
S:= 1; P:= M + 1; Q:= N + 1;
While Mezo[P, Q]= Mezo[M, N] Do Begin Inc(S); Inc(P); Inc(Q) End;
If S=5 Then
Begin
Vege:=Mezo[M,N]; VegeVan:= Mezo[M, N];
Valto(M,N,2,Mezo[M,N]); Kepre; Exit;
End;
    S:= 1; Q:= N + 1;
While Mezo[M, Q]= Mezo[M, N] Do Begin Inc(S); Inc(Q) End;
If S= 5 Then
Begin
Vege:= Mezo[M, N]; VegeVan:= Mezo[M, N];
Valto(M, N, 3, Mezo[M, N]); Kepre; Exit;
End;
    S:= 1; P:= M - 1; Q:= N + 1;
While Mezo[P, Q]= Mezo[M, N] Do Begin Inc(S); Dec(P); Inc(Q) End;
If S=5 Then
Begin
Vege:= Mezo[M,N]; VegeVan:= Mezo[M, N];
Valto(M,N,4,Mezo[M,N]); Kepre; Exit;
End;
End;
End;

procedure TfmAmoba.FormClick(Sender: TObject);
begin
If VegeVan<>0 Then Exit;
If (Mx<Xk-F*D) Or
     (Mx>Xk+F*D) Or
     (My<Yk-F*D) Or
     (My>Yk+F*D) Then Exit;
If Mezo[(Mx-Xk+(F+1)*D+Dx) Div D,(My-Yk+(F+1)*D+Dy) Div D]<>0 Then Exit;
With Canvas Do
Begin
With Font Do
Begin
Name:= 'Times New Roman';
Size:= 30;
Color:= clBlue;
End;
Mezo[(Mx-Xk+(F+1)*D+Dx) Div D,(My-Yk+(F+1)*D+Dy) Div D]:= 2;
Kepre;
Case Vege Of
1: TextOut(Xk+(F+2)*D,Yk,' Győztem ');
      2: TextOut(Xk+(F+2)*D,Yk,' Győztél ');
End;
If VegeVan=0 Then
Begin
Gep;
Kepre;
Case Vege Of
        1: TextOut(Xk+(F+2)*D,Yk,' Győztem ');
        2: TextOut(Xk+(F+2)*D,Yk,' Győztél ');
End;
End;
End;
end;

Procedure TfmAmoba.Gep;
Var I, J, K, L, M, S, V, T: Integer;
Begin
For I:= 1 To 25 Do For J:= 1 To 25 Do PMezo[i,j]:= 0;
For I:= 1 To 25 Do For J:= 1 To 25 Do
For K:= -1 To 1 Do For L:= -1 To 1 Do
If Not (Mezo[I, J] In [1, 2]) And (Mezo[I + K, J + L] in [1, 2]) Then
PMezo[I, J]:= 3;
L:= 0; For I:= 1 To 25 Do For J:= 1 To 25 Do If PMezo[I, J]=3 Then
Begin LMezo[L, 1]:= I; LMezo[L, 2]:= J; Inc(L) End;
For I:= 0 To L-1 Do
Begin
    J:= LMezo[I, 1] - 1; K:= LMezo[I, 2]; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Dec(J); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1] + 1; K:= LMezo[I, 2]; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Inc(J); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1]; K:= LMezo[I, 2] - 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Dec(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1]; K:= LMezo[I, 2] + 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Inc(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
J:= LMezo[I, 1] - 1; K:= LMezo[I, 2] - 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Dec(J); Dec(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1] + 1; K:= LMezo[I, 2] - 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Inc(J); Dec(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1] - 1; K:= LMezo[I, 2] + 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Dec(J); Inc(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
    J:= LMezo[I, 1] + 1; K:= LMezo[I, 2] + 1; T:= Mezo[J, K]; S:= 0;
If T In [1,2] Then While Mezo[J, K]= T Do
Begin Inc(PMezo[LMezo[I, 1], LMezo[I, 2]]); Inc(J); Inc(K); Inc(S) End;
If S>=3 Then Inc(PMezo[LMezo[I, 1], LMezo[I, 2]], 50*s);
End;
  M:=0; For I:= 0 To L-1 Do If PMezo[LMezo[I, 1], LMezo[I, 2]]> M Then
  M:= PMezo[LMezo[I, 1], LMezo[I, 2]]; T:= 0;
For I:= 0 To L-1 Do If PMezo[LMezo[I, 1], LMezo[I, 2]]=M Then
Begin
LMezo[T, 1]:= LMezo[I, 1]; LMezo[T, 2]:= LMezo[I, 2]; Inc(T);
End;
  V:= Random(T); Mezo[LMezo[V, 1], LMezo[V, 2]]:= 1;
End;

procedure TfmAmoba.btUjJatekClick(Sender: TObject);
Var I, J: Integer;
begin
For I:= 0 To Max+1 Do For J:= 0 To Max+1 Do Mezo[I,J]:= 0;
VegeVan:= 0;
With Canvas Do
Begin
Pen.Color:= clBtnFace;
Brush.Color:= clBtnFace;
Rectangle(Xk+(F+2)*D,Yk,Xk+(F+13)*D,Yk+3*D);
End;
FormPaint(Sender);
end;

end.