Nyerő négyzet

 

Írjunk az amőbához hasonló játékprogramot, amelyben a cél az, hogy jeleinket egy négyzet csúcsaiban kell elhelyezni. A négyzet elhelyezkedése nemcsak tengelyirányú lehet, azaz az oldalai akár L alakban is elhelyezkedhetnek a rácshoz képest.

 

A program írja ki a 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 4 jele egy négyzet négy csúcsában helyezkedik el,

- a négyzet oldali nem feltétlen párhuzamosak a rácsrendszer soraival, oszlopaival.

 

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:

 

 

         A program listája:

 

unit UNegyzet;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

  Graphics, Controls, Forms, Dialogs, StdCtrls;

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

Const Max=31;
      D=16;
      Dx=8;
      Dy=8;
      R=5;

var
  fmNegyzet: TfmNegyzet;
  Xk, Yk, Mx, My, F: Integer;
  Mezo: Array[0..Max+1,0..Max+1] Of Byte;
  VegeVan: Byte;

implementation

{$R *.dfm}

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

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

procedure TfmNegyzet.FormPaint(Sender: TObject);
Var I, J: Integer;
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
  With Canvas Do
  Begin
    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;
end;

Procedure TfmNegyzet.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 TfmNegyzet.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Mx:= X; My:= Y;
end;

procedure TfmNegyzet.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;
    Case Vege Of
      1: TextOut(Xk+(F+2)*D,Yk,' Győztem ');
      2: TextOut(Xk+(F+2)*D,Yk,' Győztél ');
    End;
    Kepre;
    If VegeVan=0 Then
    Begin
      Gep;
      Case Vege Of
        1: TextOut(Xk+(F+2)*D,Yk,' Győztem ');
        2: TextOut(Xk+(F+2)*D,Yk,' Győztél ');
      End;
      Kepre;
    End;
  End;
end;

Function TfmNegyzet.Vege: Byte;
Var I, J, N, M, V: Word;
Begin
  Vege:= 0; VegeVan:= 0;
  For I:= 1 To Max Do For J:= 1 To Max Do If Mezo[I,J]<>0 Then
  Begin
    V:= Max-I; If Max-J<V Then V:= Max-J;
    For N:= 1 To V Do For M:= 0 To V Do
    If ((I+N-M)>0) And ((I-M)>0) Then
    If (Mezo[I,J]=Mezo[I+N  ,J  +M]) And
       (Mezo[I,J]=Mezo[I+N-M,J+N+M]) And
       (Mezo[I,J]=Mezo[I  -M,J+N  ]) Then
    Begin
      Vege:= Mezo[I,J]; VegeVan:= Mezo[I,J];
      Inc(Mezo[I,    J    ],2);
      Inc(Mezo[I+N  ,J  +M],2);
      Inc(Mezo[I+N-M,J+N+M],2);
      Inc(Mezo[I  -M,J+N  ],2);
      Break;
    End;
  End;
End;

Procedure TfmNegyzet.Gep;
Var I, J, N, M, P, Q, R, V, Z: Word;
Begin
  For I:= 1 To Max Do For J:= 1 To Max Do
  Begin
    V:= Max-I; If Max-J<V Then V:= Max-J;
    For N:= 1 To V Do For M:= 0 To V Do
    If ((I+N-M)>0) And ((I-M)>0) Then
    Begin
      P:= 0; Q:= 0; R:= 0; Z:= 0;
      If Mezo[I,J]=0 Then Begin Inc(R); Z:= 1 End;
      If Mezo[I,J]=1 Then Inc(P);
      If Mezo[I,J]=2 Then Inc(Q);
      If Mezo[I+N  ,J  +M]=0 Then Begin Inc(R); Z:= 2 End;
      If Mezo[I+N  ,J  +M]=1 Then Inc(P);
      If Mezo[I+N  ,J  +M]=2 Then Inc(Q);
      If Mezo[I+N-M,J+N+M]=0 Then Begin Inc(R); Z:= 3 End;
      If Mezo[I+N-M,J+N+M]=1 Then Inc(P);
      If Mezo[I+N-M,J+N+M]=2 Then Inc(Q);
      If Mezo[I  -M,J+N  ]=0 Then Begin Inc(R); Z:= 4 End;
      If Mezo[I  -M,J+N  ]=1 Then Inc(P);
      If Mezo[I  -M,J+N  ]=2 Then Inc(Q);
      If (R=1) And ((P=3) Or (Q=3)) Then
      Begin
        Case Z Of
          1: Mezo[I,J]:= 1;
          2: Mezo[I+N  ,J  +M]:= 1;
          3: Mezo[I+N-M,J+N+M]:= 1;
          4: Mezo[I  -M,J+N  ]:= 1;
        End;
        Exit;
      End;
    End;
  End;

  For I:= 1 To Max Do For J:= 1 To Max Do
  Begin
    V:= Max-I; If Max-J<V Then V:= Max-J;
    For N:= 1 To V Do For M:= 0 To V Do
    If ((I+N-M)>0) And ((I-M)>0) Then
    Begin
      P:= 0; Q:= 0; R:= 0; Z:= 0;
      If Mezo[I,J]=0 Then Begin Inc(R); Z:= 1 End;
      If Mezo[I,J]=1 Then Inc(P);
      If Mezo[I,J]=2 Then Inc(Q);
      If Mezo[I+N  ,J  +M]=0 Then Begin Inc(R); Z:= 2 End;
      If Mezo[I+N  ,J  +M]=1 Then Inc(P);
      If Mezo[I+N  ,J  +M]=2 Then Inc(Q);
      If Mezo[I+N-M,J+N+M]=0 Then Begin Inc(R); Z:= 3 End;
      If Mezo[I+N-M,J+N+M]=1 Then Inc(P);
      If Mezo[I+N-M,J+N+M]=2 Then Inc(Q);
      If Mezo[I  -M,J+N  ]=0 Then Begin Inc(R); Z:= 4 End;
      If Mezo[I  -M,J+N  ]=1 Then Inc(P);
      If Mezo[I  -M,J+N  ]=2 Then Inc(Q);
      If (R=2) And ((P=2) Or (Q=2)) Then
      Begin
        Case Z Of
          1: Mezo[I,J]:= 1;
          2: Mezo[I+N  ,J  +M]:= 1;
          3: Mezo[I+N-M,J+N+M]:= 1;
          4: Mezo[I  -M,J+N  ]:= 1;
        End;
        Exit;
      End;
    End;
  End;
  Repeat
    I:= Random(Max)+1;
    J:= Random(Max)+1;
  Until (Mezo[I,J]=0) And
        (Mezo[I-1,J-1]+Mezo[I  ,J-1]+Mezo[I+1,J-1]+
         Mezo[I-1,J  ]+              Mezo[I+1,J  ]+
         Mezo[I-1,J+1]+Mezo[I  ,J+1]+Mezo[I+1,J+1]>0);
  Mezo[I,J]:= 1;
  //(0,0); (n,0);(n,n);(0,n); (0,1);(-1,1);(-1,0)
End;

procedure TfmNegyzet.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.