A CrtPlus

A Pascal fejlesztői megadták a lehetőséget a felhasználóknak is arra, hogy saját UNIT-okat szerkesszenek. Ennek az a hatalmas előnye, hogy egyszer jól megírt eljárásainkat UNIT-ban tárolva nagyon sokszor és sokáig használhatjuk. Mi a Crt-hez kapcsolódó eljárásainkat és függvényeinket a CrtPlus-ban helyeztük el.

KeyEmpty : eljárás, billentyűzet-puffer ürítő.

Varj : eljárás, vár addig, ameddig meg nem nyomunk egy billentyűt. A billentyűzet puffer üres lesz az eljárás után.

Felre : eljárás, kurzor az aktív képernyő bal alsó sarkába ugrik

Tunj : eljárás, a kurzor eltűnik

Szinek : kétparaméteres eljárás, első paraméter a háttérszín, második a karakterszín

Szinez : ötparaméteres eljárás, a képernyő egy sorában megadható darabszámú képernyőhely színeit állítja be. Paraméterek:

1. hsz: háttérszín;

2. ksz: karakterszín;

3. x koordináta;

4. y koordináta;

5. karakterek száma.

Torol : eljárás, a képernyő egy adott helyétől törli a képernyő memórát

Tolt : eljárás, a képernyő egy adott helyétől adott karakterrel tölti a képernyő memóriát

WriteXY : háromparaméteres eljárás, képernyő adott helyére ír. Paraméterek:

1. x koordináta;

2. y koordináta;

3. kiírandó szöveg.

IrXY : eljárás, adott helytől, adott stringet ír a képernyő memóriába

Vvonal : háromparaméteres eljárás, a képernyő adott sorába vízszintes vonalat húz. Paraméterek:

1. x kezdőhely;

2. x véghely;

3. y sor.

Fvonal : háromparaméteres eljárás, a képernyő adott oszlopába függőleges vonalat húz. Paraméterek:

1. x oszlop;

2. y kezdőhely;

3. y véghely.

Keret : négyparaméteres eljárás, a képernyőre egy téglalap alakú keretet rajzol. A négy paraméter a Window standard eljárás paramétereivel teljesen megegyezik. (bfx: bal felső csúcs x koordináta, bfy: bal felső csúcs y koordináta, jax: jobb alsó csúcs x koordináta, jay: jobb alsó csúcs y koordináta)

Racs : hatparaméteres eljárás, a képernyőre egy téglalap elrendezésű rácsot helyez. Paraméterek:

1. bfx;

2. bfy;

3. bx: a rács egy cellája belsejének x irányú mérete;

4. by: a rács egy cellája belsejének y irányú mérete;

5. nx: cellák száma vízszintesen;

6. ny: cellák száma függőlegesen.

Ablak : nyolcparaméteres eljárás, a képernyőre egy színes, keretes, címkés, árnyékos ablakot rajzol. Paraméterek:

1. hsz;

2. ksz;

3. bfx;

4. bfy;

5. jax;

6. jay;

7. arny: logikai paraméter, ha igaz, akkor van árnyék, ha hamis akkor nincs;

8. c: az ablak címkéje.

Uzenet : háromparaméteres eljárás, a képernyő közepén egy ablakban egy egysoros üzenetet jelenít meg. Paraméterek:

1. hsz;

2. ksz;

3. sz: a megjelenítendo szöveg, az ablak bármely billentyűre eltűnik.

Kerdezo : háromparaméteres függvény, mely egy eldöntendo kérdést tesz fel, visszatérési értéke logikai. Paraméterek:

1. hsz;

2. ksz;

3. sz: a kérdés, csak igen vagy nem válaszra lép ki a függvényből.

Bevitel : ötparaméteres függvény, amely a képernyő egy helyétől kezdve, legfeljebb a képernyősor végéig egy szerkeszthető beviteli területet ad. A visszaadott érték a bevitt szöveg. Paraméterek:

1. hsz;

2. ksz;

3. x;

4. y;

5. sh: a szerkeszthető karakterek száma.

Password : függvény, mely a Bevitel függvénnyel bevitt stringről megállapítja, hogy mint jelszó, helyes-e

Menu : nyolcparaméteres függvény, mely a képernyőn megjelenített menüpontokból a vezérlőbillentyűk segítségével választási lehetőséget biztosít. Visszaadott értéke a kiválasztott menüpont sorszáma. Paraméterek:

1. hsz;

2. ksz;

3. vsz: választósor háttérszine;

4. bfx;

5. bfy;

6. sh: menüsorok hossza;

7. ss: menüsorok száma;

8. as: aktuális menüsorszám, egyúttal a visszaadott érték is.

ValidSt : egyparaméteres függvény, mely a paraméterként kapott stringbol eltávolítja a fölösleges Space-szeket és így adja vissza.

Listazo : tízenegy-paraméteres függvény, mely a képernyőn egy string-listát jelenít meg, melyből a vezérlőbillentyuk segítségével választhatunk, visszaadott értéke a kiválasztott string indexe. Paraméterek:

1. hsz;

2. ksz;

3. vsz: választósor háttérszine;

4. bfx;

5. bfy;

6. sh: string-ek hossza;

7. ss: string-ek száma;

8. ls: egyszerre látható string-ek száma (az ablak magassága);

9. as: aktuális string-index, egyuttal a visszaadott érték;

10. arny: logikai érték, a megjelenítő ablaknak legyen-e árnyéka;

11. c: a lista címkéje.

Listara : egyparaméteres függvény, nemlátható elem, lényegében egy rendezett string-listát kezel, mely a globális string-tömbben található, visszaadott értéke a string-lista elemszáma, nem enged meg azonos string-eket a listában, a listára helyezés előtt a string-eket validálja (ValidSt).

Listarol : egyparaméteres függvény, nemlátható elem, lényegében egy rendezett string-listát kezel, arról törli a paraméter stringet, mely a globális string-tömbben található, visszaadott értéke a string-lista elemszáma, ha nem volt a listán, akkor 0-t kapunk. (a paraméter stringet validálja (ValidSt)).

FileKereso : függvény, az aktuális könyvtár, adott kiterjesztésű állományait a Listazo függvény segítségével megmutatja, visszaadott értéke a kiválasztott file neve.

Gomb : eljárás, mely egy feliratos, egérrel kezelhető nyomógomb látványát adja.

GombKereso : függvény, mely megadja az adott helyen található egérrel kezelhető látvány Hot-Key kódját.

ImputLine : függvény, mely címkés beviteli sort kezel, visszaadott értéke a bevitt String.

RadioGomb : eljárás, mely egy egérrel választható, rádiógomb kapcsoló látványát állítja elő.

RadioGombKapcs : függvény, mely rádiógomb választását adja vissza.

Destop : eljárás, mely a Turbo Pascal IDE látványát adja, egérrel kezelhető felületek alapja, Alt-X -re kilép.

Binaris : függvény, mely az átvett Word típusú számnak a kettes számrendszerbeli alakját adja vissza String-ként.

Tizes : függvény, mely az átvett String-ből a szám tízes számrendszerbeli alakját adja vissza.

SetBit : függvény, mely az átvett Word típusú számnak a megadott sorszámú bitjét az adott bitre állítja.

ValtBit : függvény, mely az átvett Word típusú számnak a megadott sorszámú

A CrtPlus listája:

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.