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(
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)) +
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
);
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
if j < 0 then
P1:= Bitmap.ScanLine[0]
else
P1:= Bitmap.ScanLine[j];
P2:= Bitmap.ScanLine[j+1];
if j > Bitmap.Height - 3 then
P3:= Bitmap.ScanLine[Bitmap.Height - 1]
else
P3:= Bitmap.ScanLine[j+2];
P4:= Img.Bitmap.ScanLine[j+1];
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;
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;