TP / 11 / Лабораторная 11

Пермский Государственный Технический Университет

Кафедра ИТАС

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

Выполнил: Попов М.В.

Проверил : Мосиенко А. Ю.

Пермь. 2008 г.

uses U1136;

begin

repeat

MakeList;

MaxIndex;

HeaderX(33,'Лабораторная 11');

Menu(3,3,17,12,7,M);

WriteF;

until False;

end.

unit U1136;

{------------------------------------------------------------}

INTERFACE

{------------------------------------------------------------}

uses Crt, Dos;

const

Base = 'Base.dat';

Len = 29;

X1W = 20; Y1W = 5; {X1,Y1,X2,Y2 for Window}

X2W = 80; Y2W = 25;

HC = Yellow; THC = Brown; { HeaderColor, TableHeaderColor }

TC = LightGray;

MTC = Brown; STC = White; { MenuTextColor, SelectTextColor }

LU = #218; RU = #191; { LeftUp, RightUp }

LD = #192; RD = #217; { LeftDown, RightDown }

H = #196; V = #179; { Horisontal, Vertical }

type

AMenu = array[1..7] of String[10];

Worker = record

FIO: string[Len];

Kafedra,Dolgnost,Razrad: Byte;

Stavka: Real;

Oklad,Zarplata: Longint;

end;

PtrPoint = ^Point;

Point = record

D: Worker;

Pred, Next: PtrPoint;

end;

const

M: AMenu = (

'Просмотр',

'Добавить',

'Изменить',

'Удалить',

'Поиск',

'Сортировка',

'Выход');

FM: AMenu = (

'ФИО',

'Кафедра',

'Должность',

'Разряд',

'Ставка',

'Оклад',

'Зарплата');

var

R: Registers;

ListBegin, ListEnd: PtrPoint;

i: Byte;

Index: Integer;

f: file of Worker;

procedure HeaderX(X: Byte; s: String);

function MouseInButton(X1M,Y1M,X2M:Byte): Boolean;

procedure Run(i: Byte);

procedure Menu(X1,Y1,X2,Y2,n: Byte; Me: AMenu);

{ Процедура выводит на экран меню из n элементов массива M

в окне с координатами (X1;Y1), (X2;Y2), и осуществляет выбор

элемента меню и запуск соотвествующей проудуры.

Параметры: координаты окна, количество пунктов меню, текст кнопок}

procedure MakeList;

function SeekofPoint(n: Integer): PtrPoint;

procedure MaxIndex;

procedure Viewing;

procedure Additing;

procedure Editing;

procedure Deleting;

procedure Searching;

function Direct(C: Boolean; D: Char): Boolean;

procedure Sorting;

procedure WriteF;

{------------------------------------------------------------}

IMPLEMENTATION

{------------------------------------------------------------}

procedure HeaderX(X: Byte; s: String);

begin

TextBackground(Black);

ClrScr;

TextColor(HC);

GotoXY(X,1); Write(s);

GotoXY(1,3);

TextColor(TC);

end;

function MouseInButton(X1M,Y1M,X2M:Byte): Boolean;

var

X1,Y1,X2,Y2: Integer;

begin

MouseInButton:= False;

R.AX:= $03; Intr($33,R);

for i:=1 to 7 do begin

X1:= X1M*8;

Y1:= Y1M*8 + (i-1)*8;

X2:= X2M*8;

Y2:= Y1 + 8;

if (R.CX > X1) and (R.CX < X2) and

(R.DX > Y1) and (R.DX < Y2) then begin

MouseInButton:= True;

exit;

end;

end;

end;

procedure Run(i: Byte);

begin

case i of

1: Viewing;

2: Additing;

3: Editing;

4: Deleting;

5: Searching;

6: Sorting;

7: halt;

end;

end;

procedure Menu(X1,Y1,X2,Y2,n: Byte; Me: AMenu);

var

ch: Char;

s: String;

begin

R.AX:= $00; Intr($33,R);

R.AX:= $01; Intr($33,R);

Window(X1,Y1,X2,Y2);

{ Рисуем рамку }

s:= '';

for i:=1 to 12 do

s:= s + H;

TextColor(MTC);

Write(LU,s,RU);

GotoXY(1,9); Write(LD,s,RD);

for i:=1 to n do begin

GotoXY(1,1+i); Write(V);

GotoXY(14,1+i); Write(V);

