Текст ПРОГРАММЫ tovar_1.pas

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}

Program Tovar_1;

{ Вариант № }

Uses Crt;

Const

ColRec=10; {Максимальное количество записей}

LenNaimt=27;{Максимальная длина наименования товара}

ErrMes=' Ошибка ввода!!! ';

Err1='Число записей больше максимального - операция НЕВОЗМОЖНА!!!!';

MesNumb='Численное значение должно быть в диапазоне ';

Enter='Нажмите ENTER...';

EnterOrSpace='Нажмите ENTER или ПРОБЕЛ...';

EmptyStr=' ';

Empty='';

EmptyArr='Массив записей пуст. ';

Continue='Для окончания операции введите ESC, для продолжения - Enter';

CaseStr='Выберите курсором нужный режим. ';

RecNotFound='Запись НЕ найдена!!!! ';

Shure='Вы уверены, что это нужная запись? (Y/N)';

Inv1='Создать массив записей';

Inv2='Вывести данные на экран';

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

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

Inv5='Добавить запись';

Inv6='Изменить запись';

Inv7='Удалить запись';

Color=Yellow; {желтый цвет символов}

Fon =Blue; {голубой цвет фона}

TaOld=15; {Стандартный атрибут: белые символы на черном фоне}

YearMin=1990; {Минимальный год}

YearMax=2020; {Максимальный год}

Type

data=

record

day: byte;

year: word;

month: byte;

end;

RecType=

record

naimt: string[LenNaimt];

kolt: longint;

stoimt: real;

dmg: data;

end;

MasType=array[1..ColRec] of RecType;

Var

Rec: RecType;

Mas: MasType;

ch: char;

flag: boolean;

MaxElem: integer;

{Процедура вывода верхней части шапки таблицы }

Procedure TopT;

begin

writeln('??????????????????????????????');

writeln('? Наименование? Кол-во? Стоимость? Год? Месяц? День?');

writeln('????????????????????????????????');

end;

{Процедура вывода нижней части шапки таблицы}

Procedure EndT;

begin

write('??????????????????????????????');

end;

{Вывод сообщений Str1, Str2, начиная с позиции курсора X,Y }

Procedure OutMessageXY(X,Y:Byte;Str1,Str2:String);

Var Xcur, Ycur: byte;

Begin

Xcur:=WHereX; {запоминание текущей позиции курсора}

Ycur:=WHereY;

GotoXY(X, Y);

TextAttr:=Red+16*LightGray+Blink;{красный цвет на сером фоне с мерцанием}

Write(Str1,Str2);

TextAttr:=TaOld;

GotoXY(Xcur, Ycur); {восстановление позиции курсора}

End;

{Вывод Width символов # цветом Color на фоне Fon с восстановлением прежних

атрибутов вывода TaOld и возвратом в начальную позицию курсора}

Procedure OutPutString(Color, Fon, TaOld, Width: Byte);

Var Str: String;

i, Xcur, Ycur, TaNew: byte;

Begin

Xcur:=WHereX; {запоминание текущей позиции курсора}

Ycur:=WHereY;

Str:='';

TextAttr:=Color+16*Fon; {установка атрибута для вывода пробелов}

for i:=1 to Width do

Str:=Str + '#';

Write(Str);

TextAttr:=TaOld; {восстановление прежних атрибутов}

GotoXY(Xcur, Ycur); {восстановление позиции курсора}

End;

{Функция выдачи сообщений об ошибках Message при нарушении диапазона

[NumberMin.. NumberMax] на вводе целочисленных значений элементов полей записи}

Function error(Message: string; NumberMin, NumberMax: LongInt):boolean;

Var Mes: string;

begin

error:=true;

if flag then

begin

Mes:=ErrMes + Message;

writeln(Mes, '[', NumberMin, '..', NumberMax, ']');

error:=false;

end;

end;

{Функция выдачи сообщения об ошибке Mes

при вводе вещественных значений элементов полей записи}

Function error1:boolean;

Var Mes: string;

begin

error1:=true;

if flag then

begin

Mes:=ErrMes +' Введено НЕ число....';

writeln(Mes);

error1:=false;

end;

end;

{Ввод строки символов S с проверкой количества введенных символов

в диапазоне [1..LenNaimt] и со строкой приглашения Inv }

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, LenNaimt);

Readln(S);

if length(S)>LenNaimt then flag:=true;

until error('Количество символов в строке должно быть в диапазоне ',1,LenNaimt);

End;

{Ввод целочисленных данных Number (ширина поля Width)

с проверкой диапазона [NumberMin.. NumberMax]

и со строкой приглашения Inv }

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(Number);

{$I+}

if IOResult<>0 then flag:=true

else

if (Number<NumberMin) or (Number>NumberMax) then flag:=true;

until error(MesNumb, NumberMin, NumberMax);

End;

{Ввод вещественных данных R (ширина поля Width)

с проверкой на допустимый символ и со строкой приглашения Inv }

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(R);

{$I+}

if IOResult<>0 then flag:=true;

until error1;

End;

{Процедура ввода значений элементов полей записи}

Procedure InputFields(var rec: RecType);

Var a: real;

s: String;

begin

InputString(S, LenNaimt, 'Наименование');

Rec.naimt:=s;

InputNumber(a,0,2147483647,10,'Количество');

Rec.kolt:=trunc(a);

InputReal(a,11,'Стоимость');

rec.stoimt:=a;

begin

Mes:=ErrMes +' Введено НЕ число....';

writeln(Mes);

error1:=false;

end;

end;

{Ввод строки символов S с проверкой количества введенных символов

в диапазоне [1..LenNaimt] и со строкой приглашения Inv }

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, LenNaimt);

Readln(S);

if length(S)>LenNaimt then flag:=true;

until error('Количество символов в строке должно быть в диапазоне ',1,LenNaimt);

End;

{Ввод целочисленных данных Number (ширина поля Width)

с проверкой диапазона [NumberMin.. NumberMax]

и со строкой приглашения Inv }

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(Number);

{$I+}

if IOResult<>0 then flag:=true

else

if (Number<NumberMin) or (Number>NumberMax) then flag:=true;

until error(MesNumb, NumberMin, NumberMax);

End;

{Ввод вещественных данных R (ширина поля Width)

с проверкой на допустимый символ и со строкой приглашения Inv }

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(R);

{$I+}

if IOResult<>0 then flag:=true;

until error1;

End;

{Процедура ввода значений элементов полей записи}

Procedure InputFields(var rec: RecType);

Var a: real;

s: String;

begin

InputString(S, LenNaimt, 'Наименование');

Rec.naimt:=s;

InputNumber(a,0,2147483647,10,'Количество');

Rec.kolt:=trunc(a);

InputReal(a,11,'Стоимость');

rec.stoimt:=a;

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

rec.dmg.year:=trunc(a);

InputNumber(a,1,12,2,'Месяц');

rec.dmg.month:=trunc(a);

InputNumber(a,1,31,2,'День');

rec.dmg.day:=trunc(a);

end;

{Процедура вывода значений элементов полей записи}

Procedure OutputRec(rec: RecType);

begin

Write('?',Rec.naimt);

Gotoxy(29,Wherey);

Write('?',Rec.kolt:10);

Gotoxy(40,Wherey);

Write('?',Rec.stoimt:11:2);

Gotoxy(52,Wherey);

Write('?',Rec.dmg.year:5);

Gotoxy(58,Wherey);

Write('?',Rec.dmg.month:3);

Gotoxy(64,Wherey);

Write('?',Rec.dmg.day:3);

Gotoxy(69,Wherey);

Writeln('?');

end;

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

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