Приклад програми

Умова задачі: Створити масив записів із структурою

1) Визначити кількість робіт кожного автора.

2) Визначити журнали, що видавались за вказаний рік

uses crt;

type zap=record

author,title:string;

case tag:Integer of

1:(price:Integer);

2:(year:Integer;journal:string);

3:(date:string;news:string);

end;

var katalog:array[1..20]of zap;

i,j,k,l:byte;

ch:char;

procedure vvod;

begin clrscr;

repeat

i:=i+1;

with katalog[i] do

begin

write('lnput type of editions: 1-book,2-journal,3-newspaper');

readln(tag);

case tag of

1:begin

write('author of book: '); readln(author);

write('title of book: '); readln(title);

write('price of book: '); readln(price);

end;

2:begin

write('author of article In journal:'); readln(author);

write('tltle of article:'); readln(title);

write('name of journal: '); readln(journal);

write('year :'); readln(year);

end;

3:begin

write('author of article In newspaper: '); readln(author);

write('tltle of article In newspaper: '); readln(title);

write('name of newspaper: '); readln(news);

write('date :'); readln(date);

end;

end;

end;

writeln('continue?Y/N');

ch:=readkey;

until ch=upcase('N');

end;

procedure vyvod;

{var tag:integer;}

begin

clrscr;

for j:=1 to i do

with katalog[j] do

case tag of

1: begin

writeln('books: ',author,' ',title,' ',price); readln;

end;

2:begin

writeln('|ournals:',journal,' ',year,' ',author,' ',title); readln;

end;

3:begin

writeln('newspaper: ',news,' ',date,' ',author,' ',title); readln;

end;

end;

end;

procedure task1;

var kol:integer;

fl:boolean;

begin clrscr;

for j:=1 to I do begin

kol:=1;

fl:=false;

for k:=1 to j-1 do

if katalog[j].author=katalog[k].author then fl:=true;

If fl=false then begin

for l:=j+1 to i do

if katalog[l].author=katalog[j].author then kol:=kol+1;

writeln('author',katalog[i].author,'has works= ',kol);

end;

end;

readln;

end;

procedure task2;

var tmp:integer;

flag:boolean;

begin clrscr;

writeln('lnput journal"s edition year');

readln(tmp);

clrscr;

flag:=false;

writeln('journals In ',tmp, ' year');

for j:=1 to I do begin

if katalog[j].year=tmp then

begin

writeln(katalog[j].journal);flag:=true;

end;

end;

if flag=false then

writeln('journals not exist In katalog In year ',Tmp);

readln;

end;

procedure endprog;

begin clrscr;

gotoxy(15,10); writeln('Do you want to exit from program? y/n');

ch:=readkey; If ch='y' then halt(0);

end;

procedure menu;

begin

repeat

cLrscr;

gotoxy(21,3); writeln('MENU');

gotoxy(15,5); writeln('1. Input database');

gotoxy(15,7); writeln('2. Show database');

gotoxy(15,9); writeln('3. Number of author"s works .');

gotoxy(15,11); writeln('4. Journals In current year.');

gotoxy(15,13); writeln('5. Exit');

ch:=readkey;

case ch of

'1':vvod;

'2':vyvod;

'3':task1;

'4':task2;

'5':endprog;

end;

until ch='5';

end;

begin

clrscr;

i:=0;

menu;

end.