Unit CrtPlus;

Interface

Uses NewDelay, Crt, Dos, Drivers;

Procedure KeyEmpty;

Procedure Varj;

Procedure Felre;

Procedure Tunj;

Procedure Szinek(HSz,KSz: Byte);

Procedure Szinez(HSz,KSz,X,Y,Sh: Byte);

Procedure Torol(X,Y,Sh: Byte);

Procedure Tolt(X,Y,Sh: Byte; C: Char);

Function Olvas(X,Y,Sh: Byte): String;

Procedure WriteXY(X,Y: Byte; Sz: String);

Procedure IrXY(X,Y: Byte; Sz: String);

Procedure Vvonal(Xk,Xv,Y: Byte);

Procedure Fvonal(X,Yk,Yv: Byte);

Procedure Keret(Bfx,Bfy,Jax,Jay: Byte);

Procedure Racs(Bfx,Bfy,BX,By,NX,Ny: Byte);

Procedure Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay: Byte; Arny: Boolean; C: String);

Procedure Uzenet(HSz,KSz: Byte; Sz: String);

Procedure Duda;

Function Kerdezo(HSz,KSz: Byte; Sz: String): Boolean;

Function Bevitel(HSz,KSz,X,Y,Sh: Byte): String;

Function PassWord(HSz,KSz,X,Y,Sh: Byte; Pw: String): Boolean;

Function Menu(HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,AS: Byte): Byte;

Function Kmenu(Fmp: Byte): Integer;

Function Listazo(HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,Ls,AS: Integer;

Arny: Boolean; C: String): Integer;

Function Combo(X,Y,Sh,KS: Byte; Ss,AS: Integer; C: String): Integer;

Function ValidSt(S: String): String;

Function Listara(S: String): Integer;

Function Listarol(S: String): Integer;

Function FileKereso(HSz,KSz,Vsz,Dr: Byte; Ext: String): String;

Procedure Gomb(HSz,KSz,Vsz,X,Y,Sh: Byte; S: String);

Function GombKereso(X,Y: Byte): Char;

Function InputLine(Dhsz,Dksz,DVsz,HSz,KSz,X,Y,Sh: Byte; S: String): String;

Procedure RadioGomb(Dhsz,Dksz,HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,AS: Byte; S: String);

Function RadioGombKapcs(HSz,KSz,Bfx,Bfy,Sh,Ss,AS: Byte): Byte;

Procedure DeskTop;

Function Binaris(S: Word): String;

Function Tizes(S: String): Word;

Function SetBit(W: Word; N,B: Byte): Word;

Function ValtBit(W: Word; N: Byte): Word;

Const Max=250;

GtMax=64;

Type Scr=Array[1..25,1..80,1..2] Of Byte;

GombRec=Record

Tip: Byte;

GX,Gy,Gsh: Byte;

Key: Char;

End;

Hang=Record

Hq: Real;

Hc,Hcisz,Hd,Hdisz,He,Hf,Hfisz,Hg,Hgisz,Ha,Hbe,Hh: Integer;

End;

