Посчитать Фрактальную Размерность

Dimomaas

New member
18.03.2013
1
0
#1
Надо посчитать фрактальную рамерность замкнутой кривой. Для этого надо "обойти" всю кривую окружностями. Как это реализовать подскажите.

Вот код который я написал:

Код:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, JPEG, Math;

type
TForm1 = class(TForm)
mm1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Image: TImage;
But1: TButton;
but2: TButton;
OD1: TOpenDialog;
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DrawCircle(x1, y1, R : Integer);
procedure But1Click(Sender: TObject);
procedure but2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1; x, y,c:Integer; arr:array[0..473, 0..289] of Integer;

implementation

{$R *.dfm}

var ass,ass2:Integer;

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

procedure TForm1.N2Click(Sender: TObject); //Добавляет картинку и вносит в массив координаты точек кривой 0 - черный цвет, 1 - белый цвет
var Fname:string;	Bitmap: TBitmap; i,j:Integer; f:file;
begin
if OD1.Execute then
begin
FName := OD1.FileName;
begin
Bitmap:=TBitmap.Create;
Bitmap.LoadfromFile(Fname);

With Image.Picture.bitmap do
Begin
Width:=Bitmap.Width;
height:=Bitmap.Height;
Palette:=Bitmap.Palette;
Canvas.draw(0,0,bitmap);
Refresh;
end;
end;
end;
for i:=0 to 289 do
begin
for j:=0 to 473 do
begin
if Form1.Image.Picture.Bitmap.Canvas.Pixels[i,j]=clblack then
begin
Arr[i,j]:=1;
end
else
begin
Arr[i,j]:=0;
end;
end;
end;
end;

procedure SearchNew1(a,b:integer);// поиск пересечений окружности с кривой
var i,r,a11,b11:Integer; exit,exit1:Boolean;
begin
r:=16;
a11:=a;
b11:=b;
exit1:=false;
for a:=0 to 289 do
begin
for b:=0 to 473 do
begin
if ((Sqr(a-a11)+sqr(b-b11))=Sqr(16)) and (Arr[a,b]=1) then	  //проверяем что точка принадлежит окружности радиуса 16
begin
ass:=a;
ass2:=b;
exit1:=False;
exit:=False;
end;
end;
end;
end;

procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(x-16,y-16,x+16,y+16);
SearchNew1(x,y);
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(ass-16,ass2-16,ass+16,ass2+16);
SearchNew1(ass,ass2);
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(ass-16,ass2-16,ass+16,ass2+16);
SearchNew1(ass,ass2);
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(ass-16,ass2-16,ass+16,ass2+16);
SearchNew1(ass,ass2);
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(ass-16,ass2-16,ass+16,ass2+16);
SearchNew1(ass,ass2);
Form1.Image.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
Form1.Image.Picture.Bitmap.Canvas.Ellipse(ass-16,ass2-16,ass+16,ass2+16);
end;
procedure TForm1.But1Click(Sender: TObject);
begin
DrawCircle(ass,ass2, 16);
SearchNew1(ass,ass2);
end;

procedure TForm1.but2Click(Sender: TObject);
var
tx:textfile;
i,j:integer;
a:array [1..10,1..10] of integer;
begin
randomize;
AssignFile(tx,'G:\1.txt');
Rewrite(tx);
for i:=1 to 289 do
begin
for j:=1 to 473 do
begin
Write(tx,Arr[i,j]);
end;
end;
closefile(tx);
end;

end.
 

Вложения

  • 32.6 КБ Просмотры: 11