//typen
PRGBTriple = ^TRGBTriple;
TRGBTriple = packed Record
rgbtBlue: Byte;
rgbtGreen: Byte;
rgbtRed: Byte;
End;
PRGBLine = ^TRGBLine;
TRGBLine = Array[0..0] of TRGBTriple;
//nebenfunktion
procedure Gray(var Picture: TBitmap);
var
sl: PRGBLine;
x: Integer;
procedure _Gray(var rgbt: TRGBTriple );
begin
with rgbt do
begin
{weiß}
rgbtBlue := (rgbtBlue+rgbtGreen+rgbtRed) div 3;
rgbtGreen := rgbtBlue;
rgbtRed := rgbtBlue;
end;
end;
begin
sl := PRGBLine( Picture.Scanline[Picture.Height-1] );
for x := 0 to Picture.Width*Picture.Height-1 do
_Gray( sl^[x] );
end;
//hautpfunktion
procedure Sobel(var Picture: TBitmap; const EdgeWhite: Boolean = True);
type
T4 = -2..2;
const
xMatrix: Array[0..2, 0..2] of T4 =
( (-1, 0, 1),
(-2, 0, 2),
(-1, 0, 1 ) );
yMatrix: Array[0..2, 0..2] of T4 =
( (1, 2, 1),
( 0, 0, 0),
(-1, -2,-1) );
var
sl: PRGBLine;
x, y: Integer;
i, j: Integer;
sumX, sumY: Integer;
Data: Array of Array of Byte;
begin
Gray(Picture);
sl := PRGBLine( Picture.Scanline[Picture.Height-1] );
SetLength(Data, Picture.Width, Picture.Height);
for y := 0 to Picture.Height-1 do
for x := 0 to Picture.Width-1 do
Data[x,y] := sl^[y*Picture.Width+x].rgbtBlue;
for y := 0 to Picture.Height-1 do
for x := 0 to Picture.Width-1 do
begin
sumX := 0;
sumY := 0;
for i := -1 to 1 do
for j := -1 to 1 do
begin
inc( sumX, Data[fValInRange(x+i, 0, Picture.Width-1),fValInRange(y+j, 0, Picture.Height-1)]*xMatrix[i+1,j+1] );
inc( sumY, Data[fValInRange(x+i, 0, Picture.Width-1),fValInRange(y+j, 0, Picture.Height-1)]*yMatrix[i+1,j+1] );
end;
sumX := Abs(sumX)+Abs(sumY);
pValInRange( sumX, 0, $FF );
with sl^[y*picture.Width+x] do
begin
if EdgeWhite then
rgbtBlue := sumX
else
rgbtBlue := $FF-sumX;
rgbtGreen := rgbtBlue;
rgbtRed := rgbtBlue;
end;
end;
end;