TURBO PASCAL

Новости

ЦЕЛЬ РАБОТЫ. Создать массив записей (базу данных) в соответствии с заданной структурой. Количество записей не больше 10.

Рис. П.1.1. Структура записи «ТОВАР».

1. Реализовать редактирование записей (изменение, добавление, удаление).

2. Реализовать вывод содержимого записи по следующим ключам:

? по номеру записи;

? по наименованию товара;

? по стоимости товара;

? по году поступления товара.

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

Предусмотреть вывод всей базы данных на экран. Вся обработка базы данных должна происходить путем выбора соответствующего пункта из меню. Исходные данные должны вводиться с проверкой на область допустимых значений. Все действия пользователя должны контролироваться и снабжаться осмысленными сообщениями.

п.1.1. Структура записи «ТОВАР»

На алгоритмическом языке Pascal структура, изображенная на рис. П.1.1, может быть описана следующим образом:

data= { дата поступления товара }

record

day : byte; {день}

year : word; {год}

month : byte; {месяц}

end;

RecType= {Запись «товар»}

record

naimt : string[LenNaimt]; {наименование товара}

kolt : longint; {количество товара}

stoimt : real; {стоимость товара}

dmg : data; { дата поступления товара }

end;

п.1.2. Структура базы данных «ТОВАРы»

Рис. П.1.2. Массив записей Mas : Array [1.. ColRec] of RecType

В программе предусмотрен жесткий контроль ввода исходных данных (символьных, целочисленных и вещественных) - см. Процедуры InputString, InputNumber, InputReal. Вывод информационных и аварийных сообщений оформлен единообразно - через процедуру OutMessageXY. Для ориентации пользователя в количестве допустимых символов для каждого поля записи введена процедура OutPutString. В данной программе задействованы такие понятия, как атрибут вывода (переменная TextAttr), позиция курсора (WhereX, WhereY, GotoXY), а также обработка обычных (ESC, ENTER, пробел, символы псевдографики) и расширенных ASCII-кодов (стрелки ? ? ) - см. Прил. 4, 5 настоящего пособия и прил. 6 [5].

п.1.3. ЛИСТИНГ ПРОГРАММЫ Work8.pas

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

{$M 16384,0,655360}

program Work8;

{ Вариант № 40.

Создать массив записей в соответствии с заданной структурой. Количество записей не больше 10. Реализовать редактирование записей (изменение, добавление, удаление). Исходные данные должны вводиться с проверкой на область допустимых значений. Реализовать в соответствии со своим вариантом запрос: «Определить общее количество товара, поступившего за определенный год» и вывод содержимого записи по определенным ключам. Предусмотреть вывод всей базы данных на экран. Вся обработка базы данных должна происходить путем выбора соответствующего пункта из меню.

}

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=2000; {Максимальный год}

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;

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

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

Function error1:boolean;

Var Mes: string;

begin

error1:=true;

if flag then

begin

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

writeln(Mes);

error1:=false;

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}

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;

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;

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;

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

Procedure AddRecord;

Var i, j: Word;

begin

repeat

clrscr;

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

{$I-}

readln(i);

{$I+}

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

MaxElem:=MaxElem+1;

if MaxElem>ColRec then

begin

OutMessageXY(2,23,Err1,Enter);

MaxElem:=MaxElem-1; {Игнорируем запись}

Readln;

exit;

end;

for j:=MaxElem downto i+1 do

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

InputFields(mas[I]);

OutMessageXY(20,24,'Запись добавлена. ',Enter);

readln;

end;

{Процедура коррекции положения курсора при его движении вверх-вниз}

Procedure UpDown(var Vari: integer; Im: byte);

begin

if ch=#0 then ch:=readkey;

case ch of

#72: begin {стрелка вверх ?}

if vari=1 then vari:=im else vari:=vari-1;

gotoxy(1,vari);

end;

#80: begin {стрелка вниз ?}

if vari=im then vari:=1 else vari:=vari+1;

gotoxy(1,vari);

end;

{Функция организации главного меню}

Function MainMenu :boolean;

const i: integer=1; {начальное положение курсора}

begin

MainMenu:=false;

clrscr;

Writeln(Inv1);

Writeln(Inv2);

Writeln(Inv3);

Writeln(Inv4);

Writeln(Inv5);

Writeln(Inv6);

Writeln(Inv7);

Writeln('Выход');

