Sobel-Operator

[WS1976]

Hallo,
wenn du den Code schon ihn die Codelib schieben willst, dann bitte in der fertigen Form als Unit.
Der Code ist wohl erst in dieser Form brauchbar:

Delphi-Quellcode:

unit kantendetektion;

interface
uses graphics;

type
  PRGBTriple = ^TRGBTriple;
  TRGBTriple = packed Record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  End;
  PRGBLine = ^TRGBLine;
  TRGBLine = Array[0..0] of TRGBTriple;

procedure Sobel(var Picture: TBitmap; const EdgeWhite: Boolean = True);

implementation

procedure pValInRange( var Val: Integer; const cFrom, cTo: Integer ); 
begin 
  if Val > cTo then 
    Val := cTo 
  else 
  if Val < cFrom then 
    Val := cFrom; 
end; 

function fValInRange( Val: Integer; const cFrom, cTo: Integer ): Integer; 
begin 
  if Val > cTo then 
    Result := cTo 
  else 
  if Val < cFrom then 
    Result := cFrom 
  else 
    Result := Val; 
end; 

//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;
end.

Grüsse
rainer