{$N+}
{$E+}
Program Grafika;
{Задание: Нарисовать прямоугольник, круг... Если они пересекаются, то
область пересечения закрасить в какой-то цвет.}
Uses
Graph;
Type
Pryam_1=Record {Переменная описывающая прямоугольник}
L_KoordX, L_KoordY, R_KoordX, R_KoordY: Word;
End;
Kryg_1=Record {Переменная описывающая круг}
C_KoordX, C_KoordY, Rad: Word;
End;
Const {Задаем координаты}
{Прямоугольник}
Pryam: Pryam_1 = (
L_KoordX: 200;
L_KoordY: 100;
R_KoordX: 400;
R_KoordY: 300);
{Круг}
Kryg: Kryg_1 = (
C_KoordX: 450;
C_KoordY: 200;
Rad: 100);
Zaris_Peres=3;
Cvet=2;
Var
Driver, Mode: Integer; {переменные установки графического режима}
i,j,KoordX,KoordY:Word;
d: Extended;
Begin
{Определяем тип драйвера}
Driver:=Detect;
{Инициализируем графический режим}
InitGraph(Driver, Mode, '');
If GraphResult=0 then
Begin
With Pryam do
Begin
{Устанавливаем цвет прямоугольника}
SetColor(Cvet);
{Чертим прямоугольник}
Rectangle(L_KoordX, L_KoordY, R_KoordX, R_KoordY);
End;
With Kryg do
Begin
{Чертим круг}
For i:=0 to Rad do
Begin
d:=Sqrt(Sqr(Rad)-Sqr(i));
{по оси Х}
PutPixel(C_KoordX+i,C_KoordY+Round(d),Cvet);
PutPixel(C_KoordX-i,C_KoordY+Round(d),Cvet);
PutPixel(C_KoordX+i,C_KoordY-Round(d),Cvet);
PutPixel(C_KoordX-i,C_KoordY-Round(d),Cvet);
{по оси Y}
PutPixel(C_KoordX+Round(d),C_KoordY+i,Cvet);
PutPixel(C_KoordX+Round(d),C_KoordY-i,Cvet);
PutPixel(C_KoordX-Round(d),C_KoordY+i,Cvet);
PutPixel(C_KoordX-Round(d),C_KoordY-i,Cvet);
End;
{Текущие настройки палитры}
SetFillStyle(1,Zaris_Peres);
{Определяем пересечения круга с прямоугольником}
For j:=1 to Rad-1 do
For i:=0 to j do
Begin
{Определяем величину смещения}
d:=Sqrt(Sqr(j)-Sqr(i));
{Ось Х}
{Вычисляем координаты х,у}
KoordX:=C_KoordX+i;
KoordY:=C_KoordY+Round(d);
{Определяем принадлежность 1}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX-i;
KoordY:=C_KoordY+Round(d);
{Определяем принадлежность 2}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX+i;
KoordY:=C_KoordY-Round(d);
{Определяем принадлежность 3}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX-i;
KoordY:=C_KoordY-Round(d);
{Определяем принадлежность 4}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Ось Y}
{Вычисляем координаты х,у}
KoordX:=C_KoordX+Round(d);
KoordY:=C_KoordY+i;
{Определяем принадлежность 1}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX+Round(d);
KoordY:=C_KoordY-i;
{Определяем принадлежность 2}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX-Round(d);
KoordY:=C_KoordY+i;
{Определяем принадлежность 3}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
{Вычисляем координаты х,у}
KoordX:=C_KoordX-Round(d);
KoordY:=C_KoordY-i;
{Определяем принадлежность 4}
If (KoordX>Pryam.L_KoordX) and (KoordX<Pryam.R_KoordX) and
(KoordY>Pryam.L_KoordY) and (KoordY<Pryam.R_KoordY) then
Begin
FloodFill(KoordX,KoordY,Cvet);
Break;
End;
End;
End;
End;
ReadLn;
{Закрываем графический режим}
CloseGraph;
End.
помогите пожалуйста написать программу!!!
Помогите написать программу на курсовую работу... Мне надо нарисовать прямоугольник, круг... и если они пересекаются то область пересечения закрасить в какойто цвет.
Привет, Lalala! Есть похожая программа на Паскале. (PascalABC v 2.7.3.52)
Если что, пиши на [email]sadfor@ukr.net[/email]...
Если что, пиши на [email]sadfor@ukr.net[/email]...
А вот, собственно, сама прога...
uses ABCObjects;
var
jadro: CircleABC;
r: RectangleABC;
i: integer;
procedure CheckPulyaIntersects;
var i,j: integer;
begin
for i:=ObjectsCount-1 downto 1 do
if jadro.Intersect(Objects) then
Objects.Destroy;
r.color:=ClBlue;
end;
begin
for i:=1 to 500 do
r:=RectangleABC.Create(WindowWidth-200,100,100,100,clRed);
jadro:=CircleABC.Create(10,100,100,clBlack);
for i:=1 to 700 do
begin
jadro.MoveOn(1,0);
CheckPulyaIntersects;
end;
end.
uses ABCObjects;
var
jadro: CircleABC;
r: RectangleABC;
i: integer;
procedure CheckPulyaIntersects;
var i,j: integer;
begin
for i:=ObjectsCount-1 downto 1 do
if jadro.Intersect(Objects) then
Objects.Destroy;
r.color:=ClBlue;
end;
begin
for i:=1 to 500 do
r:=RectangleABC.Create(WindowWidth-200,100,100,100,clRed);
jadro:=CircleABC.Create(10,100,100,clBlack);
for i:=1 to 700 do
begin
jadro.MoveOn(1,0);
CheckPulyaIntersects;
end;
end.