2021/08/07 プログラムの修正と部分拡大の追加
マンデルブロ集合
ウィキペディア（Wikipedia）のマンデルブロ集合にある複素数を使用しない場合のプログラムです。
他のフラクタルのプログラムにも、Mandelbrotのプログラムが組み込まれたものがあるのですが、ここのプログラムはMandelbrotの基本的なプログラムです。
マウスで範囲を指定すればその範囲を拡大表示されます。
画像を単にクリックすれば初期画像に戻ります。
本格的なMandelbrotのプログラムが必要な場合は、実行ファイルは、Xaos-project からダウンロードできます。
Windows、MAC用があり、Windows用のは 32ビットの実行ファイルですが、64ビットWindowsでもインストール実行でき、種々のフラクタル図形を描画し、滑らかなズームが可能です。
ソースファイルが必要な場合は、https://github.com/xaos-project/XaoS
からダウンロードでき、C,C++です。
プログラム
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ExtCtrls, system.Types;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
RadioGroup1: TRadioGroup;
Image1: TImage;
RadioGroup2: TRadioGroup;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
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);
private
{ Private 宣言 }
// 部分拡大表示用
Deplacement : Boolean;
Origine, Move : TPoint;
// 作図係数
au, ao: double; // X 方向
bo, bu: Double; // y 方向
//--------------------
OutputBitmap : TBitmap; // 作図用ビットマップ
DREWF : Boolean; // 作図済みフラグ
procedure initial_value;
procedure DrawMandelbrot(Aimage: Timage; X, Y, au, bu: Double; X2, Y2, item, md: Integer);
procedure Zoom(Lz, Rz, Lt: integer);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TPrgbarry = array[0..0] of Trgbtriple; // 24ビットカラーレコード 32ビット用はTRGBQuadArray
Prgbarray = ^TPrgbarry; // ポインター
// -------------- Mandelbrot 作図 ------------------------
// Aimage : Timage
// X, Y : xy方向1ドット変化量
// au, bu : x方向y方向作図係数初期値
// X2, Y2 : 描画サイズX, Y
// item : 色選択
// md : 作図カラーモード
procedure TForm1.DrawMandelbrot(Aimage: Timage; X, Y, au, bu: Double; X2, Y2, item, md: Integer);
var
a, b, Xn, Yn, tmp : Double;
i, j, Count : Integer;
col : byte;
PBA : Prgbarray; // RGBtriple配列のポインター
begin
col := 0;
b := bu;
for i := 0 to Y2 - 1 do
begin
PBA := OutputBitmap.ScanLine[i];
a := au;
for j := 0 to X2 - 1 do
begin
Xn := 0;
Yn := 0;
count := 0;
while Xn * Xn + Yn * Yn < 4 do
begin
tmp := Xn;
Xn := Xn * Xn - Yn * Yn + a;
Yn := 2 * tmp * Yn + b;
Inc(count);
case md of
0: if count = 60 then break;
1: if count = 256 then break;
2: if count = 255 then break;
end;
end;
case md of
0: col := 16 * Count mod 256;
1: col := count;
2: col := count;
end;
case item of
0 : begin PBA[j].rgbtRed := col; PBA[j].rgbtGreen := 0; PBA[j].rgbtBlue := 0; end; // 赤
1 : begin PBA[j].rgbtRed := 0; PBA[j].rgbtGreen := col; PBA[j].rgbtBlue := 0; end; // 緑
2 : begin PBA[j].rgbtRed := col div 2; PBA[j].rgbtGreen := col div 2; PBA[j].rgbtBlue := col; end; // 青
3 : begin PBA[j].rgbtRed := col; PBA[j].rgbtGreen := 0; PBA[j].rgbtBlue := col; end; // 紫
4 : begin PBA[j].rgbtRed := col; PBA[j].rgbtGreen := col; PBA[j].rgbtBlue := 0; end; // 黄
5 : begin PBA[j].rgbtRed := col; PBA[j].rgbtGreen := col; PBA[j].rgbtBlue := col; end; // 灰白
end;
a := a + X;
end;
b := b + Y;
end;
Aimage.Picture.Bitmap := OutputBitmap;
end;
// 初期値
procedure TForm1.initial_value;
begin
ao := 0.7; // X方向初期値
au := -2; // X方向最終値
bo := 1.5; // Y方向初期値
bu := -1.5; // Y方向最終値
end;
// 作図
procedure TForm1.BitBtn1Click(Sender: TObject);
var
dX, dY: Double;
item, md : integer;
begin
// Initialize Mandelbrot
item := RadioGroup1.ItemIndex; // 色の選択
md := RadioGroup2.ItemIndex; // 色パターンの選択
initial_value;
// direct scaling cause of speed
dX := (ao - au) / Image1.Width; // X方1ドット変化量
dY := (bo - bu) / Image1.Height; // y方1ドット変化量
DrawMandelbrot(Image1, dX, dY, au, bu, Image1.Width, Image1.Height, item, md);
DREWF := True;
end;
// 画像クリア
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
initial_value;
Image1.Canvas.Brush.Color := clbtnface;
Image1.Canvas.FillRect(Canvas.ClipRect);
DREWF := False;
end;
// 終了処理 ビットマップ解放
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
OutputBitmap.Free; // bitmapの開放
end;
// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
begin
DREWF := False; // 作図済みフラグ
Image1.Width := Bitbtn1.Left - 30;
OutputBitmap := TBitmap.Create;
OutputBitmap.PixelFormat := pf24bit;
OutputBitmap.Height := Image1.Height;
OutputBitmap.Width := Image1.Width;
end;
// --------範囲指定拡大表示追加 ------------------------------------------------
// Lz 範囲左座標
// Rz 範囲右座標
// Lt 範囲上座標
procedure TForm1.Zoom(Lz, Rz, Lt: integer);
var
dX, dY : Double;
item, md : integer;
Wz, Hz : integer;
begin
item := RadioGroup1.ItemIndex; // 色の選択
md := RadioGroup2.ItemIndex; // 色パターンの選択
Wz := Image1.Width;
Hz := Image1.Height;
dX := (ao - au) / Wz * (Rz - Lz) / Wz; // X方1ドット変化量
dY := (bo - bu) / Hz * (Rz - Lz) / Wz; // Y方1ドット変化量
au := (ao - au) / Wz * Lz + au; // X方向初期値
bu := (bo - bu) / Hz * Lt + bu; // X方向最終値
ao := au + Dx * Wz; // Y方向初期値
bo := bu + Dy * Hz; // Y方向最終値
DrawMandelbrot(Image1, dX, dY, au, bu, Wz, Hz, item, md);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not DREWF then exit;;
Deplacement := True;
Origine := Point(X, Y);
Move := Origine;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
Rapport : Double;
begin
if not DREWF then exit;;
if Deplacement then
begin
Rapport := Image1.Height / Image1.Width;
Canvas.Pen.Style := psDot;
Canvas.Pen.Mode := pmNotXor;
Canvas.Rectangle(Origine.x, Origine.y, Move.x, Origine.y + Round((Move.x-Origine.x)*Rapport));
Move := Point(X, Y);
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
if not DREWF then exit;;
Canvas.Pen.Mode := pmCopy;
Deplacement := False;
if (Origine.X - X >= 0) or (Origine.Y - Y >= 0) then
begin
BitBtn1Click(nil);
end
else begin
Zoom(Origine.X, X, Origine.Y);
end;
end;
end.
MandelbrotN01.zip
画像処理プログラム 作図 に戻る