case Active of
1: LoadData(n, BGTU);
2: InputData(n, BGTU);
3: OutputData(n, BGTU);
4: FindData(n, BGTU);
5: ChangeData(n, BGTU);
6: DeleteData(n, BGTU);
7: SaveData(n, BGTU);
8: About;
9: Quit:=True;
end;
Active:=1;
ClrScr;
PrintMainFraime(2, 2, 78, 13);
PrintMainMenu(Active);
end;
end;
until Quit;
end;
end.
unit Work;
uses Crt, Structur, Menu;
procedure LoadData(var n: Integer; var BGTU: Link);
procedure InputData(var n: Integer; var BGTU: Link);
procedure OutputData(n: Integer; var BGTU: Link);
procedure FindData(n: Integer; BGTU: Link);
procedure ChangeData(n: Integer; var BGTU: Link);
procedure DeleteData(var n: Integer; var BGTU: Link);
procedure SaveData(n: Integer; BGTU: Link);
procedure About;
{------Вспомогательные процедуры и функции------}
procedure PressKey;
var Clean: Char;
begin
GotoXY(1,25);
Write('Нажмите любую клавишу...');
repeat
until KeyPressed;
while keyPressed do Clean:=ReadKey;
end;
function SafeRead(MaxLen, MinLen ,Code: Integer): String;
var Poz: Integer; { code=1 - только цифры }
Flag: Boolean; { code=0 - все символы }
Result: String;
Ch: Char;
begin
Result:='';
Poz:=0; Flag:=False;
repeat
Ch:=ReadKey;
case Ch of
#13: if Length(Result)>=MinLen then Flag:=True;
#08: if Length(Result)>0 then
begin
Delete(Result, Length(Result), 1);
GotoXY(WhereX-1, WhereY); write(' ');
GotoXY(WhereX-1, WhereY);
end;
else if (Length(Result)<MaxLen) and (Ch<>#27) and ((Code=1) and (Ord(Ch)>47)
and (Ord(Ch)<58) or (Code=0)) then
begin
Write(Ch);
Result:=Result+Ch;
end;
end;
until Flag;
SafeRead:=Result;
end;
procedure Clear(x1, y1, x2, y2: Integer);
var zicl, zicl2: Integer;
begin
GotoXY(x1, y1);
for zicl:=y1 to y2 do
begin
for zicl2:=x1 to x2 do Write(' ');
GotoXY(x1, WhereY+1);
end;
end;
{------Работа со связанным списком------}
procedure SpInsert (var Base, Add: Link); {Добавление Элемента}
var Temp: Link;
begin
if (Base=nil) or (Add^.Name<=Base^.Name) then
begin
Add^.Pred:=Nil;
Add^.Next:=Base;
Base^.Pred:=Add;
Base:=Add;
end
else
begin
Temp:=Base;
while (Temp^.Name<Add^.Name) and (Temp^.Next<>Nil) do
Temp:=Temp^.Next;
if Add^.Name<=Temp^.Name then
begin
Add^.Next:=Temp;
Add^.Pred:=Temp^.Pred;
Temp^.Pred^.Next:=Add;
Temp^.Pred:=Add;
end
else
begin
Temp^.Next:=Add;
Add^.Next:=Nil;
Add^.Pred:=Temp;
end;
end;
end;
procedure SpSearch(var Temp, Search: Link); {поиск элемента}
var Found: Boolean;
begin
Found:=False;
while not Found and (Temp<>Nil) do
begin
if (Temp^.Name=Search^.Name) or
(Temp^.BirthYear=Search^.BirthYear) or
(Temp^.Address=Search^.Address) or
(Temp^.Phone=Search^.Phone) or
(Temp^.Facultet=Search^.Facultet) or
(Temp^.Group=Search^.Group) then Found:=True
else Temp:=Temp^.Next;
end;
end;
procedure SpDelete(var Base, Del: Link); {Удаление элемента}
begin
if Del^.Pred=Nil then
begin
Base:=Base^.Next;
Base^.Pred:=Nil;
end
else
Del^.Pred^.Next:=Del^.Next;
if Del^.Next=Nil then
begin
Del^.Pred^.Next:=Nil;
end
else
Del^.Next^.Pred:=Del^.Pred;
Dispose(Del);
end;
{------Основные процедуры------}
procedure LoadData(var n: Integer; var BGTU: Link); {I Пункт меню}
var F: Text;
Path: String;
Loaded: Word;
Add: Link;
begin
ClrScr;
GotoXY(24, 1);
Write('Загрузка данных из текст. файла');
PrintMainFraime(2, 2, 78, 15);
GotoXY(4, 4);
Write('Введите имя файла: ');
Path:=SafeRead(50,1,0);
GotoXY(4, 6);
Assign(f, Path);
{$I-}
Reset(F);
{$I+}
if IoResult<>0 then
Write('Ошибка открытия файла...')
else
begin
Loaded:=n;
while not Eof(f) and (MaxAvail>3*SizeOf(Person)) do
begin
Inc(n);
New(Add);
with Add^ do
begin
Readln(f, Name);
Readln(f, BirthYear);
Readln(f, Address);
Readln(f, Phone);
Readln(f, Facultet);
Readln(f, Group);
end;
SpInsert(BGTU, Add);
end;
Loaded:=n-Loaded;
if not Eof(f) then Write('База данных заполнена...');
Close(f);
GotoXY(4, 8);
Write('Загружено записей: ', Loaded);
end;
PressKey;
end;
procedure InputData (var n: Integer; var BGTU: Link); {II Пункт меню}
var Add: Link;
Key: Char;
Quit: Boolean;
begin
Quit:=False;
while Quit=False do
begin
ClrScr;
GotoXY(32, 1);
Write('Добавление записи');
PrintMainFraime(2, 2, 78, 15);
GotoXY(4, 3);
Writeln('Ввод записи номер ', n+1);
GotoXY(4,5);
if MaxAvail<3*SizeOf(Person) then
begin
Write('Невозможно выделить память...');
PressKey;
ClrScr;
PrintMainFraime(2, 2, 78, 13);
PrintMainMenu(1);
Exit;
end;
New(Add);
with Add^ do
begin
Write('Фамилия: '); Name:=SafeRead(20, 1, 0);
GotoXY(4,6);
Write('Год Рождения: '); BirthYear:=SafeRead(4, 1, 1);
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.