Sobel-Operator

[mr_emre_d]

Hier ein Kantenerkennungs-Algorithmus - wichtigeste Informationen aus der Wiki
(http://de.wikipedia.org/wiki/Sobel-Operator) entnommen !

Delphi-Quellcode:

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

Könnte man evt. in die CodeLib verschieben ...
Falls irgendjemand diesen Algo schon einmal programmiert & gepostet hat
-> tut mir leid für den unnötigen Thread, ich hab unter "kantendetektion" leider nichts
finden können ...

MfG Emre


[edit=Matze][code]-Tags durch [delphi]-Tags ersetzt. MfG, Matze[/edit]