Разработка форматов хранения данных программы. Структурирование (стр. 2 из 2)
Program Lab2;
uses Crt;
label ExitFromCalc;
Const Nmax=100;
Type
CircleType = record
x : integer;
y : integer;
R : word
end;
RectangleType=record
x : integer;
y : integer;
end;
Var
CircleAr : array[1..Nmax] of CircleType;
CircleFile : file of CircleType;
RectangleAr : array[1..2] of RectangleType;
RectangleFile : file of RectangleType;
ResultFile : text;
n : word; {Кол-во окружностей для проверки}
i : byte; {параметр цикла}
S : byte; {счётчик пересечений окружностей с прямоугольником}
ch : char;
size : longint;
{ ------------------------------------------------------------ }
Procedure FrazaReadError(k:integer);
{ Сообщение о неправильном формате вводимого числа с подачей }
{ звукового сигнала }
Begin
If k<>0 then
Begin
Writeln(#7'Неправильный формат числа');
Writeln('Повторите ввод');
End;
End { FrazaReadError };
{ ------------------------------------------------------------ }
Procedure ReadWord(Var Number:word);
{ Ввод с клавиатуры и проверка формата переменной типа word}
Var k : word;
Begin
Repeat
{$I-} Read(Number); {$I+}
k:=IOResult;
FrazaReadError(k);
Until k=0;
End { ReadWord };
{ ------------------------------------------------------------ }
Procedure ReadInt(Var Number:integer);
{ Ввод с клавиатуры и проверка формата переменной типа integer }
Var k : integer;
Begin
Repeat
{$I-} Read(Number); {$I+}
k:=IOResult;
FrazaReadError(k);
Until k=0;
End { ReadInt };
{ ------------------------------------------------------------ }
Procedure PrintInData;
Var i : byte;
Begin
Writeln(' Исходные данные');
Writeln('Окружности:');
For i:=1 to n do
Begin
Write(i,':','R=',CircleAr[i].R,' (',CircleAr[i].x,':',CircleAr[i].x,')','; ');
End;
Writeln;
Writeln('Прямоугольник:');
Writeln('Верхняя правая точка: (',RectangleAr[1].x,':',RectangleAr[1].y,')');
Writeln('Верхняя правая точка: (',RectangleAr[2].x,':',RectangleAr[2].y,')');
End {PrintInData};
{ ------------------------------------------------------------ }
Function Cross1(Var R:word; P,C:integer):boolean;
Begin
Cross1:=false;
if (R*R-(P-C*C))>=0 then Cross1:=true;
End {Cross1};
{ ------------------------------------------------------------ }
Function Cross2(Var Inter1,Inter2:integer; R:word; P,C1,C2:integer):boolean;
Var Buf : real;
Begin
Cross2:=false;
Buf:=sqrt(R*R-(P-C1*C1))+C2;
if Buf<=Inter2 then
if Buf>=Inter1 then Cross2:=true;
End {Cross2};
{ ------------------------------------------------------------ }
Procedure PrintHead;
Begin
ClrScr;
Writeln('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒');
Writeln('▒ Лабораторная работа №2 ▒');
Writeln('▒ студента гр▒');
Writeln('▒ ▒');
Writeln('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒');
Writeln('▒ Условие задачи по аналитической геометрии: ▒');
Writeln('▒ Найти количество окружностей на плоскости ▒');
Writeln('▒ имеющих пересечение с прямоугольником стороны ▒');
Writeln('▒ которого параллельны осям координат. ▒');
Writeln('▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒');
End { ReadInt };
{ ------------------------------------------------------------ }
Begin
PrintHead;
Writeln('Откуда произвести ввод исходных данных?');
Writeln('f - файл, k-клавиатура');
Repeat
ch:=ReadKey;
Until ((ch='k') or (ch='f'));
if (ch='k') then
Begin
Writeln('Набор параметров завершайте нажатием клавиши Enter');
Write('Введите количество окружностей:'); ReadWord(n);
For i:=1 to n do
Begin
Writeln('Введите кординаты центра ',i,' окружности.');
Write('x='); ReadInt(CircleAr[i].x);
Write('y='); ReadInt(CircleAr[i].y);
Writeln('Введите радиус ',i,' окружности.');
Write('R='); ReadWord(CircleAr[i].R);
End;
For i:=1 to 2 do
Begin
Writeln('Введите кординаты ',i,' точки прямоугольника');
Write('x='); ReadInt(RectangleAr[i].x);
Write('y='); ReadInt(RectangleAr[i].y);
End;
PrintHead;
PrintInData;
Writeln('Записать введённые данные в файлы входных данных?');
Writeln('(y - Да, n - Нет)');
Repeat
ch:=ReadKey;
Until ((ch='y') or (ch='n'));
if (ch='y') then
Begin
Assign(CircleFile,'circle.dat'); Rewrite(CircleFile);
Assign(RectangleFile,'rectangl.dat'); Rewrite(RectangleFile);
For i:=1 to n do
Write(CircleFile,CircleAr[i]);
size:=FileSize(CircleFile);
Writeln('Файл circle.dat перезаписан!!! Текущий размер ',size,' компонент.');
For i:=1 to 2 do
Write(RectangleFile,RectangleAr[i]);
Writeln('Файл rectangle.dat перезаписан!!!');
Close(RectangleFile); Close(CircleFile);
End;
End
else
Begin
Assign(CircleFile,'circle.dat'); Reset(CircleFile);
Assign(RectangleFile,'rectangl.dat'); Reset(RectangleFile);
size:=FileSize(CircleFile);
n:=size;
For i:=1 to n do
Read(CircleFile,CircleAr[i]);
For i:=1 to 2 do
Read(RectangleFile,RectangleAr[i]);
Close(RectangleFile); Close(CircleFile);
Writeln('Данные из входных файлов загружены!!!');
PrintInData;
End;
S:=0;
{Цикл проверки}
For i:=1 to n do
Begin
if Cross1(CircleAr[i].R,RectangleAr[1].y,CircleAr[i].y) then
Begin
if Cross2(RectangleAr[1].x,RectangleAr[2].x,CircleAr[i].R,RectangleAr[1].y,CircleAr[i].y,CircleAr[i].x) then
Begin
S:=S+1; GoTo ExitFromCalc;
End
End;
if Cross1(CircleAr[i].R,RectangleAr[2].y,CircleAr[i].y) then
Begin
if Cross2(RectangleAr[1].x,RectangleAr[2].x,CircleAr[i].R,RectangleAr[2].y,CircleAr[i].y,CircleAr[i].x) then
Begin
S:=S+1; GoTo ExitFromCalc;
End
End;
if Cross1(CircleAr[i].R,RectangleAr[1].x,CircleAr[i].x) then
Begin
if Cross2(RectangleAr[1].y,RectangleAr[2].y,CircleAr[i].R,RectangleAr[1].x,CircleAr[i].x,CircleAr[i].y) then
Begin
S:=S+1; GoTo ExitFromCalc;
End
End;
if Cross1(CircleAr[i].R,RectangleAr[2].x,CircleAr[i].x) then
Begin
if Cross2(RectangleAr[1].y,RectangleAr[2].y,CircleAr[i].R,RectangleAr[2].x,CircleAr[i].x,CircleAr[i].y) then
Begin
S:=S+1; GoTo ExitFromCalc;
End
End;
ExitFromCalc:
End;
{Конец цикла проверки}
Writeln('С прямоугольником пересекаются ',S,' окружности(ей) из ',n,'.');
Assign(ResultFile,'result.txt');
Rewrite(ResultFile);
Write(ResultFile,'С прямоугольником пересекаются ',S,' окружности(ей) из ',n,'.');
Close(ResultFile);
Readln;
End.
4. Экранные формы:
