Hamm

 

Írjunk programot, mely az itt látható játéktéren lévő csillagokat kikapcsolja. Oldal vagy átlós irányokban ugorhatjuk át a csillagokat, miáltal az eltűnik. Cél: csak egyetlen csillag maradjon. „D” billentyűre Demo indítható.

 

 

Program Hamm;

Uses NewDelay, Crt, CrtPlus, Drivers;

Var Ch: Char;

    H: Array[0..8,0..8] Of Byte;

Procedure Jatekter;

Var I, J: Byte;

Begin

  HideMouse; Szinek(7,15); ClrScr; WriteXY(33,25,'D: Demo');

  Racs(17,5,1,1,3,7); Racs(13,9,1,1,7,3);

  For I:= 1 To 4 Do

  Begin WriteXY(15+2*i,9,Chr(197)); WriteXY(15+2*i,15,Chr(197)) End;

  For I:= 0 To 8 Do For J:= 0 To 8 Do H[I, J]:= 0; Szinek(7,1);

  For I:= 1 To 7 Do For J:= 1 To 7 Do If (I In [3..5]) Or (J In [3..5]) Then

  If Not((I=4) And (J=4)) Then

  Begin WriteXY(12+2*I,4+2*J, Chr(15)); H[I, J]:=1 End; ShowMouse; Tunj;

End;

Function BentK(A, B: Byte): Boolean;

Begin

  BentK:=((A In [18, 20, 22]) And (B In [ 6,  8, 10, 12, 14, 16, 18])) Or

         ((A In [14, 16, 18, 20, 22, 24, 26]) And (B In [10, 12, 14]));

End;    

Function BentH(A, B: Byte): Boolean;

