Rubik kocka

A bűvös kocka 1974-ben jelent meg először Rubik Ernő képzeletében, és rá 7 évre már sok országban elterjedt a 3*3*3-as változata. Mára világméretű biznisszé vált. Az alapötletet felhasználva szinte megmondhatatlan, hogy hány verziója látott napvilágot a kockához hasonló játékoknak. Ezzel a programmal az alapkocka forgatását lehet gyakorolni.

A program nem használ animációt, a forgatási fázisok átrendezéssel jönnek létre. A másik jellegzetessége és talán egyedi vonása a programnak, hogy egyszerre a kocka mind a hat lapját láthatjuk. A képernyő felső részét úgy kell elképzelni, mintha az, az alsónak a tükörben látható (szemből nem látható) lapjai lennének.

A forgatás egérrel lett megoldva. A vékonyabb nyilakkal rétegek forgathatók 90 fokkal, a vastagabb nyilakkal lapok forgathatók. A nyilak végei a vezérlő pontok, a forgatási irányokat használat közben megszokhatjuk (egyébként ezt a nyíl vége jelzi: ha rámutat a kockára, akkor a megcélzott felület távolodik a nyíltól, a másik végére kattintva közeledik).

A program a rendezett állapottól indul. A kevert állapotot a Kever feliratú nyomógombbal hozhatjuk létre. Aki jártas a kockaforgatásban, biztosan könnyedén elboldogul evvel a programmal is. Akinek gondja van a kocka rendezésével, annak javaslom, hogy nézzen utána az Interneten, számos rendezési módszer leírását megtalálhatja.

A futtatási kép rendezetlen állapotban:

A futtatási kép a fehér színű lap kirakása után:

És a rendezett állapot:

A program listája:

unit URubik;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TfmRubik = class(TForm)
    btKever: TButton;
    btKilep: TButton;
