Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Графика и Игры , Изображения

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

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{ 
 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-конволюцию изображения с помощью маски и значения смещения. Код использует единицы Graphics и Windows, а также пользовательские типы, такие как TRGBTripleArray, PRGBTripleArray и T3x3FloatArray.

Расшифровка кода:

  1. Функция Convolve принимает три параметра: ABitmap (входное изображение), AMask (массив 3x3 float, определяющий маску конволюции) и ABias (целочисленное значение для добавления к результату).
  2. Функция сначала рассчитывает сумму значений маски (LCoef) для нормализации результата.
  3. Затем она создает новый объект TBitmap, чтобы хранить выходное изображение, размеры которого на один пиксель меньше размеров входного изображения по всем сторонам.
  4. Функция проходит через каждую строку и столбец выходного изображения, используя три указателя (LRow1, LRow2 и LRow3) для доступа к соответствующим строкам входного изображения.
  5. Для каждого пикселя в выходном изображении она рассчитывает взвешенный сумму пикселей в входном изображении, соответствующих значениям маски. Веса берутся из массива маски, а сумма делится на LCoef для нормализации результата.
  6. Функция затем добавляет значение смещения к результату и ограничивает его диапазон [0, 255].
  7. Наконец, она присваивает полученные значения пикселей соответствующим пикселям в выходном изображении.

Пример использования в конце демонстрирует, как применить функцию конволюции для обнаружения границ. Он создает маску с отрицательными значениями на границах и положительными в центре, что будет подчеркивать границы входного изображения при конволюции.

Некоторые предложения по улучшению кода:

  • Код можно сделать более читаемым, добавив комментарии и переменные с именами, лучше описывающими их цель.
  • Функция Convolve может быть оптимизирована для производительности, используя более эффективный алгоритм или уменьшая количество циклов.
  • Значения маски жестко закодированы, что может не быть гибким для различных случаев использования. Рассмотрите возможность добавления параметров для указания пользователем значений маски.
  • Код не обрабатывает ошибки и исключения хорошо. Например, если входное изображение равно null или имеет неправильный формат, программа будет крашиться. Рассмотрите возможность добавления механизмов обработки ошибок.

В целом, этот код предоставляет хороший старт для реализации 2D-конволюции в Delphi. Однако он может потребовать модификаций и оптимизаций для соответствия конкретным случаям использования и требованиям производительности.

В статье описывается функция 2D-свертки для изображений, которая может использоваться для выполнения различных операций по обработке изображений, таких как сглаживание, анти-алиасинг, обнаружение границ, улучшение деталей и т.д.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Изображения ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-01-28 07:12:12/0.0035459995269775/0