Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 30-09-2008
Cesar Junior Cesar Junior is offline
Miembro
 
Registrado: ago 2007
Posts: 24
Poder: 0
Cesar Junior Va por buen camino
Question Uso de erosion en procesamiento de imagenes

Hola amigos, aqui nuevamente a pedir ayuda a usteds, explicando resumidamente cual es el trabajo realizado, estoy con un proyecto de un sistema para contar objetos automaticamente usando imagenes, ya aqui en el forum el problema de contar fue solucionado usando el algoritmo de coso que es asi:

Código Delphi [-]
 
procedure TForm1.Rellena_colonia(i,j : integer; col,rel : TColor; im : TImage; var tam : integer);
begin
        if (i = 0) or (j = 0) or (i > Im.Width) or (i > Im.Height) then exit;
        if Im.Canvas.Pixels[i,j] <> col then exit;
        Im.Canvas.Pixels[i,j] := rel;
        inc(tam);
        rellena_colonia(i-1,j-1,col,rel,im,tam);
        rellena_colonia(i  ,j-1,col,rel,im,tam);
        rellena_colonia(i+1,j-1,col,rel,im,tam);
        rellena_colonia(i-1,j  ,col,rel,im,tam);
        rellena_colonia(i  ,j  ,col,rel,im,tam);
        rellena_colonia(i+1,j  ,col,rel,im,tam);
        rellena_colonia(i-1,j+1,col,rel,im,tam);
        rellena_colonia(i  ,j+1,col,rel,im,tam);
        rellena_colonia(i+1,j+1,col,rel,im,tam);

end;
 
procedure TForm1.BitBtn6Click(Sender: TObject);
var
        i,j : integer;
        colonias : integer;
        tam: integer;
begin

        colonias := 0;
        for i := 0 to Image1.Width do
        for j := 0 to Image1.Height do
        if Image1.Canvas.Pixels[i,j] = clBlack then
        begin
             tam := 0;

             rellena_colonia(i,j,clBlack,clRed,Image1,tam);
             //ShowMessage(inttostr(tam)); // tamaño de colonia
             if tam > quantidade then
             inc(colonias);
        end;
        Label2.Caption := inttostr(colonias);
        Label2.Visible:=true;
end;

Este algoritmo funciona depues de una imagen ser binarizada, contamos los objetos de interes usando el color para busqueda asi incrementar el contador, como los objetos que este trabajo propone contar son circulares esto funciona de maravilha, aplicando y haciendo pruebas con varias imagenes llegamos a un problema, cuando dos objetos circulares estan mui pegados, en el momento de la binarizacion estos se quedan unidos, ai el proceso de contar toma este objeto como uno solo, buscando soluciones para este problema encontramos una morfología matematica conocida como erosion, que consiste en desgastar los bordes de los objetos teniendo como padrón una imagen pr estabelecida, para tener una idea algunos links de sitios que explican mejor el processo de erosión

http://www.uaem.mx/cicos/memorias/5tocic2006/Articulos/articulo8.pdf


el link abajo es de una pagina en portugues, tine unas imagenes explicativas para mejorar el entendimiento, a todos aquellos que de dispongan a ayudar desde ya les agradesco!!!!!


http://www.ene.unb.br/~juliana/cursos/semana/aulas/see-pi-jfc-3-2x1.pdf


este aqui abajo explica bien en español el funcionamiento de erosión

http://wellpath.uniovi.es/es/conteni...ml/binaria.htm

Última edición por Cesar Junior fecha: 30-09-2008 a las 16:53:13.
Responder Con Cita
  #2  
Antiguo 30-09-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Hola de nuevo,

la gracia de la 'erosion' seria transformar a negro aquellos pixeles que tienen alguno de sus pixeles colindantes en negro tambien...quedaria algo asi :

Código Delphi [-]

procedure Erosionar( origen, destino : TCanvas);
var
   i, j  : integer;
begin
         for i := 0 to origen.Width do
         for j := 0 to origen.Height do
         begin
                   if (origen.Pixels[i-1,j-1] = clBlack) or 
                      (origen.Pixels[i  ,j-1] = clBlack) or 
                      (origen.Pixels[i+1,j-1] = clBlack) or
                       ...
                      (origen.Pixels[i  ,j+1] = clBlack) or 
                      (origen.Pixels[i+1,j+1] = clBlack) then
                   destino.Pixels[i,j] := clBlack else destino.Pixels[i,j] := clWhite;
         end;     
end;

mas o menos...como ves, se miran los pixeles colindantes o el mismo, y si alguno de ellos es clBlack, entonces el destino se pinta tambien clBlack. Saludos.

Última edición por coso fecha: 30-09-2008 a las 19:41:57.
Responder Con Cita
  #3  
