Unit inputinf;
        Interface
                        Uses
crt,error,oform;
                        Const
{длина полей ввода}
lengthOffield : array [1..10] of string[15] =
('··',             {код}
'··',              {тип аудитории}
'···',             {аудитория}
'·',               {тип недели}
'··',              {день недели}
'·',               {пара}
'·······',         {группа}
'···············', {фамилия и инициалы}
'··',              {человек}
'··');             {мест}

lengthOffield2 : array [1..3] of string[15] =
('··',                         {код}
'··········',                  {название}
'············');               {адрес}
st='Старое значение поля:';
Type strukt=record
a:string[2];   {код здания}
b:string[2];   {тип аудитории}
c:string[3];   {аудитория}
d:string[1];   {тип недели}
e:string[2];   {день неделт}
f:string[1];   {пара}
g:string[7];   {группа}
h:string[15];  {преподаватель}
i:string[2];   {человек}
j:string[2];   {мест}
end;

procedure newbase;
procedure addbase;
procedure outputbase;
procedure spravka;
procedure outputspravka;
procedure addspravka;
procedure creativbase;
procedure creatisprav;
procedure veda;

     Implementation
{==================================}
                                                        procedure forma;
Var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
PROCEDURE ClearMessageBox;
BEGIN
Window(02,17,55,23); {установить границы активного окна}
ClrScr;              {очистить экран в этих пределах}
Window(01,01,80,25); {восстановить прежние границы}
END;
PROCEDURE MessageError(Message : string);
Var
Key : char;
BEGIN
RightField := false; {поле ошибочно}
{печать отцентрированного в окне сообщения}
GotoXY(2 + ((54-length(Message)) div 2),18);
Write(Message);
{ожидание и очистка бокса}
GotoXY(05,22);
Write('Нажмите любую клавишу, чтобы повторить ввод...');
While not(KeyPressed) do; {пустой цикл "ПОКА" не нажата клавиша}
Key := ReadKey; {очистить буфер клавиатуры}
ClearMessageBox; {очистить бокс сообщений}
END;

PROCEDURE ControlSignificance;
Var
j : byte; {вспомогательная переменная}
PROCEDURE Check1; {контроль на цифры}
Var
j : byte;
BEGIN
For j := 1 to length(Field) do begin
If not(Field[j] in ['0'..'9']) then begin
MessageError('Поле может содержать только цифры.');
Exit;
end; {if}
end; {for}
END;
{контроль на принадлежность поля-параметра интервалу
Top <= Variable <= Bottom}
PROCEDURE Check2(Variable   : integer;
Top,Bottom : integer;
Message    : string);
BEGIN
If not((Top <= Variable) and (Variable <= Bottom)) then begin
MessageError(Message);
end; {if}
END;


BEGIN
RightField := true; {предположим, что поле верно}
{контроль на отсутствие информации в поле}
If length(Field) = 0 then begin
MessageError('Необходимо заполнить поле.');
Exit;
end;
{контроль на превышение полем положенной длины}
If length(Field) > length(LengthOfField[nom]) then begin
MessageError('Длина поля превышает допустимую.');
Exit;
end;

Case (nom) of
3 : begin Check1;  If not(RightField) then Exit; end;
6 : begin Check1;  If not(RightField) then Exit; end;
9 : begin Check1;  If not(RightField) then Exit; end;
10 : begin Check1; If not(RightField) then Exit; end;
end; {case}
END;
begin
assign(f1,'base');
While True do begin
 ClrScr;
Write('╔══════════════════════════════════════════════════════╗┌──────── Код здания ─┐ ');
Write('║                         Код здания : ··              ║│Н1 - Новое - 1       │ ');
Write('║                      Тип аудитории : ··              ║│Н2 - Новое - 2       │ ');
Write('║                          Аудитория : ···             ║│В - Варшавка         │ ');
Write('║                         Тип недели : ·               ║│C - Старое           │ ');
Write('║                        День недели : ··              ║└─────────────────────┘ ');
Write('║                               Пара : ·               ║┌──── Тип аудитории───┐ ');
Write('║                             Группа : ·······         ║│ВЦ - Вычислител      │ ');
Write('║                      Преподаватель : ············    ║│     центр           │ ');
Write('║                            Человек : ··              ║│С - Сессийный        │ ');
Write('║                               Мест : ···             ║│Л - Лекционный       │ ');
Write('║                                                      ║└─────────────────────┘ ');
Write('║                                                      ║┌──── Тип недели  ────┐ ');
Write('╚══════════════════════════════════════════════════════╝│В - Верхняя          │ ');
Write('┌──────────────────────────────────────────────────────┐│Н - Нижняя           │ ');
Write('│                                                      ││                     │ ');
Write('│       Заполните поля необходимой информацией.        │└─────────────────────┘ ');
Write('│                                                      │                        ');
Write('│     Если хотите закончить ввод, нажмите "Enter".     │                        ');
Write('└──────────────────────────────────────────────────────┘                        ');

