Структурированный тип запись. Массив записей в динамической памяти. Построение на экране меню

Балтийский государственный технический университет «ВОЕНМЕХ» им. Д. Ф. Устинова

Кафедра информационных систем и технологий

Лабораторная работа №3

«Структурированный тип запись. Массив записей в динамической памяти. Построение на экране меню.»

Преподаватель: Шеляпин Ю. П.

Выполнил: Королев М. Ю.

Группа: И-351

Санкт-Петербург

2006 год.

Задание

Разработать модуль, определяющий в масиве записей с полями: Наименование детали; Материал; Количество. Совпадение с отдельно введенным «материалом» и выводящий данные о таких элементах массива. Поиск и удаление.

Блок-схема алгоритма

program lab3; {Korolev I351}

uses crt;

const

n=10;

k=5; {meny}

a:array[1..k] of string=(

'Добавить запись',

'Удалить запись',

'Вывод в таблицу',

'Поиск записей',

'Выход');

type

detal=record

name:string[20];

material:string[20];

kolvo:integer;

end;

detals=array[1..n] of detal;

ptrdetals=^detals;

arr=array[0..n] of integer;

ptrarr=^arr;

var

sklad,masFind:ptrdetals;

masN,masNF:ptrarr;

choose,klFind,l:byte;

Pole:string;

procedure ShowMeny(n,LeftX,LeftY,RightX,RightY:byte; a:array of string; var result:byte);

var i,nowPoz:byte;

choose:boolean;

answer:char;

begin

nowPoz:=0;

choose:=false;

window(LeftX,LeftY,RightX,RightY);

Repeat

textattr:=$07;

clrscr;

For i:=0 to n-1 do

if i=nowPoz then begin

textattr:=$2F;

WriteLn(chr(16),' ',a[i],' ':(20-length(a[i])),chr(17));

end

else begin

textAttr:=$07;

WriteLn('  ',a[i]);

end;

answer:=readkey;

Case answer of

#80{Down} : If nowPoz<n-1 then

nowPoz:=nowPoz+1

Else

nowPoz:=0;

#72{Up}   : If nowPoz>0 then

nowPoz:=nowPoz-1

Else

nowPoz:=n-1;

#13{Enter}: begin

result:=nowPoz+1;

choose:=true

end;

end;

Until choose;

textattr:=$07;

clrscr;

window(1,1,80,25);

end;

procedure AddRec(var n:byte;var rec:ptrdetals; var masN:ptrarr);

var

i,j:integer;

f:boolean;

begin

clrscr;

WriteLn('Ввод записей:');

Write('Сколько записей вы хотите ввести: ');

f:=false;

Repeat

{$I-}

ReadLn(i);

if (ioresult=0) and (i>0) then f:=true

else begin

WriteLn('Неверный формат ввода');

readkey;

gotoxy(1,3);

clreol;

gotoxy(35,2);

clreol;

end;

{$I+}

Until f;

For j:=n+1 to n+i do

With rec^[j] do begin

masN^[j]:=j;

WriteLn('Деталь №',j,': ');

Write('     Введите название детали:    ');

Readln(name);

Write('     Введите материал детали:    ');

Readln(material);

Write('     Введите количество деталей: ');

f:=false;

Repeat

{$I-}

Readln(kolvo);

if (ioresult=0) and (i>0) then f:=true

else begin

WriteLn('Неверный формат ввода');

readkey;

gotoxy(1,WhereY-1);

clreol;

gotoxy(34,WhereY-1);

clreol;

end;

{$I+}

Until f;

end;

n:=j;

end;

procedure DelRec(var n:byte;var rec:ptrdetals);

var

i,j:byte;

f:char;

begin

clrscr;

if l=0 then begin

WriteLn('Сначала нужно ввести записи!');

readkey;

exit;

end;

Write('Какую запись вы хотите удалить(№): ');

ReadLn(j);

with rec^[j] do begin

WriteLn('Название - ',name);

WriteLn('Материал - ',material);

WriteLn('Количество - ',kolvo);

end;

Write('Вы действительно хотите удалить запись (y/n): ');

Readln(f);

if f<>'y' then exit;

if (j>n) or (j<1) then begin

WriteLn('Неверный формат ввода');

readkey;

exit;

end;

if (j=n) then begin

WriteLn('Запись №',j,' удалена');

WriteLn('Нажмите любую клавишу для продолжения');

readkey;

dec(n);

exit;

end;

For i:=j to n-1 do

rec^[i]:=rec^[i+1];

WriteLn('Запись №',j,' удалена');

WriteLn('Нажмите любую клавишу для продолжения');

readkey;

dec(n);

end;

procedure TabRec(var n:byte;var rec:ptrdetals; masN:ptrarr);

var

i:byte;

begin

if l=0 then begin

WriteLn('Сначала нужно ввести записи!');

readkey;

exit;

end;

WriteLn('г=========T=======================T====================T====================¬');

WriteLn('¦  Номер  ¦  Наименование детали  ¦      Материал      ¦ Количество деталей ¦');

WriteLn('¦=========+=======================+====================+====================¦');