Begin

  BentH:=((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 BentH(A-1,B) And BentH(A-2,B) And (H[A-1,B]=1) And (H[A-2,B]=0)

  Then Begin Lephet:= True; Exit End;

  If BentH(A-1,B-1) And BentH(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 BentH(A,B-1) And BentH(A,B-2) And (H[A,B-1]=1) And (H[A,B-2]=0)

  Then Begin Lephet:= True; Exit End;

  If BentH(A+1,B-1) And BentH(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 BentH(A+1,B) And BentH(A+2,B) And (H[A+1,B]=1) And (H[A+2,B]=0)

  Then Begin Lephet:= True; Exit End;

  If BentH(A+1,B+1) And BentH(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 BentH(A,B+1) And BentH(A,B+2) And (H[A,B+1]=1) And (H[A,B+2]=0)

  Then Begin Lephet:= True; Exit End;

  If BentH(A-1,B+1) And BentH(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;

  For I:= 1 To 7 Do For J:= 1 To 7 Do If BentH(I, J) And Lephet(I, J) Then

  Begin Vege:= False; Exit End;

End;

Procedure Jatek;

Var X, Y, Px, Py, Hx, Hy, PHx, PHy, V: Byte;

Begin

  Repeat

    While Not KeyPressed And (MouseButtons=0) Do; If KeyPressed Then Exit;

    X:= MouseWhere.X + 1; Y:= MouseWhere.Y + 1;

    If BentK(X, Y) Then

    Begin

      Hx:= X Div 2 - 6; Hy:= Y Div 2 - 2;

      If Lephet(Hx, Hy) Then

      Begin

        Px:= X; Py:= Y; PHx:= Hx; PHy:= Hy;

        Duda; Szinek(7, 1+Blink);

        HideMouse; WriteXY(X, Y, Chr(15)); Szinek(7, 1); Tunj; ShowMouse;

        While MouseButtons=1 Do;

        While Not KeyPressed And (MouseButtons=0) Do; If KeyPressed Then Exit;

        X:= MouseWhere.X + 1; Y:= MouseWhere.Y + 1;

        If BentK(X,Y) Then

        Begin

          Hx:= X Div 2 - 6; Hy:= Y Div 2 - 2; 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; HideMouse; WriteXY(PX, PY, ' '); ShowMouse;

            Case V Of

              1: Begin H[PHx - 1, PHy    ]:= 0; WriteXY(Px-2, Py  , ' ') End;

              2: Begin H[PHx - 1, PHy - 1]:= 0; WriteXY(Px-2, Py-2, ' ') End;

              3: Begin H[PHx - 1, PHy + 1]:= 0; WriteXY(Px-2, Py+2, ' ') End;

              4: Begin H[PHx + 1, PHy    ]:= 0; WriteXY(Px+2, Py  , ' ') End;

              5: Begin H[PHx + 1, PHy - 1]:= 0; WriteXY(Px+2, Py-2, ' ') End;

              6: Begin H[PHx + 1, PHy + 1]:= 0; WriteXY(Px+2, Py+2, ' ') End;

              7: Begin H[PHx    , PHy - 1]:= 0; WriteXY(Px  , Py-2, ' ') End;

              8: Begin H[PHx    , PHy + 1]:= 0; WriteXY(Px  , Py+2, ' ') End;

            End;

            H[Hx, Hy]:= 1; HideMouse; WriteXY(X, Y, Chr(15)); ShowMouse;

            While MouseButtons=1 Do;

          End

          Else

          Begin

            HideMouse; WriteXY(PX, PY, Chr(15)); ShowMouse;

            While MouseButtons=1 Do;

          End; Tunj;

        End

        Else

        Begin

          HideMouse; WriteXY(PX, PY, Chr(15)); ShowMouse;

          While MouseButtons=1 Do;

        End; Tunj;

      End;

    End;

    If Vege Then

    Begin

      PX:= 0; Szinek(7,1+Blink); HideMouse;

      For X:= 1 To 7 Do For Y:= 1 To 7 Do PX:= PX + H[X, Y];

      If PX=1 Then WriteXY(14,2, 'G Y Ő Z T É L') Else

                   WriteXY(12,2, 'V E S Z T E T T É L'); Tunj; ShowMouse;

      Repeat Until KeyPressed;

    End;

  Until False;

End;

Procedure Demo;

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

  JatekTer;

  For I:=1 To 31 Do

  Begin

    If KeyPressed Or (MouseButtons=1) Then Exit;

    HideMouse;

    Szinek(7,1+Blink); WriteXY(12+2*L[i,1,1],4+2*L[i,1,2], Chr(15));

    Szinek(7,14);WriteXY(12+2*L[i,3,1],4+2*L[i,3,2], Chr(15)); Tunj;

    ShowMouse; Delay(1500); HideMouse;

    WriteXY(12+2*L[i,1,1],4+2*L[i,1,2], ' ');

    WriteXY(12+2*L[i,3,1],4+2*L[i,3,2], ' ');

    Szinek(7,1); WriteXY(12+2*L[i,2,1],4+2*L[i,2,2], Chr(15)); ShowMouse;

  End;

  WriteXY(18,1,'Kész');

  Tunj;

  While Not KeyPressed And (MouseButtons=0) Do;

End;

Begin

  TextMode(CO80); InitEvents;

  Repeat

    JatekTer; Jatek; Ch:= Readkey; If Ch='D' Then Demo;

  Until Ch=#27; TextMode(CO80);

End.

 

 

 

 

Lámpák

 

Írjunk programot, mellyel az itt látható játéktéren lévő lámpácskákat mind felkapcsolhatjuk.

 

 

Program Lampak;

 

 (*

   Lámpácskák nevű játék szabályai:

 - ha egy lámpának az állapotát megváltoztatjuk, akkor a szomszédos lámpák állapota is az ellenkezőjére változik;

 - egy téglalap alakban elrendezett lámparendszerünk van, melyben minden lámpa kezdetben kikapcsolt állapotú;

 - a lámpák kapcsolgatásával el kell érni azt, hogy minden lámpa égjen.

                                                                       *)

 

Uses NewDelay, Crt, CrtPlus, Drivers;

 

Var S, O, N: Byte;

    Ch: Char;

    L: Array[0..20, 0..14] Of Byte;

    Ax, Ay: Byte;

 

Procedure Jatekter;

Var Ws: String;

    Kod: Integer;

    I, J: Byte;

Begin

  HideMouse;

  TextMode(CO80);

  Szinek(7,9);

  ClrScr;

  ShowMouse;

  WriteXY(2,3,'Sorok  száma   (3..12): ');

  Repeat

    GotoXY(26,3);

    ClrEol;

    Ws:= Bevitel(1,15,26,3,3);

    Val(Ws,S,Kod)

  Until S In [3..12];

  WriteXY(2,5,'Oszlopok száma (3..18): ');

  Repeat

    GotoXY(26,5);

    ClrEol;

    Ws:= Bevitel(1,15,26,5,3);

    Val(Ws,O,Kod)

  Until O In [3..18];

  For I:= 0 To O Do For J:= 0 To S Do L[I, J]:= 0;

  HideMouse;

  TextMode(CO80);

  Szinek(7,15);

  ClrScr;

  If Not Odd(O) And Not Odd(S) Then Begin Ax:= 19; Ay:= 13 End;

  If Not Odd(O) And Odd(S) Then Begin Ax:= 19; Ay:= 14 End;

  If Odd(O) And Not Odd(S) Then Begin Ax:= 20; Ay:= 13 End;

  If Odd(O) And Odd(S) Then Begin Ax:= 20; Ay:= 14 End;

  Racs(Ax-O, Ay-S, 1,1, O, S);

  Tunj;

  ShowMouse;

  N:=0;

End;

 

Function Vege: Boolean;

Var I, J: Byte;

Begin

  Vege:= True;

  For I:= 1 To O Do For J:= 1 To S Do If L[I, J]= 0 Then

  Begin I:= O; J:= S; Vege:= False End;

End;

 

Procedure Jatek;

Var X, Y, Tx, Ty: Byte;

Begin

  Repeat

    While Not KeyPressed And (MouseButtons=0) Do;

    If KeyPressed Then Exit;

    X:= MouseWhere.X +1; Y:= MouseWhere.Y + 1;

    If Not(Odd(X) Or Odd(Y)) Then

    If (X>Ax-O) And (X<Ax+O) And (Y>Ay-S) And (Y<Ay+S) Then

    Begin

      HideMouse;

      Duda;

      Inc(N);

      GotoXY(38,2);

      Szinek(7,14);

      Write(N:3);

      Tx:= (X-20+O) Div 2 + 1;

      Ty:= (Y-14+S) Div 2 + 1;

      L[Tx, Ty]:= 1 - L[Tx, Ty];

      Szinek(7,15);

      WriteXY(X, Y, Chr(32 + L[Tx, Ty] * 187));

      L[Tx-1, Ty]:= 1 - L[Tx-1, Ty];

      If Tx>1 Then WriteXY(X-2, Y, Chr(32 + L[Tx-1, Ty] * 187));

      L[Tx+1, Ty]:= 1 - L[Tx+1, Ty];

      If Tx<O Then WriteXY(X+2, Y, Chr(32 + L[Tx+1, Ty] * 187));

      L[Tx, Ty-1]:= 1 - L[Tx, Ty-1];

      If Ty>1 Then WriteXY(X, Y-2, Chr(32 + L[Tx, Ty-1] * 187));

      L[Tx, Ty+1]:= 1 - L[Tx, Ty+1];

      If Ty<S Then WriteXY(X, Y+2, Chr(32 + L[Tx, Ty+1] * 187));

      SHowMouse;

      Tunj;

      If Vege Then

      Begin

        Szinek(7,1+Blink);

        WriteXY(12, 2, 'G A M E   O V E R');

        Tunj;

        Exit

      End;

    End; While MouseButtons=1 Do;

  Until False;

End;

 

Begin

  InitEvents;

  Repeat

    Jatekter;

    Jatek;

    Ch:= ReadKey

  Until Ch=#27;

End.

 

 

 

 

 

 

Útkereszteződés

 

Írjunk karakteres képernyőn egyszerű eszközökkel megjelenő, egyenrangú útkereszteződés forgalmát szimuláló, programot. A négy irányból érkező forgalmat egy-egy láncolt listában rögzítsük. Ha a programot megállítjuk, akkor az aktuális forgalmi helyzetet mentse lemezre, a következő indításkor erről a forgalmi helyzetről induljon a program. A járműveket a haladási irányba mutató háromszög szemléltesse, az autók legyenek véletlen színűek, járművek megjelenését mi idézzük elő, a megfelelő irányba mutató nyíl megnyomásával. Az áthaladásnál a járművek tartsák be a KRESZ előírásait. Az útkereszteződés elhagyása után a járművek mozgását már nem kell szemléltetni.

 

A program egy futási képe:

 

 

A program listája:

 

Program XRoad;              

Uses NewDelay, Crt, CrtPlus;
Const LSzM=4;
      O1  =39;
      S2  =12;
      O3  =42;
      S4  =14;
      RV  =500;
      HV  =2000;

Type
     RecMut= ^Rec;
     Rec   = Record
               Ch  : Char;
               Szin: Byte;
               KMut: RecMut;
             End;

     KepHely= Record
                Kar,
                Atr: Byte;
              End;
     Scr    = Array[1..25,1..80] Of KepHely;

Var
    ARec  : Rec;
    URecM,
    ARecM : RecMut;

    KocsiT: Array[1..LSzM] Of RecMut; 
    FNev  : File Of Rec;
    DNev  : String
    Kep   : Scr Absolute $B800:0;

Procedure Felfuz(URecM:RecMut);
Var Szel:Byte; 
Begin
  Case URecM^.Ch Of 
    #31:Szel:=1;
    #17:Szel:=2;
    #30:Szel:=3;
    #16:Szel:=4;
  End;
  If KocsiT[Szel]=Nil Then 
  KocsiT[Szel]:=URecM 
  Else
  Begin
    ARecM:=KocsiT[Szel]; 
    While ARecM^.KMut<>Nil Do 
    ARecM:=ARecM^.KMut; 
    ARecM^.KMut:=URecM; 
  End
End;

Procedure Lemezrol; 
Begin
  Assign(FNev,DNev);{$I-}Reset(FNev);{$I+}
    If IOResult=0 Then 
    While Not EOF(FNev) Do 
    Begin
      Read(FNev,ARec); 
      URecM:=New(RecMut); 
      With URecM^ Do 
      Begin
        Ch  := ARec.Ch; 
        Szin:= ARec.Szin; 
        KMut:= Nil
      End;
      Felfuz(URecM); 
    End
    Else 
    ReWrite(FNev);
  Close(FNev); 
End;

Procedure Lemezre; 
Var I:Byte; 
Begin
  Assign(FNev,DNev);ReWrite(FNev); 
    For I:=1 To LSzM Do 
    Begin
      ARecM:=KocsiT[I];
      While ARecM<>Nil Do 
      Begin
        With ARec Do 
        Begin
          Ch  :=ARecM^.Ch; 
          Szin:=ARecM^.Szin;
          KMut:=Nil
        End;
        Write(FNev,ARec); 
        ARecM:=ARecM^.KMut; 
      End;
    End;
  Close(FNev); 
End;

Procedure Kepernyo; 
Begin
  Szinek(Black,LightGray);
  ClrScr;

  Szinek(LightGray,Black); 
  Window(10,3,71,23);
  ClrScr;

  GoToXY(25,1);
  Write('Útkereszteződés');

  GoToXY(10,21);
  Write('Autó megjelen
ése: Nyilakkal  Kilépés: ESC');

  Szinek(Green,Black);
  Window(12,4,37,11); 

  ClrScr;

 
 Window(44,4,69,11); 

  ClrScr;

 
 Window(12,15,37,22); 

  ClrScr;

 
 Window(44,15,69,22); 
  ClrScr;

  Window(1,1,80,25); 


  Kep[25,1].Atr:=0;
  Tunj;
End;

Procedure Kepre;
Var I, 

    H, 
    S :Longint; 
Begin
  For I:= 4 To 11 Do Kep[I,O1].Kar:=32; 
  For I:=44 To 69 Do Kep[S2,I].Kar:=32;
  For I:=15 To 22 Do Kep[I,O3].Kar:=32;
  For I:=10 To 37 Do Kep[S4,I].Kar:=32;

  For I:=1 To LSzM do 
  Begin
    S:=0; 
    ARecM:=KocsiT[I]; 
    While ARecM<>Nil Do 
    With ARecM^ Do
    Begin
      Case I Of 
        1:Begin 
            H:=11-S;
            If H>3 Then 
            Begin
              Kep[H,O1].Kar:=31;
              Kep[H,O1].Atr:=Szin
            End;
          End;
        2:Begin
            H:=44+2*S; 
            If H<70 Then 
            Begin
              Kep[S2,H].Kar:=17;
              Kep[S2,H].Atr:=Szin
            End;
          End;
        3:Begin
            H:=15+S;
            If H<23 Then
            Begin
              Kep[H,O3].Kar:=30;
              Kep[H,O3].Atr:=Szin
            End;
          End;
        4:Begin
            H:=37-2*S;
            If H>11 Then
            Begin
              Kep[S4,H].Kar:=16;
              Kep[S4,H].Atr:=Szin
            End;
          End;
      End;
      ARecM:=ARecM^.KMut; 
      Inc(S); 
    End;
  End;
End;

Procedure Levesz(N:Byte); 
Var I: Byte; 
Begin
  If KocsiT[N]=Nil Then Exit; 
  KocsiT[N]:=KocsiT[N]^.KMut; 
  Case N Of
    1:Begin 
        For I:=S2 To S4 Do 
        Begin
          Kep[I,O1]:=Kep[I-1,O1]; 
          Kep[I-1,O1].Kar:=32; 
          Delay(RV); 
        End;
        Kep[I,O1].Kar:=32; 
      End;
    2:Begin
        For I:=O3+1 DownTo O1-1 Do
        Begin
          Kep[S2,I]:=Kep[S2,I+1];
          Kep[S2,I+1].Kar:=32;
          Delay(RV);
        End;
        Kep[S2,I].Kar:=32;
      End;
    3:Begin
        For I:=S4 DownTo S2 Do
        Begin
          Kep[I,O3]:=Kep[I+1,O3];
          Kep[I+1,O3].Kar:=32;
          Delay(RV);
        End;
        Kep[I,O3].Kar:=32;
      End;
    4:Begin
        For I:=O1-1 To O3+1 Do
        Begin
          Kep[S4,I]:=Kep[S4,I-1];
          Kep[S4,I-1].Kar:=32;
          Delay(RV);
        End;
        Kep[S4,I].Kar:=32;
      End;
  End;
  Kepre; 
End;

Function Valasztas:Byte; 
Var I, 
    M, 
    V: Byte;
    P:  Array[1..LSzM] Of Byte;
Begin
  M:=0;
  For I:=1 To LSzM Do P[I]:=0;
  For I:=1 To LSzM Do If KocsiT[i]<>Nil Then Inc(M);
  Case M Of
    LSzM: Valasztas:=Random(LSzM)+1; 
       0: Valasztas:=0; 
    Else
      Begin
        If (KocsiT[1]<>NilAnd 
        (KocsiT[LSzM]=Nil
        Then P[1]:=1;
        For I:=2 To LSzM Do 
        If (KocsiT[I]<>NilAnd 
        (KocsiT[I-1]=Nil
        Then P[I]:=1; 
        Repeat 
          V:=Random(LSzM)+1;
        Until P[V]=1; 
        Valasztas:=V;
      End;
  End;
End;

Procedure Vezerlo;
Var Bill:Char;
Begin
  Repeat
    If Not KeyPressed Then 
    Begin
      Levesz(Valasztas);
      Delay(HV)
    End;
    If KeyPressed Then Bill:=ReadKey;
    If Bill=#27 Then Exit; 
    If Bill=#0 Then
    Begin
      Bill:=ReadKey; 
      If Bill In [#72,#75,#77,#80] Then
      Begin
        URecM:=New(RecMut);
        With URecM^ Do
        Begin
          Case Bill Of
            #72: Ch:=#30;
            #75: Ch:=#17;
            #77: Ch:=#16;
            #80: Ch:=#31;
          End;
          Szin:=Random(16);
          If Szin=7 Then Szin:=15;
          Szin:=16*LightGray+Szin; 
          KMut:=Nil;
        End;
        Felfuz(URecM);
        Kepre;
        Delay(RV);
      End;
    End;
  Until False;
End;

Begin
  DNev:='XRoad.Dat';
  Lemezrol;
  Kepernyo;
  Kepre;
  Randomize;
  Vezerlo;
  Lemezre;
  Szinek(Black,LightGray);

  ClrScr;
End
.

 

Nyolc vezér

 

Írjunk programot, amely nyolc vezért helyez el a sakktáblán ütésmentesen.

 

Program Vezer;

Uses NewDelay, Crt, CrtPlus;

Var H: Array[1..8] Of Byte;

    I, J, K: Byte;

    Re, Je: Boolean;

Procedure VKepre(S, O: Byte);

Begin

  WriteXY(20+4*O,20-2*S,'V');

End;

Procedure VKeprol(S, O: Byte);

Begin

  WriteXY(20+4*O,20-2*S,' ');

End;

Procedure Kep;

Begin

  TextMode(CO80);

  Szinek(1,14);

  ClrScr;

  WriteXY(26,1,'Nyolc vezér a sakktáblán:');

  Racs(22,3,3,1,8,8);

  For I:= 1 To 8 Do For J:= 1 To 8 Do

  If Odd(I+J) Then WriteXY(19+4*I,20-2*J,'.');

  Tunj;

End;

Function Rossz(B, C: Byte): Boolean;

Begin

  J:= 1;

  While (J<B) And (C<>H[J]) And (Abs(C-H[J])<>Abs(B-J)) Do

  Inc(J);

  Re:= Not(J<B);

  Rossz:= Re;

End;

Function Jo(A: Byte): Boolean;

Label 1;

Begin

  Repeat

    Inc(H[I]);

    If H[I]>8 Then GoTo 1;

  Until (H[I]<=8) And Rossz(A,H[I]);

  1: Je:= H[I]<=8;

  Jo:= Je;

End;

Procedure Felrak;

Begin

  I:= 1;

  While I In [1..8] Do

  If Jo(I) Then

  Begin

    VKepre(H[I],I);

    Tunj;

    Delay(400);

    Inc(I);

    H[I]:= 0;

  End

  Else

  Begin

    Dec(i);

    VKeprol(H[I],I);

  End;

End;

Begin

  For K:= 0 To 7 Do

  Begin

    Kep;

    If K=0 Then

    Begin

      WriteXY(37,21,'Start');

      Tunj;

      Varj;

      WriteXY(37,21,'     ');

    End;

    For I:= 1 To 8 Do H[I]:= K;

    Felrak;

    WriteXY(37,21,'Kész');

    Tunj;

    Varj;

  End;

  WriteXY(37,21,'Vége');

  Tunj;

  Varj;

End.

 

 

 

 

 

 

Passziánsz

 

Írjuk meg a Windows környezetből jól ismert Passziánsz nevű programnak a karakteres képernyőre való változatát.

 

Program Passz;

 

Uses NewDelay, Crt, CrtPlus, Drivers;

 

Const KepSz: Byte=  1;

      FonSz: Byte=  2;

      LSz        = 52;

      

Type TLap= Object

       Fx, Fy, Ft, Fs, Fc: Byte;{tipus:káró,kör,treff,pikk; szám:1-13; color}

       Fl: String[3];           {label}

       Fv, Ff, Fe: Boolean;     {visible, flash, enable}

       Procedure Init(Ix, Iy, It, Is: Byte; Iv: Boolean);

       Procedure Show;

       Procedure Hide;

       Procedure SetVisible(V: Boolean);

       Function GetVisible: Boolean;

       Procedure MoveTo(X, Y: Byte);

       Procedure MoveRel(X, Y: Integer);

       Function InSide(X, Y: Byte): Boolean;

       Procedure FlashOn; 

       Procedure FlashOff;

       Function GetFlash: Boolean;

       Function GetTip: Byte;

       Function GetSzin: Byte;

       Function GetFig: Byte;  {Az Fs-t adja vissza}

       Procedure SetEnable(E: Boolean); 

       Function GetEnable: Boolean;

     End;

     

     TLFor= Object

       FLapF: Array[1..LSz] Of TLap;

       FNum: Byte;

       Procedure Feltolt;

       Procedure Kever;

       Procedure Show;

       Function InSide(X, Y: Byte): Boolean; 

     End;

     

     TLMut= Object

       FLapM: Array[1..LSz] Of TLap;

       FNum: Byte;

       Procedure Show;

       Function InSide(X, Y: Byte): Boolean; 

     End;

     

     TLAsz= Object

       FLapA: Array[1..7, 0..18] Of TLap;

       Procedure Show;

     End;

     

     TLCel= Object

       FLapC: Array[1..4, 1..13] Of TLap;

       FFent: Array[1..4] Of Byte;

       Procedure Show;

     End;

     

     TLPuf= Object

       FLapP: Array[1..12] Of TLap; 

       FNum: Byte;

     End;

     

     TControl= Object

       FLFor: TLFor;

       FLMut: TLMut;

       FLAsz: TLAsz;

       FLCel: TLCel;

       FLPuf: TLPuf;

       ULap: TLap;

       Procedure Init;

       Procedure Run;

       Procedure Done;

     End;

     

(******* TLap *************)

 

Procedure TLap.Init(Ix, Iy, It, Is: Byte; Iv: Boolean);

Begin

  Fx:= Ix; Fy:= Iy; Ft:= It; Fs:= Is; Fv:= Iv;

  Fv:= False; Ff:= False; Fe:= False; 

End;

 

Procedure TLap.Show;

Var I, J, AHs, AKs: Byte; 

Begin

  If Fx=0 Then Exit;

  HideMouse; AHs:= FonSz; AKs:= 0;

  If Fv Then 

  Begin 

    AHs:= 7; 

    Case Ft Of

      3,4: AKs:= 6;

      5,6: AKs:= 0;

    End;

  End;

  Fc:= AKs;

  Szinek(AHs, AKs); Window(Fx,Fy,Fx+6,Fy+7); ClrScr; Window(1,1,80,50);

  Keret(Fx,Fy,Fx+6,Fy+8);

  If Fv Then

  Case Fs Of

    1: Begin

         Fl:= Chr(Ft)+'A'; WriteXY(Fx+1,Fy,Fl);

         For I:= 3 To 7 Do WriteXY(Fx+1,Fy+I,Chr(Ft));

         For I:= 3 To 7 Do WriteXY(Fx+5,Fy+I,Chr(Ft));

         For I:= 2 To 4 Do WriteXY(Fx+I,Fy+5,Chr(Ft));

         For I:= 2 To 3 Do WriteXY(Fx+I,Fy+4-I,Chr(Ft));

         WriteXY(Fx+4,Fy+2,Chr(Ft));

       End;

    2: Begin

         Fl:= Chr(Ft)+'2'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+3,Fy+2,Chr(Ft)); WriteXY(Fx+3,Fy+6,Chr(Ft));

       End;

    3: Begin

         Fl:= Chr(Ft)+'3'; WriteXY(Fx+1,Fy,Fl); WriteXY(Fx+3,Fy+2,Chr(Ft));

         WriteXY(Fx+3,Fy+4,Chr(Ft));   WriteXY(Fx+3,Fy+6,Chr(Ft));

       End;

    4: Begin

         Fl:= Chr(Ft)+'4'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+2,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+6,Chr(Ft)+'   '+Chr(Ft));

       End;

    5: Begin

         Fl:= Chr(Ft)+'5'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+2,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+4,Chr(Ft));

         WriteXY(Fx+1,Fy+6,Chr(Ft)+'   '+Chr(Ft));

       End;

    6: Begin

         Fl:= Chr(Ft)+'6'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+2,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+4,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+6,Chr(Ft)+'   '+Chr(Ft));

       End;

    7: Begin

         Fl:= Chr(Ft)+'7'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+2,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+3,Chr(Ft));

         WriteXY(Fx+1,Fy+4,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+6,Chr(Ft)+'   '+Chr(Ft));

       End;

    8: Begin

         Fl:= Chr(Ft)+'8'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+2,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+3,Chr(Ft));

         WriteXY(Fx+1,Fy+4,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+5,Chr(Ft));

         WriteXY(Fx+1,Fy+6,Chr(Ft)+'   '+Chr(Ft));

       End;

    9: Begin

         Fl:= Chr(Ft)+'9'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+1,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+3,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+4,Chr(Ft));

         WriteXY(Fx+1,Fy+5,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+7,Chr(Ft)+'   '+Chr(Ft));

       End;

   10: Begin

         Fl:= Chr(Ft)+'10'; WriteXY(Fx+1,Fy,Fl);

         WriteXY(Fx+1,Fy+1,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+2,Chr(Ft));

         WriteXY(Fx+1,Fy+3,Chr(Ft)+'   '+Chr(Ft));

         WriteXY(Fx+1,Fy+5,Chr(Ft)+'   '+Chr(Ft));WriteXY(Fx+3,Fy+6,Chr(Ft));

         WriteXY(Fx+1,Fy+7,Chr(Ft)+'   '+Chr(Ft));

       End;

   11: Begin

         Fl:= Chr(Ft)+'J'; WriteXY(Fx+1,Fy,Fl);

         For I:= 1 To 6 Do WriteXY(Fx+5,Fy+I,Chr(Ft));

         For I:= 3 To 4 Do WriteXY(Fx+I,Fy+1,Chr(Ft));

         For I:= 2 To 4 Do WriteXY(Fx+I,Fy+7,Chr(Ft));

         WriteXY(Fx+4,Fy+4,Chr(Ft)); WriteXY(Fx+1,Fy+6,Chr(Ft));

       End;

   12: Begin

         Fl:= Chr(Ft)+'Q'; WriteXY(Fx+1,Fy,Fl);

         For I:= 2 To 6 Do WriteXY(Fx+1,Fy+I,Chr(Ft));

         For I:= 2 To 5 Do WriteXY(Fx+5,Fy+I,Chr(Ft));

         For I:= 2 To 4 Do WriteXY(Fx+I,Fy+1,Chr(Ft));

         For I:= 2 To 3 Do WriteXY(Fx+I,Fy+7,Chr(Ft));

         For I:= 3 To 5 Do WriteXY(Fx+I,Fy+2+I,Chr(Ft));

       End;

   13: Begin 

         Fl:= Chr(Ft)+'K'; WriteXY(Fx+1,Fy,Fl);

         For I:= 1 To 7 Do WriteXY(Fx+1,Fy+I,Chr(Ft));

         For I:= 2 To 5 Do WriteXY(Fx+I,Fy+6-I,Chr(Ft));

         For I:= 3 To 5 Do WriteXY(Fx+I,Fy+2+I,Chr(Ft));

       End;

  End  

  Else 

  For I:= 1 To 5 Do For J:= 1 To 7 Do WriteXY(Fx+I,Fy+J,'*');

  ShowMouse;Tunj;

End;

 

Procedure TLap.Hide;

Begin

  Szinek(KepSz, 0); Window(Fx,Fy,Fx+6,Fy+8); ClrScr; Window(1,1,80,50);

End;

 

Procedure TLap.MoveTo(X, Y: Byte);

Begin

  Hide; Fx:= X; Fy:= Y; Show;

End;

 

Procedure TLap.MoveRel(X, Y: Integer);

Begin

  Fx:= Fx + X; Fy:= Fy + Y;

  If Fx<Then Fx:= 1; If Fx>74 Then Fx:= 74;

  If Fy<Then Fy:= 1; If Fy>42 Then Fy:= 42;

  Show;

End;

 

Procedure TLap.SetVisible(V: Boolean);

Begin

  Fv:= V; 

End;

 

Function TLap.GetVisible: Boolean;

Begin

  GetVisible:= Fv;

End;

 

Function TLap.InSide(X, Y: Byte): Boolean;

Begin

  InSide:= (Fx<=X) And (X<=Fx+6) And (Fy<=Y) And (Y<=Fy+8);

End;

 

Procedure TLap.FlashOn;

Begin

  If Fx=0 Then Exit;

  Szinek(7, Fc+128); Keret(Fx,Fy,Fx+6,Fy+8);

  Window(Fx,Fy,80,50); WriteXY(2,1,Fl); Window(1,1,80,50); Tunj;

  Ff:= True;

End;

 

Procedure TLap.FlashOff;

Begin

  If Fx=0 Then Exit;

  Szinek(7, Fc); Keret(Fx,Fy,Fx+6,Fy+8);

  Window(Fx,Fy,80,50); WriteXY(2,1,Fl); Window(1,1,80,50); Tunj;

  Ff:= False;

End;

 

Function TLap.GetFlash: Boolean;

Begin

  GetFlash:= Ff;

End;

 

Function TLap.GetTip: Byte;

Begin

  GetTip:= Ft;

End;

 

Function TLap.GetSzin: Byte;

Begin

  GetSzin:= Fc;

End;

 

Function TLap.GetFig: Byte;

Begin

  GetFig:= Fs;

End;

 

Procedure TLap.SetEnable(E: Boolean);

Begin

  Fe:= E; 

End;

 

Function TLap.GetEnable: Boolean;

Begin

  GetEnable:= Fe;

End;

 

(******** TLFor *********)

 

Procedure TLFor.Feltolt;

Var I: Byte;

Begin

  FNum:= 0;

  For I:= 1 To LSz Do With FLapF[I] Do

  Begin

    Init(4, 2, ((I-1) Div 13)+3, ((I-1) Mod 13)+1, False); Inc(FNum);

  End;

End;

 

Procedure TLFor.Kever;

Var I: Word;

    A, B: Byte;

    P: TLap;

Begin

  For I:= 1 To 2000 Do

  Begin

    A:= Random(LSz)+1; B:= Random(LSz)+1;

    P:= FLapF[A]; FLapF[A]:= FLapF[B]; FLapF[B]:= P;

  End;

End;

 

Procedure TLFor.Show;

Begin

  If FNum>0 Then FLapF[FNum].Show

End

 

Function TLFor.InSide(X, Y: Byte): Boolean;

Begin

  InSide:= (X>3And (11>X) And (Y>1) And (11>Y)

End;

 

(******** TLMut ****************)

 

Procedure TLMut.Show;

Begin

  If FNum>0 Then FLapM[FNum].Show;

End

 

Function TLMut.InSide(X, Y: Byte): Boolean;

Begin

  InSide:= (X>14And (22>X) And (Y>1) And (11>Y) 

End;

 

(******** TLAsz ***************) 

 

Procedure TLAsz.Show;

Var I, J: Byte;

Begin

  For I:= 1 To 7 Do For J:= 1 To I Do

  Begin

    If I = J Then

    Begin FLapA[I, J].SetVisible(True); FLapA[I, J].SetEnable(True) End;

    FLapA[I, J].MoveTo(11*(I-1)+4, J+12);

  End;

End;

 

(******** TCel **********)

 

Procedure TLCel.Show;

Var I: Byte;

Begin

  For I:= 1 To 4 Do If FFent[I]>0 Then FLapC[I,FFent[I]].Show;

End;

 

(******** TControl ************)

 

Procedure TControl.Init;

Var I, J: Byte;

Begin

 

  {A környezet beállítása}

  TextMode(259); Szinek(KepSz, 15); ClrScr; Randomize; InitEvents;

  

  {A képernyõ állandó elemei}

  Szinek(KepSz,  7); For I:= 0 To 1 Do Keret( 3+I*11,1,11+I*11,11);

  Szinek(KepSz, 15); For I:= 1 To 4 Do Keret( 25+I*11,1,33+I*11,11);

  

  {A forrás feltöltése és keverés}

  FLFor.Feltolt; FLFor.Kever;

  

  {Üres lap inicializálása}

  ULap.Init(0,0,0,0,False);

  

  {Az asztal és a célhely üres lapokkal való feltöltése}

  For I:= 1 To 7 Do For J:= 0 To 18 Do FLAsz.FLapA[I,J]:= ULap;

  For I:= 1 To 4 Do For J:= 1 To 13 Do FLCel.FLapC[I,J]:= ULap;

  

  {Az Asztal 0. sorának feltöltése} 

  For I:= 1 To 7 Do FLAsz.FLapA[I,0].Init(11*(I-1)+4,13,0,0,False);

  

  {A lapok átrakása az asztalra}

  For I:= 1 To 7 Do For J:= 1 To I Do

  Begin

    FLAsz.FLapA[I, J]:= FLFor.FLapF[FLFor.FNum];

    FLFor.FLapF[FLFor.FNum]:= ULap; Dec(FLFor.FNum)

  End;

  

  {Kezdõkép}

  FLCel.Show; FLAsz.Show; FLFor.Show; Tunj;

  

End;

 

Procedure TControl.Run;

Var I, J, K, L, X, Y: Byte;

    Event: TEvent; 

  Function Atteheto(A, B: Byte): Boolean;

  Var C, D, E, F: Byte;

  Begin

    Atteheto:= False;

    C:= 18; While Not FLAsz.FLapA[B,C].GetVisible Do Dec(C);

    D:=  0; While Not FLAsz.FLapA[A,D].GetVisible Do Inc(D);

    E:= 18; While Not FLAsz.FLapA[A,E].GetVisible Do Dec(E);

    For F:= D To E Do 

    If (FLAsz.FLapA[B,C].GetSzin<>FLAsz.FLapA[A,F].GetSzin) And

       (FLAsz.FLapA[B,C].GetFig-FLAsz.FLapA[A,F].GetFig=1) Then

       Atteheto:= True;

  End

  Function KAtteheto(A: Byte): Boolean;

  Var D: Byte;

  Begin

    KAtteheto:= False; D:=  0; 

    While Not FLAsz.FLapA[A,D].GetVisible Do Inc(D);

    If FLAsz.FLapA[A,D].GetFig<>13 Then Exit; KAtteheto:= True;

  End

  Procedure Atrak(A, B: Byte);

  Var C, D: Byte;

  Begin

    C:= 18; While Not FLAsz.FLapA[B,C].GetVisible Do Dec(C);

    D:= 18; While Not FLAsz.FLapA[A,D].GetVisible Do Dec(D);

    FLPuf.FNum:= 0;

    While (FLAsz.FLapA[B,C].GetFig-FLAsz.FLapA[A,D].GetFig>0) And

          (FLAsz.FLapA[A,D].GetVisible) Do

    Begin 

      Inc(FLPuf.FNum);

      FLAsz.FLapA[A,D].Moveto(25,2);

      FLPuf.FLapP[FLPuf.FNum]:= FLAsz.FLapA[A,D];

      FLAsz.FLapA[A,D]:= ULap; Dec(D);

    End;

    If D>0 Then FLAsz.FLapA[A,D].Show;

    If FLAsz.FLapA[A,D].GetVisible Then FLAsz.FLapA[A,D].SetEnable(True);

    FLAsz.FLapA[B,C].SetEnable(False);

    While FLPuf.FNum>0 Do

    Begin 

      Inc(C); FLPuf.FLapP[FLPuf.FNum].MoveTo((B-1)*11+4,12+C);

      FLAsz.FLapA[B,C]:= FLPuf.FLapP[FLPuf.FNum];

      Dec(FLPuf.FNum);

    End;

  End;

  Procedure KAtrak(A, B: Byte);

  Var C, D: Byte;

  Begin

    C:= 0; D:= 0; While Not FLAsz.FLapA[A,D].GetEnable Do Inc(D);

    FLPuf.FNum:= 0;

    While FLAsz.FLapA[A,D].GetVisible Do

    Begin 

      Inc(FLPuf.FNum);

      FLAsz.FLapA[A,D].Moveto(25,2);

      FLPuf.FLapP[FLPuf.FNum]:= FLAsz.FLapA[A,D];

      FLAsz.FLapA[A,D]:= ULap; Dec(D);

    End;

    If D>0 Then FLAsz.FLapA[A,D].Show;

    While FLPuf.FNum>0 Do

    Begin 

      Inc(C); FLPuf.FLapP[FLPuf.FNum].MoveTo((B-1)*11+4,12+C);

      FLAsz.FLapA[B,C]:= FLPuf.FLapP[FLPuf.FNum];

      Dec(FLPuf.FNum);

    End;

  End;

  Function Vege: Boolean;

  Var A, S: Byte;

  Begin

    S:= 0; For A:= 1 To 4 Do S:= S+FLCel.FFent[A];

    Vege:= S = LSz;

  End;

Begin

  Repeat

    While (Not KeyPressed) And (MouseButtons=0) Do

    Begin 

    

      {Lapok célhelyre rakása kettõs kattintással}

      GetMouseEvent(Event);

      If (Event.What=evMouseDown) And Event.Double Then

      Begin

        X:= MouseWhere.X+1; Y:= MouseWhere.Y+1;

        

        {Forráshelyrõl}

        With FLMut.FLapM[FLMut.FNum] Do If InSide(X,Y) Then

        Begin

          If FLCel.FLapC[GetTip-2,FLCel.FFent[GetTip-2]].GetFig=GetFig-1 Then

          Begin

            MoveTo((GetTip-3)*11+37,2);

            FLCel.FLapC[GetTip-2,FLCel.FFent[GetTip-2]+1]:=

            FLMut.FLapM[FLMut.FNum];

            Inc(FLCel.FFent[GetTip-2]);

            FLMut.FLapM[FLMut.FNum]:= ULap; Dec(FLMut.FNum); FLMut.Show; 

          End;

        End Else

        

        {Asztalról}

        For I:= 1 To 7 Do For J:= 1 To 18 Do With FLAsz.FLapA[I,J] Do

        If InSide(X,Y) And GetVisible And GetEnable Then

        Begin

          If FLCel.FLapC[GetTip-2,FLCel.FFent[GetTip-2]].GetFig=GetFig-1 Then

          Begin

            MoveTo((GetTip-3)*11+37,2);

            FLCel.FLapC[GetTip-2,FLCel.FFent[GetTip-2]+1]:= FLAsz.FLapA[I,J];

            Inc(FLCel.FFent[GetTip-2]); FLAsz.FLapA[I,J]:= ULap;

            If J>1 Then

            Begin

              FLASz.FLapA[I,J-1].Show; FLAsz.FLapA[I,J-1].SetEnable(True)

            End;

            I:= 7; J:= 18;

            X:= 0; Y:= 0;

          End;

        End;

        If Vege Then Exit;

        While MouseButtons=1 Do;

      End;

      

      {Ász automatikus kirakása}

      If FLMut.FLapM[FLMut.FNum].GetFig=1 Then   {Mutatóról}

      Begin

        K:= FLMut.FLapM[FLMut.FNum].GetTip;

        FLMut.FLapM[FLMut.FNum].MoveTo((K-3)*11+37,2);

        FLCel.FLapC[K-2,FLCel.FFent[K-2]+1]:= FLMut.FLapM[FLMut.FNum];

        Inc(FLCel.FFent[K-2]);

        FLMut.FLapM[FLMut.FNum]:= ULap; Dec(FLMut.FNum); FLMut.Show; Duda;

      End;

      For I:= 1 To 7 Do For J:= 1 To 18 Do With FLAsz.FLapA[I,J] Do

      If (GetFig=1) And GetVisible Then          {Asztalról}

      Begin

        K:= FLAsz.FLapA[I,J].GetTip;

        FLAsz.FLapA[I,J].MoveTo((K-3)*11+37,2);  

        FLCel.FLapC[K-2,FLCel.FFent[K-2]+1]:= FLAsz.FLapA[I,J];

        Inc(FLCel.FFent[K-2]); FLAsz.FLapA[I,J]:= ULap; If J>1 Then

        Begin

          FLAsz.FLapA[I,J-1].Show; FLAsz.FLapA[I,J-1].SetEnable(True)

        End; Duda;

      End;

    End;

    If Vege Then Exit;

    

    {Bármely billentyûre kilép}

    If KeyPressed Then Exit;

    

    If MouseButtons=1 Then

    Begin X:= MouseWhere.X+1; Y:= MouseWhere.Y+1 End;

    

    {Kattintás a forráson}

    If FLFor.InSide(X,Y) Then 

    Begin

      If FLFor.FNum>0 Then

      Begin

        Inc(FLMut.FNum);

        FLMut.FLapM[FLMut.FNum]:= FLFor.FLapF[FLFor.FNum];

        FLMut.FLapM[FLMut.FNum].SetVisible(True);

        FLMut.FLapM[FLMut.FNum].MoveTo(15,2);

        FLFor.FLapF[FLFor.FNum]:= ULap;

        Dec(FLFor.FNum);

      End Else

      Begin

        For I:= 1 To FLMut.FNum Do

        Begin

          FLFor.FLapF[FLMut.FNum-I+1]:= FLMut.FLapM[I];

          FLFor.FLapF[FLMut.FNum-I+1].SetVisible(False);

          FLFor.FLapF[FLMut.FNum-I+1].MoveTo(4,2);

          FLMut.FLapM[I]:= ULap;

        End;

        FLFor.FNum:= FLMut.FNum; FLMut.FNum:= 0;

      End;

      X:= 0; Y:= 0;

      FLFor.Show; FLMut.Show; If Vege Then Exit; While MouseButtons=1 Do;

    End;

    

    {Kattintás a mutatón}

    If X<>0 Then 

    If (FLMut.FNum>0) And FLMut.InSide(X,Y) Then 

    Begin

      FLMut.FLapM[FLMut.FNum].FlashOn; While MouseButtons=1 Do;

      Repeat

      

        {Mozgás az asztal felett, a jó helyek mutatása villogással}

        While (Not KeyPressed) And (MouseButtons=0) Do 

        Begin 

          X:= MouseWhere.X+1; Y:= MouseWhere.Y+1;

          For I:= 1 To 7 Do For J:= 1 To 18 Do With FLAsz.FLapA[I,J] Do

          If InSide(X,Y) And GetVisible And GetEnable And

             (GetSzin<>FLMut.FLapM[FLMut.FNum].GetSzin) And

             ((GetFig-FLMut.FLapM[FLMut.FNum].GetFig)=1) And

             Not GetFlash Then FlashOn Else

          If Not InSide(X,Y) And

             GetVisible And

             GetFlash Then FlashOff;

        End

        

        {Majd kattintás az asztalon}

        If (MouseButtons=1) Then

        Begin

          X:= MouseWhere.X+1; Y:= MouseWhere.Y+1;

          For I:= 1 To 7 Do For J:= 1 To 18 Do With FLAsz.FLapA[I,J] Do

          If InSide(X,Y) And GetVisible And GetEnable And

             (GetSzin<>FLMut.FLapM[FLMut.FNum].GetSzin) And

             ((GetFig-FLMut.FLapM[FLMut.FNum].GetFig)=1) Then

          Begin

            FLMut.FLapM[FLMut.FNum].FlashOff;

            FLAsz.FLapA[I,J].FlashOff;

            FLAsz.FLapA[I,J].SetEnable(False);

            FLMut.FLapM[FLMut.FNum].MoveTo((I-1)*11+4,12+J+1);

            FLAsz.FLapA[I,J+1]:= FLMut.FLapM[FLMut.FNum];

            FLAsz.FLapA[I,J+1].SetEnable(True);

            FLMut.FLapM[FLMut.FNum]:= ULap;

            Dec(FLMut.FNum); FLMut.Show;

            I:= 7; J:= 18;

          End Else 

          If (FLAsz.FLapA[I,1].Fx=0) And

             FLAsz.FLapA[I,0].InSide(X,Y) And

             (FLMut.FLapM[FLMut.FNum].GetFig=13) Then

          Begin

            FLMut.FLapM[FLMut.FNum].MoveTo((I-1)*11+4,12+J);

            FLAsz.FLapA[I,1]:= FLMut.FLapM[FLMut.FNum];

            FLAsz.FLapA[I,1].SetEnable(True);

            FLMut.FLapM[FLMut.FNum]:= ULap; Dec(FLMut.FNum); FLMut.Show;

            I:= 7; J:= 18;

          End;

          While MouseButtons=1 Do;

          With FLMut.FLapM[FLMut.FNum] Do If GetFlash Then FlashOff;

        End;

        If Vege Then Exit;

      Until Keypressed Or (MouseButtons=0);

      X:= 0; Y:= 0;

    End;

    

    {Elsõ kattintás az asztalon}

    If X<>0 Then

    For I:= 1 To 7 Do For J:= 1 To 18 Do With FLAsz.FLapA[I,J] Do

    If InSide(X,Y) And GetVisible And GetEnable Then

    Begin

      FlashOn; While MouseButtons=1 Do;

      Repeat

        While (Not KeyPressed) And (MouseButtons=0) Do

        Begin {Megnézi, van-e mit villogtatni}

          X:= MouseWhere.X+1; Y:= MouseWhere.Y+1;

          For K:= 1 To 7 Do For L:= 1 To 18 Do With FLAsz.FLapA[K,L] Do

          If InSide(X,Y) And GetVisible And GetEnable And

             (I<>K) And (J<>L) And

             (GetSzin<>FLAsz.FLapA[I,J].GetSzin) And

             ((GetFig-FLAsz.FLapA[I,J].GetFig)=1) And 

             Not GetFlash Then FlashOn Else

          If Not InSide(X,Y) And GetVisible And

             GetFlash And (I<>K) And (J<>L) Then FlashOff;

        End

        

        {Majd második kattintás az asztalon}

        If (MouseButtons=1) Then

        Begin

          X:= MouseWhere.X+1; Y:= MouseWhere.Y+1;

          For K:= 1 To 7 Do For L:= 1 To 18 Do With FLAsz.FLapA[K,L] Do

          If InSide(X,Y) And GetVisible And GetEnable And

             (GetSzin<>FLAsz.FLapA[I,J].GetSzin) And

             ((GetFig-FLAsz.FLapA[I,J].GetFig)=1) Then

          Begin   {Ha hely nem üres, de a lapra rátehetõ}

            FLAsz.FLapA[I,J].FlashOff;

            If (J>1And FLAsz.FLapA[I,J-1].GetVisible Then

            FLAsz.FLapA[I,J-1].SetEnable(True);

            FLAsz.FLapA[K,L].FlashOff;

            FLAsz.FLapA[K,L].SetEnable(False);

            FLAsz.FLapA[I,J].MoveTo((K-1)*11+4,12+L+1);

            FLAsz.FLapA[K,L+1]:= FLAsz.FLapA[I,J];

            FLAsz.FLapA[I,J]:= ULap;

            If J>1 Then FLAsz.FLapA[I,J-1].Show;

            K:= 7; L:= 18;

          End Else 

          If InSide(X,Y) And GetVisible And GetEnable And

             Atteheto(I,K) Then

          Begin

            Atrak(I,K); K:= 7; L:= 18;

          End Else

          If (FLAsz.FLapA[K,1].Fx=0) And

             FLAsz.FLapA[K,0].InSide(X,Y) And

             (FLAsz.FLapA[I,J].GetFig=13) Then

          Begin   {Ha a hely üres és amit tenni akarunk, az egy király}

            FLAsz.FLapA[I,J].FlashOff;

            If (J>1) And FLAsz.FLapA[I,J-1].GetVisible Then 

            FLAsz.FLapA[I,J-1].SetEnable(True);

            FLAsz.FLapA[I,J].MoveTo((K-1)*11+4,12+L);

            FLAsz.FLapA[K,1]:= FLAsz.FLapA[I,J];

            FLAsz.FLapA[I,J]:= ULap;

            If J>1 Then FLAsz.FLapA[I,J-1].Show;

            K:= 7; L:= 18;

          End Else {Ha a hely üres, de az átrakandók közül elsõ egy király}

          If (FLAsz.FLapA[K,1].Fx=0) And

             FLAsz.FLapA[K,0].InSide(X,Y) And

             KAtteheto(I) Then

          Begin

            KAtrak(I,K); K:= 7; L:= 18;

          End Else FLAsz.FLapA[I,J].FlashOff;

          If Vege Then Exit;

          While MouseButtons=1 Do;

        End;

        I:= 7; J:= 18;

        X:= 0; Y:= 0;

      Until Keypressed Or (MouseButtons=0);

    End Else

    If InSide(X,Y) And 

       Not GetVisible And 

       (FLAsz.FLapA[I,J+1].Fx=0) Then

    Begin

      SetVisible(True); SetEnable(True); Show;

      I:= 7; J:= 18;

      X:= 0; Y:= 0;

    End;

    If Vege Then Exit;

    While (MouseButtons=1) And (Not Vege) Do;

  Until False;

End;

 

Procedure TControl.Done;

Var I, J, K: Byte;

    Dx, P: Integer;

Begin

  If KeyPressed Then Exit; Duda; Randomize;

  For I:= 1 To 4 Do FLCel.FFent[I]:= 13;

  Repeat

    P:= Random(4)+1; Dx:= Random(4)-2;

    If FLCel.FFent[P]>0 Then

    Begin

      With FLCel.FLapC[P,FLCel.FFent[P]] Do

      Begin

        Show;

        For K:= 1 To 39 Do Begin MoveRel(Dx, 1); Delay(6) End;

      End;

      Dec(FLCel.FFent[P]); 

    End;

  Until Keypressed Or

  (FLCel.FFent[1]+FLCel.FFent[2]+FLCel.FFent[3]+FLCel.FFent[4]=0);

  Varj;

End;

 

Var Control: TControl;

 

Begin

  Control.Init;

  Control.Run;

  Control.Done;

End.