courbes.pas

演示如何画“曼德罗勃”及“朱丽叶”分形图(Delphi)

unit Courbes;

{ Sample Code for Delphi 1 , 2  and more
How to draw a fractal Julia or Mandelbrot, sinus, in a canvas
Auteur Marc CAPUANO
Adresse: "Le Goussat" 42340 Veauchette (FRANCE)
Copiable dans un but non commercial.
Freeware for non commercial use)
http://www.multimania.com/spsoft/
}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Buttons, Menus;
type
  TForm1 = class(TForm)
    Pop1: TPopupMenu;
    Mandel: TMenuItem;
    Julia: TMenuItem;
    Sinusoide: TMenuItem;
    Quitter1: TMenuItem;
    Efface: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Infos1: TMenuItem;
    Taille: TMenuItem;
    procedure SinusClick(Sender: TObject);
    procedure FractClick(Sender: TObject);
    procedure MandClick(Sender: TObject);
    procedure Quitter1Click(Sender: TObject);
    procedure EffaceClick(Sender: TObject);
    procedure Infos1Click(Sender: TObject);
    procedure TailleClick(Sender: TObject);

  private
    { D閏larations private }
  public
    { D閏larations public }
  end;

var
  Form1: TForm1;
  stop:boolean;
  h0,h1:TDAteTime;

implementation
 uses u_taille;
{$R *.DFM}

procedure TForm1.SinusClick(Sender: TObject);
var
cst,i,j:integer;
y,x,angle:real;
wx,wy,zero,maxL,MaxH:integer;

begin
h0:=time;
cst:=0;
MaxH:=clientHeight-1;
MaxL:= clientWIdth-1;
zero:=trunc(MaxH/2);
wx:=0;
While (wx < MaxL)  do
    begin
    angle:= (2*Pi)/200*cst;
    x:=angle;
    angle:=angle-trunc(angle/2*Pi)*2*Pi;
    y:=sin(angle);
    wx:=round(30*x);

    wy:=round(zero+y*zero);
    Canvas.pixels[wx,wy]:=clBlack;
    If wy>zero then begin
    for j:=zero to wy do
    Canvas.pixels[wx,j]:=clBlue;
    for j:=0 to zero do
    Canvas.pixels[wx,j]:=clSilver;
    for j:=wy to maxH do
    Canvas.pixels[wx,j]:=clSilver;
                    end else
                    begin
    for j:=wy to zero do
    Canvas.pixels[wx,j]:=clRed;
    for j:=zero to MaxH do
    Canvas.pixels[wx,j]:=clSilver;
    for j:=0 to wy do
    Canvas.pixels[wx,j]:=clSilver;
                     end;

    inc(cst);
    end;
for i:=0 to MaxL do
    Canvas.pixels[i,zero]:=clBlack;
 h1:=time;
  h0:=h1-h0;
  MessageDlg( TimeToStr(H0), mtInformation,
      [mbOk], 0);
end;

procedure TForm1.FractClick(Sender: TObject);
const
R=9;
a=-1.8;b=-1;
c=1.8;d=1;
var
x,y,z,w:real;
couleur,k,l:integer;
co:longint;
begin 
h0:=time;
for k:=0 to clientWIdth-2 do
   begin
   for l:=0 to clientHeight-2 do
   begin
   x:=a+(c-a)*k/clientWidth;
   y:=b+(d-b)*l/clientHeight;
   couleur:=0;
   repeat
   z:=sqr(x)-sqr(y)-1.06;
   w:=2*x*y;
   x:=z;
   y:=w;
   couleur:= couleur+1;
   until (x*x+y*y>R) or (couleur=14);
    co:=0;
   case couleur of
   0:co:=clBlack;
   1:co:=clMaroon;
   2:co:=clGreen;
   3:co:=clNavy;
   4:co:=clPurple;
   5:co:=clTeal;
   6:co:=clGray;
   7:co:=clSilver;
   8:co:=clRed;
   9:co:=clLime;
   10:co:=clBlue;
   11:co:=clFuchsia;
   12:co:=clAqua;
   13:co:=clWhite;
      end;

   Canvas.pixels[k+1,l+1]:=co;
   end;
  end;
  h1:=time;
  h0:=h1-h0;
  MessageDlg( TimeToStr(H0), mtInformation,
      [mbOk], 0);
end;

procedure TForm1.MandClick(Sender: TObject);
const
R=9;
a=-0.8;b=-1.4;
c=2.2;d=1.4;
var
x,y,z,w,u,v:real;
k,l,couleur:integer;
co:longint;

begin
h0:=time;
for k:=0 to clientWIdth-2 do
   begin
   for l:=0 to clientHeight-2 do
   begin
   x:=a+(c-a)*k/clientWidth;
   y:=b+(d-b)*l/clientHeight;
   couleur:=0;
   u:=0;
   v:=0;
   repeat
   z:=u*u-v*v-x;
   w:=2*u*v-y;
   u:=z;
   v:=w;
   couleur:= couleur+1;
   until (u*u+v*v>R) or (couleur=14);
   co:=0;
   case couleur of
   0:co:=clBlack;
   1:co:=clMaroon;
   2:co:=clGreen;
   3:co:=clNavy;
   4:co:=clPurple;
   5:co:=clTeal;
   6:co:=clGray;
   7:co:=clSilver;
   8:co:=clRed;
   9:co:=clLime;
   10:co:=clBlue;
   11:co:=clFuchsia;
   12:co:=clAqua;
   13:co:=clWhite;
      end;
   Canvas.pixels[k+1,l+1]:=co;
   end;
  end;
  h1:=time;
  h0:=h1-h0;
  MessageDlg( TimeToStr(H0), mtInformation,
      [mbOk], 0);
end;



procedure TForm1.Quitter1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.EffaceClick(Sender: TObject);
begin
Refresh;
end;

procedure TForm1.Infos1Click(Sender: TObject);
begin
Refresh;
Canvas.TextOut(20,20,'FRACTAL 1.0 (FreeWare) SP Soft');
Canvas.TextOut(20,40,'Menu : Appuyez bouton droit souris');
Canvas.TextOut(20,80,'Delphi 16bits ou 32bits');
Canvas.TextOut(10,150,'Marc Capuano 42340 Veauchette FRANCE');
end;



procedure TForm1.TailleClick(Sender: TObject);
begin
F_Taille.SpinEdit1.Value:=form1.ClientWidth;
F_Taille.SpinEdit2.Value:=Form1.Clientheight;
F_Taille.ShowModal;
form1.ClientWidth:=F_Taille.SpinEdit1.Value;
Form1.Clientheight:=F_Taille.SpinEdit2.Value;
end;


end.