マンデルブロ集合

　フラクタルのMandelbrotプログラムで、複素数を使用したプログラムです。
https://codes-sources.commentcamarche.net/source/22471-fractal-de-mandelbrot　から ダウンロードし、修正したものです。

　表示画像の切り替えは、左上のアイコンをマウスでクリックするとメニューが表示されるので、選択してください。
画像は、五種類ほどあります。
部分拡大表示が出来ます、拡大する範囲をマウスで選択してください、元の大きさに戻す場合は、画像部を単にクリックするか、左下から右上に範囲をしていします。

プログラム

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Unit_Complexe, ActnList, Menus, ExtDlgs, ExtCtrls, System.Actions,
  system.Types, system.UITypes;

type
  TPointFloat = record
    x, y : Extended;
    Ex, Ey : Integer;
  end;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FermerExecute(Sender: TObject);
    procedure TracerExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Debut, Fin : TPointFloat;
    PrecDebut, PrecFin : TPointFloat;
    R, PrecR, RapportReel : Extended;
    Longueur, Hauteur : Extended;
    Deplacement : Boolean;
    Origine, Move : TPoint;
    select: integer;
    OutputBitmap  : TBitmap;
    procedure Initialize;
    procedure Effacer;
    procedure AddMenu;
    Procedure WMSysCommand(var msg: TWMSysCommand);message WM_SysCommand;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TPrgbarry = array[0..0] of Trgbtriple;  // 24ビットカラーレコード　32ビット用はTRGBQuadArray
  Prgbarray = ^TPrgbarry;                 // ポインター

procedure TForm1.WMSysCommand(var msg: TWMSysCommand);
begin
  case Msg.CmdType and $FFof
    10: begin select := 0; Initialize; TracerExecute(nil); end;
    11: begin select := 1; Initialize; TracerExecute(nil); end;
    12: begin select := 2; Initialize; TracerExecute(nil); end;
    13: begin select := 3; Initialize; TracerExecute(nil); end;
    14: begin select := 4; Initialize; TracerExecute(nil); end;
  end;
  inherited;
end;

procedure TForm1.AddMenu;
var
  hSysMenu:integer;
begin
  hSysMenu := GetSystemMenu(Handle,False);
    // 底に（最後に）追加する
    // セパレータを追加
  AppendMenu(hSysMenu, MF_SEPARATOR,0,nil);
    // 'NewMenuを追加
  AppendMenu(hSysMenu, MF_STRING, 10, 'Menu_1');
  AppendMenu(hSysMenu, MF_STRING, 11, 'Menu_2');
  AppendMenu(hSysMenu, MF_STRING, 12, 'Menu_3');
  AppendMenu(hSysMenu, MF_STRING, 13, 'Menu_4');
  AppendMenu(hSysMenu, MF_STRING, 14, 'Menu_5');
end;

procedure TForm1.FermerExecute(Sender: TObject);
begin
  Close;
end;

procedure TForm1.TracerExecute(Sender: TObject);
var
  Couleur         : Byte;
  Module          : Double;
  IndexX, IndexY  : Integer;
  Taille          : Integer;
  X, Y            : Extended;
  W2, h2          : integer;
  PBA             : Prgbarray;            // RGBtriple配列のポインター
begin
  Effacer;
  Taille := 250;
  case select of
    0, 4: c := Complexe.Create(0, 0);
    1: c := Complexe.Create(-0.0986, -0.65186);
    2: c := Complexe.Create(-0.772691322542185, 0.124281466072787);
    3: c := Complexe.Create(-0.3380, 0.6230);
  end;
  i := Complexe.Create(0, 0);
  z := Complexe.Create(0, 0);
  W2 := image1.Width div 2;
  if (select = 0) or (select = 4) then W2 := W2 + 150;
  H2 := image1.Height div 2;
  for IndexY := 0 to image1.Height - 1 do
  begin
    PBA := OutputBitmap.ScanLine[IndexY];
    for IndexX := 0 to image1.Width - 1 do
    begin
      X := Debut.x + IndexX / RapportReel - W2;
      Y := Debut.y + IndexY / RapportReel - H2;
      z.Re := X / Taille;
      z.Im := Y / Taille;
      if (select = 0) or (select = 4) then
      begin
        c.Re := X / Taille;
        c.Im := Y / Taille;
      end;
      Module := 0;
      Couleur := 0;
      repeat
        z.Polynome(z, 2);
        z.Addition(z, c);
        Module := z.Module;
        inc(Couleur, 1);
        if select = 4 then begin
          if Couleur = 60 then Break;
        end
        else
          if Couleur = 0 then Break;
      until Module >= 4;
      if select = 4 then Couleur := 16 * Couleur mod 256;
      case select of
        0: begin PBA[indexX].rgbtRed := 0; PBA[indexX].rgbtGreen := Couleur; PBA[indexX].rgbtBlue := Couleur; end;
        1: begin PBA[indexX].rgbtRed := Couleur; PBA[indexX].rgbtGreen := 0; PBA[indexX].rgbtBlue := Couleur; end;
        2: begin PBA[indexX].rgbtRed := Couleur; PBA[indexX].rgbtGreen := Couleur; PBA[indexX].rgbtBlue := 0; end;
        3: begin PBA[indexX].rgbtRed := Couleur; PBA[indexX].rgbtGreen := Couleur; PBA[indexX].rgbtBlue := Couleur; end;
        4: begin PBA[indexX].rgbtRed := Couleur; PBA[indexX].rgbtGreen := 0; PBA[indexX].rgbtBlue := 0; end;
      end;
    end;
  end;
  image1.Picture.Bitmap := OutputBitmap;
  FreeAndNil(i);
  FreeAndNil(c);
  FreeAndNil(z);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PrecDebut := Debut;
  PrecFin := Fin;

  Longueur := PrecFin.x - PrecDebut.x;
  Hauteur := PrecFin.y - PrecDebut.y;

  Debut.Ex := X;
  Debut.Ey := Y;
  Debut.x := Longueur / Image1.Width * Debut.Ex + PrecDebut.x;
  Debut.y := Hauteur / Image1.Height * Debut.Ey + PrecDebut.y;

  Deplacement := True;
  Origine := Point(X, Y);
  Move := Origine;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Rapport : Double;
