|
Исходный
код программы:
program
NZLAB_8A;
uses
crt;
type
rec=record
family,name,surname:string[26];
ADR:string[26];
mark:string[26];
year:string[5];
color:string[26];
enige:string[26];
number:string[10];
end;
base=array[1..1]of
rec;
link=^base;
proc_out=procedure(var
all_base:link;var i:integer);
proc_in=procedure(var
all_base:link;var i:integer);
var
all_base:link;
i:integer;
k:boolean;
{$R-}
{$F+}
procedure
card_out(var vsa_baza:link;var i:integer);
begin
with
all_base^[i] do begin
writeln('╔═══════════╤═══════════════════════════╗');
writeln('║Фамилия:
│',family:27,'║');
writeln('║Имя:
│',name:27,'║');
writeln('║Отчество:
│',surname:27,'║');
writeln('║Адрес:
│',adr:27,'║');
writeln('║Марка:
│',mark:27,'║');
writeln('║Год:
│',year:27,'║');
writeln('║Цвет:
│',color:27,'║');
writeln('║Движок:
│',enige:27,'║');
writeln('║Номер:
│',number:27,'║');
writeln('╚═══════════╧═══════════════════════════╝');
end;
end;
procedure
card_in(var all_base:link;var i:integer);
begin
if
all_base=nil then
begin
writeln('MEMORY
END');
readln;
halt;
end;
writeln('Вы
заполняете карточку №',i);
with
all_base^[i]
do
begin
write('Фамилия:
');
readln(family);
write('Имя:
');
readln(name);
write('Отчество:
');
readln(surname);
write('Адрес:
');
readln(adr);
write('Марка:
');
readln(mark);
write('Год
выпуска:
');
readln(year);
write('Цвет:
');
readln(color);
write('Двигатель:
');
readln(enige);
write('Гос.номер:
');
readln(number);
end;
end;
{$F-}
procedure
inrec(vvod_kartoshki:proc_in;card_out:proc_out;var i:integer;var
k:boolean);
var
x:char;
n,y:integer;
begin
y:=0;
clrscr;
writeln('Введите
количество вводимых записей');
readln(n);
n:=n+i;
y:=i+1;
while
y<=n do
begin
clrscr;
card_in(all_base,y);
clrscr;
writeln('Проверьте
введенные данные и подтвердите ',
'занесение
в
базу:');
card_out(all_base,y);
y:=y+1;
writeln;
writeln('Сохранить
данные
или
повторить
ввод?');
writeln('AnyKey-Сохранить,2-Повторить
ввод: ');
x:=readkey;
if
x='2'
then
y:=y-1;
end;
k:=false;
i:=y-1;
end;
procedure
outrec(card_out:proc_out;var i:integer; var k:boolean);
var
x,y:integer;
begin
clrscr;
if
i=0 then
begin
writeln('В
базе
нет
элементов');
readln;
k:=false;
exit;
end;
y:=0;
repeat
clrscr;
y:=y+1;
writeln('Выводится
элемент
№',y);
card_out(all_base,y);
readln;
until
y>=i;
clrscr;
writeln('Элементы
закончились');
readln;
k:=false;
end;
procedure
search(card_out:proc_out;var i:integer; var k:boolean);
var
stroka:string;
x,y:integer;
z:char;
flag:boolean;
begin
clrscr;
if
i=0
then
begin
writeln('В
базе
нет
элементов');
readln;
k:=false;
exit;
end;
writeln('Введите
строку
для
поиска
(одно
слово
или
одно
поле)');
readln(stroka);
clrscr;
for
x:=1
to
i
do
begin
flag:=true;
with
all_base^[x] do
begin
y:=pos(stroka,family);
if
y=0 then
y:=pos(stroka,name);
if
y=0 then
y:=pos(stroka,surname);
if
y=0 then
y:=pos(stroka,adr);
if
y=0 then
y:=pos(stroka,mark);
if
y=0 then
y:=pos(stroka,year);
if
y=0 then
y:=pos(stroka,color);
if
y=0 then
y:=pos(stroka,enige);
if
y=0 then
y:=pos(stroka,number);
if
y<>0 then
begin
writeln('Найдена
карточка
№',x);
card_out(all_base,x);
flag:=false;
writeln;
writeln('Нажмите
AnyKey-Для
продолжения
поиска,
2-Для
выхода
');
z:=readkey;
clrscr;
if
z='2'
then
exit;
end;
end;
end;
if
flag then
writeln('Ничего
не
найдено')
else
writeln('Поиск
успешно завершен');
readln;
k:=false;
end;
procedure
delete(card_out:proc_out;var i:integer; var k:boolean);
var
x,z:integer;
y:char;
begin
clrscr;
if
i=0 then
begin
writeln('В
базе
нет
элементов');
readln;
k:=false;
exit;
end;
write('Введите
номер
элемента:
');
readln(x);
if
(x>i) or (x<=0) then
begin
clrscr;
writeln('Удаление
невозможно , элемента не существует');
readln;
k:=false;
exit;
end;
card_out(all_base,x);
writeln;
writeln('Вы
хотите
удалить
эту
запись?
(1-Да\AnyKey-Нет)');
y:=readkey;
if
y='1' then
begin
for
z:=x to i-1 do
all_base^[z]:=all_base^[z+1];
i:=i-1;
end;
k:=false;
end;
procedure
main_menu(var i:integer; var k:boolean);
var
g:char;
begin
clrscr;
window(14,6,66,24);
writeln('Вы
находитесь в главном меню БД ДПС v1.0
Записей: ',i);
writeln;
writeln('Выберете
действие:');
writeln('┌───┬────────────────────────┐');
writeln('│
1 │Ввод новых элементов │ ');
writeln('│
2 │Вывод элементов на экран│');
writeln('│
3 │Поиск в базе по ключу │');
writeln('│
4 │Удаление элемента │');
writeln('│
5 │Завершение работы │');
writeln('└───┴────────────────────────┘');
g:=readkey;
case
g
of
'1':inrec(card_in,card_out,i,k);
'2':outrec(card_out,i,k);
'3':search(card_out,i,k);
'4':delete(card_out,i,k);
'5':k:=true
else
writeln('Неправильная
команда');
end;
end;
begin
textcolor(15);
textbackground(1);
new(all_base);
k:=true;
i:=0;
main_menu(i,k);
while
k=false do
main_menu(i,k);
dispose(all_base);
end.
|