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,2,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 0. Ha üres stringgel hívjuk meg, akkor a visszaadott érték a lista aktuális hossza. Mivel a levétel előtt validálást hajt végre, nem érzékeny a fölösleges SPACE-ekre.

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.