Пермский Государственный Технический Университет
Кафедра ИТАС
Лабораторная №10
Выполнил: Попов М.В.
Проверил : Мосиенко А. Ю.
Пермь. 2008 г.
1=1
Esc:
1:
2:
3:
4:
5:
6:
uses
Unit36, Crt;
begin
repeat
Menu;
case ReadKey of
'1': Viewing;
'2': Additing;
'3': Editing;
'4': Deleting;
'5': Searching;
'6': Sorting;
#27: exit;
end;
Until 1<>1
end.
UNIT Unit36;
{------------------------------------}
INTERFACE
{------------------------------------}
uses Crt;
const
Base = 'Base.dat';
Temp = 'Temp.dat';
LengthFIO = 30;
HC = Yellow;
THC = Brown;
type
Worker = record
N: Integer;
FIO: string[LengthFIO];
Kafedra,Dolgnost,Razrad: Byte;
Stavka,Oklad,Zarplata: Real;
end;
var
Index: Integer;
w: Worker;
f,ft: file of Worker;
procedure Header(s: String);
procedure Menu;
procedure FMenu;
procedure MaxIndex;
procedure Viewing;
procedure Additing;
procedure Editing;
procedure Deleting;
procedure Searching;
function Direct(C: Boolean; D: Char): Boolean;
procedure Sorting;
{------------------------------------}
IMPLEMENTATION
{------------------------------------}
procedure Header;
begin
ClrScr;
TextColor(HC);
GotoXY(35,1); Write(s);
GotoXY(1,3);
TextColor(LightGray);
end;
procedure Menu;
begin
Header('Лабораторная 10');
WriteLn('1 - Просмотр');
WriteLn('2 - Добавить');
WriteLn('3 - Изменить');
WriteLn('4 - Удалить');
WriteLn('5 - Поиск');
WriteLn('6 - Сортировка');
WriteLn('Esc - Выход');
end;
procedure FMenu;
begin
WriteLn('1 - ФИО');
WriteLn('2 - Кафедра');
WriteLn('3 - Должность');
WriteLn('4 - Разряд');
WriteLn('5 - Ставка');
WriteLn('6 - Оклад');
WriteLn('7 - Зарплата');
WriteLn;
end;
procedure MaxIndex;
var
w: Worker;
begin
reset(f);
Index:= 0;
while not EOF(f) do begin
Inc(Index);
Read(f,w);
end;
close(f);
end;
procedure Viewing;
var
i: Integer;
begin
MaxIndex;
reset(f);
Header('Просмотр');
TextColor(THC);
WriteLn('N Фамилия Имя Отчество Каф Долж Разр Ставка Оклад Зарплата');
TextColor(LightGray);
WriteLn;
for i:= 1 to Index do begin
Read(f,w);
with w do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
ReadKey;
close(f);
end;
procedure Additing;
begin
repeat
MaxIndex;
reset(f);
Seek(f,Index);
Header('Добавление');
with w do begin
WriteLn(Index+1); N:= Index+1;
Write('ФИО: '); ReadLn(FIO);
Write('Кафедра: '); ReadLn(Kafedra);
Write('Должность: '); ReadLn(Dolgnost);
Write('Разряд: '); ReadLn(Razrad);
Write('Ставка: '); ReadLn(Stavka);
Write('Оклад: '); ReadLn(Oklad);
Zarplata:= Stavka * Oklad;
end;
Write(f,w);
WriteLn;
WriteLn('Enter - меню');
WriteLn('Любая другая - продолжить');
close(f);
until ReadKey = #13;
end;
procedure Editing;
var
i: Integer;
wt: Worker;
begin
repeat
MaxIndex;
reset(f);
Header('Изменение');
Write('Введите номер записи: '); ReadLn(i);
if not (i in [1..Index]) then begin
TextColor(Brown);
WriteLn('Неправильно введен номер карточки!');
WriteLn('Он должен быть: 1..',Index);
TextColor(LightGray);
ReadKey;
exit;
end
else with w do begin
Seek(f,i-1); Read(f,wt);
N:= i;
Write('ФИО: '); ReadLn(FIO);
if FIO = '0' then FIO:= wt.FIO;
Write('Кафедра: '); ReadLn(Kafedra);
if Kafedra = 0 then Kafedra:= wt.Kafedra;
Write('Должность: '); ReadLn(Dolgnost);
if Dolgnost = 0 then Dolgnost:= wt.Dolgnost;
Write('Разряд: '); ReadLn(Razrad);
if Razrad = 0 then Razrad:= wt.Razrad;
Write('Ставка: '); ReadLn(Stavka);
if Stavka = 0 then Stavka:= wt.Stavka;
Write('Оклад: '); ReadLn(Oklad);
if Oklad = 0 then Oklad:= wt.Oklad;
Zarplata:= Stavka * Oklad;
end;
Seek(f,i-1); Write(f,w);
close(f);
WriteLn;
WriteLn('Enter - меню');
WriteLn('Любая другая - продолжить');
until ReadKey = #13;
end;
procedure Deleting;
var
i,n: Integer;
w: Worker;
begin
repeat
WriteLn;
WriteLn('1 - Удалить одну запись');
WriteLn('0 - Удалить все записи');
WriteLn;
case ReadKey of
'1': begin
MaxIndex;
Write('Запись N: '); ReadLn(n);
if not (n in [1..Index]) then begin
TextColor(Brown);
WriteLn('Неправильно введен номер карточки!');
WriteLn('Он должен быть: 1..',Index);
TextColor(LightGray);
ReadKey;
exit;
end
else begin
reset(f); rewrite(ft);
for i:= 1 to Index do
if i<n then begin
Read(f,w);
Write(ft,w);
end
else if i>n then begin
Read(f,w);
w.N:= i-1;
Write(ft,w);
end
else Read(f,w);
close(f); close(ft);
erase(f);
rename(ft,Base);
TextColor(Red);
WriteLn('Данные удалены');
TextColor(LightGray);
end;
end;
'0': begin
erase(f);
rewrite(f);
TextColor(Red);
WriteLn('Все данные удалены');
TextColor(LightGray);
end;
end;
WriteLn;
WriteLn('Enter - меню');
WriteLn('Любая другая - продолжить');
until ReadKey = #13;
end;
procedure Searching;
var
i: Integer;
wf: Worker;
begin
repeat
Header('Поиск');
FMenu;
Case ReadKey of
'1': begin
Write('ФИО: '); ReadLn(wf.FIO);
reset(f);
while not EOF(f) do begin
Read(f,w);
if Pos(wf.FIO,w.FIO) > 0 then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'2': begin
Write('Кафедра '); ReadLn(wf.Kafedra);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Kafedra = w.Kafedra then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'3': begin
Write('Должность '); ReadLn(wf.Dolgnost);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Dolgnost = w.Dolgnost then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'4': begin
Write('Разряд '); ReadLn(wf.Razrad);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Razrad = w.Razrad then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'5': begin
Write('Ставка '); ReadLn(wf.Stavka);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Stavka = w.Stavka then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'6': begin
Write('Оклад '); ReadLn(wf.Oklad);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Oklad = w.Oklad then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
'7': begin
Write('Зарплата '); ReadLn(wf.Zarplata);
reset(f);
while not EOF(f) do begin
Read(f,w);
if wf.Zarplata = w.Zarplata then With w Do
WriteLn(N:2,FIO:LengthFIO,Kafedra:3,Dolgnost:5,
Razrad:5,Stavka:7:1,Oklad:10:2,Zarplata:10:2);
end;
close(f);
end;
end;
WriteLn;
WriteLn('Enter - меню');
WriteLn('Любая другая - продолжить');
until ReadKey = #13;
end;
function Direct;
begin
if D = '+' then Direct:= C else Direct:= not C;
end;
procedure Sorting;
var
Ch,D: Char;
Direction: Boolean;
i,j,Nt: Integer;
w1,w2,wt: Worker;
begin
repeat
Header('Сортировка');
FMenu;
Ch:= ReadKey;
Case Ch of
'1': WriteLn('ФИО');
'2': WriteLn('Кафедра');
'3': WriteLn('Должность');
'4': WriteLn('Разряд');
'5': WriteLn('Ставка');
'6': WriteLn('Оклад');
'7': WriteLn('Зарплата');
end;
Write('Направление (+,-): '); ReadLn(D);
MaxIndex;
reset(f);
for i:=0 to Index-2 do begin
Seek(f,i); Read(f,w1);
wt:= w1; Nt:= w1.N;
for j:=i to Index-1 do begin
Seek(f,j); Read(f,w2);
Case Ch of
'1': Direction:= Direct(w2.FIO < w1.FIO, D);
'2': Direction:= Direct(w2.Kafedra < w1.Kafedra, D);
'3': Direction:= Direct(w2.Dolgnost < w1.Dolgnost, D);
'4': Direction:= Direct(w2.Razrad < w1.Razrad, D);
'5': Direction:= Direct(w2.Stavka < w1.Stavka, D);
'6': Direction:= Direct(w2.Oklad < w1.Oklad, D);
'7': Direction:= Direct(w2.Zarplata < w1.Zarplata, D);
end;
if Direction then begin
wt:= w2;
Nt:= j;
end;
end;
Case Ch of
'1': Direction:= Direct(wt.FIO < w1.FIO, D);
'2': Direction:= Direct(wt.Kafedra < w1.Kafedra, D);
'3': Direction:= Direct(wt.Dolgnost < w1.Dolgnost, D);
'4': Direction:= Direct(wt.Razrad < w1.Razrad, D);
'5': Direction:= Direct(wt.Stavka < w1.Stavka, D);
'6': Direction:= Direct(wt.Oklad < w1.Oklad, D);
'7': Direction:= Direct(wt.Zarplata < w1.Zarplata, D);
end;
if Direction then begin
j:= wt.N;
wt.N:= w1.N;
w1.N:= j;
Seek(f,i); Write(f,wt);
Seek(f,Nt); Write(f,w1);
end;
end;
close(f);
Viewing;
WriteLn;
WriteLn('Enter - меню');
WriteLn('Любая другая - продолжить');
until ReadKey = #13;
end;
{------------------------------------}
begin
assign(f,Base); assign(ft,Temp);
{$I-}
reset(f);
{$I+}
if IOResult<>0 then rewrite(f);
close(f);
end.