Sobel-Operator
Hier ein Kantenerkennungs-Algorithmus - wichtigeste Informationen aus der Wiki
(http://de.wikipedia.org/wiki/Sobel-Operator) entnommen !
Delphi-Quellcode:
Könnte man evt. in die CodeLib verschieben ...
//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; 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] |
Re: Sobel-Operator
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 |
Re: Sobel-Operator
ja er ist für dort :) danke für die Infos - wusste es noch gar nicht
und ja der Code müsste funktionieren ! |
DP-Maintenance
Dieses Thema wurde von "Matze" von "Multimedia" nach "Neuen Beitrag zur Code-Library hinzufügen" verschoben.
|
Re: Sobel-Operator
Hm, woher stammen diese Prozeduren?
Delphi-Quellcode:
fValInRange(...);
pValInRange(...); |
Re: Sobel-Operator
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; |
Re: Sobel-Operator
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:
Grüsse
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. rainer |
Re: Sobel-Operator
Zitat:
|
Re: Sobel-Operator
Zitat:
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. |
Re: Sobel-Operator
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 |
Re: Sobel-Operator
Bitte Diskussion hier beenden (und wenns sein muss in Klatsch und Tratsch weitermachen)
Nicht das wir hier den Thread zumüllen ;) :P |
Re: Sobel-Operator
Liste der Anhänge anzeigen (Anzahl: 1)
und hier mal als Unit (und ohne Objektübergabe durch Referenzparameter)...
|
Re: Sobel-Operator
Liste der Anhänge anzeigen (Anzahl: 1)
Ok ich veröffentliche mal hier meine Unit .. sind ein paar Andere Funktionen auch dabei
MfG |
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:20 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz