Haladó billentyűzet- és képernyőkezelés
25.)
Vizsgáljuk meg ReadKey segítségével a billentyűzet pufferből kiolvasható
kódokat.
Azt szeretnénk, hogy
bármely billentyűre a program tovább fusson, ezért a szokásos leállításokat nem
használhatjuk. Egyszerű, de ritkán használatos és kerülendő megoldást
használtunk az állandó olvasás megvalósítására, a GoTo-t. A lista bármely utasítása címkével látható el (összetett
esetén csak az első), és a program bármely helyéről a vezérlést feltétel nélkül
ide lehet küldeni. A címke deklarációja: Label
és egy jelsorozat, programunkban:
Program
BillTest;
Uses NewDelay,
Crt;
Label 1;
Begin
TextMode(CO80);
ClrScr;
1: WriteLn(Ord(ReadKey));
GoTo
1;
End.
Futtatva a programot, a következőket
tapasztaljuk: az Esc, Tab, BackSpace, a normál betűk, számok és írásjelek egy
kódot adnak vissza, Shift-el a kód változik. A következő billentyűk önmagukban
nem adnak kódot: CapsLock, NumLock, ScrollLock, Pause, PrintScreen, Ctrl, Alt,
Shift, F11 és F12. A további funkcióbillentyűk, a kurzorvezérlő, a Home, End,
PageUp, PageDown, Insert és Delete billentyűk kettős kódot, amelyből az első
nulla. Ha betűt Ctrl-el nyomunk más kódot kapunk, ha Alt-al, akkor kettős
kódot.
26.)
Írjunk programot, amely egy csillagot jelenít meg a képernyőn, és amelyet a
kurzorvezérlő billentyűkkel mozgathatunk, Esc-re pedig befejeződik a program.
Program Vezerlo;
Uses NewDelay,
Crt, CrtPlus;
Var Ch: Char;
X, Y: Byte;
Begin
TextMode(CO80);
ClrScr;
X:= 40;
Y:= 12;
{a képernyő közepe}
WriteXY(X,Y,'*');
Tunj;
Repeat
Ch:= ReadKey;
If
Ch=#0 Then
Begin
Ch:= ReadKey;
WriteXY(X,Y,' ');
Case
Ch Of
#72: If Y>1 Then Dec(Y);
#75: If X>1 Then Dec(X);
#77: If X<80 Then Inc(X);
#80: If Y<25 Then Inc(Y);
End;
WriteXY(X,Y,'*');
Tunj;
End;
Until
Ch=#27;
End.
A programban a ch változóban a billentyűzetről
beolvasott karakter található, X a csillag x, Y a csillag y koordinátája. A
vezérlést egy Repeat ciklus végzi. A
leállítás #27-re történik, ami az Esc billentyű kódja. A ciklus első
függvényhívása a ch:= Readkey; ami a futást megfogja, mindaddig nem lép tovább
a program, amit a billentyűzethez hozzá nem nyulunk. Ha kettőskódú billentyűt
nyomtunk meg, akkor annak első kódja #0, a második minden
kettőskódú billentyűnél más. Így beazonosítható, hogy melyik volt megnyomva, ha
újra olvassuk a billentyűzet puffert. A feltételes elágazás után ez a szerepe
az újabb ReadKey-nek. Az ismétlő eljárásban az első WriteXY kikapcsolja, a
második bekapcsolja a csillagot. Közben egy Case szerkezet dönt arról, hogy
mozog-e és merre a csillag, azaz hogyan változzék az X és Y. Vezérlő kódok:
#72: Fel,
#75:
Balra,
#77:
Jobbra és
#80:
Lefelé.
A változtatást csak akkor hajtja végre, ha a
koordináták nem lépik túl a képernyőnek megfelelő értékeket. A WriteXY-ok utáni
Tunj; eljárásnak az a szerepe, hogy a kurzor ne villogjon a csillag mellett.
Ha futtatjuk a programot és a képernyő jobb alsó
sarkába vezéreljük a csillagot azt tapasztaljuk, hogy a képernyő jobb szélén
további csillagok jelennek meg, mind ahányszor az utolsó képernyőhelyre
szeretnénk lépni. Ez természetes, hiszen Write-al szeretnénk írni erre a
helyre, ez pedig automatikus soremeléssel jár, ezért jelennek meg a további
csillagok. Az ilyen természetű problémák megoldására ad lehetőséget a következő
program.
27.) Írjunk
programot, amely a video puffert feltölti azonos értékekkel, majd megjelenít
rajta egy ablakot, majd újra visszaállítja az eredeti képernyőt.
Ennek a feladatnak a megoldásához több új dolog
is szükséges. Az első mindjárt az, hogy a Pascal lehetőséget ad saját változó
típusok deklarálására. Ezt a Type
kulcsszó vezeti be. Ezt követi az új típusnév, esetünkben Scr
(screen=képernyő). Aztán egy egyenlőség után az új típus leírása már ismert
típusokkal. Példánkban az Scr típus egy, a video puffer szerkezéhez
alkalmazkodó háromdimenziós tömb, melynek elemei byte-ok. Az első index jelenti
a képernyő Y(!) koordinátáját, a második az X-et. (Tehát az eddigiekhez képest
fordított sorrendben!). A harmadik a képernyőhely tartalmát írja le úgy, hogy
az első érték a karakter képernyő kódja, a második a színe. Így a vezérlő
karaktereknek is lesz képernyő kódja, azaz megjeleníthetők. A második érték a
szín byte, melynek 8 bitje a következőket jelenti: az első bit a villogást, ha
értéke 1 és
Program
VideoPuf;
Uses NewDelay,
Crt, CrtPlus;
Type Scr=Array[1..25,1..80,1..2] Of Byte;
Var KKep: Scr;
BKep: Scr Absolute $B800:0;
I, J: Byte;
Begin
TextMode(CO80);
ClrScr;
Tunj;
For
I:= 1 To 25 Do For J:= 1 To 80 Do
BKep[I,J,1]:= 65;
KKep:= BKep;
Varj;
Ablak(4,15, 20,5,60,15, True, 'Ez egy
ablak');
Tunj;
Varj;
BKep:= KKep;
Varj;
End.
A Var
deklarációban a KKep és BKep is egy-egy képernyőt definiálnak. Csakhogy, amíg a
KKep helyét a fordító az adatszegmens üres helyére teszi, addig a BKep helyét
mi mondjuk meg a memóriában. A deklarációjában lévő Absolute lefoglalt szó arra utal, hogy a memória rögzített helyén
kell tárolni a változót. A helyet a kulcsszó után kell leírni. A leíráshoz
hexadecimális számrendszert célszerű használni. A programban egyébként bárhol
használhatunk 16-os számrendszerbeli számokat, csak egy dolgot kell tenni, a
szám elé $ (dollár) jelet kell tenni. Az operatív tár (RAM) objekt
helyét két szakaszban kell megadni, (mivel értéke $FFFF-nél nagyobb is lehet, és
legfeljebb 64kB-ot lehet folytonos memóriaterületként kezelni) először a
szegmens értéket, majd pedig az ofszet-et. Mindkét érték Word típusú. Szokás a
szegmens-t nagyra választani, az ofszet így 0-15 értéket vehet fel.
Programunkban a szegmens $b800, az ofszet pedig $0.
Ez a színes képernyő objektív helye a memóriában. A video-vezérlő áramkörök
innen olvassák ki a megjelenítendő karaktereket. A BKep változónk ezek után
olyan, hogy értékadással a képernyőn való megjelenítést valósíthatunk meg. Ezek
szerint a BKep[1,1,1]:= 65 értékadás a
képernyő első helyére egy A betűt helyez. A programban a képernyő törlése (azaz
32-es karakterekkel való feltöltése a BKep tömbnek) után a kursorra nincs
szükség, hiszen nincs írás a programban (de az ablak után újra el kell
tüntetni). A kettős For ciklus A
betűkkel teleírja a képernyőt, a ciklus lejátszódását a gép gyorsasága miatt
nem látjuk, de ha lassítást írnánk a végrehajtásba, akkor láthatnánk. A KKep:= BKep értékadással
azért élhetünk, mert a két változó típusa azonos. Ha mindkettő külön-külön
tömbként lenne deklarálva, akkor csak For
ciklussal lehetne átvinni az adatokat egyikből a másikba, ami sokkal lassúbb
lenne. A KKep a BKep tartalmát a fordító által meghatározott helyen, a képernyő
memóriától függetlenül tárolja. Várakozás után egy ablak kerül a képernyőre,
újabb billentyű megnyomásra az ablak eltűnik és a BKep:= KKep értékadás
visszahozza az A betűket. Ezzel a program teljesen megoldja a kitűzött
feladatot miközben egy régi vágyunk is teljesült: tudtunk írni a képernyő
utolsó helyére.
Lássunk még két kis rövid programot, amely a gép
lelki világába enged egy kis betekintést. Az első folyamatosan másolja a nullás
lapot a képernyőre, megfigyelhetjük, hogy mennyire változik a tartalma.
Program
NullasPg;
Uses NewDelay,
Crt, CrtPlus;
Type Scr=Array[1..25,1..80,1..2] Of Byte;
Var NLap: scr
Absolute $0:0;
BKep: scr Absolute $b800:0;
Begin
TextMode(CO80);
ClrScr;
Repeat
BKep:= NLap;
Until
KeyPressed;
End.
Mivel a Scr típust és a színes képernyőre
vonatkozó BKep-et több programban is használhatjuk, deklaráljuk ezeket is a
CrtPlus-ban, az Implementation
kulcsszó előtt.
Unit
CrtPlus;
InterFace
Uses NewDelay,
Crt;
. . .
Type Scr= Array[1..25,1..80,1..2] Of byte;
Var BKep: Scr
Absolute $B800:0;
KKep: Scr;
Implementation
. . .
End.
A következő kis programot futtatva a gép
teljesen leáll, csak Reset-tel vagy ki-be kapcsolással indítható újra, ugyanis
a nullás lapot 0-val teleírjuk. A FillChar eljárás a megadott a tömböt, a
teljes SizeOf(a) méretben 0–val tölti fel (Csak Win98-on működik, XP már nem
enged ilyen értékadást).
Program Rezet;
Uses NewDelay,
Crt, CrtPlus;
Var A: Array[0..1023] Of Byte Absolute $0:0;
Begin
TextMode(CO80);
ClrScr;
WriteXY(34,12,'Most száll el a gép');
Varj;
FillChar(A,SizeOf(A),0);
End.
Futtatás
előtt feltétlen mentsük ki, mert aztán már nem lehet!
Eddigi programjainkban gyakran kellett a
billentyűzetről adatot bevinni. Ha nem voltunk eléggé elővigyázatosak, bizony
előfordult, hogy a program leállt, vagy egyszerűen megváltozott az input helye
a képernyőn, mert fölöslegesen nyomtunk Enter-t. Ezek bizony egy komolyabb
programnál végzetes következményekkel járna, pl. nagy mennyiségű
adatvesztéshez, ami csak hosszú fáradságos munkával lenne pótolható. A
programjainkat a téves billentyűzéstől a lehető legjobban meg kell védeni.
Mostanra tanultunk meg annyit a Pascal nyelvből, hogy egy komoly Input rutint
írhatunk. Ennek helye természetesen a CrtPlus-ban van, hiszen bármikor
használni szeretnénk.
28.)
Bővítsük a CrtPlus Unit-ot egy olyan Bevitel függvénnyel, amellyel a
billentyűzetről való beolvasás a lehető legbiztonságosabb lesz.
A végleges megoldásban szükség lesz arra, hogy a
képernyő egy – az inputnak megfelelő – területén a képernyő színeket utólag
megadhassuk. A feladat megkönnyítése, illetve más programokban való alkalmazás
lehetősége végett, célszerű egy kis eljárást készíteni a CrtPlus-ba, mely tehát
a képernyő valamely sorában, annak egy összefüggő részén, be tudja állítani a
háttér és a betű színeit. Legyen ennek az eljárásnak a neve szinez. Helyezzük a szinek eljárás után. Paraméterei: a háttérszín, karakterszín,
képernyőhely X és Y koordinátája, és a sor hossza.
Unit
CrtPlus;
Interface
Uses
NewDelay, Crt;
. . .
Procedure
Szinek(HSz,KSz: Byte);
Procedure
Szinez(HSz,KSz,X,Y,Sh: Byte);
Implementation
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;
. . .
End.
Eek után nézzük a Bevitel függvényt. Illesszük a
függvényt utolsóként a CrtPlus-ba. A függvény öt paraméterrel hívható: az
inputhely háttér és karakterszíne, az inputhely első karakterének két
koordinátája, valamint az input hossza (HSz,KSz,X,Y,Sh). A hely megtervezéséről
nekünk kell gondoskodni, pl. kifér-e a sorban, az Bevitel ugyanis hossza
maximum egy sornyi lehet. A visszaadott érték String típusú. Ha számot szeretnénk beolvasni, akkor a szöveges
változóból Val eljárással nekünk számmá kell konvertálni. A változók szerepe:
Ax:
aktuális x koordináta,
Ch:
a billentyűzetről olvasott karakter;
Ovw:
ha True akkor felülírásos, ha False beszúrásos az írásmód;
I:
ciklusváltozó;
BSzov:
munka string.
Az egyes részek magyarázatát a lista
tartalmazza. Aki nem kíván elmélyülni a megvalósításban, megteheti, hogy csak
azt tanulja meg, hogyan kell használni, úgy is hasznos lehet a számára.
Unit
CrtPlus;
Interface
Uses NewDelay,
Crt;
...
Function
Bevitel(HSz,KSz,X,Y,Sh: Byte): String;
Implementation
...
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
Ch:= ReadKey;
Case
Ch Of
#0:Begin
{ha kettős kódú billentyűt nyomtak}
Ch:= ReadKey;
Case
Ch Of
#71: Ax:= X; {Home}
#75: If Ax>X Then Dec(Ax);
{Balra}
#77: If
Ax<X+Sh Then Inc(Ax); {Jobbra}
#79: Begin {End}
I:= X+Sh;
Repeat
Dec(I);
Until (BKep[Y,I,1]<>32) Or
(I<X);
Ax:= I+1;
End;
#82: Ovw:= Not Ovw; {Ins: felülírás-beszúrás váltása}
#83: If Ax<X+Sh Then
{Delete}
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 {BackSpace}
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: ; {Tab}
#13: ; {Enter}
#27: ; {Esc}
Else {megjeleníthető karakter esetén}
If
Ax<X+Sh Then
Begin
If
Not Ovw Then {beszúrás esetén helyet csinál}
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 [#9,#13,#27]; {a bevitel
Enter, Tab vagy Esc-re áll le}
If
Ch=#27 Then bevitel:= '' Else {ha Esc-re állt le, az bevitel
üres String}
Begin
BSzov:= '';
I:= X+Sh;
Repeat
{megkeresi az utolsó nem üres helyet}
Dec(I);
Until
(BKep[Y,I,1]<>32) Or (I=X);
Ax:= I;
{a karakterek
összerakása szöveggé a munka stringben}
For
I:= X To Ax Do BSzov:= BSzov+Chr(BKep[Y,I,1]);
Bevitel:= BSzov;
End;
End;
End.
29. Készítsünk egy kis
program, amely a most készített bevitelt teszteli.
Program
InputPro;
Uses NewDelay,
Crt, CrtPlus;
Var Sz: String;
Begin
TextMode(CO80);
Szinek(1,3);
ClrScr;
Sz:= Bevitel(7,0, 20,10,15);
WriteXY(20,20,Sz);
Tunj;
Varj;
End.
30.
Bővítsük a CrtPlus Unitot egy menu függvénnyel. A függvénynek meg kell oldani a
felhasználó által elkészített, ablakban megjelenő menüpontokból való választást
a kurzorvezérlő billentyűk segítségével. A függvény visszaadott értéke a
kiválasztott menüpont sorszáma, ESC-re kilép és a visszaadott érték nulla.
Eddigi programjaink olyanok voltak, hogy egy-egy
részét legfeljebb csak egyszer hajtotta végre futása közben. Az ilyen
felépítést lineárisnak is nevezhetnénk. Ha más feltételekkel (paraméterekkel)
akartuk lefuttatni, akkor újra el kellett indítani a programot és a bevitelt
kellett megváltoztatni. Ha a program újra futtatása nélkül, tetszőleges
sorrendben és számban szeretnénk egy-egy programrészletet használni anélkül,
hogy a teljes programot leállítanánk, ezt legkönnyebben menü segítségével
tudjuk elérni. A többször is végrehajtandó részfeladatokra általában
eljárásokat szoktunk szervezni. A Unit-ba építhető végleges megoldás előtt,
nézzünk néhány megoldási lehetőséget. Az elsőben még a menü sorszáma alapján
választhatunk. A főprogram Repeat
ismétlő eljárásának érdekessége, hogy a leállító feltétele False, azaz állandóan hamis. A program végét jelentő menüpontban
ugyanis az egyszerű megállítás mellett, (pontosabban előtte) még egyéb
tevékenységek is szükségesek lehetnek, pl. adatok kimentése háttértárolóra vagy
a környezeti paraméterek visszaállítása a program futtatása előtti állapotnak
megfelelően.
Program Menu1;
Uses NewDelay,
Crt, CrtPlus;
Procedure Elso;
Begin
ClrScr;
Write('Első');
Tunj;
Varj;
End;
Procedure Masodik;
Begin
ClrScr;
Write('Második');
Tunj;
Varj;
End;
Procedure Vege;
Begin
ClrScr;
Write('Vége');
Tunj;
Varj;
Halt;
End;
Function Menu:
Byte;
Var Ch: Char;
Begin
ClrScr;
WriteXY(38,3,'Menü');
VVonal(37,42,4);
WriteXY(36,7,'1. Első');
WriteXY(36,9,'2. Második');
WriteXY(36,11,'3. Vége');
WriteXY(20,14,'A megfelelő szám segítségével
választhat!');
Tunj;
Repeat
Ch:= ReadKey;
Until
Ch In ['1'..'3',#27];
Menu:= Ord(Ch)-48;
End;
Begin
TextMode(CO80);
Repeat
Case
Menu Of
1: Elso;
2: Masodik;
3: Vege;
End;
Until
False;
End.
A második megoldásban egy jobbra mutató nyíl
mozgatható a menüpontok előtt, amikor a kívánt menüpont előtt áll,
megnyomhatjuk az ENTER-t, ezáltal a választás megtörténik. (Az előző
programból, Mentés másként (Save as…) funkcióval készüljön a következő lista,
és így csak javítani kell a megfelelő részeket.)
Program Menu2;
Uses NewDelay,
Crt, CrtPlus;
Procedure Elso;
Begin
ClrScr;
Write('Első');
Tunj;
Varj;
End;
Procedure Masodik;
Begin
ClrScr;
Write('Második');
Tunj;
Varj;
End;
Procedure Vege;
Begin
ClrScr;
Write('Vége');
Tunj;
Varj;
Halt;
End;
Function Menu:
Byte;
Var Ch: Char;
X, Y: Byte;
Mp: Byte;
Begin
Szinek(1,4);
ClrScr;
Ablak(7,0,31,6,50,12,True,'Menü');
WriteXY(36,7,'1. Első');
WriteXY(36,9,'2. Második');
WriteXY(36,11,'3. Vége');
WriteXY(13,18,'A le-fel billentyű
segítségével választhat + ENTER!');
X:= 34;
Y:= 7;
Mp:= 1;
WriteXY(x,y,Chr(26));
Tunj;
Repeat
Ch:= ReadKey;
If
Ch=#13 Then
Begin
Menu:= Mp;
Exit;
End;
If
ch=#0 Then
Begin
Ch:= ReadKey;
WriteXY(X,Y,' ');
Case
Ch Of
#72: If Y>7 Then
Begin
Dec(Y,2);
Dec(Mp);
End
Else
Begin
Y:= 11;
Mp:= 3;
End;
#80: If Y<11 Then
Begin
Inc(Y,2);
Inc(Mp);
End
Else
Begin
Y:= 7;
Mp:= 1;
End;
End;
WriteXY(x,y,Chr(26));
Tunj;
End;
Until
False;
End;
Begin
TextMode(CO80);
Repeat
Case
Menu of
1: elso;
2: masodik;
3: vege;
End;
Until
False;
End.
A harmadik megoldás már megjelenésében a
véglegest tükrözi. A menüpontok között a kurzorvezérlőkkel választhatunk, az
aktuális menüpont inverz kiírással jelenik meg. Új nyelvi elem a konstans tömb
megadásának módja, mely tömb itt a menüpontok neveit tartalmazza.
Program Menu3;
Uses NewDelay,
Crt, CrtPlus;
Const Msor: Array[1..3] Of String[9]=
(' Első
',
' Második ',
' Vége
');
Procedure Elso;
Begin
ClrScr;
Write('Első');
Tunj;
Varj;
End;
Procedure Masodik;
Begin
ClrScr;
Write('Második');
Tunj;
Varj;
End;
Procedure Vege;
Begin
ClrScr;
Write('Vége');
Tunj;
Varj;
Halt;
End;
Function Menu:Byte;
Var Ch: Char;
I,X,Y: Byte;
Mp:Byte;
Begin
Szinek(1,4);
ClrScr;
Ablak(7,0, 33,6,48,12, True,'Menü');
Szinek(7,0);
For
I:= 1 To 3 Do
WriteXY(36,5+2*i,msor[i]);
WriteXY(13,18,'A le-fel billentyű
segítségével választhat + ENTER!');
X:= 34;
Y:= 7;
Mp:= 1;
Szinek(0,15);
WriteXY(36,5+2*mp,msor[mp]);
Tunj;
Repeat
Ch:= ReadKey;
If
Ch=#13 Then
Begin
Menu:= Mp;
Exit;
End;
If
Ch=#0 Then
Begin
Ch:= ReadKey;
Szinek(7,0);
WriteXY(36,5+2*mp,msor[mp]);
Case
Ch Of
#72: If Y>7 Then
Begin
Dec(Y,2);
Dec(Mp);
End
Else
Begin
Y:= 11;
Mp:= 3;
End;
#80: If Y<11 Then
Begin
Inc(Y,2);
Inc(Mp);
End
Else
Begin
Y:= 7;
Mp:= 1;
End;
End;
Szinek(0,15);
WriteXY(36,5+2*mp,msor[mp]);
Tunj;
End;
Until
False;
End;
Begin
TextMode(CO80);
Repeat
Case
Menu Of
1: Elso;
2: Masodik;
3: Vege;
End;
Until
False;
End.
Nézzük ezek után a végleges megoldást a CrtPlus
Unit-ban. Illesszük be utolsó függvényként. Paraméterei: háttérszín,
karakterszín, kiválasztó háttérszín, bal felső csúcs X és Y koordinátája,
menüsorok hossza, menüsorok száma, aktuális menüpont sorszáma.
Unit
CrtPlus;
Interface
Uses NewDelay,
Crt;
. . .
Function
menu(HSz,KSz,SZz,Bfx,Bfy,Sh,Ss,As:Byte): Byte;
Implementation
. . .
Function
menu(HSz,KSz,VSz,Bfx,Bfy,Sh,Ss,As:Byte): Byte;
Var Ch: Char;
Begin
Szinez(Vsz,KSz,Bfx,Bfy+As-1,Sh);
repeat
Ch:= ReadKey;
If
Ch=#0 Then
Begin
Ch:= ReadKey;
If
Ch In [#71,#72,#75,#77,#79,#80] Then
Szinez(HSz,Ksz,Bfx,Bfy+As-1,Sh);
Case
Ch Of
#71: As:=1;
#72,#75: If As>1 Then Dec(As) Else As:= Ss;
#77,#80: If As<Ss Then Inc(As)
Else As:= 1;
#79: As:= Ss;
end;
If
Ch In [#71,#72,#75,#77,#79,#80] Then
Szinez(VSz,KSz,Bfx,Bfy+As-1,Sh);
End;
Until
Ch In [#13,#27];
If
Ch=#13 Then Menu:= As Else Menu:= 0;
End;
End.
A következő kis program a most megírt menu
függvényt teszteli. Fontos elemezni, az ablak és a menu paramétereinek
illesztését.
Program
MenuPro;
Uses NewDelay,
Crt, CrtPlus;
Const Msor: Array[1..3] Of String[9]=
(' Első
',
' Második ',
' Vége
');
Var Mp: Byte;
I: Byte;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
Ablak(7,0,33,4,45,8,True,'Menü');
For
I:= 1 To 3 Do WriteXY(35,4+I,Msor[I]);
Tunj;
Mp:= Menu(7,0,green,35,5,9,3,1);
WriteXY(1,24,Msor[Mp]);
Varj;
End.
Rekordok és file-kezelés
31.
Írjunk programot, mely bekér néhány gépkocsi adatát egy végjelig (pl.: - ),
majd gyártási éve szerint csökkenő sorrendben kiírja az összes adatot a
képernyőre. A gépkocsik adatai: gyártó, típus, rendszám, szín, gyártási év és
érvényes-e a műszakija.
Gyakran előfordul, hogy az adatok nem
függetlenek, hanem egy-egy tárgy vagy személy különböző jellemzői. Ebben az
esetben az a célszerű, ha ezt adatszerkezetileg is együtt vannak. Több adat
együttes tárolására eddig csak a tömb volt használható. Ennek a mostani
felvetésben az a problémája, hogy csak azonos típusú adatokat lehet benne
tárolni. Új típusra lenne szükség, amelyben szöveget, számok különböző
típusait, logikai változókat tárolhatunk. Ennek a típusnak a neve: rekord (Record), deklarációját a Type vezeti be és a mezők leírása az
ezt követő End;-ig tart. A mezők
típusa bármilyen előzőleg ismert, vagy deklarált típus lehet, lehet akár Record is. A rekord egy mezőjére Recordnev.Mezonev formában
hivatkozhatunk. Megengedett az azonos típusú rekordok között a közvetlen
értékadás is, valamint képezhetünk rekordokból akár tömböt is. Ha egy rekord
több mezejét akarjuk kezelni egymás után, akkor a rekordazonosító többszöri
kiírása helyett a With . . . Do minősítő utasítást (szerkezetet) is
használhatjuk. Mivel több mezőt szeretnénk kezelni a Do után, ezért kötelező összetett utasítást írni, azaz szinte
biztosan Begin . . . End;-el folytatódik a program.
Program Kocsik;
Uses NewDelay,
Crt, CrtPlus;
Const Max=100;
Type Kocsi=Record
Gyarto :String[10];
Tipus :String[15];
Rendszam:String[8];
Szin :String[12];
GyEv :Integer;
Muszak :String[5];
End;
Var KocsiTomb:
Array[1..Max] Of Kocsi;
UKocsi: Kocsi;
Procedure Init;
Var I: Byte;
Begin
UKocsi.Gyarto
:= ’’;
UKocsi.Tipus
:= ’’;
UKocsi.Rendszam:= ’’;
UKocsi.Szin
:= ’’;
UKocsi.GyEv
:= 0;
UKocsi.Muszak
:= ’’;
For
I:= 1 To Max Do KocsiTomb[I]:= UKocsi;
End;
Procedure Adatbe;
Var I: Byte;
Begin
ClrScr;
I:= 0;
Repeat
Inc(I);
With KocsiTomb[I] Do
Begin
Write(’Kérem a ’,i:3,’. kocsi
gyártóját : ’);
ReadLn(Gyarto);
If
Gyarto<>’-’ Then
Begin
Write(’Kérem a ’,i:3,’. kocsi
típusát : ’);
ReadLn(Tipus);
Write(’Kérem a ’,i:3,’. kocsi
rendszámát : ’);
ReadLn(Rendszam);
Write(’Kérem a ’,i:3,’. kocsi színét : ’);
ReadLn(Szin);
Write(’Kérem a ’,i:3,’. kocsi gyártási
évét : ’);
ReadLn(GyEv);
Write(’Van-e a ’,i:3,’. kocsinak műszakija : ’);
ReadLn(Muszak);
End;
End;
Until
KocsiTomb[I].Gyarto=’-’;
End;
Procedure Kepre;
Var I: Byte;
Begin
Szinek(0,15);
CrlScr;
WriteLn(’Gyártó’:10,’ ’,’Típus’:15,’
’,’Rendszám’:8,’ ’,’Szín’:12,’ ’,’Gyév’:12,’ ’,’Műszak’:5);
Szinek(0,7);
I:= 0;
While KocsiTomb[I].Gyarto<>’-’ Do
With
KocsiTomb[I] Do
Begin
WriteLn(Gyarto:10,’ ’,Tipus:15,’
’,Rendszam:8,’ ’,Szin:12,’ ’,GyEv:12,’ ’,Muszak:5);
Inc(I);
End;
Tunj;
Varj;
End;
Begin
TextMode(CO80);
Init;
Adatbe;
Kepre;
End.
32.
Írjunk programot, amely lemezen tudja tárolni a felhasználó nevét és lakhelyét.
Indítás után kiírja a tárolt adatokat, megkérdezi, hogy helyesek-e, ha nem,
bekéri és kimenti a helyes adatokat.
A legtöbb program több-kevesebb olyan adattal
dolgozik, amely minden futtatáshoz szükséges, esetleg a futtatások alkalmával
megváltozik, de a legközelebbi használatkor a legutóbbi állapotoknak
megfelelően kell rendelkezésre állni. A programnak gondoskodni kell tehát az
adatoknak lemezre való mentéséről. Ennek alapjaival ismerkedünk meg ennek a
programnak a kapcsán. A pascal programok lemezes állományba menthetik az
adatokat (és természetesen onnan be is olvashatják). A lemezes állományok vagy
file-ok három csoportját tudja kezelni a pascal: szöveges állományok, tipizált
állományok és típus nélküli állományok. A szöveges állományok ASCII
karaktereket tartalmaznak, sorokra tagolódnak, melyeket soremelés, kocsi-vissza
karakterek választanak el egymástól, írni és olvasni soronként lehet. A
tipizált állományokban általában rekordok találhatók, bennük minden rekordnak
ugyanannyi byte a hossza, a rekordokon mozoghatunk, rekordokat írhatunk és
olvashatunk. A típus nélküli állományok, vagy bináris file-ok, változó
hosszúságú írás és olvasást engedélyez, de a kiolvasott adatok helyes
értelmezése a program(ozó) felelőssége. Feladatunk legegyszerűbben tipizált
file segítségével oldható meg. Az FNev
logikai file-név, egy személyekből álló file-t jelent. A DNev a file OS-beli neve, melyet teljesen konkrétan értékadással le
kell írni. A főprogramnak ez az első sora. A név tetszőleges lehet, csak az OS
által támasztott követelményeknek kell megfelelnie. A program első futtatáskor
még biztosan nem tudja teljesíteni a specifikáció feltételeit, hiszen a nevet
tartalmazó file-nak valamikor létre kell jönni. Ezért a program első változata
csak a kimentést tartalmazza. A file-kezelés lépéseit a Lemezre eljárásban figyelhetjük meg. Első lépésként a logikai és a
fizikai file-neveket egymáshoz kell rendelni. Ezt hajtja végre az Assign eljárás. Ettől kezdve minden
utasítást a logikai file-névre adunk ki, de az a fizikai állományon fog
végrehajtódni. A file-t kétféleképpen lehet megnyitni: írásra és olvasásra.
Írásra a ReWrite-tal kell megnyitni, ami egyúttal a file teljes újra építését
is jelenti, azaz, ha létezett az eljárás meghívása előtt, akkor teljesen elvész
a régi tartalom. Lényegében így hozzuk létre az új file-t. A másik megnyitás a
Reset, amely után a file-t
olvashatjuk és írhatjuk is. Ekkor a régi tartalom megmarad, mármint azok a
rekordok, amelyeket nem írunk fölül. Ez a második programlistában láthatjuk, a Lemezrol függvényben. Annak érdekében,
hogy a file tartalma el ne vesszen, az adatkezelés után, de legkésőbben a
program leállása előtt zárni kell. Ezt végzi a Close eljárás. A Write
eljárás alkalmazása jelent még itt újdonságot. Eddig csak a képernyőre írásra
használtuk. Ha a Write-ot úgy hívjuk
meg, hogy első paramétere egy logikai file-név, akkor nem a képernyőre, hanem a
megfelelő file-ba ír. Szöveges állománynál a Write helyett WritLln-t
kell használni, itt a tipizált állománynál viszont csak a Write használható.
Program Nevem;
Uses NewDelay,
Crt, CrtPlus;
Type Szemely=
Record
Neve: String[30];
Lakhelye: String[40];
End;
Var En: Szemely;
FNev:
File Of Szemely;
DNev: String;
Procedure Adatbe;
Begin
Szinek(0,7);
ClrScr;
Write('Kérem a személy nevét : '); ReadLn(En.Neve);
Write('Kérem a személy lakhelyét: ');
ReadLn(En.Lakhelye);
End;
Procedure Lemezre;
Begin
Assign(FNev,DNev); ReWrite(FNev);
Write(FNev,En);
Close(FNev);
End;
Begin
TextMode(CO80);
DNev:= 'ne.vem';
Adatbe;
Lemezre;
End.
A második, teljes listában természetesen a Lemezrol tartogat meglepetéseket. Az
első mindjárt az, hogy nem eljárás, hanem függvény logikai visszaadott
értékkel. Ez most kétszeresen is indokolt. Egyrészt nem biztos, hogy file amit
olvasni kell az egyáltalán létezik-e, másrészt nem biztos, hogy a benne lévő
adat megfelelő-e. Mindkettőre logikai értékkel válaszolhatunk. Így a két
vizsgálatot egyetlen függvény visszaadott értékében kifejezhetjük. Az első az
igazán érdekes, vajon mi van akkor, ha az adatot tartalmazó állomány nem is
létezik, mert pl. valaki letörölte. Hát bizony kellemetlen lenne, ha emiatt a
program nem lenne futtatható, mert Run-time error-ral megállna. A futás idejű
hibák egy részének kezelésére alkalmas az IOResult
hibakezelő függvény. Pontosan az input-output eljárások meghíváskor fellépő
hibák kezelhetők vele. Ha értéke nem nulla meghíváskor, akkor az érték a hiba
jellegére utal. Ahhoz, hogy a hiba létrejöttekor a program le ne álljon, még
egy dolgot tenni kell. A lehetséges hibaforrást (ez esetben a Reset eljárást)
körbe kell venni fordítási direktívákkal, olyanokkal, amely az input-output
hibafigyelő gépi rutinokat kikapcsolja, majd visszakapcsolja. A {$I-}
kikapcsol, a {I$+} bekapcsol. Viszont a következő utasításban a hibakezelő
függvényt kell lekezelni, különben értéke elvész. Ha tehát a nem létező file-t
olvasásra szeretnénk megnyitni, akkor az IOResult
értéke nem lesz nulla. Ekkor nyilván a tartalma sem egyezhet meg a felhasználó
nevével. Ezért a Lemezrol függvény False értéket kapja és Exit-el befejeződik.
Program Nevem;
Uses NewDelay,
Crt, CrtPlus;
Type Szemely=
Record
Neve:String[30];
Lakhelye:String[40];
End;
Var En: szemely;
FNev: File
Of Szemely;
DNev: String;
Function Lemezrol:
Boolean;
Var Ch: Char;
Begin
Szinek(0,15);
ClrScr;
Assign(FNev,DNev);{$I-}Reset(FNev);{$I+}
If
IOResult<>0 Then
Begin
Lemezrol:= False;
Exit;
End;
Read(FNev,En);
Close(FNev);
WriteLn('A felhasználó adatai:');
WriteLn;
Szinek(0,7);
WriteLn('Neve : ',En.Neve);
WriteLn('Lakhelye: ',En.Lakhelye);
WriteLn;
Szinek(0,15);
WriteLn('Helyesek az adatok (I/N)?');
Tunj;
Repeat
Ch:= ReadKey;
Ch:= UpCase(ch);
Until
Ch In ['I','N'];
Lemezrol:= Ch='I';
End;
Procedure Adatbe;
Begin
WriteXY(1,8,'Kérem a személy nevét : '); ReadLn(En.Neve);
WriteXY(1,9,'Kérem a személy lakhelyét: ');
ReadLn(En.Lakhelye);
End;
Procedure Lemezre;
Begin
Assign(FNev,DNev); ReWrite(FNev);
Write(FNev,En);
Close(FNev);
End;
Begin
DNev:= 'ne.vem';
If
Not lemezrol Then
Begin
Adatbe;
Lemezre;
End;
End.
Ha a file létezik, akkor tartalmát Read-el kiolvassa. Aztán tér rá annak
megkérdezésére, hogy jó-e a tárolt adat. A válasz kiértékelésekor használjuk az
UpCase függvényt, amely a betűkhöz a
nagybetűs alakját rendeli, ezért elegendő csak nagybetűs I és N-nel a logikai
beállítást megtenni. Végül is, így a főprogramban egyetlen Lemezrol függvényhívással kezelhetjük mindkét, előzőleg említett
logikai értékkel bíró esetet.
33.
Írjunk programot, amely tanulók adatait tudja nyilvántartani. Legyen lehetőség
az adatok felvételére (név, születési év, osztálya, lakása és tanulmányi
átlaga), azok javitására. A program egyszerre tudjon kezelni 50 tanuló adatát,
melyet lemezes állományban tárol. Legyen lehetőség a következő lekérdezésekre:
névsor szerint, korok szerint, lakhely szerint, átlag szerint és tudjon
osztályátlagot számítani.
A program megírásához gyakorlatilag mindent
megtanultunk az eddigi programok kapcsán. Ez a program annyiban lesz új, hogy
ilyen komplex program megírására eddig még nem vállalkoztunk. A program
használata közben szükség lesz arra, hogy egy esemény bekövetkezéséről a gép
informáljon minket (lemezműveletek), illetve eldöntendő kérdést tegyen fel a
program (pl. adatmentéssel kapcsolatban). Ilyen rutin illetve függvény más
programban is hasznos lehet, ezért ezeket a CrtPlus-ba helyezzük.
Unit CrtPlus;
Interface
Uses NewDelay,
Crt;
. . .
Procedure Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay:
Byte; Arny: Boolean; C: String);
Procedure
Uzenet(HSz,KSz: Byte; Sz: String);
Function
Kerdezo(HSz,KSz: Byte; Sz: String): Boolean;
. . .
Implementation
. . .
Procedure
Uzenet(HSz,KSz: Byte; Sz: String);
Var
Bfx,Bfy,Jax,Jay: Byte;
LKep: Scr;
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;
LKep:= BKep;
Ablak(HSz,KSz,Bfx,Bfy,Jax,Jay,True,’Info’);
Writexy(40-Round(Length(Sz)/2,12,Sz);
Tunj;
Varj;
BKep:= LKep;
End;
Function
Kerdezo(HSz,KSz: Byte; Sz: String): Boolean;
Var
Bfx,Bfy,Jax,Jay: Byte;
LKep: Scr;
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;
LKep:= 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:= LKep;
End;
. . .
End.
Gyakran előfordul, hogy a programok által kezelt
objektumok közül választanunk kell azért, hogy a program a továbbiakban a
kiválasztott elemen végezzen bizonyos műveletek. Legtöbb esetben az elemek
lineárisan rendezett tömbökben helyezkedik el. A választást megkönnyíthetjük
azáltal, hogy az objektumok (legtöbbször rekordok) kulcsmezőit egy
string-listába helyezzük, majd egy ablakban megmutatjuk és a listából a
kurzorvezérlő billentyükkel választhatunk. A választás eredménye (visszaadott
értéke) a kiválasztott elem sorszáma. A most vázolt megoldás szintén elég
általános, a megvalósító függvényt a CrtPlus-ban helyezzük el. A listázandó
stringeket a Tomb[1..Max] String
tömbbe kell előzőleg betölteni.
Unit CrtPlus;
Interface
Uses NewDelay,
Crt;
. . .
Function
Menu(Bfx,Bfy,Sh,Ss,As: Byte): Byte;
Function
Listazo(HSz,KSz,VSz,Bfx,Bfy,Sh,Ss,Ls,As: Integer;
Arny: Boolean; C: String): Integer;
const Max=500;
Var
. . .
Tomb: Array[1..Max]
Of String[80];
VCh: Char;
. . .
Implementation
. . .
Function
Listazo(HSz,KSz,Vsz,Bfx,Bfy,Sh,Ss,Ls,As: Integer;
Arny: Boolean; C: String): Integer;
Var
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;
Kiir;
If
Ch In [#71,#72,#73,#79,#80,#81] Then Szinez(VSz,KSz,Bfx+2,Aks,Sh-3);
End;
Until
Ch In [#13,#27];
VCh:= Ch;
If
Ch=#27 Then Listazo:= 0 Else Listazo:= As;
End;
End.
A
Listazo függvény paraméterei:
HSz:
ablak háttérszín;
KSz:
ablak karakterszín;
VSz:
választósor háttérszíne;
Bfx:
az ablak bal felső sarka X koordinátája;
Bfy:
az ablak bal felső sarka Y koordinátája;
Sh:
sorok hossza;
Ss:
sorok száma;
Ls:
látható sorok száma;
As:
aktuális sorszám.
Ezek
után nézzük a Tanulok nevű program
listáját. Az egyes rutinok funkciói:
Init:
kezdő illetve üres értékek beállítása;
Lemezrol:
az adatállomány lemezről való betöltése, ha nem létezik létrehozása;
Lemezre:
adatállomány lemezre mentése;
Nevtolto:
a tanulónevek betöltése a Tomb[1..Max] tömbbe, a listázó függvény számára;
Javitás:
az adatok karbantartását végző eljárás;
Smake:
a minden tanulói adatot tartalmazó string tömb előállítása a listázó függvény
számára;
Nevszerint:
a tanulói adatok rendezése név szerint;
Korszerint:
a tanulói adatok rendezése kor szerint;
Lakszerint:
a tanulói adatok rendezése lakhely szerint;
Atlszerint:
a tanulói adatok rendezése átlag szerint;
Osztatlag:
osztályátlag kiszámítása;
Stati:
a statisztikai műveletek hívását végző rutin;
Program
Tanulok;
Uses NewDelay,
Crt,CrtPlus;
Const Amax=50;
Msor: Array[1..4]
Of String[15]=
(' Betöltés ',
' Tanuló adatai ',
' Lekérdezések ',
' Befejezés ');
Type Tanulo=Record
Nev: String[25];
Szul: Integer;
Oszt: String[3];
Lak: String[30];
Atl: Real;
End;
Var ATanulo,UTanulo:
Tanulo;
At: integer;
TTanulo: Array[1..Amax] Of Tanulo;
Mp: Byte;
I: Integer;
Adatbent, Adatvalt: Boolean;
FNev: File
Of Tanulo;
DNev: String;
Atlag: Real;
Procedure Init;
Begin
Adatbent:= False;
Mp:= 1; At:= 1;
With
UTanulo Do
Begin
Nev:= '-';
Szul:= 0;
Oszt:= '-';
Lak:= '-';
Atl:= 0;
End;
For
I:= 1 To Amax Do TTanulo[I]:= UTanulo;
DNev:= '11b.tan';
End;
Procedure Lemezrol;
Begin
If
Adatbent Then
Begin
Uzenet(5,15,'Az adatállomány már be van
töltve!');
Exit;
End;
Assign(FNev,DNev); {$I-}Reset(FNev);{$I+}
If
IOResult<>0 Then
Begin
ReWrite(fnev);
For
I:= 1 To Amax Do Write(FNev,TTanulo[I]);
End
Else
For
I:= 1 To Amax Do Read(FNev,TTanulo[I]);
Close(FNev);
Adatbent:= True;
Uzenet(5,15,'Az adatállomány betöltve!');
End;
Procedure Lemezre;
Begin
Assign(FNev,DNev); ReWrite(FNev);
For
I:= 1 To Amax Do Write(FNev,TTanulo[I]);
close(FNev);
Uzenet(5,15,'Az adatállomány kimentve!');
End;
Procedure Nevtolto;
Var S: String;
Begin
For
I:= 1 To Amax Do
Begin
Str(I,S);
If
I<10 Then S:= ' '+S;
Tomb[I]:= ' '+S+'.'+TTanulo[I].Nev;
End;
End;
Procedure Javitas;
Var S: String;
Sz,Kod :integer;
R: real;
Begin
If
Not Adatbent Then
Begin
Uzenet(5,15,'Nincs megnyitva
adatállomány!');
Exit;
End;
Szinek(1,0); ClrScr;
At:= Listazo(7,0,2,25,5,30,Amax,11,At,True,'Tanulók
névsora:');
If
VCh=#27 Then Exit;
Szinek(7,0); ClrScr;
ATanulo:= TTanulo[At];
Ablak(1,14,10,6,70,18,True,'A tanuló
adatai:');
WriteXY(13, 8,'A tanuló neve.......:');
WriteXY(13,10,'Születési éve.......:');
WriteXY(13,12,'Osztálya............:');
WriteXY(13,14,'Lakhelye............:');
WriteXY(13,16,'Tanulmányi átlaga...:');
Szinek(0,14);
With
Atanulo Do
Begin
WriteXY(37,8,nev);
Str(Szul,S);
WriteXY(37,10,S);
WriteXY(37,12,Oszt);
WriteXY(37,14,Lak);
GoToXY(37,16);
Write(Atl:4:2);
End;
With
Atanulo Do
Begin
S:= Bevitel(7,0,37,8,25); If VCh<>#27 Then
Begin
Adatvalt:= True; Nev:= s End;
Repeat
S:= Bevitel(7,0,37,10,4); Val(S,Sz,Kod);
Until
(Kod=0) Or (VCh=#27);
If
VCh<>#27 Then Begin Adatvalt:= True; Szul:= Sz End;
S:= Bevitel(7,0,37,12,3);
If
VCh<>#27 Then Begin Adatvalt:= True; Oszt:= S End;
S:= Bevitel(7,0,37,14,30);
If
VCh<>#27 Then Begin Adatvalt:= True; Lak:= S End;
Repeat
S:= Bevitel(7,0,37,16,4); Val(S,R,Kod);
Until
(Kod=0) Or (VCh=#27);
If
VCh<>#27 Then Begin Adatvalt:= True; Atl:= R End;
End;
If
Adatvalt Then TTanulo[At]:= ATanulo;
End;
Procedure SMake;
Var Ws,W: String[80];
Begin
For
I:= 1 To Amax Do
Begin
Ws:= '';
Str(I,Ws);
If
Length(Ws)=1 Then Ws:= ' '+Ws;
Ws:= Ws+'.';
Ws:= Ws+TTanulo[I].Nev;
Ws:= Copy(Ws+' ',1,29);
Str(TTanulo[I].Szul,W);
Ws:= Ws+W;
Ws:= Copy(Ws+' ',1,34);
Ws:= Ws+TTanulo[I].Oszt;
Ws:= Copy(Ws+' ',1,38);
Ws:= Ws+TTanulo[I].Lak;
Ws:= Copy(Ws+' ',1,69);
Str(TTanulo[I].Atl:4:2,W);
Ws:= Ws+W;
Tomb[I]:= Ws;
End;
End;
Procedure Nevszerint;
Var I, J: Integer;
PTanulo: Tanulo;
Begin
For
I:= 1 To Amax-1 Do For J:= I+1 To Amax Do
If
TTanulo[I].Nev>TTanulo[J].Nev Then
Begin
PTanulo:= TTanulo[I];
TTanulo[I]:= TTanulo[J];
TTanulo[J]:= PTanulo;
Adatvalt:= True;
End;
While
TTanulo[1].Nev[1]='-' Do
Begin
For
J:= 1 To Amax-1 Do TTanulo[J]:= TTanulo[J+1];
TTanulo[Amax]:= UTanulo;
End;
SMake;
Listazo(7,0,2,1,3,77,Amax,19,1,True,'A
tanulók névsor szerint:');
End;
Procedure Korszerint;
Var I, J: Integer;
PTanulo: Tanulo;
Begin
For
I:= 1 To Amax-1 Do For J:= I+1 To Amax Do
If
TTanulo[I].Szul>TTanulo[J].Szul Then
Begin
PTanulo:= TTanulo[I];
TTanulo[I]:= TTanulo[J];
TTanulo[J]:= PTanulo;
Adatvalt:= True;
End;
While
TTanulo[1].Nev[1]='-' Do
Begin
For
J:= 1 To Amax-1 Do TTanulo[J]:= TTanulo[J+1];
TTanulo[Amax]:= UTanulo;
End;
SMake;
Listazo(7,0,2,1,3,77,Amax,19,1,True,'A
tanulók névsora koruk szerint:');
End;
Procedure Lakszerint;
Var I, J: Integer;
PTanulo: Tanulo;
Begin
For
I:= 1 To Amax-1 Do For J:= I+1 To Amax Do
If
TTanulo[I].Lak>TTanulo[J].Lak Then
Begin
PTanulo:= TTanulo[I];
TTanulo[I]:= TTanulo[J];
TTanulo[J]:= PTanulo;
Adatvalt:= True;
End;
While
TTanulo[1].Nev[1]='-' Do
Begin
For
J:= 1 To Amax-1 Do TTanulo[J]:= TTanulo[J+1];
TTanulo[Amax]:= UTanulo;
End;
SMake;
Listazo(7,0,2,1,3,77,amax,19,1,True,'A
tanulók névsora lakhely szerint:');
End;
Procedure Atlszerint;
Var I, J: Integer;
PTanulo: Tanulo;
Begin
For
I:= 1 To Amax-1 Do For J:= I+1 To Amax Do
If
TTanulo[I].Atl>TTanulo[J].Atl Then
Begin
PTanulo:= TTanulo[I];
TTanulo[I]:= TTanulo[J];
TTanulo[J]:= PTanulo;
Adatvalt:= True;
End;
While
TTanulo[1].Nev[1]='-' Do
Begin
For
J:= 1 To Amax-1 Do TTanulo[J]:= TTanulo[J+1];
TTanulo[Amax]:= UTanulo;
End;
SMake;
Listazo(7,0,1,3,77,Amax,19,1,True,'A tanulók
névsora tanulmányi átlaguk szerint:');
End;
Procedure Osztatlag;
Var Jsz: integer;
Ossz: real;
S: String;
Begin
Szinek(1,0); ClrScr;
Jsz:=0; Ossz:= 0; S:= '';
For
I:= 1 To Amax Do
With
TTanulo[I] Do If Atl<>0 Then
Begin
Inc(Jsz);
Ossz:= Ossz+Atl;
End;
If
Jsz<>0 Then Atlag:= Ossz/Jsz;
Str(Atlag:4:2,S);
Uzenet(5,15,'Az osztály átlaga: '+S);
End;
Procedure Stati;
Var Amp:byte;
Const Amsor:
Array[1..6] Of String[17]=
(' Névsor szerint ',
' Korok szerint ',
' Lakhely szerint ',
' Átlag szerint ',
' Osztály átlaga ',
' Főmenű ');
Begin
If
Not Adatbent Then
Begin
Uzenet(5,15,'Nincs megnyitva
adatállomány!');
Exit;
End;
Repeat
Szinek(1,0);
ClrScr;
Ablak(7,0,29,8,49,15,True,'Lekérdezések:');
For
I:= 1 To 6 Do WriteXY(31,8+i,Amsor[i]);
Tunj;
Amp:= Menu(7,0,2,31,9,17,6,1);
Case
Amp Of
1: Nevszerint;
2: Korszerint;
3: Lakszerint;
4: Atlszerint;
5: Osztatlag;
6: Exit;
End;
Until
False;
End;
Begin
TextMode(CO80);
Init;
Repeat
Szinek(1,0);
ClrScr;
Ablak(7,0,30,8,48,13,True,'Főmenű:');
For
I:= 1 To 4 Do WriteXY(32,8+i,Msor[i]);
Tunj;
Mp:= Menu(7,0,2,32,9,15,4,1);
Case
Mp Of
1: Begin
Lemezrol; Nevtolto End;
2: Begin
Javitas; Nevtolto End;
3: Begin
Stati; Nevtolto End;
4: Begin
If Adatvalt Then
If
Kerdezo(5,15,'Lemezre menti-e a megváltozott adatokat?') Then Lemezre;
Szinek(0,7); ClrScr; Halt
End;
End;
Until
False;
End.
A
Tanulok nevű program kódolási
sorrendje:
Keretprogram;
Deklarációk;
Init;
Lemezre;
Lemezrol;
Nevtolto;
Javitas;
Stati;
Nevszerint;
Korszerint;
Lakszerint;
Atlszerint;
Osztatlag.
Gyakran gondot jelent, hogy a DOS-ban megirt
programjaink adatállományait nem tudjuk programból szép formátumban papírra
vetni. Ezen segít a következő kis eljárás, amely olyan szöveges állományt hoz
létre, amely könnyen betölthető az Excel táblázatkezelőbe. Ezután már könnyedén
formázhatjuk, szépíthetjük irományunkat. A most következő rutint a Tanulok listájába kell beszúrni,
valamint a főmenüt bővíteni kell egy 'TXT-file' menüponttal.
Procedure
TxtFile;
Var I: Integer;
TxtFNev: Text;
TxtDNev: String;
Begin
TxtDNev:= 'diakok.txt';
Assign(TxtFNev,TxtDNev); ReWrite(TxtFNev);
For
I:= 1 To Amax Do With TTanulo[I] Do
Write(TxtFNev,Nev,#9,Szul,#9,Oszt,#9,Lak,#9,Atl,#13);
Close(TxtFNev);
End;
Adatainkat az Excel-ből még tovább
vándoroltathatjuk, ha Word-ben formaleveleket szeretnénk írni. Megtehetjük,
hogy körlevél készítésnél a törzsadatoknak az Excel-ből kimentett állományunkat
választjuk, így a DOS-os felületen bevitt adataink végül egy Word dokumentumban
jelennek meg.
Egy String
input esetén a bevitt szöveg tartalmazhat fölösleges SPACE-eket, akár az elején
vagy a végén, de a string belsejében is. Írjunk a CrtPlus-ba egy olyan függvényt,
mely a fölösleges üres helyeket kitörli a szövegből. Legyen ennek a függvénynek
a neve: ValidSt.
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(s,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;
Gyakran lehet szükség arra, hogy string-listákat
kezeljünk, rendezéseket, kereséseket hajtsunk végre. A következő függvény
gyakorlatilag egy olyan lista, mely stringeket tud tárolni, a listában csak
egyszer szerepelhet egy string, és a tárolás rendezetten történik. Új lista
létrehozásakor először a Tomb[1..Max] string tömböt üres stringekkel kell
feltölteni. Mindannyiszor, amikor egy stringet ráhelyezünk a listára, a Listara függvényt kell meghívni a
ráhelyezendő stringgel, mint paraméterrel. Az átvett stringet a függvény
először a ValidSt függvény
segítségével megszabadítja a fölösleges SPACE-ektől. A lista függvény
visszaadott értéke a lista új hossza. A lista üres stringet nem tartalmazhat,
és a tárolás növekedő nagyságrendben történik. Ha a listát üres stringgel
hívjuk meg, akkor megkapjuk az aktuális hosszát. Ha a meghívással a lista hossza
nem változik, akkor a paraméterként átadott string már szerepel a listában.
(pl: ha Listara(’’)=Listara(’alma’) akkor az ’alma’ string
már szerepel a listán.) A leírtakból az is kitűnik, hogy ez a lista ezzel a
függvénnyel csak növelhető, szabályos törlésre nincs lehetőség. A Listara függvény helye a CrtPlus
unit-ban van. Mivel a függvény a listára helyezés előtt egyszerű string
összehasonlítást végez, a Listara a
kis- és nagybetűket megkülönbözteti.
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;
Most írjunk egy olyan függvényt, amely a
listáról elemeket tud levenni. Legyen ennek a neve: Listarol és természetesen ez is a CrtPlus-ban lesz elhelyezve.
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;
A Listarol
függvény tehát leveszi a listáról az átvett stringet, visszaadott értéke a
lista új hossza, ha pedig nem volt a listán, a visszaadott érték
34.
Írjunk programot, amely hozzáfűzésre megnyit egy szöveges állományt, majd üres
string beírásáig a billentyűzetről strigeket olvas, amelyeket a megnyitott
lemezes állomány végéhez hozzáfűz. Az input végeztével betölti a lemezről a
stringeket, és sorrendbe rakva visszaírja ugyanabba az állományba. Használjuk a
Listara függvényünket.
Program
TextFile;
Uses NewDelay,
Crt, CrtPlus;
Var NevSor:
Text;
NevSorOS: String;
Procedure
AdatBe;
Var S: String;
Begin
S:= ' ';
Assign(NevSor, NevSorOS); {$I-}Append(NevSor);{$I-}
If
IOResult=0 Then ReWrite(NevSor);
While
S<>'' Do
Begin
ReadLn(S);
If
S<>'' Then WriteLn(NevSor, S);
End;
Close(NevSor);
End;
Procedure
Rendez;
Var S: String;
I, Sh: Integer;
Begin
ClrScr;
For
I:= 1 To Max Do Tomb[I]:= '';
Assign(Nevsor, NevSorOS); Reset(NevSor);
While
Not EOF(NevSor) Do
Begin
ReadLn(NevSor, S);
Listara(S);
End;
Close(NevSor);
I:= 1;
Sh:= 0;
Assign(NevSor, NevSorOS); Rewrite(NevSOr);
While
Tomb[I]<>'' Do
Begin
WriteLn(NevSor, Tomb[I]);
If
Length(Tomb[I])>Sh Then Sh:=
Length(Tomb[I]);
Inc(I);
End;
Close(Nevsor);
ClrScr;
Dec(I);
Listazo(7,0,2,20,2,Sh+6,I,5,1,True,'Lista');
End;
Begin
TextMode(CO80);
Szinek(1,14);
ClrScr;
NevSorOS:= 'NevSor.Txt';
AdatBe;
Rendez;
Varj;
End.
Az AdatBe
eljárás először hozzáfűzésre próbálja megnyitni az állományt, ha ez nem
sikerül, akkor ReWrite-tal. Majd billentyűzetről olvas üres string végjelig. A Rendez eljárás a file végéig (EOF)
olvassa a lemezes állományt, közben a stringeket listára teszi. Majd lezárja és
írásra megnyitja az állományt, és a teljes listát kiírja az állományba. Végül a
listát a listázóban megtekinthetjük.
Hangok
Előfordulhat, hogy egy adott tevékenységre
hanggal is fel szeretnénk hívni a géphasználó figyelmét, főleg akkor, ha a
felhasználónak be kellene avatkozni a program további menetébe. Ilyen lehet egy
menüből való választás, vagy egy input lekezelése. Erre az esetre írjunk egy Duda nevű eljárást és tegyük azt a
CrtPlus unitba:
Procedure Duda;
Begin
Sound(1000);
Delay(200);
Nosound;
End;
Ha valaki dallamosabb hangot szeretne hallani,
akkor azt egyéni ízlés szerint kialakíthatja. Ehhez a CrtPlus unitba
elhelyezhetjük a zenei hangok frekvenciáit:
Const
Hq= 1.059463;
Ha= 440;
Hc=
Round(Ha/Hq/Hq/Hq/Hq/Hq/Hq/Hq/Hq/Hq);
Hcisz=Round(Hc*Hq);
Hd= Round(Hcisz*Hq);
Hdisz=Round(Hd*Hq);
He= Round(Hdisz*Hq);
Hf= Round(He*Hq);
Hfisz=Round(Hf*Hq);
Hg= Round(Hfisz*Hq);
Hgisz=Round(Ha/Hq);
Hbe= Round(Ha*Hq);
Hh= Round(Ha*Hq*Hq);
Ezek
a frekvenciák kiszámolva:
Hc= 261;
Hcisz=232;
Hd= 294;
Hdisz=311;
He= 329;
Hf= 349;
Hfisz=370;
Hg= 392;
Hgisz=415;
Ha= 440;
Hbe= 466;
Hh= 494;
Szöveges képernyőmódok
35.
Írjunk programot, amely bemutatja, hogy milyen szöveges képernyőmódokat tud
kezelni a Turbo Pascal.
Program
SzovKep;
Uses NewDelay,
Crt, CrtPlus;
Var Eredeti:
Byte;
Begin
Eredeti:= LastMode;
TextAttr:= 15;
ClrScr;
TextMode(0);
Write(’BW40=0: fekete-fehér 40*25, színes
adapteren’);
Tunj;
Varj;
TextMode(1);
Write(’CO40=1: színes 40*25, színes
adapteren’);
Tunj;
Varj;
TextMode(2);
Write(’BW80=2: fekete-fehér 80*25, színes
adapteren’);
Tunj;
Varj;
TextMode(3);
Write(’CO80=3: színes 80*25, színes
adapteren’);
Tunj;
Varj;
TextMode(7);
Write(’MONO=7: fekete-fehér 80*25, monokróm
adapteren’);
Tunj;
Varj;
TextMode(3+256);
Write(’3+Font8x8=259: színes 80*43 ill.
80*50, EGA/VGA adapteren’);
Tunj;
Varj;
TextMode(eredeti);
End.
A megjelenítési módokat a TextMode paraméteres
eljárással állíthatjuk be. A LastMode változó a legutoljára beállított
üzemmódot tartalmazza.
36.
Írjunk bemutató programot a képernyő megjelenítés különböző eljárásaira,
írassuk ki és értelmezzük a WindMin és WindMax változók értékét. Mutassuk be az
InsLine és DelLine eljárások működését.
A képernyőn való szövegmegjelenést a LowVideo,
HighVideo, NormVideo eljárásokkal szabályozhatjuk. Hatásukat jól szemlélteti a
következő rövid program. A LowVideo alacsony intenzitásúra, a HighVideo magas
intenzitásúra állítja a karakter színeit. NormVideo a program indításakor
detektált attributumokat tartalmazza.
Program Kepernyo;
Uses NewDelay,
Crt, Crtplus;
Var I: Byte;
Begin
TextMode(CO80);
Szinek(1,5);
Clrscr;
Write(’Funkció....’);
HighVideo;
Write(’F1’);
Tunj;
Varj;
WriteXY(1,5,’N’);
LowVideo;
Write(’em’);
Tunj;
Varj;
Normvideo;
WriteXY(1,10,’Vége is lehetne, de nincs
...’);
Tunj;
Varj;
GoToXY(1,15);
Writeln(WindMin,’ ’,WindMax);
Writeln(Lo(WindMin)+
WriteLn(Lo(WindMax)+
WriteXY(30,20,'*');
Write(WhereX,’ ’,WhereY,’ Helyen volt a kurzor’);
Tunj;
Varj;
GotoXY(1,1);
For
I:= 1 To 5 Do
Begin
Varj;
DelLine;
End;
Varj;
GoToXY(1,10);
For
i:= 1 to 5 do
Begin
Varj;
InsLine;
End;
Tunj;
Varj;
End.
A programot futtatva a WindMin és WindMax
értékét és a belőlük származó ablakkoordinátákat kaphatjuk meg. A WhereX és
WhereY segítségével a kurzor pozícióját kérdezhetjük le. Az InsLine és DelLine
működését a két For ciklus szemlélteti.
A DOS unit
37. Írjunk programot, amely kilistázza az
aktuális könyvtár tartalmát, majd kiírja a a lemez szabad kapacitását.
A lemezkezelő eljárások többségét a DOS unit
tartalmazza, ezért ezt használatba kell venni. A Katalogus az aktuális
könyvtárnak a neve. A ChDir könyvtárcserét végez, a DOS parancsoknak
megfelelően. A FindFirst az első, a
FindNext a további bejegyzéseket keresi az aktuális könyvtárban. A bejegyzések
Record típusúak, és a Bejegyzes-ben
tároljuk őket. A DosError a lemezműveleteknél fellépő futás idejű
hibákat tartalmazza. 0 esetén nincs hiba. A Bejegyzes Record Name mezőjében a
név, az Attr mezőjében az attributum található. A DiskFree függvény visszaadott
értéke a lemez szabad kapacitása. A típusa miatt csak 2Gb-ig mutat helyes
értéket.
Program Director;
Uses NewDelay,
Crt, CrtPlus, Dos;
Var
Bejegyzes: SearchRec;
Katalogus: String;
Meret, Szabad: longint;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
ChDir('..');
GetDir(0,Katalogus);
If
Katalogus[Length(Katalogus)]<>'\' then
Katalogus:= Katalogus+'\';
Katalogus:= Katalogus+'*.*';
WriteLn(Katalogus,' könyvtár tartalma:');
FindFirst(Katalogus, AnyFile, Bejegyzes);
If
DosError<>0 Then WriteLn('Hiba')
Else
While
DosError=0 Do
Begin
Write(Bejegyzes.Name);
If
Bejegyzes.Attr And Directory=Directory
Then
WriteXY(14,WhereY,'<DIR>');
WriteLn;
FindNext(Bejegyzes);
End;
WriteLn;
Szabad:= DiskFree(Ord(Katalogus[1])-Ord('A')+1);
Szabad:= DiskSize(Ord(Katalogus[1])-Ord('A')+1);
WriteLn(Meret,' Byte-ból ');
WriteLn(Szabad,' Byte szabad');
Tunj;
Varj;
End.
Gyakran igény van arra, hogy egy program futása
közben, valamely lemez illetve könyvtár tartalmát megnézzük. Például azért,
hogy az ott lévő file-okból válogassunk. Egy könyvtár tartalmának elolvasásához
a DOS standard Unit használata szükséges. A következő feladatunk e témában az
lesz, hogy egy általános file-keresőt írjunk, amelyet a CrtPlus-ban szeretnénk
elhelyezni. Ehhez először a lista elején lévő Uses sor bővítendő:
Unit
CrtPlus;
InterFace
Uses NewDelay,
Crt, Dos;
. . .
38.
Írjunk olyan függvényt, amely egy általunk megadott meghajtó aktuális
könyvtárának a tartalmát úgy listázza ki, hogy csak a megadott kiterjesztéssel
rendelkező file-okat jeleníti meg.
A
feladat értelmében a függvény paraméterei a következők:
HSz:
Háttérszin;
KSz:
Karakterszin;
VSz:
Választószin;
Dr:
a lemezes egység száma (0: aktuális,
1: A:\; 2:B:\; 3: C:\; 4: D:\; …);
Ext:
a keresési maszkhoz a file kiterjesztése.
A
függvényt a CrtPlus-ban helyezzük el.
Function
FileKereso(HSz,KSz,DSz,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;
A GetDir (System Unit) eljárás a Katalogus
stringbe tölti a Dr által meghatározott lemezes egység aktuális könyvtárának a
nevét. Ha nem a gyökérkönyvtárban vagyunk, akkor a '\' jel hiányozni fog a
bejárási út végéről, ezért a vizsgálat és a hozzáfűzés. A '*.'+ext -el adjuk
meg a kiterjesztést. A FindFirst (Dos Unit) eljárás, a Katalogus-ban megadott
könyvtárban keresi, az AnyFile attributumu első file-t, és ha megtalálja a
Bejegyzes-ben helyezi el. Az első DosError vizsgálat eredményes volta akkor
következik be, ha a kapott elérési út érvénytelen, vagy hiányzik a megfelelő
lemezes egység, vagy üzemképtelen. A FindNext (Dos Unit) eljárás az előző
eljárásban már megkezdett katalógus bejegyzéseit tovább olvassa. Hiba esetén az
olvasás befejeződik (mert nincs több bejegyzés). A Bejegyzéseket a Tomb-ben
helyezzük el. A Listazo függvénnyel a katalógust megnézhetjük, sőt még
választhatunk is belőle. A SearchRec tipus és az AnyFile konstans a Dos Unitban
vannak deklarálva. További, az állományok állapotát leíró konstansok: ReadOnly,
Hidden, SysFile, VolumeID, Directory és Archive. A megírt függvényt a következő
kis program teszteli:
Program DirProba;
Uses NewDelay, Crt, CrtPlus;
Var FileNev: String;
Begin
TextMode(CO80);
Szinek(1,14);
ClrScr;
FileNev:= FileKereso(7,0,Green,0,'*');
WriteXY(1,24,filenev);
Tunj;
Varj;
End.
39.
Irjunk programot, amely a főkönyvtárban könyvtárakat (mappákat) hoz létre, és
mindegyikben egy file-bejegyzést. A file most lehet üres is.
A
program olyan egyszerű, hogy magyarázat nélkül is könnyen érthető. A
könyvtárkészítő parancs teljesen megegyezik a DOS-beli megfelelőjével.
Program DirsMake;
Uses NewDelay,
Crt, CrtPlus, Dos;
Var Ch: Char;
Procedure
DirMake(D: String);
Var FNev: Text;
DNev: String;
Begin
ChDir('\');
DNev:= 'user.dat';
MkDir(D);
ChDir(D);
Assign(FNev,DNev);
ReWrite(FNev);
Close(FNev);
End;
Begin
For
Ch:='a' To 'f' Do DirMake(Ch);
End.
40.
Írjunk programot, amely egy megadott könyvtár alatti összes könyvtár tartalmát
kilistáz, és közben egy adott nevű file-t minden könyvtárból töröl
(természetesen csak onnan, ahol volt).
Program
DirList;
Uses NewDelay,
Crt, Dos;
Var
Katalogus: DirStr;
Bejegyzes: SearchRec;
F: File;
D, HD: String;
Procedure
KatalogusLista(Katalogus: DirStr);
Var
Bejegyzes: SearchRec;
Begin
WriteLn(Katalogus);
If
WhereY>23 Then Begin ReadLn; ClrScr End;
If
Katalogus[Length(Katalogus)]='\'
Then
Delete(Katalogus,Length(Katalogus),1);
FindFirst(Katalogus+'\*.*',AnyFile,Bejegyzes);
While
(DosError=0) And
(Bejegyzes.Name[1]='.') Do
FindNext(Bejegyzes);
While
DosError=0 Do
Begin
If
(Bejegyzes.Attr And
Directory)=Directory Then
KatalogusLista(Katalogus+'\'+Bejegyzes.Name)
Else
WriteLn(Katalogus,'\',Bejegyzes.Name);
If
WhereY>23 Then Begin Readln; ClrScr End;
FindNext(Bejegyzes);
If
Bejegyzes.Name=D Then
Begin
HD:= Katalogus+'\'+Bejegyzes.Name;
Assign(F,HD);
Erase(F);
End;
End;
End;
Begin
TextMode(CO80);
D:= 'USER.DAT';
ClrScr;
Write('Katalógusnév: ');
ReadLn(Katalogus);
FindFirst(Katalogus +
'\*.*',AnyFile,Bejegyzes);
If
DosError=3 Then WriteLn('Nincs ilyen
katalógus')
Else
KatalogusLista(Katalogus);
ReadLn;
End.
A program az eddigiek alapján könnyen érthető,
ezért elemzésétől eltekintünk. A KatalogusLista rekurzív hívással jut el a
mélyebb könyvtárakba.
41.
Írjunk programot, amely a lemez kapacitásával, DOS verzióval, a dátummal és az
idővel kapcsolatos eljárásokat és függvények használatát mutatja be.
Program DosDemo;
Uses NewDelay,
Crt, CrtPlus, Dos;
Const Honap:
Array[1..12] Of String=
('Jan','Febr','Márc','Ápr','Máj','Jún',
'Júl','Aug','Szept','Okt','Nov','Dec');
Het: Array[0..6]
Of String=
('Vasárnap','Hétfő','Kedd','Szerda','Csütörtök','Péntek','Szombat');
Var Ev, Ho,
Nap, HetNap: Word;
Ora, Perc, Mp, Mp100: Word;
Ch: Char;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
WriteXY(1,7,'d: új dátum, t: új idő');
GoToXY(1,1);
WriteLn('Az aktuális lemez kapacitása
',DiskSize(0)/1024/1024:8:2,' Mbyte.');
WriteLn('Az aktuális lemezen ',DiskFree(0),'
byte szabad.');
WriteLn('Dos Vezió:
',Lo(DosVersion),'.',Hi(DosVersion));
GetDate(Ev, Ho, Nap, HetNap);
WriteLn('A mai nap: ',Ev,'. ',Honap[Ho],'.
',Nap,', ',Het[HetNap],'.');
Repeat
GetTime(Ora, Perc, Mp, Mp100);
Write('A pontos idő: ',Ora,' óra ',Perc,'
perc ',Mp,' másodperc.');
Delay(1000);
GoToXY(1,WhereY);
Until
KeyPressed;
Ch:= ReadKey;
Case
Ch Of
'd': Begin
WriteXY(1, 9,'Új év : '); ReadLn(Ev);
WriteXY(1,10,'Új hó : '); ReadLn(Ho);
WriteXY(1,11,'Új nap: '); ReadLn(Nap);
SetDate(Ev, Ho, Nap);
End;
't': Begin
WriteXY(1, 9,'Új óra : '); ReadLn(Ora);
WriteXY(1,10,'Új perc : '); ReadLn(Perc);
WriteXY(1,11,'Új mperc: '); ReadLn(Mp);
SetTime(Ora, Perc, Mp, 0);
End;
End;
End.
42.
Írjunk programot, amely a felhasználó által meghatározható, de az operációs
rendszer által elfogadható évre vonatkozóan kártyanaptárt készít. Végül el
lehessen dönteni, hogy a képernyőt kimenjük-e lemezre, vagy kinyomtatjuk
nyomtatón, esetleg egyiket sem, csak egyszerűen kilépünk a programból.
Első lépésként a képernyőtervet kell
elkészíteni. Egy hónapra vonatkozóan csak egyszer kellene kiirni a napok nevét,
pontosabban a napok nevének az első kezdőbetűjét. Mivel a 12 hónapnevet egymás
mellé, a hónapok napjait pedig egymás alá írva nem férnek el a képernyőn, ezért
célszerű egy-egy téglalap alakú területet egy hónapra fenntartani. A hónapokat
hetekre bontva a függőleges méret minimum 7 +
Program
OrokNap;
Uses NewDelay,
Crt, Crtplus, Dos, Printer;
{Mivel
nyomtatni is szeretnénk, használnunk kell a Printer Unit-ot}
Const Honap:
Array[1..12] Of String=
('Január','Február','Március','Április',
'Május','Június','Július','Augusztus',
'Szeptember','Október','November','December');
Het: Array[0..6]
Of String= ('V','H','K','S','C','P','S');
Var
Ev,Ho,Nap,NapNev,Oldev,Oldho,Oldnap: Word;
I,J,Hoszam,Napszam,Elsonap,Anap,Vv: Integer;
Szoko: Boolean;
Hh: Array[1..12]
Of Byte;
Ch: Char;
ws: String;
FNev: Text;
DosNev: String;
Begin
Hh[1]:=31;Hh[2]:=28;Hh[3]:=31;Hh[4]:=30;Hh[5]:=31;Hh[6]:=30;
Hh[7]:=31;Hh[8]:=31;Hh[9]:=30;Hh[10]:=31;Hh[11]:=30;Hh[12]:=31;
ClrScr;
GetDate(Ev,Ho,Nap,NapNev);
Oldev:= ev; Oldho:= ho; Oldnap:= nap;
GoToXY(38,1); Write(Ev);
WriteXY(24,2,'Akarsz-e évet változtatni (i/n)?');
Repeat
Ch:= ReadKey;
Ch:= UpCase(ch);
Until
Ch In ['I','N'];
If
Ch='I' Then
Begin
WriteXY(31,3,'Kérem az évszámot: ');
ReadLn(Ev);
SetDate(Ev,Ho,Nap);
GetDate(Ev,Ho,Nap,NapNev);
SetDate(Oldev,Oldho,Oldnap);
{Hogy minél
kevesebb ideig éljen a program miatti új időpont}
End;
Szoko:= False;
If
(Ev Mod 4)=0 Then Szoko:= True;
If
(Ev Mod 100)=0 Then Szoko:= False;
If
(Ev Mod 400)=0 Then Szoko:= True;
If
Szoko Then Hh[2]:= 29;
{Ez volt a
szökőév megállapítás}
Hoszam:=1; Napszam:= 0;
While
Hoszam<ho Do
Begin
Inc(Napszam,Hh[Hoszam]);
Inc(Hoszam);
End;
Inc(Napszam,Nap);
{Napszam= a
kérdéses évben a mai nap sorszáma}
Napszam:= Napszam Mod 7;
{A
maradékképzéssel hét lehetséges esetre vezetjük vissza az első nap napnevének a
megállapítását:}
Case
Napszam Of
0: Elsonap:= (NapNev+1) Mod 7;
1: Elsonap:= NapNev;
2..6: While
Napszam>1 Do
Begin
Dec(Napszam);
Dec(NapNev);
If
NapNev>6 Then NapNev:=6; {Mivel a NapNev Word típusú}
Elsonap:= NapNev;
end;
End;
{Elsonap= az
év első napja erre a napra esett, 0=V, 1=H, 2=K ... 6=S}
Anap:= Elsonap;
{Az Anap-ban
tároljuk azt, hogy az aktuális kiíráskor nap a hét melyik napja}
Szinek(1,15);
ClrScr;
GoToXY(38,1);
Write(ev);
For
I:= 1 To 12 Do WriteXY(((I-1) Mod
4)*20+7,((I-1) Div 4)*8+2,Honap[I]);
For
I:= 1 To 12 Do For J:= 0 To 6 Do
WriteXY(((I-1) Mod 4)*20+1,((I-1) Div
4)*8+3+J,Het[J]);
For
I:= 1 To 12 Do
Begin
Vv:= 0;
For
J:= 1 To Hh[I] Do
Begin
GoToXY(((I-1) Mod 4)*20+3+Vv,((I-1) Div
4)*8+3+Anap);
Inc(Anap);
Anap:= Anap Mod 7;
If
Anap=0 Then Inc(Vv,3);
Write(J:2);
End;
End;
{A Vv változó
szerepe az íráshelyek vízszintes széthúzása}
GoToXY(1,1);
Write('(F: File P: Printer)');
Tunj;
Ch:= ReadKey;
GoToXY(1,1);
Write(' ');
{Ha file-ba
mentjük a képernyőt az op-rendszerbeli neve legyen az évszám + .txt
kiterjesztés:}
If
Ch='F' Then
Begin
Str(Ev,DosNev);
DosNev:= DosNev+'.txt';
Assign(FNev,DosNev);
ReWrite(FNev);
For
I:= 1 To 25 Do
Begin
Ws:= '';
For
J:= 1 To 79 Do Ws:= Ws+Chr(BKep[I,J,1]);
WriteLn(FNev,Ws);
End;
Close(FNev);
End;
{Ha
kinyomtatjuk a képernyőt:}
If
Ch='P' Then
Begin
For
I:= 1 To 25 Do
Begin
Ws:= '';
For
J:= 1 To 80 Do Ws:= Ws+Chr(BKep[I,J,1]);
WriteLn(Lst,Ws);
{Nyomtatóra tehát ugyanúgy írunk, mint
szöveges file-ba}
End;
End;
End.
Dinamikus tárkezelés, adatstruktúrák
A téma bevezetéseként ismételjük át, hogy eddig
milyen változókkal ismerkedtünk meg. Elsőként a globális változókkal, amelyet a
program deklarációs részében irtunk le, s amelyeket a teljes programba, bárhol
használhattunk. Aztán megismerkedtünk az eljárásokkal és függvényekkel. Ezeknek
a belsejében is deklarálhattunk változókat, ezek voltak a lokális változók. A
lokális változókat csak a deklarálás helyén, vagy az alatta lévő szinteken
lehetett használni. Az ugyanazon szinten lévő rutinok nem látták egymás
változóit, sőt a főprogram sem. Definiáltunk továbbá konstansokat és tipizált
konstansokat. A Max értékek konstansok, a menüpontok nevei tipizált konstansok
voltak. Az eddig megismert változókat és konstansokat statikusoknak nevezzük
azért, mert fordításkor a helyük létrejön és a program futásának a végéig
változatlanul meg is marad.
Nézzük ezután, hogyan helyezkednek el a pascal
program esetén a memóriában a kódok és az adatok. Kezdetben, a 4.0 verzióig a
turbo pascal *.com tárgyprogramokat készített, melynek rögzített betöltési
helye volt a memóriában és mérete maximálisan egy lap, azaz 64 Kb lehetett.
Ehhez kapcsolódott az adatszegmens maximum 64 Kb-tal és az Ovelay terület (azaz
átlapolási terület az Overlay-be fordított Unit-ok részére, - mindig az
aktuálisan szükséges kódot töltötte a rendszer a lemezről a RAM-ba). A kimarad
memóriaterületen volt a Stack (a verem). Ezeket a korlátokat manapság
jelentősen átléphetjük az új típusú memória kiosztás és kezelés révén. Első
fontos dolog, hogy a Turbo Pascal 7.0 már nem *.com hanem *.exe állományokat
készít, melyet a hagyományos memória bármely üres helyére betölthet, nincs
rögzített helye. Méretére nincs korlátozás, hacsak az nem, hogy a
szövegszerkesztő maximálisan 64 Kb-os szöveget tud kezelni. Ezen viszont az tud
segíteni, hogy saját Unit-okat írhatunk, melynek darabszáma nincs korlátozva.
Így az összeszerkesztett exe állomány akár több-száz Kb is lehet. Itt
említenénk meg, hogy a pascal rendszer két IDE-t tartalmaz a DOS-os
környezetre. Ezek: a Turbo és a Tpx. A Turbo úgy dolgozik, hogy a fordítást
alapértelmezésben a RAM-ba készíti és a segédállományokat is itt hozza létre.
Nagyméretű programok esetén ez akadály lehet, hiszen DOS-ban csak maximum 10
lap (640 Kb) áll rendelkezésre, s ha mindent a memóriában oldunk meg, hamar
elfogyhat a standard memória. A Tpx viszont a fordítást mindig lemezre végzi és
az ideiglenes állományait is itt hozza létre. Ezzel tehát nagyobb programokat
lehet irni. Ezért használtuk eleve ezt a fejlesztéseink alkalmával. A mai
rendszerben a memória kiosztása a következő (az alacsony címtől kezdve a
magasak felé haladva):
-
*.exe
állomány,
-
Unit-ok,
-
tipizált
konstansok (nem tartoznak az adatszegmenshez),
-
globális
(statikus) változók - maximum 64 Kb -,
-
Stack
- maximum 64 Kb -,
-
Overlay
- ha van,
-
Heap
- a memória tetejéig.
Vizsgáljuk meg egy kicsit jobban a Stack-et,
miért szükséges és hogyan működik. A program futása közben gyakran előfordul,
hogy a programnak alprogramhoz kell fordulnia, amely gyakorlatilag egy objekt
helyre való ugrást jelent. Az alprogram végrehajtása után - alapértelmezésben -
a programot a hívás helye utáni memóriacímen kell folytatni. A gép úgy tud
visszatalálni, hogy minden alprogramhíváskor lementi a hívás helyét a
memóriába. Természetesen alprogramból újra alprogramba ugorhatunk, így az
eredeti helytől már két ugrásra vagyunk. A visszajutás először a legutóbbi,
aztán az eggyel korábbi cím ismerete alapján lehetséges. Az adatokat tehát úgy
kell feljegyezni, hogy amit később irtunk le, arra hamarabb van szükség, amit
legkorábban, arra pedig legutoljára. Ennek az adattárolásnak az angol neve:
LIFO (Last Input, First Output), magyarul: amit utoljára behelyezünk, azt
vesszük ki elsőnek. Ez úgy működik, mint egy verem (Stack), ami a verem alján
van, azt csak akkor tudjuk kivenni a veremből, ha már mindent, amit utána
tettünk bele, már kivettünk. Azt, hogy a verem véges méretű, könnyen
leellenőrizhetjük a következő kis programmal.
Program Verem;
Procedure Ide;
Ide;
End;
Begin
Ide;
End.
Ez a program gyakorlatilag semmit nem tesz, csak
azt, hogy egy rekurzív eljárást hív meg, (amely természetesen most nincs
megfelelően kidolgozva, majd a későbbiekben látunk rekurzív hívásra értelmes és
hasznos megoldásokat is). Mivel állandóan önmagát kell meghívnia, mindig menti
a visszalépési címet, amely olyan gyorsan történik, hogy a program azonnal
leáll Stack Overflow - verem túlcsordulás hibaüzenettel. Ha már itt tartunk,
említsünk meg a másik nevezetes adattárolást és a hozzá kapcsolódó hardware
megoldást. Ez pedig a FIFO (First Input, First Output), magyarul: amit először
behelyezünk, azt vehetjük ki elsőnek. Ez egy csőhöz hasonlítható, amelybe
torlódnak az adatok (mint például a hurkatöltőben a töltelék). Pl.
(szemléletesen) a baloldalon kerülnek be a csőbe az adatok, és jobb oldalon
kerülnek ki a csőből. A számítógépeink mindegyike rendelkezik ilyen elven
működő tárral: ez CACHE memória. Ezt a memóriát a processzor és az operatív tár
közé helyezik. Működési alapelve azon alapszik, hogy ha a processzornak adatra
van szüksége a memóriából, akkor nagyon valószínű, hogy nem csak egy-két
Byte-ra, hanem a memória közeli területéről többre is. Így nem csak a kívánt
adatok indulnak el a gyorsító tárba, hanem több is, akár 512 kb -is, a CACHE
méretétől függően. A CACHE -t ugyanis a processzor sokkal gyorsabban el tudja
érni, mint a RAM-ot. Ezáltal a gép működése felgyorsul.
43.
Írjunk programot, amely bemutatja, hogy maximálishoz közeli statikus tömb
deklarációja után még több, szintén maximális méretű dinamikus tömb
deklarálható és kezelhető a pascal programban.
Program
Din1;
Uses NewDelay,
Crt;
Var A: Integer;
AMut: ^Integer;
STomb: Array[1..800]
Of String[80];
Type
PTomb=^TTomb;
TTomb=Array[1..800] Of String[80];
Var T1,T2,T3,T4:PTomb;
P: Pointer;
Begin
TextMode(CO80);
TextColor(15);
ClrScr;
A:= 123;
A:= 2*A;
WriteLn('A: ',A);
New(AMut);
AMut^:= 777;
AMut^:= 2*AMut^;
WriteLn('AMut^: ',AMut^);
AMut:= @A;
AMut^:= AMut^+4;
WriteLn('A+4: ',A);
AMut:= Nil;
{Sehov sem mutat}
{Dispose(AMut); Ha egy statikus változóra
állitottuk,
már nem szabaditható fel}
New(T1); New(T2); New(T3); New(T4);
T1^[800]:= 'Nagy Medve';
T2^[799]:= T1^[800];
T3^[798]:= T2^[799];
T4^[797]:= T3^[798];
WriteLn('T4^[797]: ',T4^[797]);
WriteLn('Szabad Heap: ',MemAvail,' ,
maxim lis blokk: ',MaxAvail);
Dispose(T1);
WriteLn('Szabad Heap: ',MemAvail,' ,
maxim lis blokk: ',MaxAvail);
Dispose(T2);
WriteLn('Szabad Heap: ',MemAvail,' ,
maxim lis blokk: ',MaxAvail);
Dispose(T3);
WriteLn('Szabad Heap: ',MemAvail,' ,
maxim lis blokk: ',MaxAvail);
Dispose(T4);
WriteLn('Szabad Heap: ',MemAvail,' ,
maxim lis blokk: ',MaxAvail);
ReadLn;
End.
44.
Írjunk programot, amely egy egyszerű láncolt listát kezel. Üres string végjelig
bekér például neveket, majd a beirás sorrendjében kiirja a képernyőre és
folyamatosan felszabadítja a változó területét.
Program
Din2;
Uses NewDelay,
Crt, CrtPlus;
type RecMut=^Rec;
Rec=Record
Nev: String;
Ind: Integer;
KMut: RecMut;
End;
Var ElsoRec,
UjRec, AktRec: RecMut;
S: String;
I: Integer;
Procedure
Felfuz(UjRec: RecMut);
Begin
If
UjRec= Nil Then Exit;
If
ElsoRec= Nil Then Begin ElsoRec:= UjRec; AktRec:= ElsoRec
End
Else
Begin
AktReC^.KMut:= UjRec;
AktRec:= UjRec;
End;
End;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
I := 0;
ElsoRec:= Nil;
Write('Kérem a(z) 1. nevet: ');
ReadLn(S);
While
S<>'' Do
Begin
UjRec:= New(RecMut);
With
UjRec^ Do
Begin
Nev:= S;
Inc(I);
Ind:= I;
KMut:= Nil;
End;
Felfuz(UjRec);
Write('Kérem a(z) ',i+1,'. nevet: ');
ReadLn(S);
End;
WriteLn;
WriteLn('A lista:');
AktRec:= ElsoRec;
While
AktRec <> Nil Do With
AktRec^ Do
Begin
WriteLn(Ind:4,'. ',Nev);
ElsoRec:= AktRec;
AktRec:= KMut;
Dispose(ElsoRec);
End;
Tunj;
Varj;
End.
45.
Írjunk programot, amely kétirányú láncolt listát kezel. Üres string végjelig
bekér például neveket, majd először a beirás sorrendjében, másodszorra pedig
ezzel fordított sorrendben kiirja a képernyőre és folyamatosan felszabadítja a
változó területét.
Program
Din3;
Uses NewDelay,
Crt, CrtPlus;
type RecMut=^Rec;
Rec=Record
Nev: String;
Ind: Integer;
EMut,
KMut: RecMut;
End;
Var ElsoRec,
UjRec, AktRec, UtolsoRec: RecMut;
S: String;
I: Integer;
Procedure
Felfuz(UjRec: RecMut);
Begin
If
UjRec= Nil Then Exit;
If
ElsoRec= Nil Then
Begin
ElsoRec:= UjRec; UtolsoRec:= UjRec; AktRec:= ElsoRec; Exit End
Else
Begin
AktReC^.KMut:= UjRec;
UjRec^.EMut:= AktRec;
UtolsoRec:= UjRec;
AktRec:= UjRec;
End;
End;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
I:= 0;
ElsoRec:= Nil;
Write('Kérem a(z) 1. nevet: ');
ReadLn(S);
While
S<>'' Do
Begin
UjRec:= New(RecMut);
With
UjRec^ Do
Begin
Nev:= S;
Inc(I);
Ind:= I;
EMut:= Nil;
KMut:= Nil;
End;
Felfuz(UjRec);
Write('Kérem a(z) ',i+1,'. nevet: ');
ReadLn(S);
End;
WriteLn;
WriteLn('A lista előre:');
AktRec:= ElsoRec;
While
AktRec<>Nil Do With
AktRec^ Do
Begin
WriteLn(Ind:4,'. ',Nev);
{ElsoRec:= AktRec;}
AktRec:= KMut;
{Dispose(ElsoRec);}
End;
WriteLn;
WriteLn('A lista vissza:');
AktRec:= UtolsoRec;
While
AktRec<>Nil Do With
AktRec^ Do
Begin
WriteLn(Ind:4,'. ',Nev);
UtolsoRec:= AktRec;
AktRec:= EMut;
Dispose(UtolsoRec);
End;
Tunj;
Varj;
End.
46.
Írjunk programot, amely kétirányú rendezett láncolt listát kezel. Üres string
végjelig bekér például neveket, majd először a növekedő sorrendben, másodszorra
pedig csökkenő sorrendben kiirja a képernyőre és folyamatosan felszabadítja a
változó területét.
Program
Din4;
Uses NewDelay,
Crt, CrtPlus;
type RecMut=^Rec;
Rec=Record
Nev: String;
Ind: Integer;
EMut,
KMut: RecMut;
End;
Var ElsoRec,
UjRec, AktRec, UtolsoRec: RecMut;
S: String;
I: Integer;
Procedure
Felfuz(UjRec: RecMut);
Begin
If
UjRec= Nil Then Exit;
If
ElsoRec= Nil Then
Begin ElsoRec:= UjRec; UtolsoRec:= UjRec;Exit
End;
If
ElsoRec = UtolsoRec Then
Begin
If
ElsoRec^.Nev<UjRec^.Nev Then
UtolsoRec:= UjRec Else ElsoRec:=
UjRec;
ElsoRec^.KMut:= UtolsoRec;
UtolsoRec^.EMut:= ElsoRec;
Exit;
End;
AktRec:= ElsoRec;
While
(AKtRec^.Nev<UjRec^.Nev) And
(AktRec<>Nil) Do
AktRec:= AktRec^.KMut;
If
(AktRec<>ElsoRec) And
(AktRec<>Nil) Then
Begin
AktRec^.EMut^.KMut:= UjRec;
UjRec^.EMut:= AktRec^.EMut;
AktRec^.EMut:= UjRec;
UjRec^.KMut:= AktRec;
Exit;
End;
If
AktRec=ElsoRec Then
Begin
ElsoRec^.EMut:= UjRec;
UjRec^.KMut:= ElsoRec;
ElsoRec:=UjRec;
Exit;
End;
If
AktRec=Nil Then
Begin
UtolsoRec^.KMut:= UjRec;
UjRec^.EMut:= UtolsoRec;
UtolsoRec:= UjRec;
End;
End;
Begin
TextMode(CO80);
Szinek(1,15);
ClrScr;
I:= 0;
ElsoRec:= Nil;
Write('Kérem a(z) 1. nevet: ');
ReadLn(S);
While
S<>'' Do
Begin
UjRec:= New(RecMut);
With
UjRec^ Do
Begin
Nev:= S;
Inc(I);
Ind:= I;
EMut:= Nil;
KMut:= Nil;
End;
Felfuz(UjRec);
Write('Kérem a(z) ',i+1,'. nevet: ');
ReadLn(S);
End;
WriteLn;
WriteLn('A lista előre:');
AktRec:= ElsoRec;
While
AktRec<>Nil Do With
AktRec^ Do
Begin
WriteLn(Ind:4,'. ',Nev);
{ElsoRec:= AktRec;}
AktRec:= KMut;
{Dispose(ElsoRec);}
End;
WriteLn;
WriteLn('A lista vissza:');
AktRec:= UtolsoRec;
While
AktRec<>Nil Do With
AktRec^ Do
Begin
WriteLn(Ind:4,'. ',Nev);
UtolsoRec:= AktRec;
AktRec:= EMut;
Dispose(UtolsoRec);
End;
Tunj;
Varj;
End.
Az egér használata
Az
egér egy olyan mutató eszköz, mellyel a számítógép használója beavatkozhat a
program futásának menetébe. A képernyőn megjelenő, az egér jeleit felfogni
képes objektumok reagálnak az egér mozgására, kattintásra, kettős kattintásra
vagy vonszolásra. Így aztán egérrel parancsot adhatunk, menüpontot aktivizálhatunk
vagy átrendezhetjük a felhasználói képernyőt. Ebben a fejezetben a karakteres
képernyőn megjelenő egér lehetőségeivel ismerkedünk meg. Az egérkurzor egy
téglalap, melynek egy karakternyi a mérete. Minden karakterhely fölé odavihető,
bekapcsolt állapotban és jól működő program esetén mindig látható. Az egér
használatához szükség van: természetesen egy egérre, egy meghajtó programra,
amelyet az operációs rendszernek kell installálni. Szükség van továbbá egy
olyan programcsomagra, amely esetünkben a Pascal nyelven belül megfogalmazza az
egér megjelenésével és lekérdezésével kapcsolatos eljárásokat és függvényeket.
Megtehetnénk, hogy ez utóbbi Unit-ot saját magunk megírjuk, de a Pascal
nyelvben már van egy egység, amely ezeket tartalmazza, ezért mi ezt fogjuk
használni. Ennek az egységnek a neve Drivers. Programjainkban ezt az egységet
is használatba kell venni, ha egeret szeretnénk használni.
Nézzük a Drivers Unit egérkezelő
függvényeit és eljárásait. Mivel a Drivers a Pascal nyelv Turbo Vision részéhez
tartozik, néhány szót erről is kell ejtenünk. A Turbo Vision segítségével olyan
felépítésű programokat írhatunk, mint amilyen az IDE. Teljesen objektum orientált,
eseményvezérelt, ablaktechnikára épülő, menüvezérelt programokat. A
későbbiekben, csak néhány program erejéig, megismerkedünk a Turbo Vision
lehetőségeivel is. A Drivers egység tartalmazza a Turbo Vision eseménykezelő
eljárásait és függvényeit, amelyet szintén használni fogunk. Nézzük akkor első
egérkezelő programunkat.
47.
Írjunk programot, amely bemutatja az egér működését programban. Kérdezzük le az
egér koordinátáit, vezessük egérrel az írókurzort, kattintással rakjunk
csillagokat a képernyőre, majd pedig írjuk minden pillanatban a képernyőre
az egér összes állapotát. Végül a Menu
függvényünket (CrtPlus) tanítsuk meg az egér használatára.
Első lépésként tehát a Drivers egységet
használatba kell venni. Egeret használó programunk első eljáráshívása az
InitEvents, amely inicializálja az eseménykezelőt. Második a ShowMouse, amely
az egeret jeleníti meg. Ha csak ennyi lenne a programunkban (és egy végtelen
ciklus), akkor az egér már látható lenne a képernyőn. Az egér képernyő
koordinátáit a MouseWhere rekord tartalmazza. Ennek a rekordnak két mezője van,
az x és az y, és az egér helyének két koordinátáját tartalmazza. Ez állandóan
frissül, csak az a feladatunk, hogy programjainkban lekérdezzük. Ez látható a
programunk első szakaszában. Ha megfigyeljük a futtatás eredményét,
megállapíthatjuk, hogy a GoToXY eljárással a koordináták nincsenek szinkronban.
A képernyő első helyének két egér koordinátája (0,0), az utolsóé (79,24). Ha a
MouseWhere két koordinátája alapján szeretnénk a kurzort vezérelni, akkor
mindkettőhöz egyet hozzá kell adni. Ez látható a második szakaszban. A harmadik
szakasz az egérkattintásra figyel. A MouseButtons függvény értéke
evMouseDown
= Gomb lenyomva.
evMouseUp = Gomb felengedve.
evMouseMove
= Az egér elmozdult.
eMouseAuto = Az egér lenyomott gombbal mozog.
evNothing = Nincs esemény.
Program
EgerDemo;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Esemeny:
TEvent;
Mp: Byte;
Begin
TextMode(CO80);
InitEvents; ShowMouse; Szinek(1,15);
ClrScr; WriteXY(1,1,'Első szakasz');
Repeat
With MouseWhere do Begin GotoXY(37,1);
Write(x:3,y:3) End;
Until
Keypressed;
ClrScr; WriteXY(1,1,'Második szakasz');
KeyEmpty;
Repeat
GotoXY(MouseWhere.x+1,MouseWhere.y+1)
Until
KeyPressed;
ClrScr; WriteXY(1,1,'Harmadik szakasz');
Gotoxy(1,1); KeyEmpty;
Repeat
If
MouseButtons=1 then
Begin
WriteXY(MouseWhere.x+1,MouseWhere.y+1,'*');
GotoXY(WhereX-1,WhereY);
End;
Until
KeyPressed;
ClrScr; WriteXY(1,1,'Negyedik szakasz');
KeyEmpty;
Repeat
GetMouseEvent(Esemeny);
Case
Esemeny.What Of
evMouseDown: Begin
WriteXY(1,9,'Gomb
lenyomva ');
If Esemeny.Double Then
WriteXY(1,13,'Dupla
kattintás ');
If Not Esemeny.Double Then
WriteXY(1,13,'Szimpla
kattintás');
End;
evMouseUp
: WriteXY(1,9,'Gomb felengedve
');
evMouseMove: Begin
WriteXY(1,10,'Egér
elmozdult ');
gotoxy(20,1);
Write(MouseWhere.X:4,MouseWhere.Y:4);
End;
evMouseAuto: begin
WriteXY(1,10,'Lenyomott
gombbal mozog');
gotoxy(20,1);
Write(MouseWhere.X:4,MouseWhere.Y:4);
end;
evNothing
: WriteXY(1,11,'Nincs esemény
');
End;
Case
Esemeny.Buttons of
mbLeftButton: WriteXY(1,12,'Bal gomb
lenyomva ');
mbRightButton:WriteXY(1,12,'Jobb gomb
lenyomva');
End;
Until
KeyPressed;
ClrScr; WriteXY(1,1,'Ötödik szakasz');
KeyEmpty;
Tomb[1]:=' Első ';
Tomb[2]:=' Második ';
Tomb[3]:=' Harmadik ';
Tomb[4]:=' Vége ';
For
Mp:=1 to 4 do SzTomb[Mp]:=Mp;
Ablak(7,0,34,8,47,13,True,'Menű');
For
Mp:=1 to 4 Do WriteXY(36,8+Mp,Tomb[Mp]);
Mp:=Menu(7,0,Green,36,9,10,4,1); Writexy(1,24,Tomb[Mp]);
Tunj; Varj;
End.
Ahhoz hogy programunk ötödik szakasza működjön, azaz a
Menu függvényünk megértse az egér üzeneteket, egy kicsit ki kell bővítenünk.
Ehhez töltsük be a CrtPlus-t, és javítsuk ki a következőképpen. A CrtPlus-ban is
használatba kell venni a Drivers Unit-ot. Fel kell venni egy Esemeny nevű
Tevent típusú lokális változót a Menu függvényben.
function
menu(hsz,ksz,vsz,bfx,bfy,sh,ss,as:byte):byte;
var i:integer;
ch:char;
Esemeny: TEvent;
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;
Lényegében csak az elején, a ch:= readkey
karakterbeolvasás helyett kellett az egéresemény kezelésével kapcsolatos
sorokat megírnunk. A függvény végtelen ciklusába bekerült az egéresemény-bekérő
eljárás, valamint a programot megállító ch:= readkey helyett, az If Keypressed
Then ch:= Readkey sor került, mely billentyűesemény hiányában szintén nem áll
meg. Ez a megoldás biztosítja azt, hogy a függvény mindkét eseményt kezelni
tudja. Egeret használó programokban megfigyelhetjük azt, hogy a parancs
végrehajtása nem a kattintás pillanatában, hanem az egérgomb elengedésekor
hajtódik végre. Ezt szolgálja az Exit sor előtti While MouseButtons=1 Do; üres
ciklus. A Menu a visszaadott értékét az egér helykoordinátáiból állapítja meg.
Programokban gyakran
találkozunk nyomógombbal, amelynek segítségével, egérrel is tudunk parancsot
adni, funkciót aktivizálni. Készítsünk olyan általánosan használható
nyomógombot, mely megjelenésében és működésében a legjobban hasonlít az IDE
nyomógombjaihoz. Tegyük alkalmassá arra, hogy a nyomógomb funkcióját
billentyűzetről és egérrel is aktivizálhassuk. A nyomógombot a CrtPlus-ban
fogjuk deklarálni. Ehhez szükség van egy gombrekordra, amely a gomb típusát
(arra gondolva, hogy nemcsak nyomógomb lehet), helyét, méretét és forró
billentyű karakterét fogja tartalmazni.
Type GombRec= Record
tip:byte;
gx,gy,gsh:byte;
End;
A képernyőre egy időben több nyomógomb, illetve
olyan látvány is kikerülhet, amelynek ugyanilyen paraméterei lehetnek, illetve
képesek az egérre és a billentyűzetre egyaránt reagálni. Ezek maximális száma
legyen gtmax=64. A gombrekordokat egy tömbben fogjuk tárolni. Ezért a deklarációk
a következők:
Const gtmax=64;
Var GombT:array[1..gtmax] of GombRec;
GombIndex:byte;
A gombindex a képernyő felépülése közben
inkrementálódik, azaz tartalmazza a képernyőn látható nyomógombok számát. Lesz
egy gombkereső eljárásunk, amely maximálisan eddig az indexig fogja keresni azt
a gombot (vagy egyéb egérkezelésre alkalmas látványt), amelyen a kattintás
történt. A gomb paraméterei: háttérszín, karakterszín, választószín (a forró
billentyű karakterszíne), kezdőhely x koordináta és y koordináta, a gomb hossza
és a gomb felirata. A felirat tartalmazhat egy tilde jelet, mely nem kerül
megjelenítésre, és a tilde jel utáni karakter lesz a forró billentyű jele. A
nyomógomb kattintás hatására benyomódik, a fekete árnyéka eltűnik, a címke
jobbra tolódik, elengedéskor az eredeti látvány áll vissza. A gomb eljárás a
megjelenésért és a regisztrálásért felelős.
Procedure
gomb(hsz,ksz,vsz,x,y,sh:byte;s:string);
Begin
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;
End;
A fenti listában található egy AltKod tömbre
való hivatkozás. Ez a táblázat kapcsolja össze az egér kezelésére alkalmassá
tett elem címkéjében megjelenő karaktert a billentyűzetről alt kód segítségével
beírt karakterrel, mint paranccsal. Azaz, ettől kezdve teljesen mindegy, hogy a
Case szerkezet számára a szelektor érték honnan származik, és így csak egy
szakaszt kell a végrehajtó szakaszban egy parancshoz megírni. Íme a kérdéses
tömb.
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);
A gomb forró billentyűjének megkeresését a
gombkereső végzi el. Szüksége van arra a helyre, amelyen az egérrel kattintottak.
Visszaadott értéke a kulcs karakter. Végignézi a regisztrált gombokat, megnézi,
hogy a kattintás melyiken történt, és visszaadja a Key mező tartalmát. A repeat
until ciklus addig állítja meg a programot, ameddig lenyomva tartjuk az egér
gombját. Az egyszerű nyomógomb típusa 1, tehát ha ennél nagyobb a típus-érték,
akkor a függvényből kilépünk, ha viszont nyomógombon történt a kattintás, akkor
a nyomógombnak be kell nyomódnia, ahogy azt fentebb már leírtuk. Ennek a
látványnak a megírását tartalmazza a függvény további része.
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;
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;
Repeat Until MouseButtons<>1;
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;
Exit;
End;
End;
48.
Írjunk programot, amely a fentebb megírt nyomógombot teszteli. A fehér
képernyőn jelenjen meg két nyomógomb. Az egyik felirata legyen Irjál, a másiké
Vége. Ha az Irjál feliratú gombot megnyomjuk, akkor a program a képernyő
véletlen helyére véletlen színnel, két véletlen karaktert jelenít meg, egy
nagybetűt és egy számjegyet. A másik gomb megnyomására fejeződjön be a program.
A két forró billentyű az I és a V.
A program a véletlen karaktermegjelenítést az
Irogat eljárás végzi. A főprogram először a látvány létrehozását végzi el.
Kialakítja a hátteret, kirakja a két nyomógombot, eltünteti a kurzort,
inicializálja az eseménykezelőt és a véletlen-szám generátort, majd megjeleníti
az egérkurzort. Majd a program egy végtelen repeat ciklusba kezd. Ha nincs sem
billentyű- sem egéresemény, akkor megáll. Ha megnyomtuk a billentyűzetet, akkor
beolvassa a ch változóba a karaktert. A program végrehajtó része a ch által
vezérelt többszörös elágazás. A ch a billentyüzet Alt-kódját várja, azaz az
írást Alt+I-vel, a végét Alt+V-vel lehet aktiválni. Gyakran a programból való
kilépésre, úgy mint az IDE esetén, Alt+X-et használják. Programjainkban mi is
így fogunk eljárni, ezért a kilépés Alt+X-szel is elérhető.
Program GombPro;
Uses NewDelay, Crt, CrtPlus, Drivers;
Var Ch: char;
Procedure Irogato;
Begin
Szinek(7,Random(16));Writexy(random(79)+1,Random(25)+1,
chr(Random(26)+65)+chr(Random(10)+48));tunj;
Begin
TextMode(CO80);
Szinek(7,0); ClrScr;
Gomb(2,0,14,10,5,7,'~Irj l'); Gomb(2,0,14,20,10,6,'~Vége');
Tunj; InitEvents; Randomize; ShowMouse;
Repeat
while
(not keypressed) and (MouseButtons<>1) do;
If
Keypressed Then Ch:=Readkey;
If
MouseButtons=1 then
Ch:=
GombKereso(MouseWhere.x+1,MouseWhere.y+1);
Case
Ch Of
#23: Irogato;
#45,#47: Halt;
End;
Until
False;
End.
Mivel a továbbiakban
hasonló felépítésű programokat fogunk írni, készítsünk el egy olyan
alap-képernyőt, amely az üres IDE-hez nagyon hasonlít, lehessen a programból
kilépni, azaz legyen a nyomógombhoz hasonló felülete és forró billentyűje. Az
üres IDE-t DeskTop-nak nevezi a Pascal rendszer, nevezzük mi is így. A látványt
a CrtPlus-ban kódoljuk le.
De mielőtt ebbe
belekezdenénk, néhány egyszerű, a képernyőn való műveletekkel kapcsolatos
eljárást és függvényt kell megírnunk, természetesen szintén a CrtPlus-ban, ezek
a Töröl, a Tölt az Olvas és az ÍrXY modulok. A töröl egy egysoros téglalapot
töröl a képernyőn. A tölt egy egysoros téglalapot tölt fel megadható
karakterrel. Az olvas a képernyő egy egysoros téglalapján lévő karakterekből
egy stringet készít, és ezt adja vissza. Az ÍrXY a képernyő egy adott helyére
megadható szöveget kiír úgy, hogy közben az ottani színek nem változnak meg,
azaz nem használja a Write aktuális színeit.
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
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;
Íme a DeskTop modul:
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;
Ezek
után az Alap program listája a következő:
Program
Alap;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Ch:
Char;
Begin
TextMode(CO80);
DeskTop;
Repeat
While
(Not Keypressed) And (MouseButtons<> 1) Do;
If
KeyPressed Then Ch := ReadKey;
If
MouseButtons= 1 Then
Ch:= GombKereso(MouseWhere.X+1,
MouseWhere.Y+1);
Case
Ch Of
#45: Halt;
End;
Until
False;
End.
Minden
új programot úgy kezdhetünk írni, hogy ezt betöltjük, az új program nevével
kimentjük lemezre és már javíthatjuk, bővíthetjük új programunkat. Ehhez
legtöbb esetben a Case szakaszt kell bővíteni, illetve a DeskTop után a látványokat
a képernyőre kell helyezni.
49. Írjunk programot, amely
a képernyőn megjeleníti a DeskTop-ot egy elég nagy címkés ablakkal, rajta két
beviteli mezőt, egyikben egy számértéket, a másikban egy növekmény lehessen
beírni. Legyen a képernyőn továbbá négy nyomógomb a következő funkciókkal. Az
első növeli az értéket a léptékkel, a második csökkenti, a harmadik törli
mindkét beviteli mezőt, a negyedikkel kiléphetünk a programból.
Mielőtt
e programot megírnánk, meg kell írni még két dolgot. Az egyik a CrtPlus Bevitel
függvényének az egérkezelését, valamint egy InputLine látványt. Kezdjük az
elsővel.
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;
A függvényben az aláhúzott részek oldják meg azt, hogy
kattintásra a Bevitel függvény elhagyható. A második egy InpuLine megírása. Az
InputLine egy beviteli mezőből és egy címkéből áll. A címke a beviteli sor
felett van, a befogadó dobozban érvényes színeket nem feszi figyelembe. Ezeket
a színeket tehát körültekintően adjuk meg. A címke a doboz területén van, és rendelkezik
forró billentyűvel. Az InputLine 2-es típusú egeres látvány.
Function
InputLine(dhsz,dksz,dvsz,hsz,ksz,x,y,sh:byte;
s:string):String;
Var i,kh:byte;
Begin
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;
End;
Az InputLine paraméterei: a befogadó doboz
háttérszíne, a befogadó doboz karakterszíne, a címke választószíne, a beviteli
sor háttérszíne, a beviteli sor karakterszíne, a beviteli sor kezdőhelye (x,y)
és hossza, a címke szövege, visszaadott érték String, amelyet most még nem
használunk ki.
Ezek után a léptető program kódja:
Program
Lepteto;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Ch:
Char;
ErtekSt, LeptekSt: String;
Ertek, Leptek: Longint;
Kod: Integer;
Begin
TextMode(CO80);
DeskTop;
Ablak(7,15,15,5,65,20,True,'Léptető');
InputLine(7,0,14,1,15,25,7,8,'Érté~k:');
InputLine(7,0,14,1,15,50,7,8,'~Lépték:');
Gomb(2,0,14,36,7,10,'~Növel');
Gomb(2,0,14,36,9,10,'~Csökkent');
Gomb(2,0,14,36,11,10,'~Töröl');
Gomb(2,0,14,36,15,10,'~Vége');
Ertek:= 0; Leptek:= 0; Tunj;
Repeat
While
(Not Keypressed) And (MouseButtons<> 1) Do;
If
KeyPressed Then Ch := ReadKey;
If
MouseButtons= 1 Then
Ch:= GombKereso(MouseWhere.X+1,
MouseWhere.Y+1);
Case
Ch Of
#37: Val(Bevitel(1,15,25,7,8), Ertek,
Kod);
#38: Val(Bevitel(1,15,50,7,8), Leptek,
Kod);
#49: If
Leptek<>0 Then
Begin
Inc(Ertek, Leptek); Str(Ertek,
ErtekSt);
Torol(25,7,8); IrXY(25,7,ErtekSt);
End;
#46: If
Leptek<>0 Then
Begin
Dec(Ertek, Leptek); Str(Ertek,
ErtekSt);
Torol(25,7,8); IrXY(25,7,ErtekSt);
End;
#20: Begin
Ertek:= 0; Leptek:=0;
Torol(25,7,8); Torol(50,7,8);
End;
#45,
#47: Halt;
End;
Until
False;
End.
50. Írjunk programot, amely két beviteli és
egy kimeneti InpuLine-al rendelkezik. Az két beviteli mezőbe beírhatunk két
számot. A kimeneti mező értékét a következő funkciójú gombok állíthatják: a két
szám összege, a két szám különbsége, a két szám szorzata, a két szám hányados,
a két szám számtani közepe és a két szám mértani közepe. Legyen nyomógomb a
program elhagyására is.
Új dolgokra már nincs szükség a CrtPlus-ban. A program
listája a következő:
Program
Muvelet;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Ch:
Char;
a,b,c:real;
kod:integer;
ws:string;
Begin
TextMode(CO80);
DeskTop;
Ablak(7,15,4,3,76,22,true,'Műveletek:');
InputLine(7,15,14,1,15,18,6,10,'''~A''
szám:');
InputLine(7,15,14,1,15,18,9,10,'''~B''
szám:');
InputLine(7,15,14,1,15,18,15,10,'
~Eredmény:');
Gomb(2,0,14,40,5,23,'A két szám öss~zege');
Gomb(2,0,14,40,8,23,'A két szám
~különbsége');
Gomb(2,0,14,40,11,23,'A két szám szorza~ta');
Gomb(2,0,14,40,14,23,'A két szám
~hányadosa');
Gomb(2,0,14,40,17,23,'~Számtani közepük');
Gomb(2,0,14,40,20,23,'~Mértani közepük');
Gomb(2,0,14,18,20,6,'~Vége');
tunj;
Repeat
while
(not keypressed) and (MouseButtons<>1) do;
If
Keypressed Then Ch:=Readkey;If MouseButtons=1 Then
ch:=
GombKereso(MouseWhere.x+1,MouseWhere.y+1);
val(validst(olvas(18,6,10)),a,kod);
val(validst(olvas(18,9,10)),b,kod);
Case
Ch Of
#30: Bevitel(1,15,18,6,10);
#48: Bevitel(1,15,18,9,10);
#44: c:=a+b;
#37: c:=a-b;
#20: c:=a*b;
#35: if
b<>0 then c:=a/b else ws:=' Error';
#31: c:=(a+b)/2;
#50: if
a*b>=0 then c:=sqrt(a*b) else ws:=' Error';
#47,
#45: halt;
End;
if
ws<>' Error'then str(c:10:4,ws);
While
ws[length(ws)]='0' do
ws:=copy(ws,1,length(ws)-1);
If
ws[length(ws)]='.' then
ws:=copy(ws,1,length(ws)-1);
torol(18,15,10);irxy(28-length(ws),15,ws);
Ws:='';
Until
False;
Tunj;
Varj;
End.
51. Írjunk programot, amely
zsebszámológépet jelenít meg. Legyen nyomógomb a kikapcsolásra, minden adat
törlésére, a kijelző törlésére, tudja a négy alapműveletet és előjelváltást.
A gombok elhelyezését és címkézését,
ahol lehetett for ciklussal oldottuk meg. Az eddigieknél egy kicsit
összetettebb listát kaptunk, de a feladat sem egyszerű.
Program
ZsebSzam;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var I : Byte; Ch, MCh : Char;
os,as : Real; ws : String;
Kod
: Integer; Volt, Elso, Vege,
Hiba : Boolean;
Begin
TextMode(CO80);
Szinek(3,0);ClrScr;
Ablak(7,15,25,4,53,18,True,'Zsebszámológép');
InputLine(7,0,14,1,15,27,6,24,'E~redmény:');
Gomb(2,0,14,27,8,5,'~OFF');Gomb(2,0,14,34,8,5,'C~LR');
Gomb(2,0,14,41,8,5,'C~E');
Gomb(2,0,14,48,8,3,'~+');
For
I:=1 To 9 Do
Gomb(2,0,14,((I-1) Mod 3)*7+27,
((I-1) Div 3)*2+10,3,'~'+chr(48+I));
Gomb(2,0,14,48,10,3,'~-');Gomb(2,0,14,48,12,3,'~*');
Gomb(2,0,14,48,14,3,'~/');Gomb(2,0,14,27,16,3,'~0');
Gomb(2,0,14,34,16,3,'~.');Gomb(2,0,14,41,16,3,'~S');
Gomb(2,0,14,48,16,3,'~=');
InitEvents;ShowMouse;Tunj;
Elso:=True;Vege:=False;Hiba:=false;
Repeat
while
(not keypressed) and (MouseButtons<>1) do;
If
Keypressed Then Ch:=Readkey; If MouseButtons=1 then
Ch:=GombKereso(MouseWhere.x+1,MouseWhere.y+1);
Case
Ch Of
#18: Torol(27,6,24);
#19: Bevitel(1,15,27,6,24);
#120..#129: Begin
If Vege Then
Begin Vege:=False; Torol(27,6,24) End;
I:=27;
While (BKep[6,I,1]<>32)and(I<50)do Inc(I);
If ch=#129 Then
BKep[6,I,1]:=Ord(Ch)-81
Else BKep[6,I,1]:=Ord(Ch)-71;
End;
#46,#48..#57: Begin
If Vege Then
Begin Vege:=False; Torol(27,6,24) End;
I:=27;Volt:=false;
While (BKep[6,I,1]<>32) and
(I<50) do
Begin
If BKep[6,I,1]=46 then
volt:=true;Inc(I)
End;
If (Ch<>#46) or (Not Volt) Then
BKep[6,I,1]:=Ord(Ch);
End;
#38: Begin Torol(27,6,24);os:=0 End;
#31: Begin
If Bkep[6,27,1] in
[48..57,46] Then
Begin
For I:=50 downto 28 do
Bkep[6,i,1]:=Bkep[6,i-1,1];
Bkep[6,27,1]:=32;
end;
If Bkep[6,27,1]=32 then
Bkep[6,27,1]:=45
else
If Bkep[6,27,1]=45 Then
Bkep[6,27,1]:=43
else
If Bkep[6,27,1]=43 Then
Bkep[6,27,1]:=45;
End;
#13,#61,
#42,#43,
#45,#47: Begin
ws:=ValidSt(Olvas(27,6,24));
Val(Ws,As,Kod);
Torol(27,6,24);
If
Elso Then
Begin os:=as;elso:=false;MCh:=ch End Else
Begin
Case Mch of
#42:os:=os*as;
#43:os:=os+as;
#45:os:=os-as;
#47:If as=0 then
Begin
IrXY(46,6,'Error'); Hiba:=true;
End else os:=os/as;
End;
MCh:=ch;
End;
If MCh in [#13,#61] Then
Begin
If not hiba then
Begin
Str(Os:24:6,ws);
While ws[length(ws)]='0' do
ws:=copy(ws,1,length(ws)-1);
If ws[length(ws)]='.' then
ws:=copy(ws,1,length(ws)-1);
IrXY(50-Length(ws),6,ws);
End;
Os:=0;Vege:=true;
Elso:=True;Hiba:=false;MCh:=#0;
End;
End;
#27,#24: Halt;
End;
Ch:=#0;
Until
False;
End.
52. Írjunk egy kis egyszerű
játékprogramot. A játék lényege: a gép véletlen számértékeket mutat 1-től 6-ig
(kockadobás). A játékos minden dobás után tippelhet, vajon a következő véletlen
szám a mutatotthoz képest milyen lesz: kisebb, nagyobb vagy egyenlő. Ha
eltalálta, akkor pontjai eggyel nőnek, ha nem, akkor a gép pontjai nőnek
eggyel. Ha sikerül a játékosnak előbb elérni a 10-et akkor nyer, ha a gépnek
akkor veszít. Az állást folyamatjelző jelezze a képernyőn.
A program kódja semmi újat nem tartalmaz.
Program
Talalo;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Ch:
Char;
a, b, t, n: byte;
Ws: String;
St, Vege: Boolean;
Procedure
Start;
Begin
t:= 0; n:= 0; St:= True; Vege:= False;
Szinek(7,15);
WriteXY(37,13,'Talált:');
Szinez(7,1,37,14,10);
Tolt(37,14,10,chr(176)); WriteXY(37,16,'Nem
talált:');
Szinez(7,1,37,17,10);
Tolt(37,17,10,chr(176));
Torol(55,15,13);
Torol(10,8,12);Torol(55,8,12);
Tunj;
End;
Begin
TextMode(CO80);DeskTop;
Ablak(7,15,4,3,75,22,True,'Találó');
InputLine(7,15,13,1,15,10,8,12,'Az ''A''
szám:');
InputLine(7,15,13,1,15,55,8,12,'A ''B'' szám:');
Gomb(2,0,14,34,6,14,'~Kisebb mint');
Gomb(2,0,14,34,8,14,'~Egyenlő');
Gomb(2,0,14,34,10,14,'~Nagyobb mint');
Gomb(2,0,14,22,20,7,'~Start');
Gomb(2,0,14,55,20,7,'~Vége'); Start; St:=
False; Randomize;
Repeat
while
(not keypressed) and (MouseButtons<>1) do;
If
Keypressed Then Ch:= Readkey; If MouseButtons=1 Then
ch:=
GombKereso(MouseWhere.x+1,MouseWhere.y+1);
Case
Ch Of
#31: Begin
Start; A:=Random(6)+1; Str(A,Ws); IrXY(11, 8, Ws)
End;
#37: If
Not Vege Then
Begin
St:=False;B:=Random(6)+1;Str(B,Ws);IrXY(56,8,Ws);
If A<B Then
Begin inc(t);IrXY(36+t,14,Chr(219))End Else
Begin inc(n);
IrXY(36+n,17,Chr(219)) End;
End;
#18: If
Not Vege Then
Begin
St:=False;B:=Random(6)+1;Str(B,Ws);IrXY(56,8,Ws);
If A = B Then
Begin inc(t); IrXY(36+t,14,Chr(219)) End Else
Begin inc(n); IrXY(36+n,17,Chr(219)) End;
End;
#49: If
Not Vege Then
Begin
St:=False;B:=Random(6)+1;Str(B,Ws);IrXY(56,8,Ws);
If A > B Then
Begin inc(t); IrXY(36+t,14,Chr(219)) End Else
Begin inc(n); IrXY(36+n,17,Chr(219)) End;
End;
#45,
#47: halt;
End;
If
Ch<>#0 Then
Begin
If
(T=10) Or (N=10) Then Vege:=True;
If
(Not St) And (Not Vege) Then
Begin
Delay(1000);A:=Random(6)+1;
Str(A,Ws);IrXY(11, 8, Ws);
Torol(55,8,10); Duda;
End;
If
Vege Then
Begin
Szinek(7,Blink);
If
T=10 Then
WriteXY(55,15,'Nyertél!!!')
Else
WriteXY(55,15,'Vesztettél!!!'); Tunj;
End;
End;
Until
False;
End.
53. Írjunk labdatartást folyamatosan számoló és
kijelző programot.
Ebben
a kódlistában egyetlen új dolog található. Mégpedig az, hogy ha nincs sem egér,
sem billentyűzet esemény, akkor is számolnia kell az eltelt időt, ezért az
eddigi while (not keypressed) and
(MouseButtons<>1) do szakasz
most nem lesz üres. Itt történik a számolás és a kijelzés.
Program
Labda;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Var Ch:
Char;
Anal: Boolean;
a, as, b, bs, n: Longint;
wsa, wsb: String;
Begin
TextMode(CO80); DeskTop;
Ablak(7,0,15,4,65,21,True,'Labdatartást
figyelő program');
InputLine(7,0,14,1,15,26,7,8,'A Csapat');
InputLine(7,0,14,1,15,46,7,8,'B Csapat');
Gomb(2,0,14,25,12,10,'~A Csapat');
Gomb(2,0,14,45,12,10,'~B Csapat');
Gomb(2,0,14,38,18,6,'~Vége');
Tunj;
Anal:= True;
Repeat
while
(not keypressed) and (MouseButtons<>1) do
Begin
Inc(n);
If
Anal Then
Begin
IrXY(32,10,'A-nál van a labda'); Inc(a) End
Else
Begin IrXY(32,10,'B-nél van a
labda'); Inc(b) End;
Str(Round(100*a/n):4,Wsa);
IrXY(26,7,Wsa+'%');
Str(Round(100*b/n):4,Wsb);
IrXY(46,7,Wsb+'%');
End;
If
Keypressed Then Ch:= Readkey;
If
MouseButtons=1 Then
ch:=
GombKereso(MouseWhere.x+1,MouseWhere.y+1);
Case
Ch Of
#30: Anal:= True;
#48: Anal:= False;
#45,
#47: halt;
End;
Until
False;
End.
54. Írjunk egy tipizált
lemezes állományt kezelő programot, például a Pascal nyelv nyelvi elemeinek
tárolására. Tároljunk kulcsszavakat, típusukkal együtt, jelezzük milyen
egységben találhatók, írjunk rá mintapéldát és magyarázatot. Az állományon
lehessen mozogni, lehessen beszúrni, törölni és javítani. Az aktuális rekord
mindig jelenjen meg a képernyőn.
Program
Help;
Uses
NewDelay, Crt, CrtPlus, Drivers;
Type
HelpRec= Record
Kulcsszo: String[20];
Tipus: String[10];
Egyseg: String[10];
Minta: String[64];
Megjegy: String[64];
End;
Var Ch : Char;
ARec, PRec : HelpRec;
FNev
: File Of HelpRec;
DNev
: String;
I, RS, AS
: Integer;
Ws,WW
: String;
Procedure
KezdoKep;
Begin
Ablak(7,15,4,3,74,22,True,
'Turbo Pascal Help-file kezelő
program');
InputLine(7,15,14,1,15,7,6,20,'~A keresett kulcsszó:');
InputLine(7,15,14,1,15,7,9,10,'~Típusa:');
InputLine(7,15,14,1,15,7,12,10,'~Unit:');
InputLine(7,15,14,1,15,7,15,64,'~Példa:');
InputLine(7,15,14,1,15,7,18,64,'~Megjegyzés:');
InputLine(7,15,14,1,15,61,6,10,'Index:');
Gomb(2,0,14,7,20,11,'~Következő');
Gomb(2,0,14,21,20,7,'~Előző');
Gomb(2,0,14,31,20,8,'~Beszúr');
Gomb(2,0,14,42,20,7,'~Javít');
Gomb(2,0,14,52,20,7,'Tö~röl');
Gomb(2,0,14,64,20,6,'~Vége');
End;
Procedure
AdatTorles;
Begin
Torol(7,6,20);Torol(7,9,10);Torol(7,12,10);
Torol(7,15,64);Torol(7,18,64);
End;
Procedure
AdatKepre;
Begin
AdatTorles;
With
ARec Do
Begin
IrXY(7,6,Kulcsszo);IrXY(7,9,Tipus);IrXY(7,12,Egyseg);
IrXY(7,15,Minta);IrXY(7,18,Megjegy);
End;
End;
Procedure
AdatKeprol;
Begin
With
ARec Do
Begin
Kulcsszo := ValidSt(Olvas(7,6,20));
Tipus := ValidSt(Olvas(7,9,10));
Egyseg
:= ValidSt(Olvas(7,12,10));
Minta := ValidSt(Olvas(7,15,64));
Megjegy
:= ValidSt(Olvas(7,18,64));
End;
End;
Procedure
Lemezrol;
Begin
DNev:='Turbo.shl';Assign(FNev,DNev);{$I-}Reset(FNev);{$I+}
If
IOResult<>0 Then
RewRite(Fnev);RS:=FileSize(FNev);
AS:=0; If
RS>0 Then Begin Seek(FNev,AS);Read(Fnev,ARec) End;
End;
Begin
TextMode(CO80);DeskTop; KezdoKep; Lemezrol;
AdatKepre; Tunj;
Repeat
Str(RS,WS);Str(AS,WW);
IrXY(61,6,Copy(WW+'/'+WS+' ',1,10));
while
(not keypressed) and (MouseButtons<>1) do;
If
Keypressed Then
Begin
Ch:=Readkey;If ch=#0 Then Ch:=ReadKey End;
If
MouseButtons=1 Then
ch:= GombKereso(MouseWhere.x+1,MouseWhere.y+1);
With
ARec Do
Case
Ch Of
#30:Kulcsszo:= Bevitel(1,15,7,6,20); {Kulcsszó}
#20:Tipus := Bevitel(1,15,7,9,10); {Típus}
#22:Egyseg := Bevitel(1,15,7,12,10); {Unit}
#25:Minta := Bevitel(1,15,7,15,64); {Példa}
#50:Megjegy :=
Bevitel(1,15,7,18,64); {Megjegyzés}
#73,
#37:If
AS<RS-1 Then {Következő}
Begin
Inc(AS);Seek(FNev,AS);Read(Fnev,ARec);AdatKepre
End
Else
Begin AdatTorles;If AS<RS Then Inc(AS) End;
#81,
#18:If
AS>0 Then {Előző}
Begin
Dec(AS);Seek(FNev,AS);Read(Fnev,ARec);Adatkepre
End;
#13,
#48:If
ValidSt(Olvas(7,6,20))<>'' Then
{Beszúr}
Begin
AdatKeprol;
If (RS=0) Or (AS=RS) Then Write(FNev,ARec)
Else
If AS=RS-1 Then
Begin
Read(FNev,PRec);Write(FNev,PRec);Seek(FNev,AS);
Write(FNev,ARec);Inc(RS);
End
Else
If AS<RS-1 Then
Begin
For I:=RS DownTo AS+1 Do
Begin
Seek(FNev,I-1);
Read(FNev,PRec);
Write(FNev,PRec)
End;
Seek(FNev,AS);Write(FNev,ARec);Seek(FNev,AS);
End;
Inc(RS);
End;
#36:If
ValidSt(Olvas(7,6,20))<>'' Then
{Javˇt}
Begin
AdatKeprol;Seek(FNev,AS);Write(Fnev,ARec)
End;
#19:If
Kerdezo(5,15,' Valóban törölni
akarja az aktuális
rekordot? ')
Then
If RS>0 Then {Töröl}
Begin
If RS=1 Then
ReWrite(FNev)
Else
If AS=RS Then Inc(RS)
Else
If AS=RS-1 Then
Truncate(FNev)
Else
If AS<RS-1 Then
Begin
For I:=AS+1 To RS-1 Do
Begin
Seek(FNev,I);Read(FNev,PRec);
Seek(FNev,I-1);Write(FNev,PRec);
End;
Seek(FNev,RS-1);Truncate(FNev);
If AS=RS then Dec(AS);
Seek(FNev,AS);Read(FNev,ARec);
AdatKepre;Seek(FNev,AS);
End;
Dec(RS);If RS=0 Then AdatTorles;
End;
#47,
#45: Begin
Close(FNev);Szinek(0,7);ClrScr;halt End;
End;
Tunj;
Until
False;
End.
55. Készítsünk Turbo
Vision segítségével szótár programot.
Program
Szotar5;
Uses App,
Drivers, Objects, Menus, Views, Dialogs;
Const
cmSzotarDialogus= 100;
cmSzoItemFocused= 101;
cmASzoBeiro = 102;
cmMSzoBeiro = 103;
SzoVolt:Boolean= False;
Type
SzoDataRec= Record
ASzo: String[60];
MSzo:
String[60];
Szavak: PSortedCollection;
SzoFocused: Integer;
End;
Const
cSzoDataRec: SzoDataRec= (ASzo:
'';
Mszo: '';
Szavak: Nil;
SzoFocused: 0);
Type
PSzoCollection= ^TSzoCollection;
TSzoCollection= Object(TSortedCollection)
Function KeyOf(Item:Pointer):Pointer;Virtual;
Function
Compare(Key1,Key2:Pointer):Integer;Virtual;
End;
PSzotarListBox= ^TSzotarListBox;
TSzotarListBox= Object(TListBox)
Function GetText(Item:Integer;MaxLen:Integer):String;Virtual;
Procedure
FocusItem(Item:Integer);Virtual;
End;
PASzoInputLine= ^TASzoInputLine;
TASzoInputLine= Object(TInputLine)
Constructor Init(Var
Bounds:TRect;AMaxLen:Integer);
Procedure HandleEvent(Var
Event:TEvent);Virtual;
End;
PMSzoInputLine= ^TMSzoInputLine;
TMSzoInputLine= Object(TInputLine)
Constructor Init(Var
Bounds:TRect;AMaxLen:Integer);
Procedure HandleEvent(Var
Event:TEvent);Virtual;
End;
PSzotar= ^TSzotar;
TSzotar= Object(TObject)
FSzo: SzoDataRec;
Constructor Init(ISzo:SzoDataRec);
Constructor Load(Var
S:TStream);
Procedure Store(Var S:TStream);
End;
TTVApp= Object(TApplication)
SzotarDialogData:SzoDataRec;
Constructor Init;
Procedure HandleEvent(Var
Event:TEvent);Virtual;
Procedure
InitMenuBar;Virtual;
Destructor Done;Virtual;
End;
Const
RSzo: TStreamRec= (
ObjType: 150;
VMTLink: Ofs(TypeOf(TSzotar)^);
Load: @TSzotar.Load;
Store:
@TSzotar.Store);
RSzoCollection: TStreamRec= (
ObjType: 154;
VMTLink: Ofs(TypeOf(TSzoCollection)^);
Load: @TSzoCollection.Load;
Store: @TSzoCollection.Store);
Var
Szotar: PSzoCollection;
SzotarStream: TBufStream;
Function
TSzoCollection.KeyOf(Item:Pointer):Pointer;
Var S: String;
Begin
S:= PSzotar(Item)^.FSzo.ASzo;
KeyOf:=@S;
End;
Function
TSzoCollection.Compare(Key1,Key2:Pointer):Integer;
Begin
If
PString(Key1)^= PString(Key2)^ Then
Compare:= 0 Else
If
PString(Key1)^< PString(Key2)^ Then
Compare:= -1 Else
Compare:= 1;
End;
Function
TSzotarListBox.GetText(Item:Integer;MaxLen:Integer):String;
Begin
GetText:=PSzotar(List^.AT(Item))^.Fszo.ASzo;
End;
Procedure
TSzotarListBox.FocusItem(Item:Integer);
Var S: String;
Begin
Inherited
FocusItem(Item);
If
Szotar^.Count<>0 Then
Begin
S:= PSzotar(List^.AT(Item))^.FSzo.ASzo;
Message(Owner,evBroadcast,cmSzoItemFocused+cmASzoBeiro,@S);
S:= PSzotar(List^.AT(Item))^.FSzo.MSzo;
Message(Owner,evBroadcast,cmSzoItemFocused+cmMSzoBeiro,@S);
End;
End;
Constructor
TASzoInputLine.Init(Var
Bounds:TRect;AMaxLen:Integer);
Begin
Inherited
Init(Bounds,AMaxLen);
EventMask:=EventMask Or evBroadcast;
End;
Procedure
TASzoInputLine.HandleEvent(Var
Event:TEvent);
Begin
Inherited
HandleEvent(Event);
If
(Event.What=evBroadcast) And
(Event.Command=cmSzoItemFocused+cmASzoBeiro) And
(State And sfSelected=0) Then
Begin
Data^:=PString(Event.InfoPtr)^;
DrawView;
End;
End;
Constructor
TMSzoInputLine.Init(Var
Bounds:TRect;AMaxLen:Integer);
Begin
Inherited
Init(Bounds,AMaxLen);
EventMask:=EventMask Or evBroadcast;
End;
Procedure
TMSzoInputLine.HandleEvent(Var Event:TEvent);
Begin
Inherited
HandleEvent(Event);
If
(Event.What=evBroadcast) And
(Event.Command=cmSzoItemFocused+cmMSzoBeiro) And
(State And sfSelected=0) Then
Begin
Data^:=PString(Event.InfoPtr)^;
DrawView;
End;
End;
Constructor
TSzotar.Init(ISzo:SzoDataRec);
Begin
Inherited
Init;
FSzo:= ISzo;
End;
Constructor
TSzotar.Load(Var S:TStream);
Begin
S.Read(FSzo,SizeOf(FSzo));
End;
Procedure
TSzotar.Store(Var S:TStream);
Begin
S.Write(FSzo,SizeOf(FSzo));
End;
Constructor
TTVApp.Init;
Begin
Inherited
Init;
RegisterApp;
RegisterDialogs;
RegisterMenus;
RegisterObjects;
RegisterViews;
RegisterType(RSzo);
RegisterType(RSzoCollection);
With
SzotarStream Do
Begin
Init('szotar.str',STOpen,1024);
Szotar:=PSzoCollection(Get);
Done;
End;
If
SzotarStream.Status<>0 Then
Szotar:=New(PSzoCollection,Init(10,5));
End;
Procedure
TTVApp.HandleEvent(Var
Event:TEvent);
Var
SzotarDialog: PDialog;
R
: TRect;
Control
: PView;
V
: Integer;
Procedure
SzotarDialogus;
Begin
R.Assign(1,1,77,22);
New(SzotarDialog,Init(R,'Angol-Magyar
szótár'));
With
SzotarDialog^ Do
Begin
R.Assign(11,2,71,3);
Control:=New(PASzoInputLine,Init(R,60));Insert(Control);
R.Assign(2,2,10,3);
Insert(New(PLabel,Init(R,'~A~ngol:
',Control)));
R.Assign(11,4,71,5);
Control:=New(PMSzoInputLine,Init(R,60));Insert(Control);
R.Assign(2,4,10,5);
Insert(New(PLabel,Init(R,'Ma~g~yar:
',Control)));
R.Assign(73,8,74,20);
Control:=New(PScrollBar,Init(R));
Insert(Control);
R.Assign(2,8,73,20);
Control:=New(PSzotarListBox,Init(R,6,PScrollBar(Control)));
Insert(Control);
R.Assign(2,6,12,8);
Insert(New(PButton,Init(R,'~B~eszúr',cmOk,bfDefault)));
R.Assign(22,6,32,8);
Insert(New(PButton,Init(R,'~J~avít',cmYes,bfNormal)));
R.Assign(42,6,52,8);
Insert(New(PButton,Init(R,'~T~öröl',cmNo,bfNormal)));
R.Assign(62,6,72,8);
Insert(New(PButton,Init(R,'~M~égsem',cmCancel,bfNormal)));
SelectNext(False);
SzotarDialogData:=cSzoDataRec;
If
Szotar^.Count<>0 Then
SzotarDialogData.Szavak:=Szotar;
SetData(SzotarDialogData);
V:= DeskTop^.ExecView(SzotarDialog);
GetData(SzotarDialogData);
If
(SzotarDialogData.ASzo<>'') And
(V<>cmCancel) Then
Begin
SzoVolt:=True;
Case
V Of
cmOK:
Szotar^.Insert(New(PSzotar,Init(SzotarDialogData)));
cmYes:
Szotar^.AtPut(SzotarDialogData.SzoFocused,
New(PSzotar,Init(SzotarDialogData)));
cmNo:
Szotar^.AtDelete(SzotardialogData.SzoFocused);
End;
End;
End;
Szotar^.Pack;
Dispose(SzotarDialog,Done);
End;
Begin
Inherited
HandleEvent(Event);
If
Event.What=evCommand Then
Case
Event.Command Of
cmSzotarDialogus: SzotarDialogus;
End;
ClearEvent(Event);
End;
Procedure
TTVApp.InitMenuBar;
Var R:
TRect;
Begin
GetExtent(R);
R.B.Y:= R.A.Y+1;
MenuBar:= New(PMenuBar,Init(R,NewMenu(
NewSubMenu('~S~zótár',hcNoContext,NewMenu(
NewItem('~A~ngol-magyar
szótár','F2',kbF2,cmSzotarDialogus,hcNoContext,
NewLine(
NewItem('E~x~it','Alt-x',kbAltX,cmQuit,hcNoContext,
Nil)))),
Nil))));
End;
Destructor
TTVApp.Done;
Begin
If
SzoVolt Then With SzotarStream Do
Begin
Init('szotar.str',STCreate,1024);
Put(Szotar);
Done;
End;
Inherited
Done;
Dispose(Szotar,Done);
End;
Var
TVApp:TTVApp;
Begin
If
Not
TVApp.Init Then Halt(1);
TVApp.Run;
TVApp.Done;
End.
A teljes CrtPlus Lista, melyből néhány modult nem is
használtunk a bemutatott programozási feladatainkban:
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.