[bosterito]

Hola amigos foristas.
Les cuento que estoy desarrollando un sistema que trata sobre imagenes digitales. En el mismo consta de una sección en la cual maneja imagenes en escala de grises y la transforma a blanco y negro (binarización). Investigando en la web, di que el mejor método es el que trata el umbral de Otsu. Esta binarización también emplea una interpolación bilineal, la cual no se como acoplarla al sistema. A continuación les envío el código que desarrollé:

Type TmatrizB = array[1..16, 1..16] of Integer;
Type VectorReal = array[0..256] of Real;
Type VectorEntero = array[0..256] of Integer;
 
 
function DistribucionProbabilidad( Histograma : VectorEntero; Ancho, Alto : Integer ) : VectorReal;
Var
Probabilidad : VectorReal;
i : Integer;
begin
for i := 1 to 256 do
Probabilidad[i] := (Histograma[i]/(Ancho*Alto));
Result := Probabilidad;
end;
procedure MomentoAcumulado( Probabilidad : VectorReal; var Omega : VectorReal; var Mu : VectorReal );
Var
i : Integer;
begin
Omega[1] := Probabilidad[1];
Mu[1] := Probabilidad[1];
for i := 2 to 256 do
begin
Omega[i] := Omega[i-1] + Probabilidad[i];
Mu[i] := Mu[i-1] + ((i-1)*Probabilidad[i]){i * Probabilidad[i]};
end;
end;
function UmbralOptimo( Omega, Mu : VectorReal ) : Integer;
Var
Sigma, SigmaMax, MuTotal, Omega1, Omega2, Mu1, Mu2 : Real;
Umbral, i : Integer;
begin
Sigma := 0; SigmaMax := 0; MuTotal := Mu[256]; Umbral := 0;
for i := 1 to 256 do
begin
Omega1 := Omega[i];
Omega2 := 1 - Omega1;
if ( ( Omega1 <> 0 ) and ( Omega2 <> 0 ) ) then
begin
Mu1 := Mu[i]/Omega1;
Mu2 := (( MuTotal - Mu[i] )/Omega2);
Sigma := ((Omega1 * sqr( Mu1 - MuTotal )) + (Omega2 * sqr( Mu2 - MuTotal )));
if ( Sigma > SigmaMax ) then
begin
SigmaMax := Sigma;
Umbral := i - 1;
end;
end;
end;
Result := Umbral;
end;
function Segmentacion( Bloque : Integer; Imagen : TImage ) : TMatrizB;
var
i, j, Alto, Ancho, Umbral : Integer;
Histograma : VectorEntero;
Omega, Mu, DP : VectorReal;
Matriz : TMatrizB;
begin
FillChar(Matriz, sizeof(Matriz), 0);
Alto := 0;
While( Alto <= Form1.Image1.Picture.Bitmap.Height -1 ) do
begin
Ancho := 0;
While( Ancho <= Form1.Image1.Picture.Bitmap.Width -1 ) do
begin
FillChar(Histograma, sizeof(Histograma), 0);
for j:= Alto to Alto + (Bloque - 1) do
begin
for i:= Ancho to Ancho + (Bloque - 1) do
begin
inc (Histograma[Imagen.Canvas.Pixels[i,j] and $FF + 1]);
end;
end;
Ancho := Ancho + Bloque;
FillChar(DP, sizeof(DP), 0);
DP := DistribucionProbabilidad( Histograma, 16, 16 );
FillChar(Omega, sizeof(Omega), 0); FillChar(Mu, sizeof(Mu), 0);
MomentoAcumulado( DP, Omega, Mu );
Umbral := UmbralOptimo( Omega, Mu );
Matriz[(((Alto+Bloque)) div Bloque), ((Ancho) div Bloque)] := Umbral;
end;
Alto := Alto + Bloque;
end;
Result := Matriz;
end;
 
procedure Bina( M : TMatrizB; Imagen : TImage; Bloque : Integer );
var
i, j, Alto, Ancho, Fila, Columna : Integer;
begin
Alto := 0;
Fila := 1;
While( Alto <= Form1.Image1.Picture.Bitmap.Height -1 ) do
begin
Ancho := 0;
Columna := 1;
While( Ancho <= Form1.Image1.Picture.Bitmap.Width -1 ) do
begin
for j:= Alto to Alto + (Bloque - 1) do
begin
for i:= Ancho to Ancho + (Bloque - 1) do
begin
if ( Form1.Image1.Canvas.Pixels[i,j] and $FF >= M[Fila, Columna] ) then
Imagen.Canvas.Pixels[i,j] := RGB(255,255,255)
else
Imagen.Canvas.Pixels[i,j] := RGB(0,0,0);
end;
end;
Ancho := Ancho + Bloque ;
inc(Columna);
end;
Alto := Alto + Bloque;
inc(Fila);
end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
Var
M : TMatrizB;
begin
M := Segmentacion( 16, Image1 );
Bina( M, Image1, 16 );
end;

Saludos