Фрактал в виде папоротника

[Arigato]

Может кому пригодится, программа, выводящая итерационный фрактал в виде папоротника. В таймере добавлен элемент анимации (интервал таймера установить на 1 мс).

var T0, FPS: Integer;
    Alpha, Beta, KA, KB: Single;

procedure Fract (A, B: TPoint; Alpha, Beta, K1, K2: Single);
const LMin = 36; // Корень минимальной длины ветки
var CosA, SinA, CosB, SinB: Single;
    BitMap: TBitMap;
  procedure Fr (A, B: TPoint; Num: Integer);
  var C, D, E, F, G: TPoint;
  begin
    if Sqr (B.X - A.X) + Sqr (B.Y - A.Y) > LMin then
    begin
      C.X := Round ((B.X - A.X) * CosA - (B.Y - A.Y) * SinA + A.X);
      C.Y := Round ((B.X - A.X) * SinA + (B.Y - A.Y) * CosA + A.Y);
      D.X := Round (A.X * (1 - K1) + C.X * K1);
      D.Y := Round (A.Y * (1 - K1) + C.Y * K1);
      E.X := Round (A.X * (1 - K2) + C.X * K2);
      E.Y := Round (A.Y * (1 - K2) + C.Y * K2);
      F.X := Round ((E.X - D.X) * CosB - (E.Y - D.Y) * SinB + D.X);
      F.Y := Round ((E.X - D.X) * SinB + (E.Y - D.Y) * CosB + D.Y);
      G.X := Round ((E.X - D.X) * CosB + (E.Y - D.Y) * SinB + D.X);
      G.Y := Round (-(E.X - D.X) * SinB + (E.Y - D.Y) * CosB + D.Y);
      with BitMap.Canvas do
      begin
        Pen.Color := RGB (0, (32 + Num * 32) mod 256, 0);
        MoveTo (A.X, A.Y);
        LineTo (D.X, D.Y);
{        MoveTo (BitMap.Width - A.X, A.Y);
        LineTo (BitMap.Width - D.X, D.Y);{}
        MoveTo (A.X + 100, A.Y);
        LineTo (D.X + 100, D.Y);
        MoveTo (A.X - 100, A.Y);
        LineTo (D.X - 100, D.Y);{}
      end; {with}
      Fr (D, C, Num);
      Fr (D, F, Num + 1);
      Fr (D, G, Num + 1);
    end; {if}
  end; {proc Fr}
begin
  BitMap := TBitMap.Create;
  BitMap.Width := FMain.Width;
  BitMap.Height := FMain.Height;
  CosA := Cos (Alpha);
  SinA := Sin (Alpha);
  CosB := Cos (Beta);
  SinB := Sin (Beta);
  Fr (A, B, 0);
  FMain.Canvas.Draw (0, 0, BitMap);
  BitMap.Free;
end; {proc Fract}

procedure TFMain.Timer1Timer(Sender: TObject);
begin
  Fract (Point (250, 400), Point (300, 10), Alpha, Beta, 0.18, 0.6);
  Alpha := Alpha + KA;
  if (Alpha < -Pi / 60) or (Alpha > Pi / 60) then KA := -KA;
  Beta := Beta + KB;
  if (Beta < Pi / 8 - Pi / 60) or (Beta > Pi / 8 + Pi / 60) then KB := -KB;
  Inc (FPS);
  if GetTickCount - T0 > 1000 then
  begin
    Caption := 'FPS: ' + IntToStr (FPS);
    T0 := GetTickCount;
    FPS := 0;
  end; {if}
end;

procedure TFMain.FormShow(Sender: TObject);
begin
  Alpha := 0;
  Beta := Pi / 8;
  KA := 0.003;
  KB := 0.002;
  T0 := GetTickCount;
  FPS := 0;
  Timer1.Enabled := not Timer1.Enabled;
end;

В прикреплённом файле откомпилированная программа.

[mihali4]

Очень симпатичненько получилось. Музычку добавить еще...

[Stilet]

5 баллов )
Прикольная чтука. Попробую такое в 3DS применить )

[CraZZy RabbIt]

о=)спасибо=)приготится=)

[AinaRai]

Супер! я как раз искала нечто подобное, спасибо))

[ZvEr_HaCkEr]

Классная вещь!