With rec do begin
{ввод информации}
For nom := 1 to 10 do begin
{повторять, пока введенное поле не будет верно}
Repeat
GotoXY(40,01+nom);           {установить курсор}
WriteLn(LengthOfField[nom]); {обозначить размер поля}
GotoXY(40,01+nom);           {установить курсор}
ReadLn(Field);             {запросить поле}
{если введена пустой код, то прекратить ввод}
If (nom = 1) and (Field = '') then
Exit {выход из процедуры}
Else ClearMessageBox; {очистить бокс сообщений}
{контроль поля}
ControlSignificance;
Until RightField;

  Case (nom) of
1 : begin
  While length(Field) < 15 do Field := Field + ' ';
  rec.a := Field;
  end;
2 : rec.b:= Field;
3 : rec.c:= Field;
4 : rec.d:= Field;
5 : rec.e:= Field;
6 : rec.f:= Field;
7 : rec.g:= Field;
8 : rec.h:= Field;
9 : rec.i:= Field;
10: rec.j:= Field;
end; {else}
end; {for i}
end; {with Record2}

reset(f1);
seek(f1,filesize(f1));
Write(f1,rec); {вывод записи в файл данных}
close(f1);
end;{while True}
end;
                                                       procedure newb;
var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
begin
assign(f1,'base');
rewrite(f1);
forma;
end;


                                                    procedure newbase;
var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
Begin
assign(f1,'base');
{$I-} Reset(f1); {$I+}
if ioresult=0 then
begin
error5;
writeLN('Вы хотите продолжить? y/n');
readln(ans3);
if ans3='y' then newb;
end
else newb;
end;

                                                        procedure addb;
var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
begin
assign(f1,'base');
reset(f1);
forma;
end;
                                                        procedure addbase;
var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
Begin
assign(f1,'base');
{$I-} Reset(f1); {$I+}
if ioresult<>0 then
begin
error6;
writeLN('Вы хотите создать основной файл? y/n');
readln(ans3);
if ans3='y' then newb; end
else addb; end;
                                                 procedure Sortingbaska;
Var
f1:file of strukt;
beg, kolvo : integer; {начало и конец сортируемого файла}
i, j ,k     : integer;
iRecord1, kRecord1          : Strukt;
iRecord, jRecord, MinRecord : Strukt;
BEGIN
ClrScr;
assign(f1,'base');
reset(f1);
WriteLn('Сортировка файлов данных.':52);
WriteLn('Ждите...':43);
beg:= 0;               {номер первой записи файла}
kolvo := FileSize(f1)-1; {номер последней записи файла}
For i := beg to kolvo-1 do begin
Seek(f1,i); Read(f1,iRecord);
MinRecord := iRecord;
k := i;
For j := i+1 to kolvo do begin
Seek(f1,j); Read(f1,jRecord);
If (jRecord.a < MinRecord.a) or ((jRecord.a = MinRecord.a) and (jRecord.b < MinRecord.b)) then begin
MinRecord := jRecord;
k := j;
end; {if}
end; {for j}
{обмен записей}
If k > i then begin
Seek(f1,i); Read(f1,iRecord1);
Seek(f1,k); Read(f1,kRecord1);
Seek(f1,i); Write(f1,kRecord1);
Seek(f1,k); Write(f1,iRecord1);
Seek(f1,i); Write(f1,MinRecord);
Seek(f1,k); Write(f1,iRecord);
end; {if}
end; {for i}
END;

                                                       procedure outb;
var
rec:strukt;
f1:file of strukt;
begin
clrscr;
assign(f1,'base');
reset(f1);
ClrScr;
Sortingbaska;
clrscr;
shapabase;
with rec do begin {вывод информации}
repeat
read(f1,rec);
writeln('║',a:5,'│',b:9,'│',c:3,'│',d:6,'│',e:6,'│',f:4,'│',h:15,'│',g:7,'│',i:7,'│',j:4,'║' );
until Eof(f1);
podvalbase;
close(f1);
readkey;
end;
end;

                                                procedure outputbase;
var
rec:strukt;
f1:file of strukt;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
Begin
assign(f1,'base');
{$I-} Reset(f1); {$I+}
if ioresult<>0 then
begin
error6;
writeLN('Вы хотите создать основной файл? y/n');
readln(ans3);
if ans3='y' then newb; end
else outb; end;