Const AltKod: Array[#42..'Z'] Of Char=

(#42,#43,#0,#45,#46,#47,

#129,#120,#121,#122,#123,#124,#125,#126,#127,#128,

#0,#0,#0,#61,#0,#0,#0,

#30,#48,#46,#32,#18,#33,#34,#35,#23,#36,#37,#38,#50,

#49,#24,#25,#16,#19,#31,#20,#22,#47,#17,#45,#21,#44);

Var BKep: Scr Absolute $B800:0;

KKep: Scr;

VCh: Char;

Tomb: Array[1..Max] Of String[80];

Sztomb: Array[0..25] Of Word;

Funkcio: Byte;

BeviteliSor: String[80];

GombT: Array[1..GtMax] Of GombRec;

GombIndex: Byte;

H: Hang;

Type PMRec=^MRec;

MRec=Record

Nev: String[32];

Cmp: Word;

Key: Word;

Eng: Boolean;

Kiv: Boolean;

HEMut, VEMut, HKMut, VKMut: PMRec;

End;

Var ElsoMRec, AktMRec, UJMRec: PMRec;

Esemeny: TEvent;

Implementation

Procedure KeyEmpty;

Begin

While KeyPressed Do ReadKey;

End;

Procedure Varj;

Begin

Repeat Until KeyPressed; KeyEmpty

End;

Procedure Felre;

Begin

GoToXY(1,Hi(WindMax)-Hi(WindMin)+1);

End;

Procedure Tunj;

Var HSz: Byte;

Begin

HSz:= BKep[Hi(WindMax)+1,Lo(WindMin)+1,2] Div 16;

Szinez(HSz,HSz,Lo(WindMin)+1,Hi(WindMax)+1,1);

GoToXY(1,Hi(WindMax)-Hi(WindMin)+1);

End;

Procedure Szinek(HSz,KSz: Byte);

Begin

TextBackGround(HSz);

TextColor(KSz);

End;

Procedure Szinez(HSz,KSz,X,Y,Sh: Byte);

Var I: Byte;

Begin

For I:= X To X+Sh-1 Do BKep[Y,I,2]:= 16*HSz+KSz;

End;

Procedure Torol(X,Y,Sh: Byte);

Var I: Byte;

Begin

For I:= X To X+Sh-1 Do BKep[Y,I,1]:= 32;

End;

Procedure Tolt(X,Y,Sh: Byte; C: Char);

Var I: Byte;

Begin

For I:= X To X+Sh-1 Do BKep[Y,I,1]:= Ord(C);

End;

Function Olvas(X,Y,Sh: Byte): String;

Var I: Byte;

WS: String;

Begin

WS:= ''; For I:= X To X+Sh-1 Do WS:= Ws+Chr(BKep[Y,I,1]);

OlvaS:= Ws;

End;

Procedure WriteXY(X,Y: Byte;Sz: String);

Begin

GoToXY(X,Y);

Write(Sz);

End;

Procedure IrXY(X,Y: Byte;Sz: String);

Var I: Byte;

Begin

For I:= 1 To Length(Sz) Do BKep[Y,X+I-1,1]:= Ord(Sz[I]);

End;

Procedure Vvonal(Xk,Xv,Y: Byte);

Var I: Byte;

Begin

For I:= Xk To Xv Do WriteXY(I,Y,Chr(196));

End;

Procedure Fvonal(X,Yk,Yv: Byte);

Var I: Byte;

Begin

For I:= Yk To Yv Do WriteXY(X,I,Chr(179));

End;

Procedure Keret(Bfx,Bfy,Jax,Jay: Byte);

Begin

Vvonal(Bfx+1,Jax-1,Bfy);

Vvonal(Bfx+1,Jax-1,Jay);

Fvonal(Bfx,Bfy+1,Jay-1);

Fvonal(Jax,Bfy+1,Jay-1);

WriteXY(Bfx,Bfy,Chr(218));

WriteXY(Jax,Bfy,Chr(191));

WriteXY(Bfx,Jay,Chr(192));

WriteXY(Jax,Jay,Chr(217));

End;

Procedure Racs(Bfx,Bfy,BX,By,Nx,Ny: Byte);

Var I,J,SX,Sy: Byte;

Begin

If Nx*Ny=0 Then Exit;

Sx:= Bfx+Nx*(BX+1);

Sy:= Bfy+Ny*(By+1);

Keret(Bfx,Bfy,Sx,Sy);

I:= Bfx+Bx+1;

While I<Sx Do

Begin

WriteXY(I,Bfy,Chr(194));

WriteXY(I,Sy,Chr(193));

Fvonal(I,Bfy+1,Sy-1);

Inc(I,Bx+1);

End;

J:= Bfy+By+1;

While J<Sy Do

Begin

WriteXY(Bfx,J,Chr(195));

WriteXY(SX,J,Chr(180));

Vvonal(Bfx+1,Sx-1,J);

Inc(J,By+1);

End;

For I:= 1 To Nx-1 Do For J:= 1 To Ny-1 Do

WriteXY(Bfx+I*(BX+1),Bfy+J*(By+1),Chr(197));

End;

Procedure Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay: Byte; Arny: Boolean; c: String);

Var I,Px,Py: Byte;

Begin

If Arny Then

Begin

Px:= Jax+2;

Py:= Jay+1;

If Px>80 Then Px:= 80;

If Py>25 Then Py:= 25;

For I:= Bfy+1 To Jay+1 Do Szinez(0,8,Bfx+2,I,Jax-Bfx+1);

End;

Window(Bfx,Bfy,Jax,Jay);

Szinek(HSz,KSz);

ClrScr;

Window(1,1,80,25);

Keret(Bfx+1,Bfy,Jax-1,Jay);

If C<>''Then

WriteXY(Round(Bfx+(Jax-Bfx-Length(c))/2-1),Bfy,' '+C+' ');

End;

Procedure Uzenet(HSz,KSz: Byte;Sz: String);

Var Bfx,Bfy,Jax,Jay,N: Byte;

Begin

N:= Length(Sz);

If n<10 Then N:= 10;

Bfx:= 40-Round(n/2)-2;

Bfy:= 11;

Jax:= 40+Round(n/2)+1;

Jay:= 13;

KKep:= BKep;

Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay,True,'Info');

WriteXY(40-Round(Length(Sz)/2),12,Sz);

Tunj;

Varj;

BKep:= KKep;

End;

Procedure Duda;

Begin

Sound(2*h.a);

Delay(80);

NoSound;

End;

Function Kerdezo(HSz,KSz: Byte;Sz: String): Boolean;

Var Bfx,Bfy,Jax,Jay,N: Byte;

Ch: Char;

Begin

N:= Length(Sz);If n<20 Then N:= 20;

Bfx:= 40-Round(n/2)-2;Bfy:= 11;Jax:= 40+Round(n/2)+1;Jay:= 13;

KKep:= BKep;

Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay,True,'Válaszoljon! (i/n)');

WriteXY(40-Round(Length(Sz)/2),12,sz);

Tunj;

Repeat

Ch:= ReadKey;

Ch:= UpCase(Ch);

Until Ch In ['I','N'];

Kerdezo:= Ch='I';

BKep:= KKep;

End;

Function Bevitel(HSz,KSz,X,Y,Sh: Byte): String;

Var Ch: Char;

I,Ax: Byte;

Ovw: Boolean;

Bszov: String;

Begin

Szinez(HSz,KSz,X,Y,Sh);

Ax:= X;

GoToXY(AX,Y);

Ovw:= False;

Repeat

While (Not KeyPressed) And (MouseButtons<>1) Do;

If MouseButtons<>1 Then Ch:= ReadKey;

Case Ch Of

#0:Begin

Ch:= ReadKey;

Case Ch Of

#71: Ax:= X;

#75: If Ax>x Then Dec(Ax);

#77: If Ax<X+Sh Then Inc(Ax);

#79: Begin

I:= X+Sh;

Repeat

Dec(I);

Until BKep[Y,I,1]<>32;

Ax:= I+1;

End;

#82: Ovw:= Ovw=False;

#83: If Ax<X+Sh Then

Begin

For I:= Ax To X+Sh-1 Do

BKep[Y,I,1]:= BKep[Y,I+1,1];

BKep[Y,X+Sh-1,1]:= 32;

End;

End;

End;

#8: If Ax<>x Then

Begin

For I:= Ax-1 To X+Sh-1 Do

BKep[Y,I,1]:= BKep[Y,I+1,1];

BKep[Y,X+Sh-1,1]:= 32;

Dec(Ax);

End;

#9: ;

#13: ;

#27: ;

Else If MouseButtons<>1 Then

If Ax<X+Sh Then

Begin

If Not Ovw Then

For I:= X+Sh-1 DownTo AX+1 Do

BKep[Y,I,1]:= BKep[Y,I-1,1];

BKep[Y,AX,1]:= Ord(Ch);

Inc(Ax);

End;

End;

GoToXY(AX,Y);

