影像處理[灰階化]及[邊緣化]

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.

轉貼至 http://www.delphipraxis.net/post995075.html