Модуль по турбо паскалю не меняется в файл .tpu, ошибки не выдаёт и при компилировании показывает что программа выполняется правильно.
unit Graf_01;
interface
uses Graph,Crt;
type fun=function(x:real):real; {$F+}
procedure GrafInit;
procedure Tree(a,n:integer; x,y,L,xL,yL:real);
procedure Triangle(xa,ya,xb,yb,xc,yc,n:integer);
procedure Kantor(x,y:integer;size:word);
procedure FGraf(a,b,dx:real; f:fun; maxX,maxY:integer);
implementation
procedure GrafInit;
{ инициализация графического режима }
var gd,gm,ErrorCode:integer;
begin
gd:=Detect; { выбор графического драйвера }
InitGraph(gd, gm, 'c:\case\bp\bgi');
ErrorCode:=GraphResult;
if ErrorCode <> grOk
then begin
writeln('Error_Init:',GraphErrorMsg(ErrorCode)); Halt
end
end;
procedure Tree(a,n:integer; x,y,L,xL,yL:real);
{ построение фрактального дерева }
var r:real;
begin
if (n>0) and (not keypressed)
then begin
SetColor(21-n); { установка цвета линии }
xL:=0.5*(x+xL); yL:=0.5*(y+yL); r:=a*pi/180;
x:=xL+L*cos(r); y:=yL-L*sin(r);
Line(round(x),round(y),round(xL),round(yL)); { рисует отрезок прямой}
Tree(a-30,n-1,x,y,L/2,xL,yL); {рекурсивный вызов}
Tree(a+30,n-1,x,y,L/2,xL,yL);
Tree(a-45,n-1,x,y,L/2,xL,yL);
Tree(a+45,n-1,x,y,L/2,xL,yL);
Tree(a+15,n-1,x,y,L/1.5,xL,yL);
Tree(a+30,n-1,x,y,L/1.5,xL,yL);
end
end;
procedure Triangle(xa,ya,xb,yb,xc,yc,n:integer);
{ построение треугольника Серпинского}
var xp,xq,xr,yp,yq,yr:integer;
begin
if n > 0
then begin
xp:=(xb+xc) div 2; yp:=(yb+yc) div 2;
xq:=(xa+xc) div 2; yq:=(ya+yc) div 2;
xr:=(xb+xa) div 2; yr:=(yb+ya) div 2;
Line(xp,yp,xq,yq); Line(xq,yq,xr,yr); Line(xp,yp,xr,yr);
Triangle(xa,ya,xr,yr,xq,yq,n-1);
Triangle(xb,yb,xp,yp,xr,yr,n-1);
Triangle(xc,yc,xq,yq,xp,yp,n-1);
end
end;
procedure Kantor(x,y:integer;size:word);
{ построение множества Кантора }
var s:word;
procedure SolidRec(x,y,size:integer);
begin
Rectangle(x-size,y-size,x+size,y+size); { рисует прямоугольник}
Bar(x-size+1,y-size+1,x+size-1,y+size-1); {закрашеный квадрат}
end;
begin
if size>1
then begin
s:=size div 2;
Kantor(x-size,y+size,s); Kantor(x-size,y-size,s);
Kantor(x+size,y+size,s);Kantor(x+size,y-size,s);
end;
SolidRec(x,y,size)
end;
procedure FGraf(a,b,dx:real; f:fun; maxX,maxY:integer);

const Ots=10;
procedure MaxMinF(a,b,dx:real;f:fun; var fmin,fmax:real);
var w,x:real; k,n:integer;
begin
fmin:=f(a); fmax:=f(a); n:=trunc((b-a)/dx)+1;
for k:=0 to n do begin
x:=a+k*dx; w:=f(x);
if w < fmin then fmin:=w;
if w > fmax then fmax:=w
end
end;
var fmin,fmax,mx,my,x:real; n,x0,y0,k,xg,yg:integer;
begin
{ определение начала координат }
x0:=maxX div 2; y0:=maxY div 2;
Line(Ots,y0,maxX-Ots,y0); { проведение оси Ox}
Line(x0,Ots,x0,maxY-Ots); { проведение оси Oy}
MaxMinF(a,b,dx,f,fmin,fmax); { вычисление fmin, fmax на отрезке [a,b] }
mx:=(maxX-2*Ots)/(b-a); { масштаб по оси х}
my:=(maxY-2*Ots)/(fmax-fmin); { масштаб по оси y}
MoveTo(x0+trunc(mx*a),y0-trunc(my*f(a))); {установка курсора в начало графика}
n:=trunc((b-a)/dx)+1;
for k:=0 to n do begin
x:=a+k*dx;
xg:=x0+trunc(mx*x); { графические координаты по оси x}
yg:=y0-trunc(my*f(x)); { графические координаты по оси y}
LineTo(xg,yg); { проведение кривой}
end
end;
end.

Популярно: Информатика

• 

  Данилкакрутой

  24.03.2020 02:03
  Кодирование текста, сообщение длинной 20480 символов занимает в память...
• 

  Rabika2018

  18.10.2022 18:43
  Дано натуральное число определить а) есть ли в нем цифра 3 б)есть ли в...
• 

  1Z1D

  21.02.2023 22:10
  Дано натуральное число определить а) есть ли в нем цифра 3 б)есть ли в...
• 

  erfsdgfRyde

  20.12.2021 00:51
  Диаграмма венна на тему татьяна и девушки-представительницы её круга (а.с....
• 

  gb03041966

  12.05.2021 18:01
  Всегда ли при решении вы получали новую информацию? примеры....
• 

  kluk12

  20.12.2021 14:07
  Составить программу, выводящую количество корней квадратного уравнения...
• 

  lddld

  08.07.2020 05:29
  Определить тип синтаксической ошибки в программе на языке паскаль...
• 

  fufujyrfjyrfyjrff

  18.08.2021 23:00
  Для хранения неупакованного растрового изображения размером 50 х 50 пикселей...
• 

  Лера9814

  11.11.2022 06:28
  A​→​(a&b) Определите значение выражения при а истина б ложь...
• 

  крыска235

  17.01.2021 18:35
  Нужно 4 предложения на тему наши школьные дела без ! кто даст ответ тому...