Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 634

•  TDictionary Custom Sort  5 768

•  Fast Watermark Sources  5 576

•  3D Designer  8 154

•  Sik Screen Capture  5 876

•  Patch Maker  6 357

•  Айболит (remote control)  6 346

•  ListBox Drag & Drop  5 207

•  Доска для игры Реверси  94 487

•  Графические эффекты  6 541

•  Рисование по маске  5 611

•  Перетаскивание изображений  4 729

•  Canvas Drawing  5 107

•  Рисование Луны  4 831

•  Поворот изображения  4 383

•  Рисование стержней  3 090

•  Paint on Shape  2 327

•  Генератор кроссвордов  3 196

•  Головоломка Paletto  2 525

•  Теорема Монжа об окружностях  3 300

•  Пазл Numbrix  2 175

•  Заборы и коммивояжеры  2 824

•  Игра HIP  1 795

•  Игра Go (Го)  1 716

•  Симулятор лифта  2 048

•  Программа укладки плитки  1 774

•  Генератор лабиринта  2 214

•  Проверка числового ввода  1 895

•  HEX View  2 198

•  Физический маятник  1 888

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Сделать картинке 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;







Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте