ТОР 5 статей: Методические подходы к анализу финансового состояния предприятия Проблема периодизации русской литературы ХХ века. Краткая характеристика второй половины ХХ века Характеристика шлифовальных кругов и ее маркировка Служебные части речи. Предлог. Союз. Частицы КАТЕГОРИИ:
|
Текст ПРОГРАММЫ 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 } Не нашли, что искали? Воспользуйтесь поиском:
|