begin
  if Deplacement then
  begin
    Rapport := Image1.Height / Image1.Width;
    Image1.Canvas.Pen.Style := psDot;
    Image1.Canvas.Pen.Mode := pmNotXor;
    Image1.Canvas.Rectangle(Origine.x, Origine.y, Move.x, Origine.y + Round((Move.x - Origine.x) * Rapport));
    Move := Point(X, Y);
    Image1.Canvas.Rectangle(Origine.x, Origine.y, Move.x, Origine.y + Round((Move.x - Origine.x) * Rapport));
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image1.Canvas.Pen.Mode := pmCopy;

  Deplacement := False;

  Fin.Ex := X;
  Fin.Ey := Y;

  if Fin.Ex - Debut.Ex <= 0 then
  begin
    Initialize;
  end
  else
  begin
    PrecR := RapportReel;
    R := Image1.Width/(Fin.Ex - Debut.Ex);
    RapportReel := R*PrecR;

    Fin.x := Debut.x + Longueur/R;
    Fin.y := Debut.y + Hauteur/R;
  end;
  TracerExecute(Sender);
end;

procedure TForm1.Initialize;
begin
  { On initialise les variables }
  Debut.x := 0;
  Debut.y := 0;
  Debut.Ex := 0;
  Debut.Ey := 0;

  Fin.x := image1.Width;
  Fin.y := image1.Height;
  Fin.Ex := image1.Width;
  Fin.Ey := image1.Height;

  PrecDebut := Debut;
  PrecFin := Fin;

  PrecR := 1;
  R := 1;
  RapportReel := R*PrecR;

  Longueur := image1.Width;
  Hauteur := image1.Height;

  Deplacement := False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OutputBitmap.Free;      // bitmapの開放
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Width := 1024;
  Height := 700;
  Top := (Screen.Height - Height) div 2;
  Left := (Screen.Width - Width) div 2;
  AddMenu;
  select := 0;
  Initialize;
  OutputBitmap  := TBitmap.Create;
  OutputBitmap.PixelFormat := pf24bit;
  OutputBitmap.Height := Image1.Height;
  OutputBitmap.Width := Image1.Width;
  TracerExecute(Sender);
end;

procedure TForm1.Effacer;
var
  ColorPen, ColorBrush : TColor;
begin
  ColorPen := Image1.Canvas.Pen.Color;
  ColorBrush := Image1.Canvas.Brush.Color;
  with Image1.Canvas do begin
    Pen.Style := psSolid;
    Pen.Color := clBtnFace;
    Brush.Color := clBtnFace;
    Rectangle(0, 0, Width, Height);
    Font.Color := clBlack;
    Font.Size := 30;
    TextOut(100,50, 'S''il vous plaît');
    TextOut(100,150, 'Wait a moment');
    Pen.Color := ColorPen;
    Brush.Color := ColorBrush;
  end;
  application.ProcessMessages;
end;

end.

unit Unit_Complexe;

interface

uses
  Sysutils, Math, classes;

type
  Complexe = class
  protected
    FRe : Extended;
    FIm : Extended;
  private
  public
    constructor Create(Re, Im : Extended);
    procedure Addition(Result, C2 : Complexe);
    procedure Multiplication(Result, C2 : Complexe);
    function Module : Extended;
    procedure Polynome(Result : Complexe; Degree : Integer);
    property Re : Extended Read FRe Write FRe;
    property Im : Extended Read FIm Write FIm;
end;

var
  i, c, z : Complexe;

implementation

{ Complexe }

constructor Complexe.Create(Re, Im: Extended);
begin
  FRe := Re;
  FIm := Im;
end;

procedure Complexe.Addition(Result, C2: Complexe);
begin
  Result.Re := Self.Re + C2.Re;
  Result.Im := Self.Im + C2.Im;
end;

procedure Complexe.Multiplication(Result, C2: Complexe);
begin
  Result.Re := Self.Re * C2.Re - Self.Im * C2.Im;
  Result.Im := Self.Re * C2.Im + Self.Im * C2.Re;
end;

function Complexe.Module: Extended;
begin
  Result := Sqr(Self.Re) + Sqr(Self.Im);
end;

procedure Complexe.Polynome(Result : Complexe; Degree : Integer);
var
  Index : Integer;
  Reelle, Imaginaire : Extended;
begin
  Result.Re := Self.Re;
  Result.Im := Self.Im;
  i.Re := Self.Re;
  i.Im := Self.Im;
  for Index := 2 to Degree do
  begin
    Reelle := Result.Re * i.Re - Result.Im * i.Im;
    Imaginaire := Result.Re * i.Im + Result.Im * i.Re;
    Result.Re := Reelle;
    Result.Im := Imaginaire;
  end;
end;

end.

MandelbrotNo2Image.zip

　　画像処理プログラム　作図　に戻る