was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

27 Visitors Online


 
...eine 2D Convolution (Faltung) eines Bildes erstellen?
Autor: Peter Bone
Homepage: http://www.geocities.com/peter_bone_uk
[ Tip ausdrucken ]  

Tip Bewertung (38):  
     


{
 This function performs a 2D convolution on an image.
 It can be used for a very wide range of image processing operations
 such as image smoothing, anti-aliasing, edge detection,
 detail enhancment, etc. It is very fast.
}

uses
  
Graphics, Windows;

type
  
TRGBTripleArray = array[0..10000] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;

  T3x3FloatArray = array[0..2] of array[0..2] of Extended;

implementation

function 
Convolve(ABitmap: TBitmap; AMask: T3x3FloatArray;
  ABias: Integer): TBitmap;
var
  
LRow1, LRow2, LRow3, LRowOut: PRGBTripleArray;
  LRow, LCol: integer;
  LNewBlue, LNewGreen, LNewRed: Extended;
  LCoef: Extended;
begin
  
LCoef := 0;
  for LRow := 0 to do
    for 
LCol := 0 to do
      
LCoef := LCoef + AMask[LCol, LRow];
  if LCoef = 0 then LCoef := 1;

  Result := TBitmap.Create;

  Result.Width := ABitmap.Width - 2;
  Result.Height := ABitmap.Height - 2;
  Result.PixelFormat := pf24bit;

  LRow2 := ABitmap.ScanLine[0];
  LRow3 := ABitmap.ScanLine[1];

  for LRow := 1 to ABitmap.Height - 2 do 
  begin
    
LRow1 := LRow2;
    LRow2 := LRow3;
    LRow3 := ABitmap.ScanLine[LRow + 1];

    LRowOut := Result.ScanLine[LRow - 1];

    for LCol := 1 to ABitmap.Width - 2 do 
    begin
      
LNewBlue :=
        (LRow1[LCol - 1].rgbtBlue * AMask[0,0]) + (LRow1[LCol].rgbtBlue * AMask[1,0]) +
        (LRow1[LCol + 1].rgbtBlue * AMask[2,0]) +
        (LRow2[LCol - 1].rgbtBlue * AMask[0,1]) + (LRow2[LCol].rgbtBlue * AMask[1,1]) +
        (LRow2[LCol + 1].rgbtBlue * AMask[2,1]) +
        (LRow3[LCol - 1].rgbtBlue * AMask[0,2]) + (LRow3[LCol].rgbtBlue * AMask[1,2]) +
        (LRow3[LCol + 1].rgbtBlue * AMask[2,2]);
      LNewBlue := (LNewBlue / LCoef) + ABias;
      if LNewBlue > 255 then
        
LNewBlue := 255;
      if LNewBlue < 0 then
        
LNewBlue := 0;

      LNewGreen :=
        (LRow1[LCol - 1].rgbtGreen * AMask[0,0]) + (LRow1[LCol].rgbtGreen * AMask[1,0]) +
        (LRow1[LCol + 1].rgbtGreen * AMask[2,0]) +
        (LRow2[LCol - 1].rgbtGreen * AMask[0,1]) + (LRow2[LCol].rgbtGreen * AMask[1,1]) +
        (LRow2[LCol + 1].rgbtGreen * AMask[2,1]) +
        (LRow3[LCol - 1].rgbtGreen * AMask[0,2]) + (LRow3[LCol].rgbtGreen * AMask[1,2]) +
        (LRow3[LCol + 1].rgbtGreen * AMask[2,2]);
      LNewGreen := (LNewGreen / LCoef) + ABias;
      if LNewGreen > 255 then
        
LNewGreen := 255;
      if LNewGreen < 0 then
        
LNewGreen := 0;

      LNewRed :=
        (LRow1[LCol - 1].rgbtRed * AMask[0,0]) + (LRow1[LCol].rgbtRed * AMask[1,0])
        + (LRow1[LCol + 1].rgbtRed * AMask[2,0]) +
        (LRow2[LCol - 1].rgbtRed * AMask[0,1]) + (LRow2[LCol].rgbtRed * AMask[1,1])
        + (LRow2[LCol + 1].rgbtRed * AMask[2,1]) +
        (LRow3[LCol - 1].rgbtRed * AMask[0,2]) + (LRow3[LCol].rgbtRed * AMask[1,2])
        + (LRow3[LCol + 1].rgbtRed * AMask[2,2]);
      LNewRed := (LNewRed / LCoef) + ABias;
      if LNewRed > 255 then
        
LNewRed := 255;
      if LNewRed < 0 then
        
LNewRed := 0;

      LRowOut[LCol - 1].rgbtBlue  := trunc(LNewBlue);
      LRowOut[LCol - 1].rgbtGreen := trunc(LNewGreen);
      LRowOut[LCol - 1].rgbtRed   := trunc(LNewRed);
    end;
  end;
end;

// example use
// edge detection
procedure TForm1.Button1Click(Sender: TObject);
var
  
LMask: T3x3FloatArray;
begin
  
LMask[0,0] := -1;
  LMask[1,0] := -1;
  LMask[2,0] := -1;
  LMask[0,1] := -1;
  LMask[1,1] := 8;
  LMask[2,1] := -1;
  LMask[0,2] := -1;
  LMask[1,2] := -1;
  LMask[2,2] := -1;
  Image1.Picture.Bitmap := Convolve(Image1.Picture.Bitmap, LMask, 0);
end;

 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners