Сделать картинке 2D свертку

Советы » Изображения » Сделать картинке 2D свертку

{ 
 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

2 do

for

LCol := 0 to

2 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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com