1. Набираем команду codeby webinar. Набираем команду для организации и проведения вебинаров. Подробнее ...

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление
  3. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление

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

Тема в разделе "Вопросы новичков и не только", создана пользователем Dimomaas, 19 мар 2013.

  1. Dimomaas

    Dimomaas New Member

    Репутация:
    0
    Регистрация:
    18 мар 2013
    Сообщения:
    1
    Симпатии:
    0
    Надо посчитать фрактальную рамерность замкнутой кривой. Для этого надо "обойти" всю кривую окружностями. Как это реализовать подскажите.

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

    Код:
    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.
     

    Вложения:

    • Посчитать Фрактальную Размерность
      1.jpg
      Размер файла:
      32,6 КБ
      Просмотров:
      11
Загрузка...

Поделиться этой страницей