IPB
ЛогинПароль:

> Правила раздела!

1. Заголовок или название темы должно быть информативным !
2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК !
4. НЕ используйте форум для личного общения!
5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!

 
 Ответить  Открыть новую тему 
> Создание фрактальных рисунков, есть ли такая возможность в Паскале?
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 145
Пол: Мужской
Реальное имя: Павел

Репутация: -  0  +


Я недавно увидел несколько примеров фрактальных рисунков. Стало мне интересно, как они создаются. Оказывается, что рисунок состоит из одинаковых точек, координаты которых вычислаются по какой-то математич. формуле. Можно ли нарисовать такую картинку в Паскале?


--------------------
- Дорогие девушки! У вас сухая кожа? Редкие волосы? Проблемы с фигурой? Приходите к нам! У нас темно и мы пьяные.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






В Дельфях писал ... Если надо - могу скинуть исходник ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Знаток
****

Группа: Пользователи
Сообщений: 303
Пол: Мужской
Реальное имя: Роман

Репутация: -  2  +


Вот исходник множества Мандельброта на FPC:
Код
program Mandel;

{ This program generates the Mandelbrot set fractal curves.  It is taken from
 Roger T. Stevens book: FRACTAL Programming in Turbo Pascal.
 This is the best book to buy if you are interested in or studying fractal
 curves and chaos.
}

{$ifdef Win32}
{$apptype GUI}
{$endif}

uses
{$ifdef Win32}
 WinCrt,
 Windows,
{$endif}
 Graph;

const
    maxcol = 800;
    maxrow = 600;
    max_colors = 256;
    max_iterations = 512;
    max_size = 4;
    MaxDepth = 2; // set more for speed detalization (3,4,..)
    XMax: single = 1.2;
    XMin: single = -2.2;
    YMax: single = 1.3;
    YMin: single =-1.3;


Function ComputeColor(a,b: single): word;
var X,Y,Z,Xsquare,Ysquare : single;
    color: integer;
begin
    X := 0.0;
    Y := 0.0;
    Xsquare := 0;
    Ysquare := 0;
    color := 90;
    repeat
          Xsquare := SQR(X);
          Ysquare := SQR(Y);
          Y := 2.0*X*Y + B;
          X := Xsquare - Ysquare + A;
          dec(color);
    until (color=0) OR (Xsquare + Ysquare >= max_size);
    ComputeColor:=(color MOD max_colors)
end;

var
  YC,P,Q,Q2,deltaP,deltaQ,dQ : single;
  i,row,row2,col,depth,level : integer;
  GraphDriver,GraphMode: SMALLINT;

begin
    deltaP := (XMax - XMin)/(maxcol);
    deltaQ := (YMax - Ymin)/(maxrow);

    {$ifdef Win32}
    ShowWindow(GetActiveWindow,0);
    {$endif}

    GraphDriver := d8bit;
    GraphMode := m800x600; //m640x480
    InitGraph(GraphDriver,GraphMode,'');
    if Graphresult<>0 then exit;

    for depth:=MaxDepth downto 0 do
    begin

    YC := (YMin+YMax) / 2.0;
    Q := YC;

    level:=(1 shl depth);
    dQ := deltaQ * level;

    row := maxrow div 2;
    while row>=0 do
    begin
         if Keypressed then break;

         P := XMin;

         row2:=maxrow-row;
         Q2:=YC+Q;
         for col := 0 to maxcol-1 do
         begin
              PutPixel(col,row, ComputeColor(P,Q));
              PutPixel(col,row2, ComputeColor(P,Q2));
              P += deltaP;
         end;

         Q -= dQ;
         row-=level;
    end;
    end;

    {$ifndef Win32}
    readln;
    {$else: Win32}
    repeat
    until keypressed;
    {$endif}

    CloseGraph;
end.


--------------------
Romiras HomeLab- материалы и статьи по разработке ПО, моделирование алгоритмов, обработка и анализ информации, нейронные сети, машинное зрение и прочее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


Да, фракталы можно рисовать на Паскале естественно. Язык тут не при чем.
Видел где-то очень хороший пример на паскале... (кажется на сурсах, а можети у нас...)

[offtop]
какие люди пожаловали smile.gif rolleyes.gif
[/offtop]


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 24.10.2021 16:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name