{____________________________________________________________________}
   procedure forma2;
Var
f2:text;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
q:string[2];   {код здания}
z:string[10];   {название}
x:string[11];   {адрес}
PROCEDURE ClearMessageBox;
BEGIN
Window(02,17,55,23); {установить границы активного окна}
ClrScr;              {очистить экран в этих пределах}
Window(01,01,80,25); {восстановить прежние границы}
END;
PROCEDURE MessageError(Message : string);
Var
Key : char;
BEGIN
RightField := false; {поле ошибочно}
{печать отцентрированного в окне сообщения}
GotoXY(2 + ((54-length(Message)) div 2),18);
Write(Message);
{ожидание и очистка бокса}
GotoXY(05,22);
Write('Нажмите любую клавишу, чтобы повторить ввод...');
While not(KeyPressed) do; {пустой цикл "ПОКА" не нажата клавиша}
Key := ReadKey; {очистить буфер клавиатуры}
ClearMessageBox; {очистить бокс сообщений}
END;

PROCEDURE ControlSignificance;
Var
j : byte; {вспомогательная переменная}

{___________________________________________________________________________}

BEGIN
RightField := true; {предположим, что поле верно}
{контроль на отсутствие информации в поле}
If length(Field) = 0 then begin
MessageError('Необходимо заполнить поле.');
Exit;
end;
{контроль на превышение полем положенной длины}
If length(Field) > length(LengthOfField2[nom]) then begin
MessageError('Длина поля превышает допустимую.');
Exit;
end;
END;

begin
assign(f2,'spravka');
While True do begin
ClrScr;
Write('╔══════════════════════════════════════════════════════╗┌────Код здания ──────┐ ');
Write('║                                Код : ··              ║│Н1 - Новое1          │ ');
Write('║                           Название : ········        ║│Н2 - Новое2          │ ');
Write('║                              Адрес : ···········     ║│В - Варшавка         │ ');
Write('║                                                      ║│С - Старое           │ ');
Write('║                                                      ║└─────────────────────┘ ');
Write('║                                                      ║                        ');
Write('║                                                      ║                        ');
Write('║                                                      ║                        ');
Write('║                                                      ║                        ');
Write('║                                                      ║                        ');
Write('║                                                      ║                        ');
Write('╚══════════════════════════════════════════════════════╝                        ');
Write('┌──────────────────────────────────────────────────────┐                        ');
Write('│                                                      │                        ');
Write('│       Заполните поля необходимой информацией.        │                        ');
Write('│                                                      │                        ');
Write('│                                                      │                        ');
Write('│                                                      │                        ');
Write('│                                                      │                        ');
Write('│     Если хотите закончить ввод, нажмите <Enter>.     │                        ');
Write('└──────────────────────────────────────────────────────┘                        ');


{ввод информации}
For nom := 1 to 3 do begin
{повторять, пока введенное поле не будет верно}
Repeat
GotoXY(40,01+nom);           {установить курсор}
WriteLn(LengthOfField2[nom]); {обозначить размер поля}
GotoXY(40,01+nom);           {установить курсор}
ReadLn(Field);             {запросить поле}
{если введена пустой код, то прекратить ввод}
If (nom = 1) and (Field = '') then
Exit {выход из процедуры}
Else ClearMessageBox; {очистить бокс сообщений}
{контроль поля}
ControlSignificance;
Until RightField;
Case (nom) of
1 : q:=Field;
2 : z:=Field;
3 : x:=Field;
end;
end; {for i}
append(f2); Write(f2,q,' ');close(f2); append(f2); Write(f2,z,' '); close(f2);
append(f2); Writeln(f2,x); close(f2);
end;{while True}
end;

                                                    procedure news;
Var
f:text;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
q:string[2];   {код здания}
z:string[10];   {название}
x:string[11];   {адрес}
begin
assign(f,'spravka');
rewrite(f);
forma2;
end;

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

procedure spravka;
var
f:text;
ans,ans2,ans3:char;
q:string[2];   {код здания}
z:string[10];   {название}
x:string[11];   {адрес}
Begin
assign(f,'spravka');
{$I-} Reset(f); {$I+}
if ioresult<>0 then
ClrScr;
error5;
writeLN('Вы хотите продолжить? y/n');
readln(ans3);
if ans3='y' then news;
end;

procedure addsp;
var
f:text;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
q:string[2];   {код здания}
z:string[10];   {название}
x:string[11];   {адрес}
begin
assign(f,'spravka');
append(f);
forma2;
end;