Antiguo 01-10-2008
Cesar Junior Cesar Junior is offline
Miembro
 
Registrado: ago 2007
Posts: 24
Poder: 0
Cesar Junior Va por buen camino
Cita:
Empezado por coso Ver Mensaje
Hola de nuevo,

la gracia de la 'erosion' seria transformar a negro aquellos pixeles que tienen alguno de sus pixeles colindantes en negro tambien...quedaria algo asi :


Código Delphi [-]

procedure Erosionar( origen, destino : TCanvas);
var
i, j : integer;
begin
for i := 0 to origen.Width do
for j := 0 to origen.Height do
begin
if (origen.Pixels[i-1,j-1] = clBlack) or
(origen.Pixels[i ,j-1] = clBlack) or
(origen.Pixels[i+1,j-1] = clBlack) or
...
(origen.Pixels[i ,j+1] = clBlack) or
(origen.Pixels[i+1,j+1] = clBlack) then
destino.Pixels[i,j] := clBlack else destino.Pixels[i,j] := clWhite;
end;
end;






mas o menos...como ves, se miran los pixeles colindantes o el mismo, y si alguno de ellos es clBlack, entonces el destino se pinta tambien clBlack. Saludos.

E intentado de varias forma, pro no logre exito, se que el problema esta en la programacion q hago, pero no logro corrigir, com origen, destino : TCanvas, no compila, para en origen.Width me dice q no es valido, e intentado de otras formas pero no logre
Responder Con Cita
  #4  
Antiguo 01-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
vaya, es cierto : lo escribi de memoria y resulta que TCanvas no tiene ni width ni height. Supongo q entiendes mas o menos como funciona : es bastante modificable a, por ejemplo, TImage, TPicture o lo que estes usando para guardar las imagenes. Saludos.

Última edición por coso fecha: 02-10-2008 a las 15:56:40.
Responder Con Cita
  #5  
Antiguo 10-10-2008
Cesar Junior Cesar Junior is offline
Miembro
 
Registrado: ago 2007
Posts: 24
Poder: 0
Cesar Junior Va por buen camino
Coso e intentado de esta forma pero tbm no me dio resultado, conste q si creo un origen y un destino no me compila, me da una mesage de falta de parametros, y como esta abajo solo invierte los colores


Código Delphi [-]
procedure Erosionar( ABmp : TBitmap);
var
i, j : integer;
begin
for i := 0 to ABmp.Width do
for j := 0 to ABmp.Height do
begin
if (ABmp.Canvas.Pixels[i-1,j-1] = clwhite) or
(ABmp.Canvas.Pixels[i ,j-1] = clwhite) or
(ABmp.Canvas.Pixels[i+1,j-1] = clwhite) or
(ABmp.Canvas.Pixels [i-1,j] = clwhite) or
(ABmp.Canvas.Pixels [i ,j] = clwhite) or
(ABmp.Canvas.Pixels [i+1,j] = clwhite) or
(ABmp.Canvas.Pixels [i-1,j+1] = clwhite) or
(ABmp.Canvas.Pixels [i ,j+1] = clwhite) or
(ABmp.Canvas.Pixels[i+1,j+1] = clwhite) then
ABmp.Canvas.Pixels[i,j] := clblack else ABmp.Canvas.Pixels[i,j] := clwhite;
end;
end;
Responder Con Cita
  #6  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
bueno...habia puesto...

Cita:
...
(origen.Pixels[i-1,j-1] = clBlack) or
(origen.Pixels[i ,j-1] = clBlack) or
...
then
destino.Pixels[i,j] := clBlack else destino.Pixels[i,j] := clWhite;
y el tuyo...

Cita:
...
(ABmp.Canvas.Pixels[i+1,j-1] = clwhite) or
(ABmp.Canvas.Pixels [i-1,j] = clwhite) or
...
then ABmp.Canvas.Pixels[i,j] := clblack else ABmp.Canvas.Pixels[i,j] := clwhite;
probablemente por eso te invierte invierte los colores
Responder Con Cita
  #7  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Por otra banda, en esa funcion hay dos canvas: uno de origen, otro de destino. Si vas pintando todo en uno pierde sentido, pues al mirar los anteriores ya lo habras pintado a tu manera...
Responder Con Cita
  #8  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
A ver si tengo un ratillo y lo hago...
Responder Con Cita
  #9  
Antiguo 10-10-2008
Cesar Junior Cesar Junior is offline
Miembro
 
Registrado: ago 2007
Posts: 24
Poder: 0
Cesar Junior Va por buen camino
en verdad havia notado eso, el problema es que si crio un otro Canvas de destino no me compila al aplicar el procedure a la imagen me da el siguiente erros [Error] Unit1.pas(1160): Not enough actual parameters;