OutMessageXY(5,24,CaseStr,EnterOrSpace);

Gotoxy(1,i);

repeat

ch:=readkey;

if( ch=#32) or (ch=#13) then {реакция на пробел или ENTER}

begin

case i of

1: InputRecord; {Создать массив записей}

2: OutRecord(MaxElem); {Вывести данные на экран}

3: Zapros1; {Вычислить общее количество товаров за определенный год}

4: KeyRec; {Вывести содержимое записи по ключу}

5: AddRecord; {Добавить запись}

6: ChangeDel(true); {Изменить запись}

7: ChangeDel(false); {Удалить запись}

8: begin

Mainmenu:=true;

exit;

end;

end; {case}

exit;

end

else UpDown(i,8);

until false;

end;

{Главная программа}

begin

clrscr;

repeat until MainMenu;

end.

п.1.4. Описание программы и алгоритмов

Описание главной программы

Сначала очищается экран, затем в цикле REPEAT - UNTIL выводится главное меню через обращение к функции MainMenu. Условие выхода из цикла - MainMenu = TRUE.

Алгоритм выполнения функции MainMenu

Эта функция реализует главное меню в программе. Передвигая курсор (стрелки ??) по строкам меню, выбираем необходимый режим работы. В начальном положении курсор находится в начале первой строки. Коррекция положения курсора при его перемещении вниз или вверх по строкам меню реализуется с помощью процедуры UpDown.

В бесконечном цикле REPEAT...UNTIL FALSE анализируется код нажатой клавиши (Ch), если он равен #32 (код клавиши пробел) или #13 (код клавиши ENTER), то в зависимости от того, на какой строке находится курсор (номер строки запоминается в переменной I, число выводимых строк меню равно 8), управление передается следующим процедурам, используя оператор CASE:

case i of

1: InputRecord; {Создать массив записей}

2: OutRecord(MaxElem); {Вывести данные на экран}

3: Zapros1; {Вычислить общее количество товаров за определенный год}

4: KeyRec; {Вывести содержимое записи по ключу}

5: AddRecord; {Добавить запись}

6: ChangeDel(true); {Изменить запись}

7: ChangeDel(false); {Удалить запись}

8: begin

Mainmenu := true;

exit;

end;

Если курсор находится на 8 строке и нажата клавиша ENTER или пробел, функция Mainmenu получает значение true, управление передается в основную программу и программа завершает свою работу.

Алгоритм выполнения процедуры UpDown (var Vari: integer; Im: byte)

Процедура реализует коррекцию положения курсора при его движении по строкам меню (стрелки ?? ). Через переменную Im в процедуру передается число выведенных строк на экран (в нашем случае 8), переменная VarI фиксирует строку, на которой находится курсор, - GotoXY (1,VarI).

В этой процедуре обрабатываются расширенные ASCII-коды клавиш (см. Прил. 4).

Если курсор движется вверх (т.е. нажимаем клавишу ? - код #72) и находится на первой строке (vari=1), то переменной vari присваивается значение im. Тем самым, курсор перемещается на последнюю строку экрана.

Иначе номер строки уменьшается на единицу и курсор передвигается вверх на одну строку.

Аналогично, если курсор находится в последней строке меню и движется вниз (код клавиши ? #80 и переменная vari равна Im), переменной vari присваивается значение 1 (курсор перемещается в первую строку меню).

Иначе значение переменной vari увеличивается на единицу (vari := vari+1) и курсор передвигается вниз.

Описание процедур TopT и EndT

Процедуры выводят верхнюю или нижнюю часть «шапки» базы данных, для чего используются стандартные операторы вывода. Рамка таблицы выводится с помощью символов псевдографики (см. Табл. П.6.3. «кодировка символов по стандарту ASCII» - [5] ).

Описание процедуры InputFields(var Rec: RecType)

Процедура осуществляет ввод значения элементов полей записи Rec. Переменным Rec.naimt, Rec.stoimt, Rec.kolt, Rec.dmg.year, Rec.dmg.month, Rec.dmg.day присваиваются значения. Корректность вводимых значений обеспечивается следующими процедурами:

? Procedure InputReal(Var R: Real; Width: Byte; Inv: String) контролирует ввод вещественных данных R (ширина поля Width) с проверкой на допустимый символ и со строкой приглашения Inv;

? Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt; Width: Byte; Inv: String) контролирует ввод целочисленных данных Number (ширина поля Width) с проверкой диапазона [NumberMin .. NumberMax] и со строкой приглашения Inv;

? Procedure InputString(Var S: String; LenNaimt: byte; Inv: String) контролирует ввод строки символов S с проверкой количества введенных символов [1..LenNaimt] и со строкой приглашения Inv.

Все эти процедуры предварительно выводят максимальное количество возможных позиций для данного поля цветом Color на фоне Fon (процедура OutPutString).

Описание процедуры OutputRec(rec: RecType)

Процедура осуществляет вывод значений элементов полей записи стандартными операторами вывода с использованием символов псевдографики (см. Табл. П.6.3. «кодировка символов по стандарту ASCII» - [5] ).

Описание процедуры InputRecord

Процедура формирует массив записей mas[i]. Окончание ввода контролируется нажатием клавиш: ESC (код #27) и ENTER (код #13). При нажатии клавиши ESC формирование массива записей заканчивается. В случае, если массив записей пустой или число записей i превышает заданное ColRec, процедура OutMessageXY(X, Y: byte; Str1, Str2:string) выводит сообщение об этом Str1, Str2 на экран дисплея, начиная с позиции X, Y.

Описание процедуры OutRecord (MaxElem :integer)

Процедура реализует вывод значений элементов массива записей. В случае, если массив записей пустой или число записей превышает заданное, процедура OutMessageXY(x, y: byte; Str1, Str2:string) выводит сообщение об этом на экран дисплея.

Описание процедуры Zapros1

Процедура рассчитывает суммарное количество товара, поступившего за определенный год. В цикле по i, которое изменяется от 1 до MaxElem (количество элементов в массиве записей) проверяется значение переменной mas[i].dmg.year. Если оно равно заданному god, то определяется суммарное значение количества поступившего товара, которое запоминается в переменной Sum. Строки базы данных, соответствующие нужному году, выводятся на экран. В аномальных случаях через процедуру OutMessageXY(x, y: byte; Str1, Str2:string) выводятся аварийные сообщения.

Описание процедуры KeyRec

Процедура реализует поиск записи по нужному ключу. В цикле Repeat ... until f на экран выводится меню. В зависимости от выбора производится ввод значения переменной ch:

? по номеру записи (ch:=1),

? по наименованию товара (ch:=2),

? по стоимости товара (ch:=3),

? по году поступления товара (ch:=4).

Условием выхода из цикла является значение TRUE логической переменной F. Переменная F принимает значение FALSE, если введено неизвестное значение ключа.

При вводе значений полей элементов массива записей происходит их контроль соответствующими процедурами в зависимости от типа переменных (см. описание процедуры InputFields).

После этого в зависимости от ключа происходит поиск нужной информации, формирование логических признаков f, f1 и вывод на экран записи. Если база данных пуста или нужная запись не найдена, то через процедуру OutMessageXY(x, y: byte; Str1, Str2:string) выводятся соответствующие сообщения.

Алгоритм выполнения процедуры ChangeDel (flag: boolean)

Процедура реализует изменение (входной параметр FLAG = TRUE) или удаление (входной параметр FLAG = FALSE) записи в массиве записей.

По введенному номеру записи i удаляется или изменяется запись в массиве записей. При этом эта запись выводится и пользователь может удостовериться, та ли это запись. В случае утвердительного ответа происходит коррекция массива записей.

В случае удаления записи i в цикле по j происходит переприсваивание каждого значения элемента массива записей, начиная с i до MaxElem-1 (каждому предыдущему значению элемента массива присваивается последующее значение mas[j]:=mas[j+1]). Максимальное число элементов массива записей уменьшается на единицу (MaxElem:=MaxElem-1).

В случае изменения записи вводятся измененные (новые) значения всех полей элементов записи через процедуру InputFields (mas[i]).

Вывод нужных сообщений реализуется через процедуру OutMessageXY(x, y: byte; Str1, Str2:string).

Алгоритм выполнения процедуры AddRecord

Процедура реализует добавление i-ой записи в массив записей. Количество записей в массиве увеличивается на единицу (MaxElem:=MaxElem+1). В цикле по j происходит переприсваивание элементов массива записей (обратите внимание на то, что цикл «идет» в обратном порядке, начиная с MaxElem и заканчивая i+1). Каждому последующему значению элемента массива присваивается предыдущее (mas[j]:=mas[j-1]). Затем следует ввод добавляемой записи - через процедуру InputFields(mas[i]).