Ver Mensaje Individual
  #7  
Antiguo 18-02-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
Bueno, como ayer ya me metí en el tema, ahora no me queda mas remedio que acabarlo. Si no lo termino no me quedo contento

El código seria el siguiente:
Código Delphi [-]
type
  TRGB = array[1..3] of Byte;
  PRGB = ^TRGB;
  TFila = array[1..3] of TRGB;
  PFila = ^TFila;

function Calcular(F1, F2, F3: PFila; i,j, Umbral: integer): TRGB;
var
  k: integer;
begin
  for k:= 1 to 3 do
  begin
    Result[k]:=
      Trunc(
        sqrt(
          // Horizontal
          sqr((F1[1][k]*(-1)) + (F1[i][k]*(-2)) + (F1[j][k]*(-1)) +
              (F3[1][k]*1) + (F3[i][k]*2) +(F3[j][k]*1)) +
          // Vertical
          sqr((F1[1][k]*(-1)) + (F1[j][k]*1) +
              (F2[1][k]*(-2)) + (F2[j][k]*2) +
              (F3[1][k]*(-1)) + (F3[j][k]*1) )
        )  / 5.66
      );
    // Umbralizar ¿se dice asi?, si el Umbral es cero no lo usamos
    if Umbral > 0 then
      if Result[k] > Umbral then
        Result[k]:= 255
      else
        Result[k]:= 0;
  end;
end;

procedure Sobel(Img: TPicture; Umbral: Integer);
var
  Bitmap: TBitmap;
  P1,P2,P3,P4: PByte;
  i,j: Integer;
begin
  Bitmap:= TBitmap.Create;
  try
    Bitmap.Width:= Img.Width;
    Bitmap.Height:= Img.Height;
    Bitmap.Canvas.Draw(0,0,Img.Graphic);
    if not (Img.Graphic is TBitmap) then
      Img.Assign(Bitmap);
    Img.Bitmap.PixelFormat:= pf24bit;
    Bitmap.PixelFormat:= pf24bit;
    for j:= -1 to Bitmap.Height - 2 do
    begin
      // Ajustamos el borde superior
      if j < 0 then
        P1:= Bitmap.ScanLine[0]
      else
        P1:= Bitmap.ScanLine[j];
      P2:= Bitmap.ScanLine[j+1];
      // Ajustamos el borde inferior
      if j > Bitmap.Height - 3 then
        P3:= Bitmap.ScanLine[Bitmap.Height - 1]
      else
        P3:= Bitmap.ScanLine[j+2];
      P4:= Img.Bitmap.ScanLine[j+1];
      // Primera columna
      PFila(P4)[1]:=
        Calcular(PFila(P1),PFila(P2),PFila(P3),1,2,Umbral);
      for i:= 0 to Bitmap.Width - 3 do
      begin
        PFila(P4)[2]:=
          Calcular(PFila(P1),PFila(P2),PFila(P3),2,3,Umbral);
        inc(P1,Sizeof(TRGB));
        inc(P2,Sizeof(TRGB));
        inc(P3,Sizeof(TRGB));
        inc(P4,Sizeof(TRGB));
      end;
      // Ultima columna
      PFila(P4)[2]:=
        Calcular(PFila(P1),PFila(P2),PFila(P3),2,2,Umbral);
    end;
  finally
    Bitmap.Free;
  end;
end;
Como veras aparecen los tipos ya conocidos TRGB y TFila, y sus correspondientes PRGB y PFila. El calculo de la matriz pasa a estar dentro de una función, para mayor comodidad, y se han eliminado algunos cálculos innecesarios (hay filas y columnas nulas en el filtro Sobel). El resto es muy similar a los códigos anteriores de filtros, solo que se hacen las correcciones de fila y columna que te comentaba antes.

En cuanto al Umbral, en algunos texto recomiendan pasar la imagen por un umbral después de aplicar el filtro, si no lo quieres usar (Gimp tampoco lo usa) simplemente usa el valor 0.

Bueno, pruebalo y me cuentas que tal te funciona. Ya sabes, la forma de usarlo como siempre:
Código Delphi [-]
  Sobel(Image1.Picture,0);
  Image1.Refresh;

Última edición por seoane fecha: 18-02-2007 a las 21:34:22.
Responder Con Cita