Until (Ch In [#13,#27,#9]) Or (MouseButtons=1);

VCh:= Ch;

If Ch=#27 Then Bevitel:= '' Else

Begin

Bszov:= '';

I:= X+Sh;

Repeat

Dec(I);

Until (BKep[Y,I,1]<>32) Or (I=X);

Ax:= I;

For I:= X To Ax Do Bszov:= Bszov+Chr(BKep[Y,I,1]);

Bevitel:= Bszov;

End;

Tunj;

End;

Function PassWord(HSz,KSz,X,Y,Sh: Byte;Pw: String): Boolean;

Var Ch: Char;

I,Ax: Byte;

WS: String;

Begin

Szinez(HSz,KSz,X,Y,Sh);

Ax:= X;

GoToXY(Ax,Y);

WS:= '';

Repeat

While (Not KeyPressed) And (MouseButtons<>1) Do;

If MouseButtons<>1 Then Ch:= ReadKey;

Case Ch Of

#0: Ch:= ReadKey;

#8: If Ax<>x Then

Begin

WS:= Copy(Ws,1,Length(Ws)-1);

Dec(Ax);

BKep[Y,AX,1]:= 32;

End;

#9: ;

#13: ;

#27: ;

Else If MouseButtons<>1 Then

If Ax<X+Sh Then

Begin

WS:= Ws+Ch;

BKep[Y,Ax,1]:= Ord('*');

Inc(Ax);

End;

End;

GoToXY(Ax,Y);

Until (Ch In [#13,#27,#9]) Or (MouseButtons=1);

PassWord:= WS=pw;

End;

Function menu(HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,AS: Byte): Byte;

Var I: Integer;

Ch: Char;

Begin

Szinez(Vsz,KSz,Bfx,Bfy+As-1,Sh);

Repeat

GetMouseEvent(Esemeny);

If Esemeny.What=evMouseDown Then With MouseWhere Do

If (X>Bfx-2) And (X<Bfx+Sh-1) And (Y>Bfy-2) And (Y<Bfy+Ss-1) Then

Begin

Szinez(HSz,KSz,Bfx,Bfy+As-1,Sh);

AS:= Y-Bfy+2;

Szinez(Vsz,KSz,Bfx,Bfy+As-1,Sh);

Menu:= As;

While MouseButtons=1 Do;

Exit;

End;

If KeyPressed Then Ch:= ReadKey;

If Ch=#0 Then

Begin

Ch:= ReadKey;

If Ch In [#71,#72,#79,#80] Then

Szinez(HSz,KSz,Bfx,Bfy+As-1,Sh);

Case Ch Of

#71: As:= 1;

#72: If As>1 Then Dec(As) Else As:= Ss;

#80: If As<Ss Then Inc(As) Else As:= 1;

#79: As:= Ss;

End;

If Ch In [#71,#72,#79,#80] Then

Szinez(Vsz,KSz,Bfx,Bfy+As-1,Sh);

End;

Until Ch In [#13,#27,#75,#77];

If Ch In [#13,#75,#77] Then Menu:= As Else Menu:= 0;

VCh:= Ch;

End;

Function Kmenu(Fmp: Byte): Integer;

label 1;

Var I,J,Lhs,ABfx,AJax: Byte;

Fmh: Array[1..20] Of Byte;

FmSz: Byte;

Ch: Char;

Nyitva: Boolean;

Amp: Word;

Oldmp: Byte;

Begin

For I:= 1 To 20 Do Fmh[I]:= 0;

Szinez(7,0,1,1,80);

Szinez(7,0,1,25,80);

Szinek(7,0);

GoToXY(2,1);

Fmh[1]:= 2;

Nyitva:= False;

I:= 1;

AktMRec:= ElsoMRec;

While AktMRec<>nil Do with AktMRec^ Do

Begin

Write(' ',Nev,' ');

Fmh[I+1]:= WhereX;

AktMRec:= AktMRec^.HKMut;

Inc(I);

End;

Tunj;

KKep:= BKep;

FmSz:= I-1;

Fmh[I+1]:= Fmh[I]+Length(AktMRec^.Nev);

Szinez(green,0,fmh[fmp],1,fmh[fmp+1]-fmh[fmp]);

Amp:= 0;

Repeat

Ch:= ReadKey;

If (Not Nyitva) And (Ch=#13) Then

Begin Nyitva:= True; KeyEmpty End;

If Ch=#0 Then

Begin

Ch:= ReadKey;

If Ch=#80 Then Nyitva:= True;If Ch In [#75,#77,#80] Then

Szinez(7,0,Fmh[Fmp],1,Fmh[Fmp+1]-Fmh[Fmp]);

1:

Case Ch Of

#75: If fmp>1 Then Dec(fmp) Else fmp:= fmsz;

#77: If fmp<fmsz Then Inc(fmp) Else fmp:= 1;

End;

If Nyitva And (Ch In [#75,#77,#80]) Then

Begin

BKep:= KKep;

AktMRec:= ElsoMRec;

For I:= 1 To 25 Do Tomb[I]:= '';

LhS:= 0;

Oldmp:= 1;

For I:= 1 To fmp-1 Do

AktMRec:= AktMRec^.HKMut;AktMRec:= AktMRec^.VKMut;

I:= 0;

While AktMRec<>nil Do with AktMRec^ Do

Begin

Inc(I);

Tomb[I]:= ' '+Nev+' ';

If AktMRec^.HKMut<>nil Then Tomb[I]:= Tomb[I]+Chr(16)+' ';

If Length(Tomb[I])>Lhs Then LhS:= Length(Tomb[I]);

Sztomb[I]:= cmp;

If Kiv Then Oldmp:= I;

UjMRec:= AktMRec;

AktMRec:= AktMRec^.VKMut

End;

If I>0 Then

Begin

Szinez(Green,0,Fmh[Fmp],1,Fmh[Fmp+1]-Fmh[Fmp]);

ABfx:= Fmh[Fmp]-1;

AJax:= Fmh[Fmp]+Lhs+2;

While AJax>80 Do Begin Dec(ABfx);Dec(AJax) End;

Ablak(7,0,ABfx,2,AJax,3+I,True,'');

For J:= 1 To I Do WriteXY(ABfx+2,J+2,Tomb[J]);

Felre;

Amp:= Menu(7,0,Green,ABfx+2,3,Lhs,I,Oldmp);

Ch:= VCh;

If (Pos(Chr(16),Tomb[Amp])<>0) And (Ch=#13) Then

Begin

AktMRec:= UjMRec;

While I>Amp Do

Begin

Dec(I);

AktMRec:= AktMRec^.VEMut;

End;

For I:= 1 To 25 Do Tomb[I]:= '';lhS:= 0;I:= 0;

oldmp:= 1;

AktMRec:= AktMRec^.HKMut;

While AktMRec<>Nil Do with AktMRec^ Do

Begin

Inc(I);

Tomb[I]:= ' '+Nev+' ';

If Length(Tomb[I])>Lhs Then LhS:= Length(Tomb[I]);

Sztomb[I]:= Cmp;

If Kiv Then Oldmp:= I;

UjMRec:= AktMRec;

AktMRec:= AktMRec^.VKMut

End;

ABfx:= Fmh[Fmp]+1;

AJax:= Fmh[Fmp]+Lhs+4;

While AJax>80 Do Begin Dec(ABfx); Dec(AJax) End;

Ablak(7,0,ABfx,Amp+3,AJax,Amp+4+I,True,'');

For J:= 1 To I Do WriteXY(ABfx+2,Amp+J+3,Tomb[J]);

Felre;

Amp:= Menu(7,0,Green,ABfx+2,Amp+4,Lhs,I,Oldmp);

Ch:= VCh;

End;

If Ch In [#13,#75,#77] Then

Begin

AktMRec:= UjMRec;

While i>amp Do

Begin

Dec(I);

AktMRec^.Kiv:= False;

AktMRec:= AktMRec^.VEMut;

End;

AktMRec^.Kiv:= True;

While I>1 Do

Begin

Dec(I);

AktMRec:= AktMRec^.VEMut;

AktMRec^.Kiv:= False;

End;

End;

If Ch In [#75,#77] Then GoTo 1;

End;

End;

If Ch In [#75,#77] Then

Szinez(Green,0,Fmh[Fmp],1,Fmh[Fmp+1]-Fmh[Fmp]);

End;

Until Ch In [#13,#27];

If Ch=#13 Then Kmenu:= Sztomb[Amp] Else Kmenu:= 0;

End;

Function Listazo(HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,Ls,AS: Integer;

Arny: Boolean;c: String): Integer;

Var I,Ki,Ai,Vi,AkS: Integer;

Ch: Char;

Procedure Kiir;

Var J,Ay: Integer;

Begin

Ki:= Round(As-Ls/2);

Vi:= Round(As+Ls/2)-1;

If Ki<=0 Then Inc(Ki,Ss);

If Vi>Ss Then Dec(Vi,Ss);

Window(Bfx+2,Bfy+1,Bfx+Sh-2,Bfy+Ls);

ClrScr;

If Vi>Ki Then

For J:= Ki To Vi Do WriteXY(1,1+j-Ki,Copy(Tomb[J],1,Sh-1))

Else

Begin

If As<=Ss-Ls/2 Then Inc(Ki);

For J:= Ki To Ss Do WriteXY(1,1+j-Ki,Copy(Tomb[J],1,Sh-1));

Ay:= WhereY;

For J:= 1 To Vi Do

Begin Inc(Ay);WriteXY(1,Ay,Copy(Tomb[J],1,Sh-1)) End;

End;

Window(1,1,80,25);

Tunj

End;

Begin

If LS>Ss Then LS:= Ss;If Ls<3 Then LS:= 3;

If Not Odd(Ls) Then Dec(Ls);

If LS>21 Then LS:= 21;

If Bfy+Ls+1>24 Then Repeat Dec(Bfy) Until Bfy+Ls+1<25;

AkS:= Bfy+Round(Ls/2);

Ablak(HSz,KSz,Bfx,Bfy,Bfx+Sh,Bfy+Ls+1,Arny,c);

Kiir;

Szinez(Vsz,KSz,Bfx+2,Aks,Sh-3);

Repeat

Ch:= ReadKey;

If (Ch=#0) And KeyPressed Then

Begin

Ch:= ReadKey;

If Ch In [#71,#72,#73,#79,#80,#81] Then Szinez(HSz,KSz,Bfx+2,Aks,Sh-3);

Case Ch Of

#71: AS:= 1;

#72: Begin

Dec(Ki);Dec(As);Dec(Vi);

If Ki<1 Then Ki:= Ss;

If As<1 Then AS:= Ss;

If Vi<1 Then Vi:= Ss;

End;

#73: Begin

Dec(Ki,Ls);Dec(As,Ls);Dec(Vi,Ls);

If Ki<1 Then Begin If Ki=0 Then Ki:= Ss Else Ki:= KI+Ss+1 End;

If As<1 Then Begin If AS=0 Then AS:= Ss Else AS:= As+Ss+1 End;

If Vi<1 Then Begin If Vi=0 Then Vi:= Ss Else Vi:= VI+Ss+1 End;

End;

#79: As:= Ss;

#80: Begin

Inc(Ki);Inc(As);Inc(Vi);

If Ki>Ss Then Ki:= 1;

If AS>Ss Then AS:= 1;

If Vi>Ss Then Vi:= 1;

End;

#81: Begin

Inc(Ki,Ls);Inc(As,Ls);Inc(Vi,Ls);

If Ki>Ss Then Ki:= KI-Ss;

If AS>Ss Then AS:= As-Ss;

If Vi>Ss Then Vi:= VI-Ss;

End;

End;

If Ch In [#71,#72,#73,#79,#80,#81] Then

Begin

Kiir;

Szinez(Vsz,KSz,Bfx+2,Aks,Sh-3);

End;

End;

Until Ch In [#13,#27];

If Ch=#27 Then Listazo:= 0 Else Listazo:= As;

VCh:= Ch;

End;

Function Combo(X,Y,Sh,kS: Byte;Ss,As: Integer;c: String): Integer;

label 1,2,3,4;

Var I,Ik,Iv,Pik,Piv: Byte;

Ch,Ch1: Char;

Elso: Boolean;

Kks,Apos: Byte;

Ws: String;

Procedure Kiir;

Var I: Byte;

Begin

Window(1,1,80,25);

If Elso Then Szinek(2,15) Else Szinek(1,15);

WriteXY(X,Y,' '+Tomb[As]);

Window(X+1,Y+2,X+Sh+1,Y+ks+2);

If Elso Then

Begin

Ik:= As;

Iv:= Ss;

While Iv>As+ks-1 Do Dec(iv);

Pik:= Ik;

Piv:= Iv;

For I:= As To Iv Do

Begin

If I=As Then Begin KkS:= WhereY; Szinek(2,15) End Else Szinek(3,0);

WriteLn(Tomb[I]);

End;

GoToXY(X+1,Y+2);

End

Else

Begin

If As<Pik Then Begin Dec(Pik); If Piv-Pik=Ks Then Dec(Piv) End Else

If As>Piv Then Begin Inc(Pik); Inc(Piv) End;

For I:= Pik To Piv Do

Begin

If I=As Then Begin KkS:= WhereY; Szinek(2,15) End Else Szinek(3,0);

WriteLn(Tomb[I]);

End;

End;

Szinek(3,0);

Window(1,1,80,25);

Case Apos Of

1: GoToXY(X+1,Y);

2: GoToXY(X+1,Kks+6);

End;

End;

Begin

Ablak(7,15,x-5,Y-2,X+Sh+14,Y+ks+3,True,C);

Szinek(2,0);

WriteXY(54, 7,' Beszúr ');

WriteXY(54, 9,' Javít ');

WriteXY(54,11,' Töröl ');

WriteXY(54,13,' Mégsem ');

Window(X,Y+2,X+Sh+1,Y+ks+1);

Szinek(3,0);

ClrScr;

Elso:= True; ApoS:= 1;

Kiir;

Elso:= False;

Repeat

If Ch<>#9 Then Repeat Until KeyPressed; Ch:= ReadKey;

If Ch=#27 Then GoTo 3;

1:If Ch=#9 Then Begin Inc(Apos); If ApoS>6 Then ApoS:= 1 End;

If Ch=#0 Then

Begin

Ch:= ReadKey; If Ch=#15 Then

Begin Dec(Apos); If Apos<1 Then ApoS:= 6 End;

End;

Case Apos Of

1: Begin

GoToXY(X+1,Y);

Szinez(2,15,X+1,Y,Sh-2);

Repeat Until KeyPressed;

Ch:= ReadKey;

If Ch In [#13,#0,'0'..'9',' ',

'A'..'Z','Á','É','Í','Ó','Ö','Ő','Ú','Ü','Ű',

'a'..'z','á','é','í','ó','ö','ő','ú','ü','ű'] Then

Begin

If KeyPressed Then

Begin

Ch1:= ReadKey;

If Ch1<>#77 Then GoTo 4;

End;

WS:= Bevitel(1,15,X+1,Y,Sh);

Szinez(1,15,X,Y,Sh+2);

GoToXY(X+1,Y);

End;

4: Szinez(1,15,X,Y,Sh-1);

End;

2: Begin

GoToXY(X+1,kks+6);

2: Repeat Until KeyPressed;

Ch:= ReadKey;

Case Ch Of

#9:GoTo 1;

#27:GoTo 3;

End;

If (Ch=#0) And KeyPressed Then

Begin

Ch:= ReadKey;

Case Ch Of

#15: Begin ApoS:= 1; GoTo 1; End;

#72: If AS>1 Then Dec(As);

#80: If SS>As Then Inc(As);

End;

Kiir;

End;

GoTo 2;

End;

3: Begin

Szinez(2,15,54,7,8);

Tunj;

Repeat Until KeyPressed;

Szinez(2,0,54,7,8);

Ch:= ReadKey;

If Ch In [#13,#27] Then GoTo 3 Else GoTo 1;

End;

4: Begin

Szinez(2,15,54,9,8);

Tunj;

Repeat Until KeyPressed;

Szinez(2,0,54,9,8);

Ch:= ReadKey;

If Ch In [#13,#27] Then GoTo 3 Else GoTo 1;

End;

5: Begin

Szinez(2,15,54,11,8);

Tunj;

Repeat Until KeyPressed;

Szinez(2,0,54,11,8);

Ch:= ReadKey;

If Ch In [#13,#27] Then GoTo 3 Else GoTo 1;

End;

6: Begin

Szinez(2,15,54,13,8);

Tunj;

Repeat Until KeyPressed;

Szinez(2,0,54,13,8);

Ch:= ReadKey;

If Ch In [#13,#27] Then GoTo 3 Else GoTo 1;

End;

End;

Until (Apos In [3..6]) And (Ch=#13);

3:If Ch=#27 Then Combo:= 0 Else Combo:= As;

VCh:= Ch;

Funkcio:= Apos;

BeviteliSor:= '';

For I:= X+1 To X+Sh Do BeviteliSor:= BeviteliSor+Chr(BKep[Y,I,1]);

End;

Function ValidSt(S: String): String;

Var I,N: Byte;

Ws: String;

Van: Boolean;

Begin

N:= Length(s);

ValidSt:= '';

If N=0 Then Exit;

WS:= s;

While WS[N]=' ' Do

Begin

WS:= Copy(Ws,1,N-1);

Dec(N);

End;

If N>0 Then

While WS[1]=' ' Do

Begin

Ws:= Copy(Ws,2,N-1);

Dec(N);

End;

Van:= True;

If N>3 Then While Van Do

Begin

Van:= False;

N:= Length(Ws);

For I:= 2 To N-1 Do If (Ws[I]=' ') And (Ws[I+1]=' ') Then

Begin

Van:= True;

Ws:= Copy(Ws,1,i)+Copy(Ws,I+2,N-I-1);

End;

End;

ValidSt:= Ws;

End;

Function Listara(S: String): Integer;

Var I,J,N: Integer;

Begin

S:= ValidSt(s);

N:= 0;

While Tomb[N+1]<>''Do Inc(N);

If S='' Then Begin Listara:= N; Exit End;

If n=0 Then Begin Tomb[1]:= S; Listara:= 1; Exit End;

For I:= 1 To N Do If Tomb[I]=S Then Begin Listara:= n; Exit End;

I:= 1; While (S>Tomb[I]) And (Tomb[I]<>'') Do Inc(I);

For J:= N DownTo I Do Tomb[J+1]:= Tomb[J];

Tomb[I]:= s;

Listara:= N+1;

End;

Function Listarol(S: String): Integer;

Var I,J,N: Integer;

Begin

S:= ValidSt(s);

N:= 0;

While Tomb[N+1]<>''Do Inc(N);

If (S='') or (N=0) Then Begin Listarol:= N; Exit End;

For I:= 1 To N Do If Tomb[I]=S Then

Begin

For J:= I To N-1 Do Tomb[J]:= Tomb[J+1];

Tomb[N]:= '';

Listarol:= N-1;

Exit;

End;

Listarol:= 0;

End;

Function FileKereso(HSz,KSz,Vsz,dr: Byte;ext: String): String;

Var I,v,Sh: Integer;

Bejegyzes: SearchRec;

Katalogus: String;

Begin

For I:= 0 To Max Do Tomb[I]:= '';GetDir(dr,Katalogus);

If Katalogus[Length(Katalogus)]<>'\' Then Katalogus:= Katalogus+'\';

Katalogus:= Katalogus+'*.'+ext;FindFirst(Katalogus,AnyFile,Bejegyzes);

If Doserror<>0 Then Begin FileKereso:= ''; Exit End;

I:= 1;

While Doserror=0 Do

Begin Tomb[I]:= ' '+Bejegyzes.Name;FindNext(Bejegyzes);Inc(I) End;

Dec(I);Sh:= Length(Katalogus)+5;If Sh<17 Then Sh:= 17;

v:= Listazo(HSz,KSz,Vsz,Round(40-Sh/2),6,Sh,I,11,1,True,Katalogus);

FileKereso:= ValidSt(Tomb[V]);

End;

Procedure Gomb(HSz,KSz,Vsz,X,Y,Sh: Byte;S: String);

Var I,kh: Byte;

Begin

HideMouse; Kh:= Pos(Chr(126),s);

If Kh<>0 Then

Begin

GoToXY(X+1,Y);

For I:= 1 To Length(s) Do If S[I]<>Chr(126) Then Write(S[I]);

End Else WriteXY(X+1,Y,s);

Szinez(HSz,KSz,X,Y,Sh);

If kh<>0 Then Szinez(HSz,Vsz,X+kh,Y,1);

HSz:= BKep[Y,X+Sh,2] Div 16;

Szinek(HSz,0);

WriteXY(X+Sh,Y,Chr(220));

For I:= X+1 To X+Sh Do WriteXY(I,Y+1,Chr(223));

Inc(GombIndex);

With GombT[GombIndex] Do

Begin

Tip:= 1;

Gx:= X; Gy:= y; Gsh:= Sh; Key:= #0;

If Kh<>0 Then Key:= AltKod[UpCase(S[Pos(Chr(126),s)+1])];

End;

ShowMouse;

End;

Function GombKereso(X,Y: Byte): Char;

Var I,J,HSz: Byte;

Begin

GombKereso:= #0;

For I:= 1 To gtMax Do with GombT[I] Do

If (gy=y) And (gx<=x) And (x<gX+Gsh) Then

Begin

GombKereso:= Key;

If Tip>1 Then

Begin

Repeat Until MouseButtons<>1;

Exit;

End;

HideMouse;

For J:= Gx+1 To Gx+Gsh Do BKep[Gy+1,J,1]:= 32;

For J:= Gx+Gsh DownTo Gx Do

Begin

BKep[Y,J,1]:= BKep[Y,J-1,1];

BKep[Y,J,2]:= BKep[Y,J-1,2];

End;

BKep[Y,Gx,1]:= 32;

ShowMouse; Repeat Until MouseButtons<>1; HideMouse;

HSz:= BKep[Y,Gx,2] Div 16;

For J:= Gx To Gx+Gsh Do

Begin

BKep[Y,J,1]:= BKep[Y,J+1,1];

BKep[Y,J,2]:= BKep[Y,J+1,2];

End;

Szinek(HSz,0);WriteXY(gX+Gsh,Y,Chr(220));

For J:= Gx+1 To Gx+Gsh Do WriteXY(J,Gy+1,Chr(223));

Tunj;

ShowMouse; Exit;

End;

End;

Function InputLine(Dhsz,Dksz,dVsz,HSz,KSz,X,Y,Sh: Byte; S: String): String;

Var I,kh: Byte;

Begin

HideMouse; Szinek(Dhsz,Dksz);

Kh:= Pos(Chr(126),s);

If Kh<>0 Then

Begin

GoToXY(X,Y-1);

For I:= 1 To Length(s) Do If S[I]<>Chr(126) Then Write(S[I]);

End Else WriteXY(X,Y-1,s);

If kh<>0 Then Szinez(Dhsz,dVsz,X+kh-1,Y-1,1);

Szinez(HSz,KSz,X,Y,Sh);

Inc(GombIndex);

With GombT[GombIndex] Do

Begin

Tip:= 2; Gx:= X; Gy:= y; Gsh:= Sh; Key:= #0;

If Kh<>0 Then Key:= AltKod[UpCase(S[Pos(Chr(126),S)+1])];

End; ShowMouse;

End;

Procedure RadioGomb(Dhsz,Dksz,HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,AS: Byte; S: String);

Var I,J,kh,dy: Integer;

Ch: Char;

Begin

HideMouse; Szinek(Dhsz,Dksz);WriteXY(Bfx,Bfy-1,s);

For I:= 1 To Ss Do Szinez(HSz,KSz,Bfx,Bfy-1+I,Sh);

Szinek(HSz,KSz);

For I:= 1 To Ss Do WriteXY(Bfx,Bfy-1+I,' ( )');

dy:= 0;

For I:= 1 To Ss Do

Begin

Kh:= Pos(Chr(126),Tomb[I]);

If Kh<>0 Then

Begin

GoToXY(Bfx+5,Bfy-1+i);

For J:= 1 To Length(Tomb[I]) Do

If Tomb[I][J]<>Chr(126) Then Write(Tomb[I][J]);

End Else WriteXY(Bfx+6,Bfy-1+I,Tomb[I][J]);

If kh<>0 Then Szinez(HSz,Vsz,Bfx+5+kh-1,Bfy-1+I,1);

Inc(GombIndex);

With GombT[GombIndex] Do

Begin

tip:= 3;

gx:= Bfx;gy:= Bfy+dy;Inc(dy);Gsh:= Sh;Key:= #0;

If Kh<>0 Then Key:= AltKod[UpCase(Tomb[I][Pos(Chr(126),Tomb[I])+1])];

End;

End;

WriteXY(Bfx+2,Bfy-1+As,Chr(4)); ShowMouse;

End;

Function RadioGombKapcs(HSz,KSz,Bfx,Bfy,Sh,Ss,AS: Byte): Byte;

Var I,Ax,Ay: Integer;

Ch: Char;

Begin

Repeat

Szinek(HSz,KSz);GoToXY(Bfx+2,Bfy-1+As);

While (Not KeyPressed) And (MouseButtons<>1) Do;

If KeyPressed Then Ch:= ReadKey;

If MouseButtons=1 Then With MouseWhere Do

If (X>Bfx-1) And (X<Bfx+Sh-1) And (Y>Bfy-2) And (Y<Bfy+Ss-1) Then

Begin

For I:= Bfy To Bfy+Ss-1 Do WriteXY(Bfx+2,I,' ');

As:= Y-Bfy+2;

WriteXY(Bfx+2,Bfy-1+As,Chr(4));

GoToXY(WhereX-1,WhereY);

RadioGombKapcS:= As;

Exit;

End;

If Ch=#0 Then

Begin

Ch:= ReadKey;

If Ch In [#72,#80] Then WriteXY(Bfx+2,Bfy-1+As,' ');

Case Ch Of

#72: If AS>1 Then Dec(As) Else AS:= Ss;

#80: If As<Ss Then Inc(As) Else AS:= 1;

End;

If Ch In [#72,#80] Then WriteXY(Bfx+2,Bfy-1+As,Chr(4));

End

Else

Begin

Ax:= 0; Ay:= 0;

Ch:= AltKod[UpCase(Ch)];

For I:= 1 To 16 Do with GombT[I] Do If Key=Ch Then

Begin

Ax:= gx; Ay:= gy;

If Not ((Ax>Bfx-1) And (Ax<Bfx+Sh-1) And

(Ay>Bfy-1) And (Ay<Bfy+Ss)) Then Ax:= 0;

End;

If Ax*Ay<>0 Then

Begin

WriteXY(Bfx+2,Bfy-1+As,' ');

GoToXY(WhereX-1,WhereY);

AS:= Ay-Bfy+1;

WriteXY(Bfx+2,Bfy-1+As,Chr(4));

GoToXY(WhereX-1,WhereY);

End;

End;

Until Ch In [#9,#13,#27];

RadioGombkapcS:= As;

Tunj;

End;

Procedure DeskTop;

Var I: Integer;

Begin

Szinek(7,1);

ClrScr;

For I:= 2 To 24 Do Tolt(1,I,80,Chr(176));

Szinek(7,0);

WriteXY(1,25,' Alt-X Exit');

Tunj;

Szinez(7,4,2,25,5);

Inc(GombIndex);

With GombT[GombIndex] Do

Begin

Tip:= 6; Gx:= 2; Gy:= 25; Gsh:= 5; Key:= AltKod['X'];

End;

InitEvents; ShowMouse;

End;

Function Binaris(S: Word): String;

Var WS: String;

B: Word;

Begin

WS:= '';

B:= $8000;

While B<>0 Do

Begin

If B And S=0 Then Ws:= Ws+'0' Else Ws:= Ws+'1';

B:= B Shr 1;

End;

Binaris:= Ws;

End;

Function Tizes(S: String): Word;

Var Wn: Word;

B,I: Byte;

Kod: Integer;

Begin

Wn:= 0;

While Length(S)<16 Do S:= '0'+S;

For I:= 16 DownTo 1 Do

Begin

Val(S[I],B,Kod);

If B>1 Then

Begin

Tizes:= 0;

Exit;

End;

Wn:= Wn+B*Round(Exp((16-i)*Ln(2)));

End;

Tizes:= Wn;

End;

Function SetBit(W: Word; N,B: Byte): Word;

Var S,WS: String;

Begin

If (N=0) Or (N>16) Or (B>1) Then

Begin

SetBit:= W;

Exit;

End;

S:= Binaris(W);

Str(B,Ws);

S[16-N+1]:= Ws[1];

SetBit:= Tizes(s);

End;

Function ValtBit(W: Word; N: Byte): Word;

Var S: String;

Begin

If (N=0) or (N>16) Then

Begin

ValtBit:= W;

Exit;

End;

S:= Binaris(W);

If S[16-N+1]='0' Then S[16-N+1]:= '1' Else S[16-N+1]:= '0';

ValtBit:= Tizes(s);

End;

Begin

With H Do

Begin

Hq:= 1.059463;

Ha:= 440;

Hc:= Round(a/q/q/q/q/q/q/q/q/q);

HciSz:= Round(c*q);

Hd:= Round(cisz*q);

HdiSz:= Round(d*q);

He:= Round(disz*q);

Hf:= Round(e*q);

HfiSz:= Round(f*q);

Hg:= Round(fisz*q);

HgiSz:= Round(a/q);

Hbe:= Round(a*q);

Hh:= Round(be*q);

End;

End.