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]<>Nil) And
(KocsiT[LSzM]=Nil)
Then P[1]:=1;
For I:=2 To LSzM Do
If (KocsiT[I]<>Nil) And
(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<1 Then Fx:= 1; If Fx>74 Then Fx:= 74;
If Fy<1 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>3) And (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>14) And (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>1) And 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.