la aplico de esta forma :

Erosionar(Image1.picture.bitmap);
Responder Con Cita
  #10  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Código Delphi [-]
procedure Erosionar(bmp : TBitmap);
var
    i, j : integer;
    ori  : TBitmap;
begin
    ori := TBitmap.Create;
    ori.Width  := bmp.Width;
    ori.Height := bmp.Height;
    for i := 0 to bmp.width do
    for j := 0 to bmp.Height do
    ori.Canvas.Pixels[i,j] := bmp.Canvas.Pixels[i,j];
    for i := 0 to bmp.width do
    for j := 0 to bmp.Height do
    with ori.Canvas do
    begin
      if (Pixels[i-1,j-1]  = clBlack) or
         (Pixels[i ,j-1]   = clBlack) or
         (Pixels[i+1,j-1]  = clBlack) or
         (Pixels [i-1,j]   = clBlack) or
         (Pixels [i+1,j]   = clBlack) or
         (Pixels [i-1,j+1] = clBlack) or
         (Pixels [i ,j+1]  = clBlack) or
         (Pixels[i+1,j+1]  = clBlack) then
        bmp.canvas.Pixels[i,j] := clblack else
        bmp.canvas.Pixels[i,j] := Pixels[i,j];
   end;
   ori.Free;
end;

de todas maneras, te recomiendo que entiendas el codigo, sino siempre estaras pidiendo al respecto. Un saludo
Responder Con Cita
  #11  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Ala, dejo el ejemplo entero :

Código Delphi [-]
unit erosi;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;
procedure Erosionar(bmp : TBitmap);
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
        i : integer;
        x,y : integer;
        w,h : integer;
begin
        w := Image1.Width;
        h := Image1.Height;
        Image1.Canvas.Brush.Color := clBlack;
        Image1.Picture.Bitmap.Canvas.FillRect(Rect(0,0,W,H));
        for i := 0 to 10 do
        begin
                x := random(W);
                y := random(H);
                Image1.Canvas.Brush.Color := random($00FFFFFF);
                Image1.Canvas.Ellipse(Rect(x - random(50),y-random(50),x + random(50),y + random(50)));
        end;
end;
procedure Erosionar(bmp : TBitmap);
var
    i, j : integer;
    ori  : TBitmap;
begin
    ori := TBitmap.Create;
    ori.Width  := bmp.Width;
    ori.Height := bmp.Height;
    for i := 0 to bmp.width do
    for j := 0 to bmp.Height do
    ori.Canvas.Pixels[i,j] := bmp.Canvas.Pixels[i,j];
    for i := 0 to bmp.width do
    for j := 0 to bmp.Height do
    with ori.Canvas do
    begin
      if (Pixels[i-1,j-1]  = clBlack) or
         (Pixels[i ,j-1]   = clBlack) or
         (Pixels[i+1,j-1]  = clBlack) or
         (Pixels [i-1,j]   = clBlack) or
         (Pixels [i+1,j]   = clBlack) or
         (Pixels [i-1,j+1] = clBlack) or
         (Pixels [i ,j+1]  = clBlack) or
         (Pixels[i+1,j+1]  = clBlack) then
        bmp.canvas.Pixels[i,j] := clblack else
        bmp.canvas.Pixels[i,j] := Pixels[i,j];
   end;
   ori.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
        Erosionar(Image1.Picture.Bitmap);
end;
end.
saludos de nuevo.
Responder Con Cita
  #12  
Antiguo 10-10-2008
Cesar Junior Cesar Junior is offline
Miembro
 
Registrado: ago 2007
Posts: 24
Poder: 0
Cesar Junior Va por buen camino
Che, en verdad tenes razón, funciona de maravilha, pero voia estudiar bien el codigo para entederlo bien, se que de este codigo ya me sale la Dilatacion tbm, mas una vez Gracias amigo!!
Responder Con Cita
  #13  
Antiguo 10-10-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
Cita:
pero voia estudiar bien el codigo para entederlo bien
si es q es lo mejor, no siempre tendras a alguien q te saque saludos de nuevo y adeu
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Procesamiento De Archivos De Audio Y Video JCVCARMONA Varios 3 22-01-2011 02:20:18
Libreria de procesamiento de imagen JCarlosas Gráficos 3 15-05-2007 17:51:00
procesamiento de voz elcigarra Varios 0 26-01-2006 13:05:29
Como dar Prioridad de Procesamiento a una Aplicación???? AGAG4 Varios 3 19-05-2005 18:15:31
MS intenta patentar el uso de XML en el procesamiento de textos kinobi Debates 4 25-01-2004 04:02:08


La franja horaria es GMT +2. Ahora son las 01:48:58.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi