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]

[fkerber]

Hi!

Vielen Dank für deinen Beitrag.
Könntest du bitte delphi-Tags statt der Code-Tags verwenden, dann funktioniert auch das Code-Highlighting!

Also handelt es sich bei obigem Code um funktionierenden Code, den du quasi für die Codelib vorschlagen möchtest oder geht etwas noch nicht und du hast noch eine Frage dazu?

Im ersteren Fall gibt es extra für die Codelib einen Art "Vorschlagsbereich", wo man selbst Beiträge erstellen kann, die in die CodeLib aufgenommen werden sollen: http://www.delphipraxis.net/internal_redirect.php?f=24

Wenn er also für dort ist, werden wir ihn gerne dorthin verschieben!


Ciao, Frederic

[mr_emre_d]

ja er ist für dort danke für die Infos - wusste es noch gar nicht

und ja der Code müsste funktionieren !

[Flips]

Hm, woher stammen diese Prozeduren?

Delphi-Quellcode:

fValInRange(...);
pValInRange(...);

[mr_emre_d]

fips:

Delphi-Quellcode:

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;

[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

[Meflin]

Zitat von WS1976:

wenn du den Code schon ihn die Codelib schieben willst, dann bitte in der fertigen Form als Unit.

Nene. In der CodeLib geht es um Codeschnipsel, nicht um betriebsfertige Units. Die gehören dann ja eher nach OpenSource

[worker]

Zitat von Meflin:

Zitat von WS1976:

wenn du den Code schon ihn die Codelib schieben willst, dann bitte in der fertigen Form als Unit.

Nene. In der CodeLib geht es um Codeschnipsel, nicht um betriebsfertige Units. Die gehören dann ja eher nach OpenSource

[OT]*pssst* bei dem Jahrgang herrscht noch Ordnung und Disziplin. Vielleicht ist das aber auch die Vorbereitung zur Bewerbung um einen zusätzlichen Moderator. In der myCsharp-Community haben wir auch so einen sehr eifrigen 'Ehrenamtlichen' [/OT]
Desweiteren stimme ich Dir voll und ganz zu.
Dieses ist erst das Vorzimmer der CodeLib. Bevor man dort eingelassen wird, schauen die CL-Manager sowieso nochmal drüber.

[WS1976]

Hallo,

seh ich nicht so. Es ist doch wohl so, dass eine gebrauchsfertige Lösung immer
besser ist als ein paar hingeworfene Codeschnipsel. Ausserdem hab ichs ausprobiert. Funktioniert.
Ist doch wohl auch was Wert oder?
Aber darüber kann man sich wohl endlos streiten!
Sollen meinetwegen die Admins entscheiden was sie da reinstellen wollen oder nicht.

Grüsse
Rainer