end;

{ Выводим меню }

for i:=1 to n do begin

GotoXY(3,1+i); Write(Me[i]);

end;

{ Запускаем цикл выбора пункта меню }

repeat

if MouseInButton(X1,Y1,X2) then

repeat

R.AX:= $03; Intr($33,R);

if R.BX = 1 then

if Me[1] = 'Просмотр' then begin

Run(i);

exit;

end else exit;

until not MouseInButton(X1,Y1,X2);

until False;

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 MakeList;

var

i: Integer;

w: Worker;

p,r: PtrPoint;

begin

reset(f);

if Index>0 then Read(f,w);

New(p); ListBegin:= p;

p^.D:= w;

p^.Pred:= NIL; p^.Next:= NIL;

for i:= 1 to Index do begin

Read(f,w);

New(r);

r^.D:= w;

p^.Next:= r; r^.Pred:= p;

r^.Next:= NIL;

p:= r;

end;

ListEnd:= p;

close(f)

end;

function SeekofPoint(n: Integer): PtrPoint;

var

p: PtrPoint;

i: Integer;

begin

p:= ListBegin;

for i:=1 to n-1 do

p:= p^.Next;

SeekofPoint:= p;

end;

procedure Viewing;

var

i: Integer;

p: PtrPoint;

begin

Window(X1W,Y1W,X2W,Y2W);

p:= ListBegin;

HeaderX(25,'Просмотр');

TextColor(THC);

WriteLn(' Фамилия Имя Отчество К Д Р С Оклад Зарплата');

TextColor(TC);

WriteLn;

for i:= Index downto 1 do begin

with p^.D do

WriteLn(FIO:Len,Kafedra:2,Dolgnost:2,

Razrad:3,Stavka:4:1,Oklad:7,Zarplata:9);

p:= p^.Next;

end;

ReadKey;

TextMode(Co80);

end;

procedure Additing;

var

p,r: PtrPoint;

begin

repeat

Window(X1W,Y1W,X2W,Y2W);

HeaderX(25,'Добавление');

p:= ListEnd;

New(r);

p^.Next:= r;

r^.Pred:= p;

r^.Next:= NIL;

with r^.D do begin

Inc(Index);

WriteLn(Index);

Write('ФИО: '); ReadLn(FIO);

Write('Кафедра: '); ReadLn(Kafedra);

Write('Должность: '); ReadLn(Dolgnost);

Write('Разряд: '); ReadLn(Razrad);

Write('Ставка: '); ReadLn(Stavka);

Write('Оклад: '); ReadLn(Oklad);

Zarplata:= Round(Stavka * Oklad);

end;

ListEnd:= r;

WriteLn;

WriteLn('Enter - меню');

WriteLn('Любая другая - продолжить');

until ReadKey = #13;

TextMode(Co80);

end;

procedure Editing;

var

i: Integer;

p: PtrPoint;

wt: Worker;

begin

repeat

Window(X1W,Y1W,X2W,Y2W);

p:= ListBegin;

HeaderX(25,'Изменение');

Write('Введите номер записи: '); ReadLn(i);

if not (i in [1..Index]) then begin

TextColor(Brown);

WriteLn('Неправильно введен номер карточки!');

WriteLn('Он должен быть: 1..',Index);

TextColor(TC);

ReadKey;

exit;

end

else begin

p:= SeekofPoint(i);

wt:= p^.D;

with p^.D do begin

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:= Round(Stavka * Oklad);

end;

end;

WriteLn;

WriteLn('Enter - меню');

WriteLn('Любая другая - продолжить');

until ReadKey = #13;

TextMode(Co80);

end;

procedure Deleting;

var

i,n: Integer;

p,r: PtrPoint;

w: Worker;

begin

Window(X1W,Y1W,X2W,Y2W);

repeat

WriteLn;

WriteLn('1 - Удалить одну запись');

WriteLn('0 - Удалить все записи');

WriteLn;

case ReadKey of

'1': begin

Write('Запись N: '); ReadLn(n);

if not (n in [1..Index]) then begin

TextColor(Brown);

WriteLn('Неправильно введен номер карточки!');

WriteLn('Он должен быть: 1..',Index);

TextColor(TC);

ReadKey;

exit;

end

else begin

dec(Index);

if n = 1 then begin

p:= ListBegin;

ListBegin:= ListBegin^.Next;

