Сделать картинке 2D сверткуDelphi , Графика и Игры , ИзображенияСделать картинке 2D свертку
Оформил: DeeCo { 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; Перевод текста на русский язык: Это код на языке Pascal для Delphi, выполняющий 2D-конволюцию изображения с помощью маски и значения смещения. Код использует единицы Расшифровка кода:
Пример использования в конце демонстрирует, как применить функцию конволюции для обнаружения границ. Он создает маску с отрицательными значениями на границах и положительными в центре, что будет подчеркивать границы входного изображения при конволюции. Некоторые предложения по улучшению кода:
В целом, этот код предоставляет хороший старт для реализации 2D-конволюции в Delphi. Однако он может потребовать модификаций и оптимизаций для соответствия конкретным случаям использования и требованиям производительности. В статье описывается функция 2D-свертки для изображений, которая может использоваться для выполнения различных операций по обработке изображений, таких как сглаживание, анти-алиасинг, обнаружение границ, улучшение деталей и т.д. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Изображения ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |