Уроки, алгоритмы, программы, примеры

Вход на сайт

Материалы по разделам

Построения
на плоскости (2D)
Графика
в пространстве (3D)
Вычислительная
геометрия
Физическое
моделирование
Фрактальная
графика

Новые комментарии

dobryj den, popytalas otkryt prikreplionnyj fail ctoby posmotret kak rabotaet, no mne ego ne pokazyvaet vydajet osibku. Pochemu?
Очень интересно! ии сайт крутой жалко что умирает(
У Вас число превысит максимальное число int. Можно использовать в Вашем случае uint, но лучше все переписать на double.
Добавление к программе строки glutReshapeFunc(changeSize); приводит к тому, что треугольник перестаёт совсем отрисовываться.
Выдаёт ошибку glut32.dll не найден! При том, что он лежит в System32! Всё решил) Нужно отправить не в System32, а в System.

Счетчики и рейтинг

Рейтинг@Mail.ru Яндекс.Метрика
Скриншот к примеру
Среда программирования: 
Lazarus 1.2.4 win32/win64
Статья по теме: 

Пример построения Н-фрактала. Вначале строится одна фигура, потом 4, потом 16. Размер каждых следующих фигур меньше в 2 раза предыдущих (предыдущей, если первой). Фигуры одинакового размера изображены одинаковым цветом. Цвета чередуются. Цветов 7, значит цвета фигур размерами 2^7*x и x будут совпадать. По счёту фигуры с равными цветами будут N и N+7.

Код программы: 

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons;
type
  { TForm1 }
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    PaintBox1: TPaintBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
 
    procedure H(xc,yc:integer;razd:double);         //рисует фигуру Н по координатам центра и размеру
    procedure H_fractal(x0,y0,razmer,chot,yroven:integer);
 
  private
    xc,yc,copy_yroven,copy_razmer:integer;
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.H(xc,yc:integer;razd:double);                               
var xck,yck,razk: integer;razdk:double;                                       
  begin                                                                      
    xck:=xc;                                                                   
    yck:=yc;                                                                   
    razdk:=razd;                                                             
    razk:=round(razdk);                                                    
     PaintBox1.Canvas.Line(xck-razk,yck     ,xck+razk,yck     );// —            
     PaintBox1.Canvas.Line(xck-razk,yck-razk,xck-razk,yck+razk);//|         
     PaintBox1.Canvas.Line(xck+razk,yck-razk,xck+razk,yck+razk);// |        
  end;                                                                       
 
procedure TForm1.H_fractal(x0,y0,razmer{размер первой Н},chot{счёт цвета},yroven{размер последней Н}:integer);
  var
  x1,y1,x11,y11,x01,y01,x00,y00,x10,y10,r,buff:integer;rc:double;
   begin
     r:=razmer;
     rc:=razmer;
                buff:=chot;
                copy_yroven:=yroven;
                copy_razmer:=razmer;{размер первой Н}
     x1:=x0;
     y1:=y0;
     //находим 4 координаты из которых будут строиться следующие Н.
     //x11 -- координата правого нижнего конца  по X
     //y10 -- координата правого верхнего конца по Y
     x11:=x1+r;
     y11:=y1+r;
         x01:=x1-r;
         y01:=y1+r;
            x10:=x1+r;
            y10:=y1-r;
     x00:=x1-r;
     y00:=y1-r;
 
     if buff=8 then buff:=1;//возвращаемся к первому цвету
 
     if buff=1 then  PaintBox1.Canvas.Pen.Color := RGBToColor(255,0  ,0  );  //красный
     if buff=2 then  PaintBox1.Canvas.Pen.Color := RGBToColor(255,127,0  );  //оранжевый
     if buff=3 then  PaintBox1.Canvas.Pen.Color := RGBToColor(255,255,0  );  //жёлтый
     if buff=4 then  PaintBox1.Canvas.Pen.Color := RGBToColor(0  ,255,0  );  //зелёный
     if buff=5 then  PaintBox1.Canvas.Pen.Color := RGBToColor(0  ,127,255);  //голубой
     if buff=6 then  PaintBox1.Canvas.Pen.Color := RGBToColor(0  ,0  ,255);  //синий
     if buff=7 then  PaintBox1.Canvas.Pen.Color := RGBToColor(127,0  ,255);  //фиолетовый
     buff:=buff+1;//переходим к следующему цвету
          H(x1,y1,rc);// строим одну Н
     rc:=rc/2; //уменьшаем размер Н в 2 раза
     r:=round(rc); //нужно округлить round() т.к. частное может получиться не целым
 
     if r>=copy_yroven then    //будем строить, если размер текущей Н не меньше размера последней Н
     begin
      //строим 4 Н меньшего размера в четырёх вершинах большей Н, которую мы уже построили
      //рекурсия
      H_fractal(x11,y11,r,buff,copy_yroven) ;
      H_fractal(x01,y01,r,buff,copy_yroven) ;
      H_fractal(x00,y00,r,buff,copy_yroven) ;
      H_fractal(x10,y10,r,buff,copy_yroven) ;
     end;
   end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color := RGBToColor(50,200,255); //цвет фона
PaintBox1.Canvas.Rectangle(0,0, PaintBox1.Width, PaintBox1.Height);//заливка фона
  xc:=round(PaintBox1.Width/2);
  yc:=round(PaintBox1.Height/2);
   H_fractal(xc,yc,128,1,2); //(координата центра по X,по Y,размер первой Н,первый цвет,размер последней Н)
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
var buff:double;
begin
 
PaintBox1.Canvas.Brush.Color := RGBToColor(50,200,255);
PaintBox1.Canvas.Rectangle(0,0, PaintBox1.Width, PaintBox1.Height);
  xc:=round(PaintBox1.Width/2);
  yc:=round(PaintBox1.Height/2);
  if copy_yroven>1  //нельзя допустить, чтобы размер Н был меньше 1
  then begin
  buff:= copy_yroven/2;
  copy_yroven:=round(buff);
  end;
   H_fractal(xc,yc,128,1,copy_yroven);
end;
 
 
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color := RGBToColor(50,200,255);
PaintBox1.Canvas.Rectangle(0,0, PaintBox1.Width, PaintBox1.Height);
  xc:=round(PaintBox1.Width/2);
  yc:=round(PaintBox1.Height/2);
  if copy_yroven<128  then begin    //размер маленькой Н не должен превышать размера большой Н
  copy_yroven:=copy_yroven*2;
  end;
   H_fractal(xc,yc,128,1,copy_yroven);
end;
end.

Прикрепленный файлРазмер
Riza_H_fraktal.rar693.38 кб