Форум: "Media";
Текущий архив: 2007.04.22;
Скачать: [xml.tar.bz2];

Вниз

найти на изображении окружность   Найти похожие ветки 

← →
MiHoY ©   (2006-08-08 07:37) [0]

в общем проблемы такая:
есть изображение произвольного размера
найти на нём окружность с статическим диаметром

и по ней определить ЦЕНТР окружности
основная проблемма в том, что изображение полученно со сканера

---

← →
MBo ©   (2006-08-08 07:47) [1]

Для поиска окружностей можно использовать преобразование Хоха (Хафа, Hough transform)

---

← →
MiHoY ©   (2006-08-08 08:39) [2]

а полегче. надо просто определить центр окружности (можно и с небольшими погрешностями) и всё

---

← →
MBo ©   (2006-08-08 09:23) [3]

>надо просто определить центр окружности
Если помех, шума немного, можно использовать подгонку - метод МНК (наименьших квадратов) для поиска окружности
http://www.geometrictools.com/Documentation/LeastSquaresFitting.pdf

---

← →
Pavia ©   (2006-08-08 23:24) [4]

{Методом наименьших квадратов.
Xc=((X1^2+X2^2+...Xn^2)/n)^(1/2);
Yc=((Y1^2+Y2^2+...Yn^2)/n)^(1/2);
Или просто геометрический центр точик, менее точное.
Xc=(X1+X2+...Xn)/n;
Yc=(Y1+Y2+...Yn)/n;
Преоброзование Хафа даст точный ответ. Оно не сложное.
http://cgm.graphicon.ru/content/view/36/62/
В добавок еще два метода.
И процедура для рисования окружности.
И еще это только пример и для нармальной работы следует все вызовы pixels
заменить на scanline.
}

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Image1: TImage;
   Edit1: TEdit;
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   Button4: TButton;
   Button5: TButton;
   Button6: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure Button5Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure Button6Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 bp:TBitmap; {Картинка с которой идет работа}
const
 R=50;  {Радиус окружности}

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
{Просто геометрический центр точик.
Xc=(X1+X2+...Xn)/n;
Yc=(Y1+Y2+...Yn)/n;}
var
n,i,j:integer;
x,y:Real;
begin
x:=0;
y:=0;
n:=0;
for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
if bp.Canvas.Pixels[i,j]=clBlack then
 begin
 x:=x+i;
 y:=y+j;
 inc(n);
 end;
x:=x/n;
y:=y/n;
edit1.Text:=format("x=%F,y=%F",[x,y]);
end;

procedure TForm1.Button2Click(Sender: TObject);
{Методом наименьших квадратов.
Xc=((X1^2+X2^2+...Xn^2)/n)^(1/2);
Yc=((Y1^2+Y2^2+...Yn^2)/n)^(1/2);}
var
n,i,j:integer;
x,y:Real;
begin
x:=0;
y:=0;
n:=0;
for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
if bp.Canvas.Pixels[i,j]=clBlack then
 begin
 x:=x+i*i;
 y:=y+j*j;
 inc(n);
 end;
x:=sqrt(x/n);
y:=sqrt(y/n);
edit1.Text:=format("x=%F,y=%F",[x,y]);
end;

procedure TForm1.Button3Click(Sender: TObject);
{Преоброзования Хафа}
var
i,j,m,n:integer;
x,y:Integer;
max:Integer;
a:array of array of Integer;
begin
SetLength(a,bp.Height,bp.Width);
for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
if bp.Canvas.Pixels[i,j]=clBlack then
 begin
 for m:=0 to bp.Height-1 do
  for n:=0 to bp.Width-1 do
   if sqr(i-n)+sqr(j-m)-sqr(R) <1  then a[m,n]:=a[m,n]+1;
 end;

max:=a[0,0];
x:=0;
y:=0;
for m:=0 to bp.Height-1 do
for n:=0 to bp.Width-1 do
 if a[m,n]>max then
  begin
  max:=a[m,n];
  y:=m;
  x:=n;
  end;
edit1.Text:=format("x=%D,y=%D",[x,y]);
end;

procedure TForm1.Button4Click(Sender: TObject);
{Оптимизированное преоброзования Хафа}
var
i,j,m,n,d:integer;
x,y:Integer;
max:Integer;
a:array of array of Integer;
begin
SetLength(a,bp.Height+2*r,bp.Width+2*r);
for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
if bp.Canvas.Pixels[i,j]=clBlack then
  begin
  {Рисуем окружность окружность одним из известных методов}
  n:=0;
  m:=r;
  d:=3-2*r;
  while  n<=m do
   begin
   Inc(a[r+j+m, r+i+n]);
   Inc(a[r+j+n, r+i+m]);
   Inc(a[r+j-n, r+i+m]);
   Inc(a[r+j-m, r+i+n]);
   Inc(a[r+j-m, r+i-n]);
   Inc(a[r+j-n, r+i-m]);
   Inc(a[r+j+n, r+i-m]);
   Inc(a[r+j+m, r+i-n]);
   if (d < 0) then d:= d + 4*n + 6
   else begin
    d:= d + 4*(n-m) + 10;
    dec(m);
    end;
   inc(n);
   end;
 end;

max:=a[0,0];
x:=0;
y:=0;
for m:=0 to bp.Height-1 do
for n:=0 to bp.Width-1 do
 if a[m,n]>max then
  begin
  max:=a[m,n];
  y:=m;
  x:=n;
  end;
edit1.Text:=format("x=%D,y=%D",[x,y]);
end;

procedure TForm1.Button5Click(Sender: TObject);
{Метод наложения картинки с выбором максимального совподения.
Работает медленно так, как часто вызывается медленный метод Pixels.
Если переписать на scanline будет работать также, а возможно быстрее
чем метод в Button4Click}
var
i,j,m,n,d,s:integer;
x,y:Integer;
max:Integer;
begin
x:=0;
y:=0;
for j:=0 to bp.Height-1 do
for i:=0 to bp.Width-1 do
 with bp.Canvas do
 begin
 s:=0;
 n:=0;
 m:=r;
 d:=3-2*r;
 while  n<=m do
  begin
  if Pixels[i+n, j+m]=clBlack then inc(s);
  if Pixels[i+m, j+n]=clBlack then inc(s);
  if Pixels[i+m, j-n]=clBlack then inc(s);
  if Pixels[i+n, j-m]=clBlack then inc(s);
  if Pixels[i-n, j-m]=clBlack then inc(s);
  if Pixels[i-m, j-n]=clBlack then inc(s);
  if Pixels[i-m, j+n]=clBlack then inc(s);
  if Pixels[i-n, j+m]=clBlack then inc(s);

  if (d < 0) then d:= d + 4*n + 6
  else begin
   d:= d + 4*(n-m) + 10;
   dec(m);
   end;
  inc(n);
  end;
 if s>max then
  begin
  max:=s;
  x:=i;
  y:=j;
  end;
 end;
Edit1.Text:=format("x=%D,y=%D",[x,y]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
bp:=TBitmap.Create;
bp:=Image1.Picture.Bitmap;
bp.PixelFormat:=pf24Bit;
end;

procedure V_MIcirc(xc,yc,r:integer);
{Процедура для рисования окружности}
var x,y,d:Integer;
begin
x:=0;
y:=r;
d:=3-2*r;
while x <= y do
begin
with form1.Image1.Canvas do
  begin
  Pixels[xc+x, yc+y]:=clBlack;
  Pixels[xc+y, yc+x]:=clBlack;
  Pixels[xc+y, yc-x]:=clBlack;
  Pixels[xc+x, yc-y]:=clBlack;
  Pixels[xc-x, yc-y]:=clBlack;
  Pixels[xc-y, yc-x]:=clBlack;
  Pixels[xc-y, yc+x]:=clBlack;
  Pixels[xc-x, yc+y]:=clBlack;
  end;
if (d < 0) then d:= d + 4*x + 6
else begin
     d:= d + 4*(x-y) + 10;
     dec(y);
     end;
inc(x);
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
V_MIcirc(50,50,r);
end;

end.

---

Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2007.04.22;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.04 c