procedure addspravka;
var
f:text;
ans,ans2,ans3:char;
nom        : byte;    {номер запрашиваемого поля}
Field      : string;  {поле для ввода информации}
RightField : boolean; {верно ли введенное поле}
q:string[2];   {код здания}
z:string[10];   {название}
x:string[11];   {адрес}
Begin
assign(f,'spravka');
{$I-} Reset(f); {$I+}
if ioresult<>0 then
begin
error6;
writeLN('Вы хотите продолжить? y/n');
readln(ans3);
if ans3='y' then news;
end
else addsp;
end;


{______________________________________________________________________}

                                                   procedure outputspravka;
var
f:text;
q:string[2];   {код здания}
z:string[7];   {название}
x:string[11];   {адрес}
begin
clrscr;
assign(f,'spravka');
reset(f);
readkey;
shapasprav;
repeat
read(f,q);
write('║',q:5);
read(f,z);
write('│',z:10,'│');
read(f,x);
write(x:11,'║') ;
writeln;
readln(f);
until Eof(f);
podvalspravka;
close(f);
readkey;
end;

procedure creativbase;
var
nom,poz       : integer;
nom2, ans2    : char;
fl, fl2       : boolean;
rec           : strukt;
Field         : string;
f1            : file of strukt;
begin
nom:=0;
assign(f1,'base'); reset(f1);
clrscr;
videditbase;
with rec do begin {вывод информации}
repeat
read(f1,rec);
inc(nom);
writeln('║',nom:2,'│',a:4,'│',b:9,'│',c:3,'│',d:6,'│',e:6,'│',f:4,'│',h:15,'│',g:7,'│',i:7,'│',j:4,'║' );
until Eof(f1);
vidcreativbasepodval;
writeln('Введите номер строки для редактирования');
readln(poz);
seek(f1,poz-1);
read(f1,rec);
shapabase;
nomerdlazaprosa;
writeln('║',a:5,'│',b:9,'│',c:3,'│',d:6,'│',e:6,'│',f:4,'│',h:15,'│',g:7,'│',i:7,'│',j:4,'║' );
podvalbase;
writeln('Введите поле для изменения');
read(nom2);
sob2;
writeln(nom2);
with rec do
case nom2  of
'0'  : begin clrscr; writeln(st, a); sob;  readln(Field); rec.a:=Field; fl:=false end;
'1'  : begin clrscr; writeln(st,b);  sob;  readln(Field); rec.b:=Field; fl:=false end;
'2'  : begin clrscr; writeln(st,c);  sob;  readln(Field); rec.c:=Field; fl:=false end;
'3'  : begin clrscr; writeln(st,d);  sob;  readln(Field); rec.d:=Field; fl:=false end;
'4'  : begin clrscr; writeln(st,e);  sob;  readln(Field); rec.e:=Field; fl:=false end;
'5'  : begin clrscr; writeln(st,f);  sob;  readln(Field); rec.f:=Field; fl:=false end;
'6'  : begin clrscr; writeln(st,g);  sob;  readln(Field); rec.g:=Field; fl:=false end;
'7'  : begin clrscr; writeln(st,h);  sob;  readln(Field); rec.h:=Field; fl:=false end;
'8'  : begin clrscr; writeln(st,i);  sob;  readln(Field); rec.i:=Field; fl:=false end;
'9'  : begin clrscr; writeln(st,j);  sob;  readln(Field); rec.j:=Field; fl:=false end;
'Q'  : begin clrscr;                                               fl:=true; end;
else   begin clrscr; error1; readln; fl:=false; end
end;
write(f1,rec) ;
close(f1);
end;
end;

procedure creatisprav;
var
f  : text;
q  : string[2];   {код здания}
z  : string[7];   {название}
x  : string[11];   {адрес}
n, poz, rab, nomer  : integer;
flagi               : boolean;
begin
n:=0;
clrscr;
assign(f,'spravka');
reset(f);
readkey;
shapaspravcreativ;
repeat
inc(n);
write('║',n:2);
read(f,q);
write('│',q:4);
read(f,z);
write('│',z:10,'│');
read(f,x);
write(x:11,'║') ;
writeln;
readln(f);
until Eof(f);
podvalspravkacreativ;
writeln('Введите номер строки для редактирования');
readln(poz);
reset(f);
for rab:=1 to poz-1 do
begin
readln(f);
end;
shapasprav;
creativshapasprav;
read(f,q);
write('║',q:5);
read(f,z);
write('│',z:10,'│');
read(f,x);
write(x:11,'║') ;
writeln;
podvalspravka;
flagi:=true;
sob2;
reset(f);
repeat
writeln('Введите поле для изменения');
read(nomer);
case nomer of
1: begin read(f,q); writeln(f,q); sob; read(q); write(f,q); flagi:=false; end;
2: begin read(f,z); writeln(f,z); sob; read(z); write(f,z); flagi:=false; end;
3: begin read(f,x); writeln(f,x); sob; read(x); write(f,x); flagi:=false; end;
end;
until flagi;
close(f);
readkey;
end;


