Написание программы базы данных для склада (Массив записей в динамической памяти. Построение на экране меню)

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

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

Второй семестр                                 

                                                            Выполнил: Суходоев Павел. Группа И-351

Задание

Написать программу выполняющую следующие операции:

1.  ввод массива

2.  вывод массива

3.  поиск записи

4.  удаление записи

5.  выход.

Организовать это меню.

Формат записи: база данных для склада:

Табельный номер, месяц, вид начисления, сумма, налоги, номер отдела.

Программа

program lab3;

uses crt;

const

n=10;

k=5;

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

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

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

'вывести запись',

'поиск',

'выход');

type

bazarec=record

tabnom:string[20];

month:string[20];

vidnach:string[20];

sum:real;

nalog:real;

nomotd:integer;

end;

bazarecs=array[1..n] of bazarec;

dinbazarecs=^bazarecs;

var

baza,masFind:dinbazarecs;

choose,klFind,l:byte;

Pole:string;

procedure Menu(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

clrscr;

For i:=0 to n-1 do

if i=nowPoz then

begin

textattr:=$09;

WriteLn(chr(16),' ',a[i],' ':(17-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 input_baza (var n:byte;var list:dinbazarecs);

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 list^[j] do

begin

WriteLn('запись №',j,': ');

Write('     введи табельний номер:    ');

Readln(tabnom);

Write('     введи месяц:    ');

Readln(month);

Write('     введи вид начисления: ');

Readln(vidnach);

Write('     введи сумму:    ');

Readln(sum);

Write('     введи налоги:    ');

Readln(nalog);

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

Readln(nomotd);

end;

n:=j;

end;

procedure output_baza(n:byte; var list:dinbazarecs);

var

i:byte;

begin

if l=0 then

begin

WriteLn('сначала введи запись');

readkey;

exit;

end;

for i:= 1 to n do

with list^[i] do

begin

writeln ('╔══════════════╤════════════════════╗');

writeln ('║табел-ый номер│ ',tabnom:18,' ║');

writeln ('║месяц         │ ',month:18,' ║');

writeln ('║вид начисления│ ',vidnach:18,' ║');

writeln ('║сумма         │ ',sum:18:2,' ║');

writeln ('║налоги        │ ',nalog:18:2,' ║');

writeln ('║номер отдела  │ ',nomotd:18,' ║');

writeln ('╚══════════════╧════════════════════╝');

readln;

clrscr;

end;

end;

procedure Delete(var n:byte;var list:dinbazarecs);

var

i,j:byte;

f:char;

begin

clrscr;

if l=0 then

begin

WriteLn('сначала надо ввести запись');

readkey;

exit;

end;

Write('введи номер записи для удаления: ');

ReadLn(j);

with list^[j] do

begin

writeln ('╔══════════════╤════════════════════╗');

writeln ('║табел-ый номер│ ',tabnom:18,' ║');

writeln ('║месяц         │ ',month:18,' ║');

writeln ('║вид начисления│ ',vidnach:18,' ║');

writeln ('║сумма         │ ',sum:18:2,' ║');

writeln ('║налоги        │ ',nalog:18:2,' ║');

writeln ('║номер отдела  │ ',nomotd:18,' ║');

writeln ('╚══════════════╧════════════════════╝');

readln;

end;

Writeln('удалить запись? (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,' удалена');

readkey;

dec(n);

exit;

end;

For i:=j to n-1 do

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

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

readkey;

dec(n);

end;

procedure search(n:byte;list:dinbazarecs;var Pole:string;var k:byte;var masFind:dinbazarecs);

const

z=1;

Men:array[1..z] of string=('name');

var

i,t:byte;

srchrec:string[20];

begin

clrscr;

if l=0 then

begin

WriteLn('сначала введи запись');

readkey;

exit;

end;

Write('введи табельный номер записи для поиска ');

ReadLn(srchrec);

k:=0;

t:=0;

For i:=1 to n do

begin

if list^[i].tabnom=srchrec then

begin

inc(k);

with masFind^[k] do

begin

tabnom:=list^[i].tabnom;

month:=list^[i].month;

vidnach:=list^[i].vidnach;

sum:=list^[i].sum;

nalog:=list^[i].nalog;

nomotd:=list^[i].nomotd;

inc(t);

end;

end;

end;

if t=0 then begin

writeln('нет такой записи ');

readkey;

end;

end;

begin

new(baza);

new(masFind);

l:=0;

Repeat

clrscr;

Menu(k,1,WhereY+1,25,WhereY+1+k,a,choose);

Case choose of