rRow - розмиття рядки без SSE
procedure BlurRow (var theRow: array of TPxlC; K: TKernel; P: PRow);
var
j, n: integer;
tr, tg, tb: double;// TempRed та ін
w: double;
begin
for j: = 0 to High (theRow) do
begin
tb: = 0;
tg: = 0;
tr: = 0;
for n: =-K.Size to K.Size do
begin
w: = K.Weights [n];
// TrimInt задає відступ від краю рядка ...
with theRow [TrimInt (0, High (theRow), j - n)] do
begin
tb: = tb + w * b;
tg: = tg + w * g;
tr: = tr + w * r;
end ;//with
end ;//for
with P [j] do
begin
b: = TrimReal (0, 255, tb);
g: = TrimReal (0, 255, tg);
r: = TrimReal (0, 255, tr);
end;
end;
Move (P [0], theRow [0], (High (theRow) + 1) * Sizeof (TPxlC));
end;
// GBlur - повне розмиття картинки
procedure GBlur (theBitmap: TBitmap; radius: double; withSSE: boolean);
var
Row, Col: integer;
theRows: PPRows;
K: TKernel;
ACol: PRow;
P: PRow;
begin
if (theBitmap.HandleType <> BmDIB) or (theBitmap.PixelFormat <> pf24Bit) then
raise
exception.Create ('GBlur може працювати тільки з 24-бітними зображеннями ');
if (withSSE) then MakeGaussianKernelSSE (K, radius, 255, 1)
else MakeGaussianKernel (K, radius, 255, 1);
GetMem (theRows, theBitmap.Height * SizeOf (PRow));
GetMm (ACol, theBitmap.Height * SizeOf (TPxlC));
frm_img.img_pbar.Max: = theBitmap.Height + theBitmap.Width +4;
// запис позиції даних зображення:
for Row: = 0 to theBitmap.Height - 1 do
theRows [Row]: = theBitmap.Scanline [Row];
// розмиваємо кожну рядок:
P: = AllocMem (theBitmap.Width * SizeOf (TPxlC));
if (Frm_imgbluropts.CheckBox1.Checked) then begin
for Row: = 0 to theBitmap.Height - 1 do begin
BlurRow (Slice (theRows [Row] ^, theBitmap.Width), K, P);
frm_img.img_pbar.StepBy (1);
end;
end;
// тепер розмиваємо кожну колонку
ReAllocMem (P, theBitmap.Height * SizeOf (TPxlC));
if (Frm_imgbluropts.CheckBox2.Checked) then begin
for Col: = 0 to theBitmap.Width - 1 do
begin
// - зчитуємо першу колонку в TRow:
frm_img.img_pbar.StepBy (1);
for Row: = 0 to theBitmap.Height - 1 do
ACol [Row]: = theRows [Row] [Col];
BlurRow (Slice (ACol ^, theBitmap.Height), K, P);
// тепер поміщаємо оброблений стовпець на своє місце в дані зображення:
for Row: = 0 to theBitmap.Height - 1 do
theRows [Row] [Col]: = ACol [Row];
end;
end;
FreeMem (theRows);
FreeMem (ACol);
ReAllocMem (P, 0);
frm_img.img_pbar.Max: = 0;
end;
// end blur ------------------------------------------------- --------------------
// відкрити картинку
procedure Tfrm_img.act_srcOpenImageExecute (Sender: TObject);
begin
if (Img_OpenPictureDialog.Execute) then begin
img_src.Picture.LoadFromFile (img_OpenPictureDialog.FileName);
img_lblImageSizeV.Caption: = format ('% d -% D ', [img_src.Picture.Width, img_src.Picture.Height]);
img_log.Lines.Add (format ('open file "% s" ', [img_OpenPictureDialog.FileName]));
img_log.Lines.Add (format ('image width = "% d" height = "% d" ', [img_src.Picture.Width, img_src.Picture.Height]));
end;
end;
// по висоті картинку - джерело
procedure Tfrm_img.act_srcProportionalImgExecute (Sender: TObject);
begin
with (sender as taction) do begin
img_src.Proportional: = Checked;
end;
end;
// по висоті картинку - результат
procedure Tfrm_img.act_desProportionalImgExecute (Sender: TObject);
begin
with (sender as taction) do begin
img_des.Proportional: = Checked;
end;
end;
// копіювати - колірне копіювання картинки з множенням на обраний колір
procedure Tfrm_img.act_srcCopyExecute (Sender: TObject);
const
xcount = 16;
var
mx, nx, ny, nw, nh: word;
citm: ^ TPxlC;
axmm: TSSERegLines;
xmm_0: TXMMArrByte;
nn, xn: byte;
np1, np2, np3: byte;
ncolor: tcolor;
xc: array [0 .. 3] of byte;
timebefore: Cardinal;
begin
if (Frm_optsimgcopy.ShowModal = mrYes) then begin
timebefore: = MilliSecondOfTheHour (Now);
if (img_src.Picture.Width> MAX_imageSize) or (img_src.Picture.Height> MAX_imageSize) then begin
MessageDlg (img_errmsg [0]. Text, mtError, [mbok], 0);
end else begin
nw: = img_src.Picture.Width ...
