Procedure InputRecord;

Var i: Word;

ch: Char;

begin

i:=0;

repeat

clrscr;

inc(i);

if i>ColRec then

begin

OutMessageXY(12,23,Err1,Empty);

exit;

end;

InputFields(mas[i]);

OutMessageXY(12,23,Continue,Empty);

ch:=Readkey;

until ch=#27; {ESC - признак окончания ввода}

MaxElem:=i;

end;

{Процедура вывода массива записей mas }

Procedure OutRecord(MaxElem: integer);

Var i: Word;

begin

clrscr;

if MaxElem<>0 then

begin

TopT;

for i:=1 to MaxElem do OutputRec(mas[i]);

EndT;

OutMessageXY(20,24,Empty,Enter);

end

else OutMessageXY(20,24,EmptyArr,Enter);

readln;

end;

{Процедура организации запроса}

Procedure Zapros1;

Var a, Sum: Real;

god, i: Word;

begin

Clrscr;

Writeln('Вычислить общее количество товаров за определенный год');

InputNumber(a,YearMin,YearMax,4,'Год');

god:=trunc(a);

sum:=0;

TopT;

for i:=1 to MaxElem do

if mas[i].dmg.year=god then

begin

sum:=sum + mas[i].kolt;

OutputRec(mas[i]);

end;

EndT;

Writeln;

if sum<>0 then

begin

Writeln('Суммарное количество товара за ',god,' год составляет ',sum:12:0);

OutMessageXY(20,24,Empty,Enter);

end

else OutMessageXY(10,24,RecNotFound,Enter);

readln;

end;

{Процедура вывода содержимого записи по ключу }

Procedure KeyRec;

var ch: char;

r, st: Real;

f,f1: Boolean;

Num, J, god: Word;

Str: String;

Label 1;

begin

repeat

f:=true;

clrscr;

if MaxElem=0 then

begin

OutMessageXY(20,24,EmptyArr,Enter);

Readln;

Exit;

end;

writeln('Вывести содержимое записи по ключу');

writeln('1: номер записи');

writeln('2: наименование товара');

writeln('3: стоимость товара');

writeln('4: год поступления товара');

Writeln;

Writeln('Введите нужный ключ');

ch:=Readkey;

case ch of

'1': begin

InputNumber(r,1,MaxElem,2,' Введите номер записи');

Num:=trunc(r);

end;

'2': InputString(Str, LenNaimt,' Введите наименование товара');

'3': InputReal(st,11,' Введите стоимость товара');

'4': begin

InputNumber(r,YearMin,YearMax,4,' Введите год поступления товара');

god:=trunc(r);

end

else

begin

Clrscr;

Writeln('Неизвестное значение ключа');

OutMessageXY(20,24,Empty,Enter);

readln;

f:=false;

end;

end;

until f;

f:=false; {Логический признак нормального завершения работы}

f1:=false; {Логический признак выдачи нужной записи}

ClrScr;

TopT;

if ch='1' then

begin

OutputRec(mas[num]);

f:=true;

goto 1;

end;

for j:=1 to MaxElem do

begin

case ch of

'2': if str=mas[j].naimt then

begin

f:=true;

f1:=true;

end;

'3': if st=mas[j].stoimt then

begin

f:=true;

f1:=true;

end;

'4': if god=mas[j].dmg.year then

begin

f:=true;

f1:=true;

end;

end;

if f1 then

begin

OutputRec(mas[j]);

f1:=false

end

end;

1: EndT;

if f then OutMessageXY(20,24,Empty,Enter)

else OutMessageXY(10,24,RecNotFound,Enter);

Readln

end;

{Процедура изменения (Flag=True) или удаления (Flag=False) записи}

Procedure ChangeDel(flag: boolean);

Var ch: char;

i, j: Word;

begin

if MaxElem=0 then

begin

OutMessageXY(1,24,EmptyStr,Empty);{Очистка строки сообщения}

OutMessageXY(10,24,EmptyArr,Enter);

Readln;

Exit

end;

repeat

clrscr;

if flag then writeln('Введите номер изменяемой записи')

else writeln('Введите номер удаляемой записи');

{$I-}

Readln(i);

{$I+}

until (IOResult=0)and(i>0) and (i<=MaxElem);

TopT;

OutputRec(mas[i]);

EndT;

writeln;

OutMessageXY(20,24,Shure,Empty);

ch:=ReadKey;

if (ch='y')or(ch='Y')then

begin

if flag then InputFields(mas[i]) {Ввод всех полей заново}

else

begin

for j:=i to MaxElem-1 do

mas[j]:=mas[j+1];

MaxElem:=MaxElem-1;

end;

if not flag then OutMessageXY(20,24,'Запись удалена. ',Enter)

else OutMessageXY(20,24,'Запись изменена. ',Enter);

readln;

end

end;

{Процедура добавления записи}

Не нашли, что искали? Воспользуйтесь поиском: