Написать программу, выполняющую следующие действия:
1. Корректировку или дополнение списка с клавиатуры.
2. Сортировку по названию товара или по общей стоимости.
3. Вывод на экран информации о товаре, название которого введено с клавиатуры.
4. Запись списка в файл под тем же или новым именем.
Пример записи в входном файле:
pizza
55.00
1.00
gr
program ge;
uses crt;
CONST
namebd = 'bd.txt';
type
vse = record
nazv: string;
sto: real;
mas: real;
ediz: string;
end;
var
tovary: array [1 .. 50] of vse;
i, n: integer;
f: text;
back: integer;
procedure menu; forward;
{ ******************************** }
procedure readf; { считывание с файла }
var
i: integer;
begin
assign(f, namebd);
reset(f);
i := 0;
while not eof(f) do
begin
inc(i);
readln(f, tovary[i].nazv);
readln(f, tovary[i].sto);
readln(f, tovary[i].mas);
readln(f, tovary[i].ediz);
end;
n := i;
close(f);
end; { конец*считывание с файла* }
procedure writef; { меню записи в файл }
var
i, option: integer;
namef: string;
newf: text;
begin
assign(f, namebd);
reset(f);
writeln;
writeln;
writeln;
writeln('"0" - vernutsya v MENU');
writeln;
writeln('1. Perezapisati fail');
writeln('2. Zapisati v novyi fail');
readln(option);
if option = 0 then
menu;
if option = 1 then
begin
close(f);
assign(f, namebd);
rewrite(f);
for i := 1 to n do
begin
writeln(f, tovary[i].nazv);
writeln(f, tovary[i].sto:0:2);
writeln(f, tovary[i].mas:0:2);
writeln(f, tovary[i].ediz);
end;
close(f);
end;
if option = 2 then
begin
writeln;
writeln('Vvedite novoe imya faila (EX: "1.txt"): ');
readln(namef);
assign(newf, namef);
rewrite(newf);
for i := 1 to n do
begin
writeln(newf, tovary[i].nazv);
writeln(newf, tovary[i].sto:0:2);
writeln(newf, tovary[i].mas:0:2);
writeln(newf, tovary[i].ediz);
end;
close(newf);
end;
clrscr;
writeln('Dannye uspeshno zapisany...');
writeln('Press ENTER...');
readln;
menu;
end; { конец*меню записи в файл* }
{ вывод на экран с "файловым меню" }
procedure vyvod;
var
i, j, k: integer;
b: string;
begin
clrscr;
writeln('#':3, '|', 'Nazvanie:':16, '| ', 'Stoimosti tovara: | Kol-vo: ');
writeln('_____________________________________________________');
for i := 1 to n do
begin
str(tovary[i].sto, b);
if pos('.', b) = 0 then
b := b + '00';
k := 10 - length(b);
b := '';
for j := 1 to k do
b := b + ' ';
writeln(i:3, '|', tovary[i].nazv:16, '| ', tovary[i].sto:2:2, ' (tsc/rub)',
b, '| ', tovary[i].mas:2:2, ' ', tovary[i].ediz);
end;
writef; { fail }
end; { конец*вывод на экран* }
{ вывод на экран без "файлового меню" }
procedure vyvod2;
var
i, j, k: integer;
b: string;
begin
clrscr;
writeln('#':3, '|', 'Nazvanie:':16, '| ', 'Stoimosti tovara: | Kol-vo: ');
writeln('_____________________________________________________');
for i := 1 to n do
begin
str(tovary[i].sto, b);
if pos('.', b) = 0 then
b := b + '00';
k := 10 - length(b);
b := '';
for j := 1 to k do
b := b + ' ';
writeln(i:3, '|', tovary[i].nazv:16, '| ', tovary[i].sto:2:2, ' (tsc/rub)',
b, '| ', tovary[i].mas:2:2, ' ', tovary[i].ediz);
end;
end; { конец*вывод на экран* }
{ сортировка }
procedure exchange(var a, b: string);
var
c: string;
begin
c := a;
a := b;
b := c;
end;
procedure exchangr(var a, b: real);
var
c: real;
begin
c := a;
a := b;
b := c;
end;
procedure sortbukva(bukva: shortint);
var
i, j, nn: integer;
swop: boolean;
vrs1, vrs2: string;
begin
nn := n;
repeat
swop := false;
for i := 1 to nn - 1 do
begin
vrs1 := tovary[i].nazv;
vrs2 := tovary[i + 1].nazv;
if ord(vrs1[bukva]) > ord(vrs2[bukva]) then
begin { esli "<" togda po ubivaniiu }
exchange(tovary[i].nazv, tovary[i + 1].nazv);
exchangr(tovary[i].sto, tovary[i + 1].sto);
exchangr(tovary[i].mas, tovary[i + 1].mas);
exchange(tovary[i].ediz, tovary[i + 1].ediz);
swop := true;
end;
end;
nn := nn - 1;
until not swop;
end;
procedure sortcena;
var
i, j, nn: integer;
swop: boolean;
begin
nn := n;
repeat
swop := false;
for i := 1 to nn - 1 do
begin
if tovary[i].sto > tovary[i + 1].sto then
begin { esli "<" togda po ubivaniiu }
exchange(tovary[i].nazv, tovary[i + 1].nazv);
exchangr(tovary[i].sto, tovary[i + 1].sto);
exchangr(tovary[i].mas, tovary[i + 1].mas);
exchange(tovary[i].ediz, tovary[i + 1].ediz);
swop := true;
end;
end;
nn := nn - 1;
until not swop;
end;
procedure sort;
var
i, option: integer;
begin
clrscr;
writeln('1.Sortirovati po nazvaniyu');
writeln('2.Sortirovati po stoimosti');
writeln;
write('vvedite cifru iz menu: ');
readln(option);
readf;
if option = 1 then
begin
for i := 3 downto 1 do
sortbukva(i);
vyvod;
end;
if option = 2 then
begin
readf;
sortcena;
vyvod;
end;
end;
{ конец*сортировка* }
procedure korrekcia;
{ проводит корректировку или дополнение списка с клавиатуры }
var
i, option, nomer: integer;
begin
readf;
vyvod2;
writeln;
writeln;
writeln('1.Korrektirovati zapisi');
writeln('2.Dopolniti spisok');
write('vvedite cifru iz menu: ');
readln(option);
if option = 1 then
begin
write('Vvedite # zapisi, kotoruyu zhelaete otkorrektirovati: ');
readln(nomer);
writeln;
writeln('Nazvanie: ');
readln(tovary[nomer].nazv);
writeln('Stoimosti tovara: ');
readln(tovary[nomer].sto);
writeln('Kol-vo: ');
readln(tovary[nomer].mas);
writeln('Edinica Izmerenia: ');
readln(tovary[nomer].ediz);
vyvod;
end;
if option = 2 then
begin
clrscr;
write('Vvedite KOL-VO dopolnitelinyh zapisei: ');
readln(nomer);
writeln;
for i := 1 to nomer do
begin
inc(n); { увеличиваем общее кол-во записей }
writeln('Dobavlyaem ', n, ' zapisi:');
writeln('Nazvanie: ');
readln(tovary[n].nazv);
writeln('Stoimosti tovara: ');
readln(tovary[n].sto);
writeln('Kol-vo: ');
readln(tovary[n].mas);
writeln('Edinica Izmerenia: ');
readln(tovary[n].ediz);
vyvod;
end;
end;
end; { конец*проводит корректировку или дополнение списка с клавиатуры* }
procedure view;
{ Вывод на экран информации о товаре, название которого введено с клавиатуры }
var
i: integer;
s: string;
begin
clrscr;
write('Vvedite nazvanie tovara: ');
readln(s);
writeln;
for i := 1 to n do
if tovary[i].nazv = s then
begin
writeln('Nazvanie: ', tovary[i].nazv);
writeln('Cena: ', tovary[i].sto);
writeln('Kol-vo: ', tovary[i].mas, ' ', tovary[i].ediz);
end;
readln;
menu;
end; { конец*Вывод на экран информации о товаре, название которого введено с клавиатуры* }
{ ***************MENU******************* }
procedure menu;
var
option: integer;
begin
clrscr;
writeln('Menu Programmy: ');
writeln;
writeln('1. Korrektirovka ili dopolnenie spiska s klaviatury');
writeln('2. Sortirovka po nazvaniyu tovara ili po obschei stoimosti');
writeln('3. Vyvod na ekran informatsii o tovare, nazvanie kotorogo vvedeno s klaviatury');
writeln('4. Vyvod vsei informatsii (BAZy) s faila');
writeln;
write('vvedite cifru iz menu: ');
readln(option);
if option = 1 then
korrekcia;
if option = 2 then
sort;
if option = 3 then
view;
if option = 4 then
begin
readf;
vyvod;
end;
end;
{ end*************MENU******************* }
{ ***********************Начало программы*************************** }
begin
menu;
readln;
end.