Hamm

Írjunk játékprogramot, amellyel a következő futtatási képen látható tábláról, a korongok eltüntethetők. A korongokat egy lap- vagy csúcsszomszédján át lehet tenni egy üres helyre, ezáltal az átlépett korong eltűnik. Az a cél, hogy csak egyetlen korong maradjon. Ha a megoldás nehéznek bizonyul, akkor egy megoldást a Demo funkcióval meg lehessen nézni. A program futtatása bármikor megszakítható legyen (Demo alatt nem), illetve újra lehessen kezdeni a játékot. A program mindig figyelje, hogy nem ért-e véget a játék. Ha csak egy koron maradt, akkor írja ki, hogy Győztél, ha több és már nem lehet lépni, akkor azt, hogy Vesztettél.

A program indulási képe:

Lépés közbeni állapot, amikor kijelöltük azt a korongot, amivel lépni fogunk (piros):

A program listája:

unit UHamm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids;

type
  TfmHamm = class(TForm)
    btKilepes: TButton;
    btDemo: TButton;
    btUjra: TButton;
Procedure Kepre;
procedure FormPaint(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btDemoClick(Sender: TObject);
procedure btUjraClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const D=40;
Dx=20;
      Dy=20;
      T=5;

var
  fmHamm: TfmHamm;
  Xk, Yk, Mx, My: Integer;
  Hx, Hy, PHx, PHy: Byte;
  H: Array[0..8,0..8] Of Byte;
  VegeVan, Lepes: Boolean;

implementation

{$R *.dfm}

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

procedure TfmHamm.FormCreate(Sender: TObject);
Var I, J: Integer;
begin
For I:= 0 To 8 Do For J:= 0 To 8 Do H[I,J]:= 0;
  VegeVan:= False; Lepes:= False;
end;

Procedure TfmHamm.Kepre;
Var I, J: Integer;
Begin
With Canvas Do
Begin
For I:= 1 To 8 Do For J:= 1 To 8 Do
Begin
Case H[I,J] Of
        0: Begin
Pen.Color:= clBtnFace;
             Brush.Color:= clBtnFace;
End;
        1: Begin
             Pen.Color:= clBlue;
             Brush.Color:= clBlue;
End;
        2: Begin
             Pen.Color:= clRed;
             Brush.Color:= clRed;
End;
End;
      Ellipse(Xk+(I-4)*D-Dx-1+T,Yk+(J-4)*D-Dy-1+T,
              Xk+(I-4)*D+Dx-T,Yk+(J-4)*D+Dy-T);
End;
End;
End;

procedure TfmHamm.FormPaint(Sender: TObject);
Var I, J: Integer;
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
With Canvas Do
Begin
    Pen.Color:= clBtnFace;
Rectangle(Xk+5*D,Yk,2*Xk,Yk+50);
    Pen.Width:= 2;
For I:= 1 To 7 Do For J:= 1 To 7 Do
If (I In [3..5]) Or (J In [3..5]) Then
Begin
      Pen.Color:= clBlack;
      Brush.Color:= clBtnFace;
      Rectangle(Xk+(I-4)*D-Dx-1,Yk+(J-4)*D-Dy-1, Xk+(I-4)*D+Dx,Yk+(J-4)*D+Dy);
      H[I,J]:= 1; If (I=4) And (J=4) Then H[I,J]:= 0;
End;
End;
  Kepre;
end;

Function Bent(A, B: Byte): Boolean;
Begin
  Bent:=((A In [3..5]) And (B In [1..7])) Or
        ((A In [1..7]) And (B In [3..5]));
End;

Function Lephet(A, B: Byte): Boolean;
Begin
  Lephet:= False; If H[A, B]= 0 Then Exit;
If Bent(A-1,B) And Bent(A-2,B) And (H[A-1,B]=1) And (H[A-2,B]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A-1,B-1) And Bent(A-2,B-2) And (H[A-1,B-1]=1) And (H[A-2,B-2]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A,B-1) And Bent(A,B-2) And (H[A,B-1]=1) And (H[A,B-2]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A+1,B-1) And Bent(A+2,B-2) And (H[A+1,B-1]=1) And (H[A+2,B-2]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A+1,B) And Bent(A+2,B) And (H[A+1,B]=1) And (H[A+2,B]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A+1,B+1) And Bent(A+2,B+2) And (H[A+1,B+1]=1) And (H[A+2,B+2]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A,B+1) And Bent(A,B+2) And (H[A,B+1]=1) And (H[A,B+2]=0)
Then Begin Lephet:= True; Exit End;
If Bent(A-1,B+1) And Bent(A-2,B+2) And (H[A-1,B+1]=1) And (H[A-2,B+2]=0)
Then Begin Lephet:= True; Exit End;
End;

Function Vege: Boolean;
Var I, J: Byte;
Begin
  Vege:= True; VegeVan:= True;
For I:= 1 To 7 Do For J:= 1 To 7 Do If Bent(I, J) And Lephet(I, J) Then
Begin Vege:= False; VegeVan:= False; Break End;
End;

procedure TfmHamm.FormClick(Sender: TObject);
Var I, J, V: Byte;
begin
If VegeVan Then Exit;
  Hx:= (Mx-Xk+4*D+Dx) Div D;
  Hy:= (My-Yk+4*D+Dy) Div D;
If Not Bent(Hx,Hy) Then Exit;
If Not Lepes And Lephet(Hx, Hy) Then
Begin
    Lepes:= True;
    H[Hx,Hy]:= 2;
    PHx:= Hx; PHy:= Hy;
    Kepre;
    Exit;
End;
If Lepes Then
Begin
    V:= 0;
If H[Hx, Hy]=0 Then
Begin
If (Hx= PHx-2) And (Hy= PHy  ) And (H[PHx-1, PHy  ]=1) Then V:=1;
If (Hx= PHx-2) And (Hy= PHy-2) And (H[PHx-1, PHy-1]=1) Then V:=2;
If (Hx= PHx-2) And (Hy= PHy+2) And (H[PHx-1, PHy+1]=1) Then V:=3;
If (Hx= PHx+2) And (Hy= PHy  ) And (H[PHx+1, PHy  ]=1) Then V:=4;
If (Hx= PHx+2) And (Hy= PHy-2) And (H[PHx+1, PHy-1]=1) Then V:=5;
If (Hx= PHx+2) And (Hy= PHy+2) And (H[PHx+1, PHy+1]=1) Then V:=6;
If (Hx= PHx  ) And (Hy= PHy-2) And (H[PHx  , PHy-1]=1) Then V:=7;
If (Hx= PHx  ) And (Hy= PHy+2) And (H[PHx  , PHy+1]=1) Then V:=8;
End;
If V>0 Then
Begin
      H[PHx, PHy]:= 0;
Case V Of
        1: H[PHx - 1, PHy    ]:= 0;
        2: H[PHx - 1, PHy - 1]:= 0;
        3: H[PHx - 1, PHy + 1]:= 0;
        4: H[PHx + 1, PHy    ]:= 0;
5: H[PHx + 1, PHy - 1]:= 0;
        6: H[PHx + 1, PHy + 1]:= 0;
        7: H[PHx    , PHy - 1]:= 0;
        8: H[PHx    , PHy + 1]:= 0;
End;
      H[Hx,Hy]:= 1; Lepes:= False;
End;
    Kepre;
If Vege Then With Canvas Do
Begin
With Font Do
Begin
        Name:= 'Times New Roman';
        Size:= 30;
        Color:= clBlue;
End;
      V:= 0;
For I:= 1 To 7 Do For J:= 1 To 7 Do Inc(V,H[I, J]);
Case V Of
        1: TextOut(Xk+5*D,Yk,'GYŐZTÉL');
Else TextOut(Xk+5*D,Yk,'VESZTETTÉL');
End;
End;
End;
end;

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

procedure TfmHamm.btDemoClick(Sender: TObject);
Const L: Array[1..31,1..3,1..2] Of Byte=
               (((6,4),(4,4),(5,4)), ((4,2),(6,4),(5,3)),
                ((2,4),(4,2),(3,3)), ((4,6),(2,4),(3,5)),
                ((6,4),(4,6),(5,5)), ((3,1),(5,3),(4,2)),
                ((1,5),(3,3),(2,4)), ((5,7),(3,5),(4,6)),
                ((5,2),(5,4),(5,3)), ((4,4),(6,4),(5,4)),
                ((7,3),(5,5),(6,4)), ((7,5),(7,3),(7,4)),
((7,3),(5,3),(6,3)), ((3,4),(5,2),(4,3)),
                ((2,3),(4,3),(3,3)), ((5,1),(3,1),(4,1)),
                ((3,1),(3,3),(3,2)), ((3,6),(5,4),(4,5)),
                ((6,5),(4,5),(5,5)), ((3,7),(5,7),(4,7)),
                ((5,7),(5,5),(5,6)), ((5,2),(3,4),(4,3)),
                ((3,4),(3,6),(3,5)), ((1,3),(1,5),(1,4)),
                ((1,5),(3,5),(2,5)), ((3,6),(3,4),(3,5)),
                ((3,3),(3,5),(3,4)), ((4,5),(6,5),(5,5)),
                ((5,3),(5,5),(5,4)), ((6,5),(4,5),(5,5)),
                ((3,5),(5,5),(4,5)));
Var I: Byte;
Begin
  FormPaint(Sender);
For I:=1 To 31 Do
Begin
    H[L[I,1,1],L[I,1,2]]:= 2;
    Kepre; Sleep(300);
    H[L[I,3,1],L[I,3,2]]:= 1;
    Kepre; Sleep(300);
    H[L[I,1,1],L[I,1,2]]:= 0;
    H[L[I,3,1],L[I,3,2]]:= 0;
    H[L[I,2,1],L[I,2,2]]:= 1;
    Kepre; Sleep(800);
End;
With Canvas Do
Begin
With Font Do
Begin
      Name:= 'Times New Roman';
      Size:= 30;
      Color:= clBlue;
End;
    TextOut(Xk+5*D,Yk,'Kész');
End;
End;

procedure TfmHamm.btUjraClick(Sender: TObject);
begin
  VegeVan:= False;
  FormPaint(Sender);
end;

end.