Решения (задачи 224-241)
Задача 239
(Вычерчивает схему сложной электрической цепи. }
{ При вычерчивании схемы цепи используется рекурсия.}
Uses Graph;
const
{ шаг сетки }
dx=7;
dy=7;
river:integer; grMode:integer; grPath:string; ErrCode:integer; x,y: integer;
k: integer; порядок цепи }
{ выводит схему цепи k-ro порядка } Procedure Cep(k: integer; x,y: integer); begin
SetColor(Green);
Line (x, y, x+2*dx, y);
Rectangle (x+2*dx,y-dy,x+6*dx,y+dy);
Line(x+6*dx,y,x+8*dx,y);
OuttextXY(x+3*dx,y-3*dy,'Rl');
SetColor(Yellow);
Line(x+8*dx,y,x+8*dx,y+2*dy);
Rectangle(x+7*dx,y+2*dy,x+9*dx,y+6*dy);
Line(x+8*dx,y+6*dy,x+8*dx", y+8*dy);
OuttextXY(x+10Mx,y+2*dy, 'R2');
SetColor(LightGray);
Line(x,y+8*dy,x+2*dx,y+8*dy);
Rectangle(x+2*dx,y+7*dy,x+6*dx, y+9*dy);
Line(x+6*dx,y+8*dy,x+8*dx, y+8*dy); 1 OuttextXY(x+3*dx,y+5*dy,'R3');
if k>l then Cep(k-l,x+8*dx,y);
end;
begin
grDriver: = VGA; grMode: = VGAHi; grPath: = 'e:\tp\bgi';
InitGraph (grDriver,grMode,grPath);
ErrCode: = GraphResult; if ErrCode <> grOK then begin
writeln ('Ошибка инициализации графического режима.1);
writeln ('Для завершения работы нажмите Enter');
readln; HALT (I
end;
OutTextXY(10.10,'Введите порядок цепи и нажмите Enter');
readln(k); сер (k, 10.50); readln; CloseGraph;
end.
Задача 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.