procedure veda;
var
rec                   : strukt;
f1                    : file of strukt;
f2,ved1,ved2          : text;
cod,a1, itogo,chelsum2,mestsum2,sumitogochel,sumitogomest      : integer;
prevtip ,prevkod   : string;
chel,mest,par, sum,sum2,sum3,sumchel,summest,code,sumchelend,summestend : integer;
zap1, zap2, zapitog1, zapitog2, zapitogo, itogo1, zapitogo2, itogo2     : real;
q  : string[2];   {код здания}
z  : string[7];   {название}
x  : string[8];   {адрес}
begin
Writeln('                               Идет составление ведомостеи ');
Writeln('                                                   ...Ждите');
clrscr;
assign(f2,'spravka'); assign(f1,'base'); {связали имена файлов и файловые перемнные}
reset(f1); reset(f2);                    {открыли для чтения основной и справочный файл}
assign(ved1,'Vedomost');  assign(ved2,'Vedomost2');
rewrite(ved1);   rewrite(ved2);
par:=0;sum:=0; sum2:=0; sum3:=0; sumchel:=0; summest:=0;
itogo1:=0; itogo2:=0;   zapitog1:=0;
shapaveda1; shapaveda2;
prevkod:=rec.a; prevtip:=rec.b;
repeat
begin
with rec do
if rec.b<>prevtip then
begin
zapitog1:=sumchel/summest;
prevtip:=rec.b; sum2:=sum2+sum;
writeln(ved1,'╔═════════════════════════════════════════════════════╗');
Writeln(ved1,'║                  Итого по типу аудитории :',sum:10,'║');
WriteLn(ved1,'╚═════════════════════════════════════════════════════╝');
zapitog2:=sum/9;
writeln(ved2,'╔═════════════════════════════════════════════════════╗');
Writeln(ved2,'║   Итого по типу аудитории  :',zapitog1:11,zapitog2:11,'║');
Writeln(ved2,'╚═════════════════════════════════════════════════════╝');
chelsum2:=chelsum2+sumchel;
mestsum2:=mestsum2+summest;
summest:=0; sumchel:=0;
writeln;
end;

if rec.a<>prevkod then
begin
prevkod:=rec.a;
writeln(ved1,'╔═════════════════════════════════════════════════════╗');
Writeln(ved1,'║                         Итого по зданию :',sum2:11,'║');
Writeln(ved1,'╚═════════════════════════════════════════════════════╝');
sumitogochel:=sumitogochel+chelsum2;
sumitogomest:=sumitogomest+mestsum2;
zapitogo:=sumitogochel/sumitogomest;
zapitogo2:=sum2/9;
writeln(ved2,'╔═════════════════════════════════════════════════════╗');
Writeln(ved2,'║           Итого по зданию :',zapitogo:11,zapitog2:11,'║');
Writeln(ved2,'╚═════════════════════════════════════════════════════╝');
sum3:=sum3+sum2; sum2:=0;  sum:=0;
end;
inc(par);
sum:=sum+par;
read(f2,z);
Writeln(ved1,'║',rec.a:7,'│',z:9,'│',rec.b:11,'│',rec.c:11,'│',rec.f:11,'║');
val(rec.i, chel,code);
val(rec.j, mest,code);
zap1:=chel/mest;
zap2:=par/9;
sumchel:=sumchel+chel;
summest:=summest+mest;
Writeln(ved2,'║',rec.a:7,'│',x:9,'│',rec.b:11,'│',zap1:12,'│',zap2:12,'║');
read(f1,rec); read(f2);
end;
until Eof(f1);

podvalveda1;
podvalveda2;
writeln(ved1,'╔═════════════════════════════════════════════════════╗');
Writeln(ved1,'║                                  Итого  :',sum3:11,'║');
WriteLn(ved1,'╚═════════════════════════════════════════════════════╝');
itogo1:=sumchelend/summestend;
itogo2:=sum3/(9*7);
writeln(ved2,'╔═════════════════════════════════════════════════════╗');
Writeln(ved2,'║                      Итого  :',itogo1:11,'│',itogo2:11,'║');
WriteLn(ved2,'╚═════════════════════════════════════════════════════╝');
writeln;

close(ved1);
close(ved2);
end;

end.