Procedure Fest;
Procedure Forgat;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure btKeverClick(Sender: TObject);
procedure btKilepClick(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const Dy=24;
      Le=150;
      Fel=150;

var
fmRubik: TfmRubik;
  Xk, Yk: Integer;
  Dx, Fx, Fy, Mx, My: Integer;
  Lk: Array[1..6,1..3,1..3,1..2] Of Integer;
  Ls: Array[1..6,1..3,1..3] Of TColor;
  Ps: Array[1..3] Of TColor;
  Vp: Array[1..24,1..2] Of Integer;
  Forg: Word;

implementation

{$R *.dfm}

procedure TfmRubik.btKilepClick(Sender: TObject);
begin
  Close;
end;

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

procedure TfmRubik.FormCreate(Sender: TObject);
Var I, J: Word;
begin
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
Dx:= Round(1.1*Sqrt(3)*Dy);
  Fx:= Dx Div 2;
  Fy:= (Dy Div 2);
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[1,I,J]:= RGB(255,128,64);
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[2,I,J]:= clWhite;
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[3,I,J]:= clGreen;
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[4,I,J]:= RGB(192,0,0);
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[5,I,J]:= clBlue;
For I:= 1 To 3 Do For J:= 1 To 3 Do Ls[6,I,J]:= clYellow;
  Randomize;
end;

Procedure TfmRubik.Fest;
Var I, J, K: Word;
Begin
With Canvas Do
For I:= 1 To 6 Do For J:= 1 To 3 Do For K:= 1 To 3 Do
Begin
Brush.Color:= Ls[I,J,K];
    FloodFill(Lk[I,J,K,1],Lk[I,J,K,2],clBlack,fsBorder);
End;
End;

Procedure TfmRubik.Forgat;
Var I, P: Word;
Begin
  P:= 0;
Case Forg Of
    1,2,3:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[1,I,Forg];
For I:= 1 To 3 Do Ls[1,I,Forg]:= Ls[6,4-Forg,4-I];
For I:= 1 To 3 Do Ls[6,4-Forg,4-I]:= Ls[4,I,4-Forg];
For I:= 1 To 3 Do Ls[4,I,4-Forg]:= Ls[2,Forg,4-I];
For I:= 1 To 3 Do Ls[2,Forg,4-I]:= Ps[I];
If Forg In [1,3] Then
Begin
If Forg=1 Then P:= 3; If Forg=3 Then P:= 5;
For I:= 1 To 3 Do Ps[I]:= Ls[P,I,1];
For I:= 1 To 3 Do Ls[P,I,1]:= Ls[P,3,I];
For I:= 1 To 3 Do Ls[P,3,I]:= Ls[P,4-I,3];
For I:= 1 To 3 Do Ls[P,4-I,3]:= Ls[P,1,4-I];
For I:= 1 To 3 Do Ls[P,1,4-I]:= Ps[I];
End;
End;
    4,5,6:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[1,I,Forg-3];
For I:= 1 To 3 Do Ls[1,I,Forg-3]:= Ls[2,Forg-3,4-I];
For I:= 1 To 3 Do Ls[2,Forg-3,4-I]:= Ls[4,I,7-Forg];
For I:= 1 To 3 Do Ls[4,I,7-Forg]:= Ls[6,7-Forg,4-I];
For I:= 1 To 3 Do Ls[6,7-Forg,4-I]:= Ps[I];
If Forg In [4,6] Then
Begin
If Forg=4 Then P:= 3; If Forg=6 Then P:= 5;
For I:= 1 To 3 Do Ps[I]:= Ls[P,1,I];
For I:= 1 To 3 Do Ls[P,1,I]:= Ls[P,I,3];
For I:= 1 To 3 Do Ls[P,I,3]:= Ls[P,3,4-I];
For I:= 1 To 3 Do Ls[P,3,4-I]:= Ls[P,4-I,1];
For I:= 1 To 3 Do Ls[P,4-I,1]:= Ps[I];
End;
End;
    7,8,9:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[1,Forg-6,I];
For I:= 1 To 3 Do Ls[1,Forg-6,I]:= Ls[5,10-Forg,4-I];
For I:= 1 To 3 Do Ls[5,10-Forg,I]:= Ls[4,10-Forg,4-I];
For I:= 1 To 3 Do Ls[4,10-Forg,I]:= Ls[3,Forg-6,4-I];
For I:= 1 To 3 Do Ls[3,Forg-6,4-I]:= Ps[I];
If Forg In [7,9] Then
Begin
If Forg=7 Then P:= 2; If Forg=9 Then P:= 6;
For I:= 1 To 3 Do Ps[I]:= Ls[P,I,1];
For I:= 1 To 3 Do Ls[P,I,1]:= Ls[P,3,I];
For I:= 1 To 3 Do Ls[P,3,I]:= Ls[P,4-I,3];
For I:= 1 To 3 Do Ls[P,4-I,3]:= Ls[P,1,4-I];
For I:= 1 To 3 Do Ls[P,1,4-I]:= Ps[I];
End;
End;
    10,11,12:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[1,Forg-9,I];
For I:= 1 To 3 Do Ls[1,Forg-9,I]:= Ls[3,Forg-9,4-I];
For I:= 1 To 3 Do Ls[3,Forg-9,I]:= Ls[4,13-Forg,4-I];
For I:= 1 To 3 Do Ls[4,13-Forg,I]:= Ls[5,13-Forg,4-I];
For I:= 1 To 3 Do Ls[5,13-Forg,4-I]:= Ps[I];
If Forg In [10,12] Then
Begin
If Forg=10 Then P:= 2; If Forg=12 Then P:= 6;
For I:= 1 To 3 Do Ps[I]:= Ls[P,4-I,1];
For I:= 1 To 3 Do Ls[P,I,1]:= Ls[P,1,I];
For I:= 1 To 3 Do Ls[P,1,I]:= Ls[P,I,3];
For I:= 1 To 3 Do Ls[P,I,3]:= Ls[P,3,4-I];
For I:= 1 To 3 Do Ls[P,3,4-I]:= Ps[I];
End;
End;
    13,14,15:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[3,I,Forg-12];
For I:= 1 To 3 Do Ls[3,I,Forg-12]:= Ls[6,4-I,16-Forg];
For I:= 1 To 3 Do Ls[6,4-I,16-Forg]:= Ls[5,I,16-Forg];
For I:= 1 To 3 Do Ls[5,I,16-Forg]:= Ls[2,4-I,Forg-12];
For I:= 1 To 3 Do Ls[2,4-I,Forg-12]:= Ps[I];
If Forg In [13,15] Then
Begin
If Forg=13 Then P:= 1; If Forg=15 Then P:= 4;
For I:= 1 To 3 Do Ps[I]:= Ls[P,I,1];
For I:= 1 To 3 Do Ls[P,I,1]:= Ls[P,3,I];
For I:= 1 To 3 Do Ls[P,3,I]:= Ls[P,4-I,3];
For I:= 1 To 3 Do Ls[P,4-I,3]:= Ls[P,1,4-I];
For I:= 1 To 3 Do Ls[P,1,4-I]:= Ps[I];
End;
End;
    16,17,18:
Begin
For I:= 1 To 3 Do Ps[I]:= Ls[3,I,Forg-15];
For I:= 1 To 3 Do Ls[3,I,Forg-15]:= Ls[2,4-I,Forg-15];
For I:= 1 To 3 Do Ls[2,4-I,Forg-15]:= Ls[5,I,19-Forg];
For I:= 1 To 3 Do Ls[5,I,19-Forg]:= Ls[6,4-I,19-Forg];
For I:= 1 To 3 Do Ls[6,4-I,19-Forg]:= Ps[I];
If Forg In [16,18] Then
Begin
If Forg=16 Then P:= 1; If Forg=18 Then P:= 4;
For I:= 1 To 3 Do Ps[I]:= Ls[P,4-I,1];
For I:= 1 To 3 Do Ls[P,4-I,1]:= Ls[P,1,I];
For I:= 1 To 3 Do Ls[P,1,I]:= Ls[P,I,3];
For I:= 1 To 3 Do Ls[P,I,3]:= Ls[P,3,4-I];
For I:= 1 To 3 Do Ls[P,3,4-I]:= Ps[I];
End;
End;
End;
End;

procedure TfmRubik.FormPaint(Sender: TObject);
Var I, J: Word;
begin
With Canvas Do
Begin
    Yk:= Yk+Le; Pen.Width:= 4; MoveTo(Xk,Yk);
//felső
    LineTo(Xk-3*Dx,Yk-3*Dy); LineTo(Xk     ,Yk-6*Dy);
    LineTo(Xk+3*Dx,Yk-3*Dy); LineTo(Xk     ,Yk     );
//bal
    LineTo(Xk     ,Yk+6*Dy); LineTo(Xk-3*Dx,Yk+3*Dy);
    LineTo(Xk-3*Dx,Yk-3*Dy);
//jobb
MoveTo(Xk     ,Yk+6*Dy); LineTo(Xk+3*Dx,Yk+3*Dy);
    LineTo(Xk+3*Dx,Yk-3*Dy);
//felső rács
    MoveTo(Xk-  Dx,Yk-  Dy); LineTo(Xk+2*Dx,Yk-4*Dy);
    MoveTo(Xk-2*Dx,Yk-2*Dy); LineTo(Xk+  Dx,Yk-5*Dy);
    MoveTo(Xk+  Dx,Yk-  Dy); LineTo(Xk-2*Dx,Yk-4*Dy);
    MoveTo(Xk+2*Dx,Yk-2*Dy); LineTo(Xk-  Dx,Yk-5*Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[1,I,J,1]:= Xk+(I-J)*Dx;
      Lk[1,I,J,2]:= Yk+(1-I-J)*Dy;
End;
//bal rács
    MoveTo(Xk-  Dx,Yk-  Dy); LineTo(Xk-  Dx,Yk+5*Dy);
    MoveTo(Xk-2*Dx,Yk-2*Dy); LineTo(Xk-2*Dx,Yk+4*Dy);
MoveTo(Xk     ,Yk+2*dy); LineTo(Xk-3*Dx,Yk-  Dy);
    MoveTo(Xk     ,Yk+4*dy); LineTo(Xk-3*Dx,Yk+  Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[2,I,J,1]:= Xk-Fx-(I-1)*Dx;
      Lk[2,I,J,2]:= Yk+Fy+(2*J-I-1)*Dy;
End;
//jobb rács
    MoveTo(Xk+  Dx,Yk-  Dy); LineTo(Xk+  Dx,Yk+5*Dy);
    MoveTo(Xk+2*Dx,Yk-2*Dy); LineTo(Xk+2*Dx,Yk+4*Dy);
    MoveTo(Xk     ,Yk+2*dy); LineTo(Xk+3*Dx,Yk-  Dy);
    MoveTo(Xk     ,Yk+4*dy); LineTo(Xk+3*Dx,Yk+  Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[3,I,J,1]:= Xk+Fx+(I-1)*Dx;
      Lk[3,I,J,2]:= Yk+Fy+(2*J-I-1)*Dy;
End;
//vezérlők
    Pen.Width:= 3;
For I:= 1 To 3 Do
Begin
      MoveTo(Xk-I*Dx,Yk+(7-I)*Dy);
      Vp[I,1]:= Xk-I*Dx;                       //1-3
      Vp[I,2]:= Yk+(7-I)*Dy;
      LineTo(Xk-(I+1)*Dx,Yk+(8-I)*Dy);
      Vp[I+3,1]:= Xk-(I+1)*Dx;                 //4-6
      Vp[I+3,2]:= Yk+(8-I)*Dy;
      MoveTo(Xk-I*Dx,Yk+(7-I)*Dy);
      LineTo(Xk-I*Dx-16,Yk+(7-I)*Dy);
      MoveTo(Xk-I*Dx,Yk+(7-I)*Dy);
      LineTo(Xk-I*Dx-6,Yk+(7-I)*Dy+10);
      MoveTo(Xk-(I+1)*Dx,Yk+(8-I)*Dy);
      LineTo(Xk-(I+1)*Dx+16,Yk+(8-I)*Dy);
      MoveTo(Xk-(I+1)*Dx,Yk+(8-I)*Dy);
LineTo(Xk-(I+1)*Dx+6,Yk+(8-I)*Dy-10);
End;
For I:= 1 To 3 Do
Begin
      MoveTo(Xk+I*Dx,Yk+(7-I)*Dy);
      Vp[I+6,1]:= Xk+I*Dx;                     //7-9
      Vp[I+6,2]:= Yk+(7-I)*Dy;
      LineTo(Xk+(I+1)*Dx,Yk+(8-I)*Dy);
      Vp[I+9,1]:= Xk+(I+1)*Dx;                 //10-12
      Vp[I+9,2]:= Yk+(8-I)*Dy;
      MoveTo(Xk+I*Dx,Yk+(7-I)*Dy);
      LineTo(Xk+I*Dx+16,Yk+(7-I)*Dy);
      MoveTo(Xk+I*Dx,Yk+(7-I)*Dy);
      LineTo(Xk+I*Dx+6,Yk+(7-I)*Dy+10);
      MoveTo(Xk+(I+1)*Dx,Yk+(8-I)*Dy);
      LineTo(Xk+(I+1)*Dx-16,Yk+(8-I)*Dy);
      MoveTo(Xk+(I+1)*Dx,Yk+(8-I)*Dy);
LineTo(Xk+(I+1)*Dx-6,Yk+(8-I)*Dy-10);
End;
For I:= 1 To 3 Do
Begin
      MoveTo(Xk+3*Dx+Fx,Yk+2*(I-2)*Dy-Fy);
      Vp[I+12,1]:= Xk+3*Dx+Fx;                 //13-15
      Vp[I+12,2]:= Yk+2*(I-2)*Dy-Fy;
      LineTo(Xk+4*Dx+Fx,Yk+(2*I-5)*Dy-Fy);
      Vp[I+15,1]:= Xk+4*Dx+Fx;                 //16-18
      Vp[I+15,2]:= Yk+(2*I-5)*Dy-Fy;
      MoveTo(Xk+3*Dx+Fx,Yk+2*(I-2)*Dy-Fy);
      LineTo(Xk+3*Dx+Fx+8,Yk+2*(I-2)*Dy-Fy-12);
      MoveTo(Xk+3*Dx+Fx,Yk+2*(I-2)*Dy-Fy);
      LineTo(Xk+3*Dx+Fx+16,Yk+2*(I-2)*Dy-Fy);
      MoveTo(Xk+4*Dx+Fx,Yk+(2*I-5)*Dy-Fy);
LineTo(Xk+4*Dx+Fx-16,Yk+(2*I-5)*Dy-Fy);
      MoveTo(Xk+4*Dx+Fx,Yk+(2*I-5)*Dy-Fy);
      LineTo(Xk+4*Dx+Fx-8,Yk+(2*I-5)*Dy-Fy+12);
End;
    Pen.Width:= 8;
    Yk:= Yk-Le;
    MoveTo(Xk-5*Dx,Yk+4*Dy+Fy);
    LineTo(Xk-4*Dx+Fx,Yk+5*Dy+2*Fy);
    LineTo(Xk-4*Dx+Fx-16,Yk+5*Dy+2*Fy);
    MoveTo(Xk-4*Dx+Fx,Yk+5*Dy+2*Fy);
    Vp[19,1]:= Xk-4*Dx+Fx;                     //19
    Vp[19,2]:= Yk+5*Dy+2*Fy;
    LineTo(Xk-4*Dx+Fx-12,Yk+5*Dy+2*Fy-12);
    MoveTo(Xk-5*Dx+16,Yk+4*Dy+Fy);
    LineTo(Xk-5*Dx,Yk+4*Dy+Fy);
    Vp[20,1]:= Xk-5*Dx;                        //20
    Vp[20,2]:= Yk+4*Dy+Fy;
LineTo(Xk-5*Dx+12,Yk+4*Dy+Fy+12);

    MoveTo(Xk-Dx-Fx,Yk-Dy);
    LineTo(Xk-Dx-Fx,Yk+Dy);
    LineTo(Xk-Dx-Fx-10,Yk+Dy-10);
    MoveTo(Xk-Dx-Fx,Yk+Dy);
    Vp[21,1]:= Xk-Dx-Fx;                       //21
    Vp[21,2]:= Yk+Dy;
    LineTo(Xk-Dx-Fx+10,Yk+Dy-10);
    MoveTo(Xk-Dx-Fx-10,Yk-Dy+10);
    LineTo(Xk-Dx-Fx,Yk-Dy);
    Vp[22,1]:= Xk-Dx-Fx;                       //22
    Vp[22,2]:= Yk-Dy;
    LineTo(Xk-Dx-Fx+10,Yk-Dy+10);

    MoveTo(Xk+Dx+Fx,Yk-Dy);
    LineTo(Xk+Dx+Fx,Yk+Dy);
    LineTo(Xk+Dx+Fx-10,Yk+Dy-10);
    MoveTo(Xk+Dx+Fx,Yk+Dy);
Vp[23,1]:= Xk+Dx+Fx;                       //23
    Vp[23,2]:= Yk+Dy;
    LineTo(Xk+Dx+Fx+10,Yk+Dy-10);
    MoveTo(Xk+Dx+Fx-10,Yk-Dy+10);
    LineTo(Xk+Dx+Fx,Yk-Dy);
    Vp[24,1]:= Xk+Dx+Fx;                       //24
    Vp[24,2]:= Yk-Dy;
    LineTo(Xk+Dx+Fx+10,Yk-Dy+10);

//tükörkép
    Yk:= Yk-Fel; Pen.Width:= 4; MoveTo(Xk,Yk);
//alsó
    LineTo(Xk-3*Dx,Yk+3*Dy); LineTo(Xk     ,Yk+6*Dy);
    LineTo(Xk+3*Dx,Yk+3*Dy); LineTo(Xk     ,Yk     );
//bal
    LineTo(Xk     ,Yk-6*Dy); LineTo(Xk-3*Dx,Yk-3*Dy);
    LineTo(Xk-3*Dx,Yk+3*Dy);
//jobb
MoveTo(Xk     ,Yk-6*Dy); LineTo(Xk+3*Dx,Yk-3*Dy);
    LineTo(Xk+3*Dx,Yk+3*Dy);
//alsó rács
    MoveTo(Xk-  Dx,Yk+5*Dy); LineTo(Xk+2*Dx,Yk+2*Dy);
    MoveTo(Xk-2*Dx,Yk+4*Dy); LineTo(Xk+  Dx,Yk+  Dy);
    MoveTo(Xk+  Dx,Yk+5*Dy); LineTo(Xk-2*Dx,Yk+2*Dy);
    MoveTo(Xk+2*Dx,Yk+4*Dy); LineTo(Xk-  Dx,Yk+  Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[4,I,J,1]:= Xk+(J-I)*Dx;
      Lk[4,I,J,2]:= Yk+(I+J-1)*Dy;
End;
//bal rács
    MoveTo(Xk-  Dx,Yk+  Dy); LineTo(Xk-  Dx,Yk-5*Dy);
    MoveTo(Xk-2*Dx,Yk+2*Dy); LineTo(Xk-2*Dx,Yk-4*Dy);
MoveTo(Xk     ,Yk-4*dy); LineTo(Xk-3*Dx,Yk-  Dy);
    MoveTo(Xk     ,Yk-2*dy); LineTo(Xk-3*Dx,Yk+  Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[5,I,J,1]:= Xk-Fx-(I-1)*Dx;
      Lk[5,I,J,2]:= Yk+Fy+(I-2*J)*Dy;
End;
//jobb rács
    MoveTo(Xk+  Dx,Yk+  Dy); LineTo(Xk+  Dx,Yk-5*Dy);
    MoveTo(Xk+2*Dx,Yk+2*Dy); LineTo(Xk+2*Dx,Yk-4*Dy);
    MoveTo(Xk     ,Yk-4*dy); LineTo(Xk+3*Dx,Yk-  Dy);
    MoveTo(Xk     ,Yk-2*dy); LineTo(Xk+3*Dx,Yk+  Dy);
For I:= 1 To 3 Do For J:= 1 To 3 Do
Begin
      Lk[6,I,J,1]:= Xk+Fx+(I-1)*Dx;
      Lk[6,I,J,2]:= Yk+Fy+(I-2*J)*Dy;
End;
End;
  Fest;
end;

procedure TfmRubik.btKeverClick(Sender: TObject);
Var I: Word;
begin
For I:= 1 To 300 Do Begin Forg:= Random(18)+1; Forgat End; Fest;
end;

procedure TfmRubik.FormClick(Sender: TObject);
Var I: Word;
begin
  Forg:= 0;
For I:= 1 To 24 Do If Sqrt(Sqr(Vp[I,1]-Mx)+Sqr(Vp[I,2]-My))<16 Then
Begin Forg:= I; Break End;
If Forg<>0 Then
Case Forg Of
    19: Begin Forg:= 16; Forgat; Forg:= 17; Forgat; Forg:= 18; Forgat; Fest End;
    20: Begin Forg:= 13; Forgat; Forg:= 14; Forgat; Forg:= 15; Forgat; Fest End;
21: Begin Forg:= 10; Forgat; Forg:= 11; Forgat; Forg:= 12; Forgat; Fest End;
    22: Begin Forg:= 7; Forgat; Forg:= 8; Forgat; Forg:= 9; Forgat; Fest End;
    23: Begin Forg:= 4; Forgat; Forg:= 5; Forgat; Forg:= 6; Forgat; Fest End;
    24: Begin Forg:= 1; Forgat; Forg:= 2; Forgat; Forg:= 3; Forgat; Fest End;
Else
Begin Forgat; Fest End;
End;
end;

end.