Programowanie TP rekordy
Tematem tego ćwiczenia są rekordy i
sposoby wpisywania ich dopisywania nowych rekordów usuwania rekordów ich
modyfikacja
Program
stypen_ucznia;
USES crt;
TYPE
Student=RECORD
Imie,Nazwisko:STRING;
Stypendium:BYTE;
Plec:char
END;
VAR
St:ARRAY[1..126] OF Student;
k,i,n:byte;
Suma:integer;
PROCEDURE
PODKRESL;
BEGIN
FOR k:=1 TO 80 DO
write('=');
END;
BEGIN
clrscr;
write('Podaj ilu
studentow otrzyma stypendium. Ilosc studentow = ‘);readln(n);
writeln('Lista studentow otrzymujcych stypendium.');
writeln('WYPELNIJ:');
PODKRESL;
FOR i:=1 TO n DO
BEGIN
write('Studenci[',i,'].Imie=');
readln(St[i].Imie);
write('Studenci[',i,'].Nazwisko=');readln(St[i].Nazwisko);
write('Studenci[',i,'].Plec=');readln(St[i].Plec);
write('Studenci[',i,'].Stypendium=');readln(St[i].Stypendium);
END;
clrscr;
writeln('Lp.':5,'Imie':15,'Nazwisko':20,'Plec':10,'Stypendium':15);
PODKRESL;
FOR i:=1 TO n DO
writeln(i:3,St[i].Imie:15,St[i].Nazwisko:20,St[i].Plec:10,St[i].Stypendium:15);
PODKRESL;
Suma:=0;
FOR i:=1 TO n DO
Suma:=Suma+St[i].Stypendium;
writeln('Suma do
wyplacenia:':53,Suma:10,' zlotych');
readln
END.
{: Tablica
rekordow z rejestracja wykorzystanych elementow.
Podstawowe operacje na tablicy }
PROGRAM Spis_Osob2;
USES CRT;
CONST
MAXN=30; {stala definiujaca rozmiar tablicy}
TYPE
St20 =STRING[20];
TOsoba=RECORD
nazwisko,
imie,
kraj,
adres :St20;
rok_ur :INTEGER;
zajety :BOOLEAN
END;
VAR
spis :ARRAY [1..MAXN] OF TOsoba;
{kartoteka w postaci tablicy rekordow}
koniec:BOOLEAN;
wyb
:CHAR;
k,ile
:INTEGER;
naz
:St20;
PROCEDURE Czytaj(VAR Osoba:TOsoba);
BEGIN
CLRSCR;
WRITELN('Prosze podac dane:
');
WITH Osoba DO
BEGIN
WRITE(' NAZWISKO ');
READLN(nazwisko);
WRITE(' IMIE ');
READLN(imie);
WRITE(' KRAJ ');
READLN(kraj);
WRITE(' ADRES
');
READLN(adres);
WRITE(' ROK URODZ
');
READLN(rok_ur);
zajety:=TRUE
END
END; {Czytaj}
PROCEDURE WyswietlRekord(Osoba:TOsoba);
BEGIN
WITH Osoba DO
BEGIN
WRITELN('NAZWISKO :
',nazwisko);
WRITELN('IMIE : ',imie);
WRITELN('ADRES : ',adres);
WRITELN('KRAJ : ',kraj);
WRITELN('ROK URODZ : ',rok_ur);
WRITELN;
WRITE(' Enter - dalej');
READLN
END
END; {Wyswietl}
PROCEDURE Czyt_Tab;
VAR
i,j,k:INTEGER;
BEGIN
WRITE('Podaj liczbe wprowadzanych rekordow ');
READLN(k);
IF k+ile>MAXN
THEN
BEGIN
k:=MAXN-ile;
WRITELN('W tablicy zmiesci sie tylko ',k,'rekordow')
END;
j:=1;
FOR i:=1 TO k DO
BEGIN
WHILE spis[j].zajety DO
j:=j+1;
Czytaj(spis[j])
END;
ile:=ile+k
END; {Czyt_Tab}
PROCEDURE Szuk_Naz(VAR i:INTEGER;VAR nazw:St20);
BEGIN
IF ile=0
THEN WRITELN('Tablica
pusta')
ELSE
BEGIN
WRITE('Podaj nazwisko : ');
READLN(nazw);
i:=0;
REPEAT
i:=i+1
UNTIL ((spis[i].nazwisko=nazw) OR
(i=MAXN));
IF (spis[i].nazwisko<>nazw) AND
NOT spis[i].zajety
THEN
BEGIN
WRITELN(' Nie znaleziono');
WRITE(' Enter - dalej');
READLN;
i:=0
END
ELSE
WyswietlRekord(spis[i])
END
END; {Szuk_Naz}
PROCEDURE Skresl;
VAR
nazwa:St20;
k,j :INTEGER;
BEGIN
IF ile=0
THEN WRITELN('Tablica
pusta')
ELSE
BEGIN
Szuk_Naz(k,nazwa);
IF k=0
THEN WRITELN('Nie
skreslono')
ELSE
BEGIN
spis[k].zajety:=FALSE;
WRITELN('Osoba o nazwisku ', nazwa,' zostala skreslona');
ile:=ile-1
END
END;
WRITE(' Enter - dalej');
READLN
END; {Skresl}
PROCEDURE Wyswietl;
VAR
i:INTEGER;
BEGIN
IF ile=0
THEN
BEGIN
WRITELN('Tablica pusta');
WRITE(' Enter - dalej');
READLN
END
ELSE
FOR i:=1 TO MAXN DO
IF spis[i].zajety=TRUE
THEN
BEGIN
WRITELN('----------------------------------------');
WyswietlRekord(spis[i])
END
END; {Wyswietl}
PROCEDURE Wybierz_Kraj;
VAR
krajp:St20;
i,j :INTEGER;
BEGIN
j:=0;
IF ile=0
THEN WRITELN('Tablica
pusta')
ELSE
BEGIN
WRITE('Podaj kraj ');
READLN(krajp);
FOR i:=1 TO ile DO
IF spis[i].zajety
THEN
IF spis[i].kraj=krajp
THEN
BEGIN
j:=j+1;
WyswietlRekord(spis[i])
END;
IF j=0
THEN WRITELN('Nie znaleziono osob z podanego kraju')
ELSE WRITELN('Znaleziono ',j,' osob z
kraju', krajp)
END;
WRITE(' Enter - dalej');
READLN
END; {Wybierz_Kraj}
PROCEDURE Oferta;
BEGIN
WRITELN(' *************************************************');
WRITELN('
***** MOJA KARTOTEKA ******');
WRITELN(' *************************************************');
WRITELN('
1 - WPROWADZENIE NOWYCH OSOB ');
WRITELN('
2 -
SKRESLENIE OSOBY');
WRITELN(' 3 - ODSZUKANIE OSOBY wg. NAZWISKA');
WRITELN(' 4 - WYKAZ OSOB Z PODANEGO KRAJU');
WRITELN(' 5 - WYSWIETLENIE SPISU OSOB');
WRITELN(' 0 - KONIEC PRACY');
WRITELN(' *************************************************')
END; {Oferta}
BEGIN {Program glowny}
FOR ile:=1 TO MAXN DO
spis[ile].zajety:=FALSE;
koniec:=FALSE;
ile:=0;
REPEAT
CLRSCR;
Oferta;
WRITE(' Wybierz
funkcje 1..5: ');
READLN(wyb);
CASE wyb OF
'1': Czyt_Tab;
'2': Skresl;
'3': Szuk_Naz(k,naz);
'4': Wybierz_Kraj;
'5': Wyswietl;
'0': koniec:=TRUE
ELSE
BEGIN
WRITELN(' Zly wybor ');
WRITE(' Enter - dalej');
READLN
END
END;
UNTIL koniec
END. {Spis_Osob2}
program kstlf;
uses crt;
TYPE
nazwisko=string[30];
imie=string[25];
ulica=string[30];
dane=record
nazw:nazwisko;
im:imie;
ul:ulica;
tel:string[15];end;
const l_opcji =8;
ile=100;
var opcja:byte;
koniec:boolean;
zbior:array[1..ile] of dane;
plik :file of dane;
procedure Upcase2 (var
str:nazwisko);
var
i:byte;
begin
for i:=1 to length(str) do str[i] :=upcase(str[i])
end;
function menu (liczba_opcji:byte):byte;
var
opcja:byte;
begin
opcja:=0;
gotoxy(23,1); write('program moja ksiazka
telefoniczna');
gotoxy(25,8); write('1:wprowadzanie
danych');
gotoxy(25,9); write('2:listowanie
informacji');
gotoxy(25,10); write('3:szukanie
informacji');
gotoxy(25,11); write('4:zapisywanie
informacji');
gotoxy(25,12); write('5:ladowanie
informacji');
gotoxy(25,13); write('6:sortowanie
informacji');
gotoxy(25,14); write('7:kasowanie informacji');
gotoxy(25,15); write('8:wyjscie z
programu');
while (not (opcja in [1..liczba_opcji])) do
begin
gotoxy(25,19); write ('podaj numer
opcji: ');
readln(opcja)
end;
menu:=opcja;
clrscr
end;
procedure wprowadz_info;
var
i:byte;
begin
for i:=1 to ile
do
if
zbior[i].nazw='' then
begin
write('podaj nazwisko');
readln(zbior[i].nazw);
if zbior[i].nazw='' then exit;
upcase2 (zbior[i].nazw);
write('podaj numer
telefonu: ');
readln(zbior[i].tel);
writeln
end;
end;
procedure listuj_info;
var i:byte;
BEGIN
for i:=1 to ile do
if
zbior[1].nazw<>'' then
writeln(zbior[i].nazw,':',zbior[i].tel)
else
begin
writeln;writeln('Lista skonczona.');
repeat until
keypressed;
exit
end;
end;
procedure szukaj_info;
var nazw:nazwisko;
opcja,i :byte;
BEGIN
OPCJA:=0;
gotoxy(25,10);write('1:szukanie wedlug nazwiska');
gotoxy(25,11);write('2:szukanie
wedlug numeru telefonu');
gotoxy(25,19);write('podaj numer
opcji: ');
while ((opcja<>1) and (opcja<>2)) do
begin
gotoxy(25,19);
write('podaj numer opcji:');
opcja:= ord
(readkey) -48
end;
clrscr;
if opcja=1 then
begin
write('podaj nazwisko: '); readln(nazw);
upcase2 (nazw);
if nazw= ''
then exit;
for i:=1 to ile do
if pos(nazw,zbior[i].nazw)=1
then
begin
writeln(zbior[i].nazw,':',zbior[i].tel);
readkey
end
end
else
begin write('podaj nr
telefonu: ');readln(nazw);
if nazw='' then exit;
for i:=1 to ile do
if pos(nazw, zbior[i].tel)=1 then
begin
writeln(zbior[i].nazw,':',zbior[i].tel);
readkey
end
end;
writeln('koniec przeszukiwan.');
readkey
end;
procedure zapisz_info;
var i:byte;
begin
gotoxy(30,12);write('prosze
czekac');
assign(plik,'ktel.dat');
rewrite(plik);
for i:=1 to ile do write(plik,
zbior[i]);
close(plik)
end;
procedure laduj_info;
var i:byte;
begin
gotoxy(30,12); writeln('prosze
czekac');
assign(plik,'ktel.dat');
reset(plik);
for i:=1 to ile do
read(plik,zbior[i]);
close(plik)
end;
procedure sortuj_info;
var pomoc: dane;
i,j: word;
begin
gotoxy(30,12); write('prosze
czekac');
for i:=1 to 99 do
begin
if zbior[i].nazw=''
then exit;
for j:=i+1 to ile do
if( zbior[i].nazw >
zbior[j].nazw)
and (zbior[j].nazw <> '') then
begin
pomoc:=zbior[i];
zbior[i]:=zbior[j];
zbior[j]:=pomoc
end
end
end;
procedure kasuj_info;
var nazw:nazwisko;
i,j:word;
begin
write('podaj nazwisko do
wyeliminowania:');
readln(nazw);
upcase2(nazw);
clrscr;
gotoxy(30,12);write('prosze
czekac');
for i:=1 to ile do
begin
if
zbior[i].nazw='' then exit;
if
zbior[i].nazw=nazw then
begin
j:=i;
while
((j<100)and (zbior[j].nazw<>'')) do
begin
zbior[j]:=zbior[j+1];
inc(j);
end;
dec(i)
end
end
end;
procedure wyjscie;
begin clrscr;
koniec:=true
end;
begin
koniec := false;
while (not koniec) do
begin
opcja:= menu(l_opcji);
case opcja of
1: wprowadz_info;
2: listuj_info;
3: szukaj_info;
4: zapisz_info;
5: laduj_info;
6: sortuj_info;
7: kasuj_info;
8: wyjscie;
end
end
end.