Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

лабы 2 семестр / 11 лаба

.doc
Скачиваний:
15
Добавлен:
10.12.2013
Размер:
97.79 Кб
Скачать

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

Кафедра ИТАС

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

Выполнил: Никулин М.С

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

Пермь. 2008 г.

uses Crt, Dos;

const

Base = 'Base.dat'

type

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

b = record

FIO: string[30];

gruppa, data, zach: Byte;

rmatem, rfizik, summ: real;

end;

PtrPoint = ^P;

P = record

D: b;

Pred, Next: PtrPoint;

end;

const

M: mass = (

'Просмотр',

'Добавить',

'Изменить',

'Удалить',

'Поиск',

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

'Выход');

FM: mass = (

'ФИО',

' Группа ',

' Дата рождения ',

' Зачетная книжка ',

' Рейтинг по математике ',

' Рейтинг по физике ',

' Суммарный рейтинг ');

var

R: Registers;

ListBegin, ListEnd: PtrPoint;

i: Byte;

Index: Integer;

f: file of b;

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

begin

TextBackground(Black);

ClrScr;

TextColor(yellow);

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

GotoXY(1,3);

TextColor(LightGray);

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: mass);

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 + #196;

TextColor(Brown);

Write(#218,s, #191);

GotoXY(1,9); Write(#192,s, #217);

for i:=1 to n do begin

GotoXY(1,1+i); Write(#179);

GotoXY(14,1+i); Write(#179);

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;

index := FileSize(f);

procedure MakeList;

var

i: Integer;

w: b;

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(20,5,80,25);

p:= ListBegin;

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

TextColor(Brown);

WriteLn(' Фамилия Имя Отчество Группа Дата Зач рейтинг по матике Рейтинг по физике Суммарный рейтинг');

TextColor(LightGray);

WriteLn;

for i:= Index downto 1 do begin

with p^.D do

WriteLn(FIO: 30,gruppa:2,data:2,zach:3,rmatem:4:1,rfizik:7,summ:9);

p:= p^.Next;

end;

ReadKey;

TextMode(Co80);

end;

procedure Additing;

var

p,r: PtrPoint;

begin

repeat

Window(20,5, 80,25);

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(gruppa);

Write('Дата рождения: '); ReadLn(data);

Write('Зачетная книжка: '); ReadLn(zach);

Write('Рейтинг по математике: '); ReadLn(rmatem);

Write('Рейтинг по физике: '); ReadLn(rfizik);

summ:= Round(rmatem + rfizik);

end;

ListEnd:= r;

WriteLn;

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

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

until ReadKey = #13;

TextMode(Co80);

end;

procedure Editing;

var

i: Integer;

p: PtrPoint;

wt: b;

begin

repeat

Window(20,5, 80,25);

p:= ListBegin;

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

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

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

TextColor(Brown);

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

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

TextColor(LightGray);

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(gruppa);

if gruppa = 0 then gruppa:= wt. gruppa;

Write(' Дата рождения: '); ReadLn(data);

if data = 0 then data:= wt. data;

Write(' Зачетная книжка: '); ReadLn(zach);

if zach = 0 then zach:= wt. zach;

Write(' Рейтинг по математике: '); ReadLn(rmatem);

if rmatem = 0 then rmatem:= wt. rmatem;

Write(' Рейтинг по физике: '); ReadLn(rfizik);

if rfizik = 0 then rfizik:= wt. rfizik;

summ:= Round(rmatem * rfizik);

end;

end;

WriteLn;

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

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

until ReadKey = #13;

TextMode(Co80);

end;

procedure Deleting;

var

i,n: Integer;

p,r: PtrPoint;

w: b;

begin

Window(20,5, 80,25);

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(LightGray);

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(LightGray);

ReadKey; exit;

end

else begin

ListBegin^.Pred:= NIL;

dispose(p);

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

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(LightGray);

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(LightGray);

end;

end;

WriteLn;

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

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

until ReadKey = #13;

TextMode(Co80);

end;

procedure Searching;

var

i: Integer;

p: PtrPoint;

wf,w: b;

begin

Window(20,5, 80,25);

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: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

2: begin

Write(' Группа '); ReadLn(wf. gruppa);

p:= ListBegin;

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

if wf. gruppa = gruppa then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

3: begin

Write(' Дата рождения '); ReadLn(wf. data);

p:= ListBegin;

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

if wf. data = data then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

4: begin

Write(' Зачетная книжка '); ReadLn(wf. zach);

p:= ListBegin;

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

if wf. zach = zach then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

5: begin

Write(' Рейтинг по математике '); ReadLn(wf. rmatem);

p:= ListBegin;

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

if wf. rmatem = rmatem then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

6: begin

Write(' Рейтинг по физике '); ReadLn(wf. rfizik);

p:= ListBegin;

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

if wf. rfizik = rfizik then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ:7);

p:= p^.Next;

end;

end;

7: begin

Write(' Суммарный рейтинг '); ReadLn(wf. summ);

p:= ListBegin;

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

if wf. summ = summ then

WriteLn(FIO: 30, gruppa:3, data:5,

zach:5, rmatem:4:1, rfizik:7, summ: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: b;

begin

Window(20,5, 80,25);

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. gruppa < w1. gruppa, D);

3: Direction:= Direct(w2. data < w1. data, D);

4: Direction:= Direct(w2. zach < w1. zach, D);

5: Direction:= Direct(w2. rmatem < w1. rmatem, D);

6: Direction:= Direct(w2. rfizik < w1. rfizik, D);

7: Direction:= Direct(w2. summ < w1. summ, 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. gruppa < w1. gruppa, D);

3: Direction:= Direct(wt. data < w1. data, D);

4: Direction:= Direct(wt. zach < w1. zach, D);

5: Direction:= Direct(wt. rmatem < w1. rmatem, D);

6: Direction:= Direct(wt. rfizik < w1. rfizik, D);

7: Direction:= Direct(wt. summ < w1. summ, 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);

repeat

MakeList;

index := FileSize(f);

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

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

WriteF;

until False;

end.

Соседние файлы в папке лабы 2 семестр