для застосування ефекту розмиття.
1. Зображення завантажується (За допомогою діалогового вікна) в компоненту В«TImageВ». p> 2. (Після вибору пунктів В«операції - Розумієте Г. В») Перевіряється на відповідність формату 24 біта на піксель. p> 3. У спеціальному діалоговому вікні, вводиться опції (радіус зерна розмиття), і запускається обробка зображення.
4. Розраховується зерно розмиття картинки за встановленими параметрами, де проводиться розрахунок (списку ваг) у кілька етапів.
5. виділяється пам'ять для обробки зображення попіксельно, а також для обробки рядків.
7. копіюється зображення в пам'ять ЕОМ. p> 8. порядково виробляємо ефект гауссово розмиття до колірних складовим кожного пікселя.
9. тепер кожну колонку за допомогою створеного списку ваг створюємо ефект розмиття.
10. оброблені дані записуються в результативний компонент В«TImageВ».
11. звільняється виділена пам'ять для скопійованого зображення і обробки рядків.
12. (За вибором пункту В«операції - зберегти В»на вкладціВ« результат В») дані результативного зображення зберігаються у файл.
Лістинг програми
const
MaxKernelSize = 64;
delay_names = 'мілісекунд';
// for image
PRGBTriple = ^ TPxlC;
TPxlC = record// TPxlC
b: byte;
g: byte;
r: byte;
end;
PRow = ^ TRow;// масив картинки
TRow = array [0 .. 1000000] of TPxlC;
PPRows = ^ TPRows;// масив рядка пікселів
TPRows = array [0 .. 1000000] of PRow;
TKernelSize = 1 .. MaxKernelSize;
TKernel = record// зерно
Size: TKernelSize;// розмір зерна
Weights: array [- (MaxKernelSize-1) .. MaxKernelSize] of single;
end;
TXMMSingle = array [0 .. 3] of Single ;//масив для SSE
TXMMArrByte = array [0 .. 15] of byte ;//масив пікселів
TXMMRsByte = record
item: TXMMArrByte;
end;
TSSERegLines = array [0 .. 5] of TXMMRsByte;
// основна процелура розмиття
procedure GBlur (theBitmap: TBitmap; radius: double; withSSE: boolean);
var
frm_img: Tfrm_img;
implementation
uses DateUtils, optscopyimg, optsblurimg;
{$ R *. dfm}
const
MAX_imageSize = 65535;
// побудова зерна (списку ваг) розмиття (Без SSE)
// MakeGaussianKernel noSSE ------------------------------------------------- ----
procedure MakeGaussianKernel (var K: TKernel; radius: double;
MaxData, DataGranularity: double);
// Робимо K (гауссово зерно) з середньоквадратичним відхиленням = radius.
// Для поточного додатка ми встановлюємо змінні MaxData = 255,
// DataGranularity = 1. Тепер у процедурі встановимо значення
// K.Size так, що при використанні K ми будемо ігнорувати Weights (вага)
// з найменш можливими значеннями. (Малий розмір нам на користь,
// оскільки час виконання напряму залежить від
// значення K.Size.)
var
j: integer;
temp, delta: double;
KernelSize: TKernelSize;
a, b: smallint;
begin
// отримали рядок ваг (зерна)
for j: = Low (K.Weights) to High (K.Weights) do begin
temp: = j/radius;
K.Weights [j]: = exp (- (temp * Temp)/2);
end;
// робимо так, щоб sum (Weights) = 1:
temp: = 0;
for j: = Low (K.Weights) to High (K.Weights) do
temp: = temp + K.Weights [j] ;//все суміровалі
for j: = Low (K.Weights) to High (K.Weights) do
K.Weights [j]: = K.Weights [j]/temp ;//ділимо кожне на суму (Нормування)
// тепер відкидаємо (або робимо позначку "ігнорувати"
// для змінної Size) дані, що мають відносно невелике значення -
// це важливо, в іншому випадку смазаваніе походимо з малим радіусом і
// тій області, яка "Захоплюється" великим радіусом ...
KernelSize: = MaxKernelSize;
delta: = DataGranularity/(2 * MaxData);
temp: = 0;
while (temp 1) do
begin
temp: = temp + 2 * K.Weights [KernelSize];
dec (KernelSize);
end ;//вирівнювання
K.Size: = KernelSize;
// тепер для коректності що повертається результату проводимо ту ж
// операцію з K.Size, так, щоб сума всіх даних була дорівнює одиниці:
temp: = 0;
for j: =-K.Size to K.Size do
temp: = temp + K.Weights [j] ;//
for j: =-K.Size to K.Size do
K.Weights [j]: = K.Weights [j]/temp ;//
end;
// побудова зерна (списку ваг) розмиття за SSE
// MakeGaussianKernel SSE ------------------------------------------------- ------
procedure MakeGaussianKernelSSE (var K: TKernel; radius: double;
MaxData, DataGranularity: double);
// Робимо K (гаус...
