Типизированные и текстовые файлы. Создание базы данных склада на основе динамического массива, страница 2

writeln(' такой строки нет в базе, удаление не может быть выполнено ‘);

exit;

end

else

begin

InFind(k,A);

writeln(' вы действительно хотите удалить эту строку? (y/n) ');

read(ans);

if (ans='y') or (ans='Y') then

Delete(k,m,A);

end

end;

end.

Unit menuIVQ;

interface

uses

Crt, GlobIV;

Function Menu:integer;

implementation

Function Menu:integer;

var

S: array [1..10] of string;

g,t,y,i,j:integer;

kurs:char;

begin

clrscr;

S[1]:='     ввод массива     ';

S[2]:='     вывод списка     ';

S[3]:='  добавление записи   ';

S[4]:='   удаление записи    ';

S[5]:='    поиск по полю     ';

S[6]:=' запись в текст.файл  ';

S[7]:=' чтение из текст.файла';

S[8]:='   запись в тип.файл  ';

S[9]:=' чтение из тип.файла  ';

S[10]:='        выход         ';

gotoXY(35, 2);

writeln('Главное меню');

gotoXY(28,4);

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

gotoXY(28,5);

writeln(' ║                      ║ ');

gotoXY(28,6);

writeln(' ╟──────────────────────╢');

gotoXY(28,7);

writeln(' ║                      ║');

gotoXY(28,8);

writeln(' ╟──────────────────────╢');

gotoXY(28,9);

writeln(' ║                      ║');

gotoXY(28,10);

writeln(' ╟──────────────────────╢');

gotoXY(28,11);

writeln(' ║                      ║');

gotoXY(28,12);

writeln(' ╟──────────────────────╢');

gotoXY(28,13);

writeln(' ║                      ║');

gotoXY(28,14);

writeln(' ╟──────────────────────╢');

gotoXY(28,15);

writeln(' ║                      ║');

gotoXY(28,16);

writeln(' ╟──────────────────────╢');

gotoXY(28,17);

writeln(' ║                      ║');

gotoXY(28,18);

writeln(' ╟──────────────────────╢');

gotoXY(28,19);

writeln(' ║                      ║');

gotoXY(28,20);

writeln(' ╟──────────────────────╢');

gotoXY(28,21);

writeln(' ║                      ║');

gotoXY(28,22);

writeln(' ╟──────────────────────╢');

gotoXY(28,23);

writeln(' ║                      ║');

gotoXY(28,24);

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

j:=5;

for i:=1 to 10 do

begin

gotoXY(30,j);

j:=j+2;

write(S[i]);

end;

g:=1;

t:=1;

kurs:=#72;

while kurs<>#13 do

begin

if kurs=#72 then

begin

t:=g;

g:=g-1;

end;

if kurs=#80 then

begin

t:=g;

g:=g+1;

end;

if g=11 then g:=1;

if g=0 then g:=10;

y:=3+2*t;

gotoXY(30,y);

write(S[t]);

y:=3+2*g;

gotoXY(30,y);

TextColor(black);

TextBackground(white);

write(S[g]);

TextColor(lightgray);

TextBackground(black);

gotoXY(80,25);

kurs:=readkey;

end;

Menu:=g;

end;

end.

Unit IOFileIV;

interface

uses

Crt, GlobIV;

procedure writetxt(var s:store; var k:integer);

procedure readtxt(var s:store; var k:integer);

procedure writebin(var s:store; var k:integer);

procedure readbin(var s:store; var k:integer);

implementation

procedure writetxt(var s:store; var k:integer);

var

filename: string;

filetxt: text;

i:integer;

begin

if m=0 then

begin

writeln('Запись не произведена, т.к. база пуста');

readkey;

exit

end;

writeln('Введите имя файла');

readln(filename);

assign(filetxt,filename);

{$i-}

rewrite(filetxt);

{$i+}

if IOresult<>0 then

begin

writeln('Файл не создан');

readkey;

exit;

end

else

begin

for i:=1 to k do

with s^[i] do

begin

writeln(filetxt,Name);

writeln(filetxt,NomNum);

writeln(filetxt,BillNum);

writeln(filetxt,Date.Day);

writeln(filetxt,Date.Month);

writeln(filetxt,Date.Year);

writeln(filetxt,Income);

writeln(filetxt,Outlay);

end;

close(filetxt);

end;

writeln('Запись успешно произведена');

end;

procedure readtxt(var s:store; var k:integer);

var

filename: string;

filetxt:  text;

begin

writeln('Введите имя файла');

readln(filename);

assign(filetxt,filename);

{$i-}

reset(filetxt);

{$i+}

if IOresult<>0 then

begin

writeln('Неверно введено имя файла ');

readkey;

exit;

end

else

begin

k:=0;

while not eof(filetxt) do

begin

k:=k+1;

with s^[k] do

begin

readln(filetxt,Name);

readln(filetxt,NomNum);

readln(filetxt,BillNum);

readln(filetxt,Date.Day);

readln(filetxt,Date.Month);

readln(filetxt,Date.Year);

readln(filetxt,Income);

readln(filetxt,Outlay);

end;

end;

if k=0 then writeln(' файл пуст ');

close(filetxt);

end;

end;

procedure writebin(var s:store; var k:integer);

var

filename:string;

filebin:file of store;

i:integer;

begin

if m=0 then

begin

writeln('Запись не произведена, т.к. база пуста');

readkey;

exit;

end;

writeln('Введите имя файла');

readln(filename);

assign(filebin,filename);

{$i-}

rewrite(filebin);

{$i+}

if IOresult<>0 then

begin

writeln('Неверно введено имя файла ');

readkey;

exit;

end;

for i:=1 to k do

write(filebin,s);

close(filebin);

end;

procedure readbin(var s:store; var k:integer);

var

filename: string;

filebin : file of store;

begin

writeln('Введите имя файла');

readln(filename);

assign(filebin,filename);

{$i-}

reset(filebin);

{$i+}

if ioresult<>0 then

begin

writeln('Неверно введено имя файла ');

readkey;

exit;

end

else

begin

k := 0;

while not eof(filebin) do

begin

k:=k+1;

read(filebin,s);

end;

close(filebin);

if k=0 then writeln(' файл пуст ');

readkey;

end;

end;

end.