if ListBegin = NIL then begin

ListEnd:= NIL;

TextColor(Red);

WriteLn('Данные удалены');

WriteLn('Список пуст');

TextColor(TC);

ReadKey; exit;

end

else begin

ListBegin^.Pred:= NIL;

dispose(p);

TextColor(Red); WriteLn('Данные удалены'); TextColor(TC);

end;

end

else begin

p:= SeekofPoint(n-1);

r:= p^.Next;

p^.Next:= r^.Next;

dispose(r);

r:= p^.Next;

if not (r = NIL) then r^.Pred:= p

else r:= p;

ListEnd:= r;

TextColor(Red); WriteLn('Данные удалены'); TextColor(TC);

end;

end;

end;

'0': begin

for i:=1 to Index do begin

p:= ListBegin;

ListBegin:= ListBegin^.Next;

dispose(p);

end;

ListEnd:= NIL;

TextColor(Red); WriteLn('Все данные удалены'); TextColor(TC);

end;

end;

WriteLn;

WriteLn('Enter - меню');

WriteLn('Любая другая - продолжить');

until ReadKey = #13;

TextMode(Co80);

end;

procedure Searching;

var

i: Integer;

p: PtrPoint;

wf,w: Worker;

begin

Window(X1W,Y1W,X2W,Y2W);

repeat

HeaderX(25,'Поиск');

Menu(4,4,8,12,7,FM);

Case i of

1: begin

Write('ФИО: '); ReadLn(wf.FIO);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if Pos(wf.FIO,FIO) > 0 then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

2: begin

Write('Кафедра '); ReadLn(wf.Kafedra);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Kafedra = Kafedra then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

3: begin

Write('Должность '); ReadLn(wf.Dolgnost);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Dolgnost = Dolgnost then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

4: begin

Write('Разряд '); ReadLn(wf.Razrad);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Razrad = Razrad then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

5: begin

Write('Ставка '); ReadLn(wf.Stavka);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Stavka = Stavka then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

6: begin

Write('Оклад '); ReadLn(wf.Oklad);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Oklad = Oklad then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

7: begin

Write('Зарплата '); ReadLn(wf.Zarplata);

p:= ListBegin;

while not (p=NIL) do with p^.D do begin

if wf.Zarplata = Zarplata then

WriteLn(FIO:Len,Kafedra:3,Dolgnost:5,

Razrad:5,Stavka:4:1,Oklad:7,Zarplata:7);

p:= p^.Next;

end;

end;

end;

WriteLn;

WriteLn('Enter - меню');

WriteLn('Любая другая - продолжить');

until ReadKey = #13;

TextMode(Co80);

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;

p,r,s: PtrPoint;

w1,w2,wt: Worker;

begin

Window(X1W,Y1W,X2W,Y2W);

repeat

HeaderX(25,'Сортировка');

Menu(4,4,8,12,7,FM);

Case i of

1: WriteLn('ФИО');

2: WriteLn('Кафедра');

3: WriteLn('Должность');

4: WriteLn('Разряд');

5: WriteLn('Ставка');

6: WriteLn('Оклад');

7: WriteLn('Зарплата');

end;

Write('Направление (+,-): '); ReadLn(D);

p:= ListBegin;

for i:=0 to Index-2 do begin

p:= SeekofPoint(i+1);

w1:= p^.D;

wt:= w1;

for j:=i to Index-1 do begin

p:= SeekofPoint(i+1);

w2:= p^.D;

Case i 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 i 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

p:= SeekofPoint(i+1); p^.D:= wt;

r:= SeekofPoint(Nt); r^.D:= w1;

s:= r^.Pred; r^.Pred:= p^.Pred; p^.Pred:= s;

s:= r^.Next; r^.Next:= p^.Next; p^.Next:= s;

end;

end;

Viewing;

WriteLn;

WriteLn('Enter - меню');

WriteLn('Любая другая - продолжить');

until ReadKey = #13;

TextMode(Co80);

end;

procedure WriteF;

var

i: Integer;

p: PtrPoint;

begin

rewrite(f);

p:= ListBegin;

for i:=1 to Index do begin

Write(f,p^.D);

p:= p^.Next;

end;

close(f);

end;

{------------------------------------------------------------}

begin

assign(f,Base);

{$I-}

reset(f);

{$I+}

if IOResult<>0 then rewrite(f);

close(f);

end.