Turbo Pascal для начинающих




Задача 240


{ Демонстрация понятия "рекурсия". Программа строит кривую Гильберта. }
uses Graph, Crt;
u: integer; { Длина штриха кривой Гильберта }
( Заменяет стандартную процедуру для вычерчивания по точкам горизонтальных и вертикальных линий. }
procedure LineTo(x2,y2: integer); const
DT = 3; ( задержка между выводом точек линии ) var
xl,yl: integer;
х,у : integer; dx: integer; dy: integer;
color: integer; a,b: real; n: integer; i: integer; begin
xlt-GetX; yl:=GetY;
{ координаты начала прямой, x2,y2 - координаты конца }
( координаты текущей точки }
{ приращение аргумента }
{ приращение у при рисовании вертикальной линии }
{ цвет линии}
( коэф-ты уравнения прямой }
( кол-во точек }
xl <> х2 then begin
( не вертикальная линия } a:=(y2-yl)/(x2-xl); ' b:=yl-a*xl;
n:=abs(x2-xl)+l; if х2 > xl then dx:=l else dx:=-l; x:=xl;
color:=GetColor; for i: =1 to n do begin
y:=Round(a*x+b); PutPixel(x,y,color); delay(DT); x:=x+dx; end; end
else begin { вертикальная л^ния } n:=abs(y2-yl); if y2 > yl then dy:=l else dy:=-l; x:=xl; y:=yl;
color:=GetColor; for i:=l to n do begin
PutPixel (x, y, color) ; delay(DT); y:=y+dy; end; end;
PutPixel(x2,y2,color); MoveTo(x2,y2); end;
{ Кривая состоит из четырех элементов: a,b,c и d.
Каждый элемент строит соответствующая процедура. } procedure a(i:integer); external;
procedure b(i:integer); external; procedure с(i:integer); external; procedure d(i:integer); external;
{ Элементы кривой. } procedure a(i: integer); begin
if i > 0 then begin
d(i-l); LineTo(GetX-u,GetY); a(i-l); LineTo(GetX,GetY+u);
a(i-l) ; LineTo(GetX+u, GetY) ;
b(i-l) ;
end;
end;
procedure b(i: integer);
begin
if i > 0 then
begin
c(i-l) ; LineTo(GetX,GetY-u) ;
b(i-l) ; LineTo(GetX+u,GetY);
b(i-l) ; LineTo(GetX,GetY+u);
a(i-l) ;
end;
end;
procedure c(i: integer);
begin
if i > 0 then
begin
b(i-l) ; LineTo(GetX+u,GetY);
c(i-l) ; LineTo(GetX,GetY-u);
c(i-l) ; LineTo(GetX-u,GetY);
d(i-l) ;
end;
end;
procedure d(i: integer); begin if i > 0 then in
a(i-l); LineTo(GetX,GetY+u); d(i-l); LineTo(GetX-u,GetY); d(i-l); LineTo(GetX,GetY-u); •c(i-l); end; end;
{ главная процедура ) var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
res: integer;
p : integer; ( Порядок кривой Гильберта } st: string; begin
grDriver := detect;
InitGraph(grDriver, grMode,'e:\tp\bgi'); ErrCode := GraphResult; if ErrCode = grOk then begin p:=5;
Str(p:2,st);
OuttextXY(0,0,'Кривая Гильберта'+st+'-го порядка.'); MoveTo(450,50) ; u:=10; a (p) ; OuttextXY(0,16,'Для завершения работы программы ',
'нажмите <Enter>.'); readln; end;
CloseGraph; end.









Начало    Назад    Вперед




Книжный магазин