source: trunk/Packages/Graphics32/GR32_Blurs.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 66.1 KB
Line 
1unit GR32_Blurs;
2
3(* BEGIN LICENSE BLOCK *********************************************************
4* Version: MPL 1.1 *
5* *
6* The contents of this file are subject to the Mozilla Public License Version *
7* 1.1 (the "License"); you may not use this file except in compliance with *
8* the License. You may obtain a copy of the License at *
9* http://www.mozilla.org/MPL/ *
10* *
11* Software distributed under the License is distributed on an "AS IS" basis, *
12* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *
13* for the specific language governing rights and limitations under the *
14* License. *
15* *
16* Alternatively, the contents of this file may be used under the terms of the *
17* Free Pascal modified version of the GNU Lesser General Public License *
18* Version 2.1 (the "FPC modified LGPL License"), in which case the provisions *
19* of this license are applicable instead of those above. *
20* Please see the file LICENSE.txt for additional information concerning this *
21* license. *
22* *
23* The Original Code is GR32_Blurs. The Gaussian blur algorithm was inspired *
24* by code published by Mario Klingemann and has been used with his permission. *
25* See also http://incubator.quasimondo.com *
26* *
27* Copyright 2012 - Angus Johnson *
28* *
29* Version 5.0 (Last updated 25-Sep-2012) *
30* *
31* END LICENSE BLOCK ***********************************************************)
32
33interface
34
35{$I GR32.inc}
36
37uses
38 {$IFDEF FPC}
39 LCLIntf,
40 {$ELSE}
41 Windows, Types,
42 {$ENDIF}
43 SysUtils, Classes, Math, GR32;
44
45type
46 TBlurFunction = procedure(Bitmap32: TBitmap32; Radius: TFloat);
47 TBlurFunctionBounds = procedure(Bitmap32: TBitmap32; Radius: TFloat;
48 const Bounds: TRect);
49 TBlurFunctionRegion = procedure(Bitmap32: TBitmap32; Radius: TFloat;
50 const BlurRegion: TArrayOfFloatPoint);
51
52procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat); overload;
53procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
54procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat;
55 const BlurRegion: TArrayOfFloatPoint); overload;
56
57procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat); overload;
58procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
59procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
60 const BlurRegion: TArrayOfFloatPoint); overload;
61
62procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat); overload;
63procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
64procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat;
65 const BlurRegion: TArrayOfFloatPoint); overload;
66
67procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat); overload;
68procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect); overload;
69procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
70 const BlurRegion: TArrayOfFloatPoint); overload;
71
72procedure MotionBlur(Bitmap32: TBitmap32;
73 Dist, AngleDeg: TFloat; Bidirectional: Boolean = True); overload;
74procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
75 const Bounds: TRect; Bidirectional: Boolean = True); overload;
76procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
77 const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True); overload;
78
79procedure MotionBlurGamma(Bitmap32: TBitmap32;
80 Dist, AngleDeg: TFloat; Bidirectional: Boolean = True); overload;
81procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
82 const Bounds: TRect; Bidirectional: Boolean = True); overload;
83procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
84 const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True); overload;
85
86const
87 GaussianBlurSimple: array [Boolean] of TBlurFunction = (GaussianBlur, GaussianBlurGamma);
88 GaussianBlurBounds: array [Boolean] of TBlurFunctionBounds = (GaussianBlur, GaussianBlurGamma);
89 GaussianBlurRegion: array [Boolean] of TBlurFunctionRegion = (GaussianBlur, GaussianBlurGamma);
90 FastBlurSimple: array [Boolean] of TBlurFunction = (FastBlur, FastBlurGamma);
91 FastBlurBounds: array [Boolean] of TBlurFunctionBounds = (FastBlur, FastBlurGamma);
92 FastBlurRegion: array [Boolean] of TBlurFunctionRegion = (FastBlur, FastBlurGamma);
93
94implementation
95
96uses
97 GR32_Blend, GR32_Gamma, GR32_Resamplers, GR32_Polygons, GR32_LowLevel,
98 GR32_VectorUtils, GR32_Transforms;
99
100type
101 TSumRecInt64 = record
102 B, G, R, A: Int64;
103 Sum: Integer;
104 end;
105
106 TSumRecord = record
107 B, G, R, A: Integer;
108 Sum: Integer;
109 end;
110
111const
112 ChannelSize = 256; // ie 1 byte for each of A,R,G & B in TColor32
113 ChannelSizeMin1 = ChannelSize - 1;
114
115procedure ResetSumRecord(var SumRecord: TSumRecInt64); overload;
116 {$IFDEF USEINLINING} inline; {$ENDIF}
117begin
118 FillChar(SumRecord, SizeOf(SumRecord), 0);
119end;
120
121procedure ResetSumRecord(var SumRecord: TSumRecord); overload;
122 {$IFDEF USEINLINING} inline; {$ENDIF}
123begin
124 FillChar(SumRecord, SizeOf(SumRecord), 0);
125end;
126
127function Divide(SumRecord: TSumRecInt64): TSumRecInt64; overload;
128 {$IFDEF USEINLINING} inline; {$ENDIF}
129begin
130 Result.A := SumRecord.A div SumRecord.Sum;
131 Result.R := SumRecord.R div SumRecord.Sum;
132 Result.G := SumRecord.G div SumRecord.Sum;
133 Result.B := SumRecord.B div SumRecord.Sum;
134end;
135
136function Divide(SumRecord: TSumRecord): TSumRecord; overload;
137 {$IFDEF USEINLINING} inline; {$ENDIF}
138begin
139 Result.A := SumRecord.A div SumRecord.Sum;
140 Result.R := SumRecord.R div SumRecord.Sum;
141 Result.G := SumRecord.G div SumRecord.Sum;
142 Result.B := SumRecord.B div SumRecord.Sum;
143end;
144
145function DivideToColor32(SumRecord: TSumRecInt64): TColor32Entry; overload;
146 {$IFDEF USEINLINING} inline; {$ENDIF}
147begin
148 Result.A := SumRecord.A div SumRecord.Sum;
149 Result.R := SumRecord.R div SumRecord.Sum;
150 Result.G := SumRecord.G div SumRecord.Sum;
151 Result.B := SumRecord.B div SumRecord.Sum;
152end;
153
154function DivideToColor32(SumRecord: TSumRecord): TColor32Entry; overload;
155 {$IFDEF USEINLINING} inline; {$ENDIF}
156begin
157 Result.A := SumRecord.A div SumRecord.Sum;
158 Result.R := SumRecord.R div SumRecord.Sum;
159 Result.G := SumRecord.G div SumRecord.Sum;
160 Result.B := SumRecord.B div SumRecord.Sum;
161end;
162
163
164{ GaussianBlur }
165
166{$R-}
167
168procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat);
169begin
170 GaussianBlur(Bitmap32, Radius, Bitmap32.BoundsRect);
171end;
172
173procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
174var
175 Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
176 RecLeft, RecTop, RecRight, RecBottom: Integer;
177 ImagePixels: PColor32EntryArray;
178 RadiusSq, RadiusRevSq, KernelSize: Integer;
179 SumRec: TSumRecInt64;
180 PreMulArray: array of TColor32Entry;
181 SumArray: array of TSumRecInt64;
182 GaussLUT: array of array of Cardinal;
183begin
184 RadiusI := Round(Radius);
185 if RadiusI < 1 then
186 Exit
187 else if RadiusI > 128 then
188 RadiusI := 128; // nb: performance degrades exponentially with >> Radius
189
190 // initialize the look-up-table ...
191 KernelSize := RadiusI * 2 + 1;
192 SetLength(GaussLUT, KernelSize);
193 for I := 0 to KernelSize - 1 do
194 SetLength(GaussLUT[I], ChannelSize);
195 for I := 1 to RadiusI do
196 begin
197 RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
198 for J := 0 to ChannelSizeMin1 do
199 begin
200 GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
201 GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
202 end;
203 end;
204 RadiusSq := Round((Radius + 1) * (Radius + 1));
205 for J := 0 to ChannelSizeMin1 do
206 GaussLUT[RadiusI][J] := RadiusSq * J;
207
208 ImageWidth := Bitmap32.Width;
209 SetLength(SumArray, ImageWidth * Bitmap32.Height);
210
211 ImagePixels := PColor32EntryArray(Bitmap32.Bits);
212 RecLeft := Max(Bounds.Left, 0);
213 RecTop := Max(Bounds.Top, 0);
214 RecRight := Min(Bounds.Right, ImageWidth - 1);
215 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
216
217 RowOffset := RecTop * ImageWidth;
218 SetLength(PreMulArray, Bitmap32.Width);
219 for Y := RecTop to RecBottom do
220 begin
221 // initialize PreMulArray for the row ...
222 Q := (Y * ImageWidth) + RecLeft;
223 for X := RecLeft to RecRight do
224 with ImagePixels[Q] do
225 begin
226 PreMulArray[X].A := A;
227 PreMulArray[X].R := DivTable[R, A];
228 PreMulArray[X].G := DivTable[G, A];
229 PreMulArray[X].B := DivTable[B, A];
230 Inc(Q);
231 end;
232
233 for X := RecLeft to RecRight do
234 begin
235 ResetSumRecord(SumRec);
236
237 I := Max(X - RadiusI, RecLeft);
238 Q := I - (X - RadiusI);
239 for I := I to Min(X + RadiusI, RecRight) do
240 with PreMulArray[I] do
241 begin
242 Inc(SumRec.A, GaussLUT[Q][A]);
243 Inc(SumRec.R, GaussLUT[Q][R]);
244 Inc(SumRec.G, GaussLUT[Q][G]);
245 Inc(SumRec.B, GaussLUT[Q][B]);
246 Inc(SumRec.Sum, GaussLUT[Q][1]);
247 Inc(Q);
248 end;
249 Q := RowOffset + X;
250 SumArray[Q] := Divide(SumRec);
251 end;
252 Inc(RowOffset, ImageWidth);
253 end;
254
255 RowOffset := RecTop * ImageWidth;
256 for Y := RecTop to RecBottom do
257 begin
258 for X := RecLeft to RecRight do
259 begin
260 ResetSumRecord(SumRec);
261
262 I := Max(Y - RadiusI, RecTop);
263 Q := I - (Y - RadiusI);
264 for I := I to Min(Y + RadiusI, RecBottom) do
265 with SumArray[X + I * ImageWidth] do
266 begin
267 Inc(SumRec.A, GaussLUT[Q][A]);
268 Inc(SumRec.R, GaussLUT[Q][R]);
269 Inc(SumRec.G, GaussLUT[Q][G]);
270 Inc(SumRec.B, GaussLUT[Q][B]);
271 Inc(SumRec.Sum, GaussLUT[Q][1]);
272 Inc(Q);
273 end;
274
275 with ImagePixels[RowOffset + X] do
276 begin
277 A := (SumRec.A div SumRec.Sum);
278 R := RcTable[A, (SumRec.R div SumRec.Sum)];
279 G := RcTable[A, (SumRec.G div SumRec.Sum)];
280 B := RcTable[A, (SumRec.B div SumRec.Sum)];
281 end;
282 end;
283 Inc(RowOffset, ImageWidth);
284 end;
285end;
286
287procedure GaussianBlur(Bitmap32: TBitmap32; Radius: TFloat;
288 const BlurRegion: TArrayOfFloatPoint);
289var
290 Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
291 RecLeft, RecTop, RecRight, RecBottom: Integer;
292 ImagePixels: PColor32EntryArray;
293 RadiusSq, RadiusRevSq, KernelSize: Integer;
294 SumRec: TSumRecInt64;
295 SumArray: array of TSumRecInt64;
296 GaussLUT: array of array of Cardinal;
297 PreMulArray: array of TColor32Entry;
298
299 Alpha: Cardinal;
300 Mask: TBitmap32;
301 Clr, MaskClr: TColor32Entry;
302 Pts: TArrayOfFloatPoint;
303 Bounds: TRect;
304begin
305 with PolygonBounds(BlurRegion) do
306 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
307 if Bounds.Left < 0 then Bounds.Left := 0;
308 if Bounds.Top < 0 then Bounds.Top := 0;
309 if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
310 if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
311
312 RadiusI := round(Radius);
313 if (RadiusI < 1) or (Bounds.Right <= Bounds.Left) or (Bounds.Bottom <= Bounds.Top) then
314 Exit
315 else if RadiusI > 128 then
316 RadiusI := 128; // nb: performance degrades exponentially with >> Radius
317
318 Mask := TBitmap32.Create;
319 try
320 Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
321 SetLength(Pts, Length(BlurRegion));
322 for I := 0 to High(BlurRegion) do
323 begin
324 Pts[I].X := BlurRegion[I].X - Bounds.Left;
325 Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
326 end;
327 PolygonFS(Mask, Pts, clWhite32);
328
329 // initialize the look-up-table ...
330 KernelSize := RadiusI * 2 + 1;
331 SetLength(GaussLUT, KernelSize);
332 for I := 0 to KernelSize - 1 do
333 SetLength(GaussLUT[I], ChannelSize);
334 for I := 1 to RadiusI do
335 begin
336 RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
337 for J := 0 to ChannelSizeMin1 do
338 begin
339 GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
340 GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
341 end;
342 end;
343 RadiusSq := Round((Radius + 1) * (Radius + 1));
344 for J := 0 to ChannelSizeMin1 do
345 GaussLUT[RadiusI][J] := RadiusSq * J;
346
347 ImageWidth := Bitmap32.Width;
348 SetLength(SumArray, ImageWidth * Bitmap32.Height);
349
350 ImagePixels := PColor32EntryArray(Bitmap32.Bits);
351 RecLeft := Max(Bounds.Left, 0);
352 RecTop := Max(Bounds.Top, 0);
353 RecRight := Min(Bounds.Right, ImageWidth - 1);
354 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
355
356 RowOffset := RecTop * ImageWidth;
357 SetLength(PreMulArray, Bitmap32.Width);
358 for Y := RecTop to RecBottom do
359 begin
360 // initialize PreMulArray for the current row ...
361 Q := (Y * ImageWidth) + RecLeft;
362 for X := RecLeft to RecRight do
363 with ImagePixels[Q] do
364 begin
365 PreMulArray[X].A := A;
366 PreMulArray[X].R := DivTable[R, A];
367 PreMulArray[X].G := DivTable[G, A];
368 PreMulArray[X].B := DivTable[B, A];
369 Inc(Q);
370 end;
371
372 for X := RecLeft to RecRight do
373 begin
374 ResetSumRecord(SumRec);
375
376 I := Max(X - RadiusI, RecLeft);
377 Q := I - (X - RadiusI);
378 for I := I to Min(X + RadiusI, RecRight) do
379 with PreMulArray[I] do
380 begin
381 Inc(SumRec.A, GaussLUT[Q][A]);
382 Inc(SumRec.R, GaussLUT[Q][R]);
383 Inc(SumRec.G, GaussLUT[Q][G]);
384 Inc(SumRec.B, GaussLUT[Q][B]);
385 Inc(SumRec.Sum, GaussLUT[Q][1]);
386 Inc(Q);
387 end;
388 Q := RowOffset + X;
389 SumArray[Q] := Divide(SumRec);
390 end;
391 Inc(RowOffset, ImageWidth);
392 end;
393
394 RowOffset := RecTop * ImageWidth;
395 for Y := RecTop to RecBottom do
396 begin
397 for X := RecLeft to RecRight do
398 begin
399 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
400 if (MaskClr.A = 0) then Continue;
401
402 ResetSumRecord(SumRec);
403
404 I := Max(Y - RadiusI, RecTop);
405 Q := I - (Y - RadiusI);
406 for I := I to Min(Y + RadiusI, RecBottom) do
407 with SumArray[X + I * ImageWidth] do
408 begin
409 Inc(SumRec.A, GaussLUT[Q][A]);
410 Inc(SumRec.R, GaussLUT[Q][R]);
411 Inc(SumRec.G, GaussLUT[Q][G]);
412 Inc(SumRec.B, GaussLUT[Q][B]);
413 Inc(SumRec.Sum, GaussLUT[Q][1]);
414 Inc(Q);
415 end;
416
417 with ImagePixels[RowOffset + X] do
418 if (MaskClr.A < 255) then
419 begin
420 Clr.A := SumRec.A div SumRec.Sum;
421 Clr.R := RcTable[Clr.A, SumRec.R div SumRec.Sum];
422 Clr.G := RcTable[Clr.A, SumRec.G div SumRec.Sum];
423 Clr.B := RcTable[Clr.A, SumRec.B div SumRec.Sum];
424 BlendMemEx(Clr.ARGB, ARGB, MaskClr.A);
425 end else
426 begin
427 A := SumRec.A div SumRec.Sum;
428 R := RcTable[A, SumRec.R div SumRec.Sum];
429 G := RcTable[A, SumRec.G div SumRec.Sum];
430 B := RcTable[A, SumRec.B div SumRec.Sum];
431 end;
432 end;
433 Inc(RowOffset, ImageWidth);
434 end;
435 EMMS;
436 finally
437 Mask.Free;
438 end;
439end;
440
441procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat);
442begin
443 GaussianBlurGamma(Bitmap32, Radius, Bitmap32.BoundsRect);
444end;
445
446procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
447var
448 Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
449 RecLeft, RecTop, RecRight, RecBottom: Integer;
450 ImagePixels: PColor32EntryArray;
451 RadiusSq, RadiusRevSq, KernelSize: Integer;
452 SumRec: TSumRecInt64;
453 PreMulArray: array of TColor32Entry;
454 SumArray: array of TSumRecInt64;
455 GaussLUT: array of array of Cardinal;
456begin
457 RadiusI := Round(Radius);
458 if RadiusI < 1 then
459 Exit
460 else if RadiusI > 128 then
461 RadiusI := 128; // nb: performance degrades exponentially with >> Radius
462
463 // initialize the look-up-table ...
464 KernelSize := RadiusI * 2 + 1;
465 SetLength(GaussLUT, KernelSize);
466 for I := 0 to KernelSize - 1 do
467 SetLength(GaussLUT[I], ChannelSize);
468 for I := 1 to RadiusI do
469 begin
470 RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
471 for J := 0 to ChannelSizeMin1 do
472 begin
473 GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
474 GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
475 end;
476 end;
477 RadiusSq := Round((Radius + 1) * (Radius + 1));
478 for J := 0 to ChannelSizeMin1 do
479 GaussLUT[RadiusI][J] := RadiusSq * J;
480
481 ImageWidth := Bitmap32.Width;
482 SetLength(SumArray, ImageWidth * Bitmap32.Height);
483
484 ImagePixels := PColor32EntryArray(Bitmap32.Bits);
485 RecLeft := Max(Bounds.Left, 0);
486 RecTop := Max(Bounds.Top, 0);
487 RecRight := Min(Bounds.Right, ImageWidth - 1);
488 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
489
490 RowOffset := RecTop * ImageWidth;
491 SetLength(PreMulArray, Bitmap32.Width);
492 for Y := RecTop to RecBottom do
493 begin
494 // initialize PreMulArray for the row ...
495 Q := (Y * ImageWidth) + RecLeft;
496 for X := RecLeft to RecRight do
497 with ImagePixels[Q] do
498 begin
499 PreMulArray[X].A := A;
500 PreMulArray[X].R := DivTable[GAMMA_DECODING_TABLE[R], A];
501 PreMulArray[X].G := DivTable[GAMMA_DECODING_TABLE[G], A];
502 PreMulArray[X].B := DivTable[GAMMA_DECODING_TABLE[B], A];
503 Inc(Q);
504 end;
505
506 for X := RecLeft to RecRight do
507 begin
508 ResetSumRecord(SumRec);
509
510 I := Max(X - RadiusI, RecLeft);
511 Q := I - (X - RadiusI);
512 for I := I to Min(X + RadiusI, RecRight) do
513 with PreMulArray[I] do
514 begin
515 Inc(SumRec.A, GaussLUT[Q][A]);
516 Inc(SumRec.R, GaussLUT[Q][R]);
517 Inc(SumRec.G, GaussLUT[Q][G]);
518 Inc(SumRec.B, GaussLUT[Q][B]);
519 Inc(SumRec.Sum, GaussLUT[Q][1]);
520 Inc(Q);
521 end;
522 Q := RowOffset + X;
523 SumArray[Q] := Divide(SumRec);
524 end;
525 Inc(RowOffset, ImageWidth);
526 end;
527
528 RowOffset := RecTop * ImageWidth;
529 for Y := RecTop to RecBottom do
530 begin
531 for X := RecLeft to RecRight do
532 begin
533 ResetSumRecord(SumRec);
534
535 I := Max(Y - RadiusI, RecTop);
536 Q := I - (Y - RadiusI);
537 for I := I to Min(Y + RadiusI, RecBottom) do
538 with SumArray[X + I * ImageWidth] do
539 begin
540 Inc(SumRec.A, GaussLUT[Q][A]);
541 Inc(SumRec.R, GaussLUT[Q][R]);
542 Inc(SumRec.G, GaussLUT[Q][G]);
543 Inc(SumRec.B, GaussLUT[Q][B]);
544 Inc(SumRec.Sum, GaussLUT[Q][1]);
545 Inc(Q);
546 end;
547
548 with ImagePixels[RowOffset + X] do
549 begin
550 A := (SumRec.A div SumRec.Sum);
551 R := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.R div SumRec.Sum)]];
552 G := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.G div SumRec.Sum)]];
553 B := GAMMA_ENCODING_TABLE[RcTable[A, (SumRec.B div SumRec.Sum)]];
554 end;
555 end;
556 Inc(RowOffset, ImageWidth);
557 end;
558end;
559
560procedure GaussianBlurGamma(Bitmap32: TBitmap32; Radius: TFloat;
561 const BlurRegion: TArrayOfFloatPoint);
562var
563 Q, I, J, X, Y, ImageWidth, RowOffset, RadiusI: Integer;
564 RecLeft, RecTop, RecRight, RecBottom: Integer;
565 ImagePixels: PColor32EntryArray;
566 RadiusSq, RadiusRevSq, KernelSize: Integer;
567 SumRec: TSumRecInt64;
568 SumArray: array of TSumRecInt64;
569 GaussLUT: array of array of Cardinal;
570 PreMulArray: array of TColor32Entry;
571
572 Alpha: Cardinal;
573 Mask: TBitmap32;
574 Clr, MaskClr: TColor32Entry;
575 Pts: TArrayOfFloatPoint;
576 Bounds: TRect;
577begin
578 with PolygonBounds(BlurRegion) do
579 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
580 if Bounds.Left < 0 then Bounds.Left := 0;
581 if Bounds.Top < 0 then Bounds.Top := 0;
582 if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
583 if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
584
585 RadiusI := round(Radius);
586 if (RadiusI < 1) or (Bounds.Right <= Bounds.Left) or (Bounds.Bottom <= Bounds.Top) then
587 Exit
588 else if RadiusI > 128 then
589 RadiusI := 128; // nb: performance degrades exponentially with >> Radius
590
591 Mask := TBitmap32.Create;
592 try
593 Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
594 SetLength(Pts, Length(BlurRegion));
595 for I := 0 to High(BlurRegion) do
596 begin
597 Pts[I].X := BlurRegion[I].X - Bounds.Left;
598 Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
599 end;
600 PolygonFS(Mask, Pts, clWhite32);
601
602 // initialize the look-up-table ...
603 KernelSize := RadiusI * 2 + 1;
604 SetLength(GaussLUT, KernelSize);
605 for I := 0 to KernelSize - 1 do
606 SetLength(GaussLUT[I], ChannelSize);
607 for I := 1 to RadiusI do
608 begin
609 RadiusRevSq := Round((Radius + 1 - I) * (Radius + 1 - I));
610 for J := 0 to ChannelSizeMin1 do
611 begin
612 GaussLUT[RadiusI - I][J] := RadiusRevSq * J;
613 GaussLUT[RadiusI + I][J] := GaussLUT[RadiusI - I][J];
614 end;
615 end;
616 RadiusSq := Round((Radius + 1) * (Radius + 1));
617 for J := 0 to ChannelSizeMin1 do
618 GaussLUT[RadiusI][J] := RadiusSq * J;
619
620 ImageWidth := Bitmap32.Width;
621 SetLength(SumArray, ImageWidth * Bitmap32.Height);
622
623 ImagePixels := PColor32EntryArray(Bitmap32.Bits);
624 RecLeft := Max(Bounds.Left, 0);
625 RecTop := Max(Bounds.Top, 0);
626 RecRight := Min(Bounds.Right, ImageWidth - 1);
627 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
628
629 RowOffset := RecTop * ImageWidth;
630 SetLength(PreMulArray, Bitmap32.Width);
631 for Y := RecTop to RecBottom do
632 begin
633 // initialize PreMulArray for the current row ...
634 Q := (Y * ImageWidth) + RecLeft;
635 for X := RecLeft to RecRight do
636 with ImagePixels[Q] do
637 begin
638 PreMulArray[X].A := A;
639 PreMulArray[X].R := DivTable[GAMMA_DECODING_TABLE[R], A];
640 PreMulArray[X].G := DivTable[GAMMA_DECODING_TABLE[G], A];
641 PreMulArray[X].B := DivTable[GAMMA_DECODING_TABLE[B], A];
642 Inc(Q);
643 end;
644
645 for X := RecLeft to RecRight do
646 begin
647 ResetSumRecord(SumRec);
648
649 I := Max(X - RadiusI, RecLeft);
650 Q := I - (X - RadiusI);
651 for I := I to Min(X + RadiusI, RecRight) do
652 with PreMulArray[I] do
653 begin
654 Inc(SumRec.A, GaussLUT[Q][A]);
655 Inc(SumRec.R, GaussLUT[Q][R]);
656 Inc(SumRec.G, GaussLUT[Q][G]);
657 Inc(SumRec.B, GaussLUT[Q][B]);
658 Inc(SumRec.Sum, GaussLUT[Q][1]);
659 Inc(Q);
660 end;
661 Q := RowOffset + X;
662 SumArray[Q] := Divide(SumRec);
663 end;
664 Inc(RowOffset, ImageWidth);
665 end;
666
667 RowOffset := RecTop * ImageWidth;
668 for Y := RecTop to RecBottom do
669 begin
670 for X := RecLeft to RecRight do
671 begin
672 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
673 if (MaskClr.A = 0) then Continue;
674
675 ResetSumRecord(SumRec);
676
677 I := Max(Y - RadiusI, RecTop);
678 Q := I - (Y - RadiusI);
679 for I := I to Min(Y + RadiusI, RecBottom) do
680 with SumArray[X + I * ImageWidth] do
681 begin
682 Inc(SumRec.A, GaussLUT[Q][A]);
683 Inc(SumRec.R, GaussLUT[Q][R]);
684 Inc(SumRec.G, GaussLUT[Q][G]);
685 Inc(SumRec.B, GaussLUT[Q][B]);
686 Inc(SumRec.Sum, GaussLUT[Q][1]);
687 Inc(Q);
688 end;
689
690 with ImagePixels[RowOffset + X] do
691 if (MaskClr.A < 255) then
692 begin
693 Clr.A := SumRec.A div SumRec.Sum;
694 Clr.R := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.R div SumRec.Sum]];
695 Clr.G := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.G div SumRec.Sum]];
696 Clr.B := GAMMA_ENCODING_TABLE[RcTable[Clr.A, SumRec.B div SumRec.Sum]];
697 BlendMemEx(Clr.ARGB, ARGB, MaskClr.A);
698 end else
699 begin
700 A := SumRec.A div SumRec.Sum;
701 R := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.R div SumRec.Sum]];
702 G := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.G div SumRec.Sum]];
703 B := GAMMA_ENCODING_TABLE[RcTable[A, SumRec.B div SumRec.Sum]];
704 end;
705 end;
706 Inc(RowOffset, ImageWidth);
707 end;
708 EMMS;
709 finally
710 Mask.Free;
711 end;
712end;
713
714
715{ FastBlur }
716
717procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat);
718begin
719 FastBlur(Bitmap32, Radius, Bitmap32.BoundsRect);
720end;
721
722procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
723var
724 LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
725 RecLeft, RecTop, RecRight, RecBottom: Integer;
726 ImagePixel: PColor32Entry;
727 SumRec: TSumRecord;
728 ImgPixel: PColor32Entry;
729 Pixels: array of TColor32Entry;
730begin
731 if Radius < 1 then
732 Exit
733 else if Radius > 256 then
734 Radius := 256;
735
736 RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
737 if RadiusI < 2 then
738 begin
739 Passes := Round(Radius);
740 RadiusI := 1;
741 end else
742 Passes := 3;
743
744 RecLeft := Max(Bounds.Left, 0);
745 RecTop := Max(Bounds.Top, 0);
746 RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
747 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
748
749 SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
750 // pre-multiply alphas ...
751 for Y := RecTop to RecBottom do
752 begin
753 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
754 Inc(ImgPixel, RecLeft);
755 for X := RecLeft to RecRight do
756 with ImgPixel^ do
757 begin
758 R := DivTable[R, A];
759 G := DivTable[G, A];
760 B := DivTable[B, A];
761 Inc(ImgPixel);
762 end;
763 end;
764
765 for I := 1 to Passes do
766 begin
767
768 // horizontal pass...
769 for Y := RecTop to RecBottom do
770 begin
771 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
772 // fill the Pixels buffer with a copy of the row's pixels ...
773 MoveLongword(ImagePixel^, Pixels[RecLeft], RecRight - RecLeft + 1);
774
775 ResetSumRecord(SumRec);
776
777 LL := RecLeft;
778 RR := RecLeft + RadiusI;
779 if RR > RecRight then RR := RecRight;
780 // update first in row ...
781 for XX := LL to RR do
782 with Pixels[XX] do
783 begin
784 Inc(SumRec.A, A);
785 Inc(SumRec.R, R);
786 Inc(SumRec.G, G);
787 Inc(SumRec.B, B);
788 Inc(SumRec.Sum);
789 end;
790
791 ImagePixel^ := DivideToColor32(SumRec);
792
793 // update the remaining pixels in the row ...
794 for X := RecLeft + 1 to RecRight do
795 begin
796 Inc(ImagePixel);
797 LL := X - RadiusI - 1;
798 RR := X + RadiusI;
799 if LL >= RecLeft then
800 with Pixels[LL] do
801 begin
802 Dec(SumRec.A, A);
803 Dec(SumRec.R, R);
804 Dec(SumRec.G, G);
805 Dec(SumRec.B, B);
806 Dec(SumRec.Sum);
807 end;
808 if RR <= RecRight then
809 with Pixels[RR] do
810 begin
811 Inc(SumRec.A, A);
812 Inc(SumRec.R, R);
813 Inc(SumRec.G, G);
814 Inc(SumRec.B, B);
815 Inc(SumRec.Sum);
816 end;
817
818 ImagePixel^ := DivideToColor32(SumRec);
819 end;
820 end;
821
822 // vertical pass...
823 for X := RecLeft to RecRight do
824 begin
825 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
826 for J := RecTop to RecBottom do
827 begin
828 Pixels[J] := ImagePixel^;
829 Inc(ImagePixel, Bitmap32.Width);
830 end;
831 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
832
833 TT := RecTop;
834 BB := RecTop + RadiusI;
835 if BB > RecBottom then BB := RecBottom;
836 ResetSumRecord(SumRec);
837
838 // update first in col ...
839 for YY := TT to BB do
840 with Pixels[YY] do
841 begin
842 Inc(SumRec.A, A);
843 Inc(SumRec.R, R);
844 Inc(SumRec.G, G);
845 Inc(SumRec.B, B);
846 Inc(SumRec.Sum);
847 end;
848
849 ImagePixel^ := DivideToColor32(SumRec);
850
851 // update remainder in col ...
852 for Y := RecTop + 1 to RecBottom do
853 begin
854 Inc(ImagePixel, Bitmap32.Width);
855 TT := Y - RadiusI - 1;
856 BB := Y + RadiusI;
857
858 if TT >= RecTop then
859 with Pixels[TT] do
860 begin
861 Dec(SumRec.A, A);
862 Dec(SumRec.R, R);
863 Dec(SumRec.G, G);
864 Dec(SumRec.B, B);
865 Dec(SumRec.Sum);
866 end;
867 if BB <= RecBottom then
868 with Pixels[BB] do
869 begin
870 Inc(SumRec.A, A);
871 Inc(SumRec.R, R);
872 Inc(SumRec.G, G);
873 Inc(SumRec.B, B);
874 Inc(SumRec.Sum);
875 end;
876
877 ImagePixel^ := DivideToColor32(SumRec);
878 end;
879 end;
880 end;
881
882 // extract alphas ...
883 for Y := RecTop to RecBottom do
884 begin
885 ImgPixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
886 for X := RecLeft to RecRight do
887 begin
888 ImgPixel.R := RcTable[ImgPixel.A, ImgPixel.R];
889 ImgPixel.G := RcTable[ImgPixel.A, ImgPixel.G];
890 ImgPixel.B := RcTable[ImgPixel.A, ImgPixel.B];
891 Inc(ImgPixel);
892 end;
893 end;
894end;
895
896procedure FastBlur(Bitmap32: TBitmap32; Radius: TFloat; const BlurRegion: TArrayOfFloatPoint);
897var
898 LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
899 RecLeft, RecTop, RecRight, RecBottom: Integer;
900 ImagePixel: PColor32Entry;
901 SumRec: TSumRecord;
902 ImgPixel: PColor32Entry;
903 Pixels: array of TSumRecord;
904
905 Mask: TBitmap32;
906 Clr, MaskClr: TColor32Entry;
907 Pts: TArrayOfFloatPoint;
908 Bounds: TRect;
909begin
910 if Radius < 1 then
911 Exit
912 else if Radius > 256 then
913 Radius := 256;
914
915 RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
916 if RadiusI < 2 then
917 begin
918 Passes := Round(Radius);
919 RadiusI := 1;
920 end else
921 Passes := 3;
922
923 with PolygonBounds(BlurRegion) do
924 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
925 if Bounds.Left < 0 then Bounds.Left := 0;
926 if Bounds.Top < 0 then Bounds.Top := 0;
927 if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
928 if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
929 RecLeft := Max(Bounds.Left, 0);
930 RecTop := Max(Bounds.Top, 0);
931 RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
932 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
933
934 SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
935 // pre-multiply alphas ...
936 for Y := RecTop to RecBottom do
937 begin
938 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
939 Inc(ImgPixel, RecLeft);
940 for X := RecLeft to RecRight do
941 begin
942 ImgPixel.R := DivTable[ImgPixel.R, ImgPixel.A];
943 ImgPixel.G := DivTable[ImgPixel.G, ImgPixel.A];
944 ImgPixel.B := DivTable[ImgPixel.B, ImgPixel.A];
945 Inc(ImgPixel);
946 end;
947 end;
948
949 Mask := TBitmap32.Create;
950 try
951 Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
952 SetLength(Pts, Length(BlurRegion));
953 for I := 0 to High(BlurRegion) do
954 begin
955 Pts[I].X := BlurRegion[I].X - Bounds.Left;
956 Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
957 end;
958 PolygonFS(Mask, Pts, clWhite32);
959
960 for I := 1 to Passes do
961 begin
962 // horizontal pass...
963 for Y := RecTop to RecBottom do
964 begin
965 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
966 // fill the Pixels buffer with a copy of the row's pixels ...
967 for J := RecLeft to RecRight do
968 begin
969 MaskClr.ARGB := Mask.Pixel[J - RecLeft, Y - RecTop];
970 if (MaskClr.A = 0) then
971 begin
972 Pixels[J].A := 0;
973 Pixels[J].R := 0;
974 Pixels[J].G := 0;
975 Pixels[J].B := 0;
976 Pixels[J].Sum := 0;
977 end else
978 with ImagePixel^ do
979 begin
980 Pixels[J].A := A;
981 Pixels[J].R := R;
982 Pixels[J].G := G;
983 Pixels[J].B := B;
984 Pixels[J].Sum := 1;
985 end;
986 Inc(ImagePixel);
987 end;
988 LL := RecLeft;
989 RR := RecLeft + RadiusI;
990 if RR > RecRight then RR := RecRight;
991 ResetSumRecord(SumRec);
992
993 // update first in row ...
994 for XX := LL to RR do
995 with Pixels[XX] do
996 begin
997 Inc(SumRec.A, A);
998 Inc(SumRec.R, R);
999 Inc(SumRec.G, G);
1000 Inc(SumRec.B, B);
1001 Inc(SumRec.Sum, Sum);
1002 end;
1003
1004 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
1005 MaskClr.ARGB := Mask.Pixel[0, Y - RecTop];
1006 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
1007 ImagePixel^ := DivideToColor32(SumRec);
1008
1009 // update the remaining pixels in the row ...
1010 for X := RecLeft + 1 to RecRight do
1011 begin
1012 Inc(ImagePixel);
1013 LL := X - RadiusI - 1;
1014 RR := X + RadiusI;
1015 if LL >= RecLeft then
1016 with Pixels[LL] do
1017 begin
1018 Dec(SumRec.A, A);
1019 Dec(SumRec.R, R);
1020 Dec(SumRec.G, G);
1021 Dec(SumRec.B, B);
1022 Dec(SumRec.Sum, Sum);
1023 end;
1024 if RR <= RecRight then
1025 with Pixels[RR] do
1026 begin
1027 Inc(SumRec.A, A);
1028 Inc(SumRec.R, R);
1029 Inc(SumRec.G, G);
1030 Inc(SumRec.B, B);
1031 Inc(SumRec.Sum, Sum);
1032 end;
1033
1034 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
1035 if (SumRec.Sum > 0) and (MaskClr.A = 255) then
1036 ImagePixel^ := DivideToColor32(SumRec);
1037 end;
1038 end;
1039
1040 // vertical pass...
1041 for X := RecLeft to RecRight do
1042 begin
1043 // fill the Pixels buffer with a copy of the col's pixels ...
1044 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1045 for J := RecTop to RecBottom do
1046 begin
1047 MaskClr.ARGB := Mask.Pixel[X - RecLeft, J - RecTop];
1048 if (MaskClr.A = 0) then
1049 begin
1050 Pixels[J].A := 0;
1051 Pixels[J].R := 0;
1052 Pixels[J].G := 0;
1053 Pixels[J].B := 0;
1054 Pixels[J].Sum := 0;
1055 end else
1056 with ImagePixel^ do
1057 begin
1058 Pixels[J].A := A;
1059 Pixels[J].R := R;
1060 Pixels[J].G := G;
1061 Pixels[J].B := B;
1062 Pixels[J].Sum := 1;
1063 end;
1064 Inc(ImagePixel, Bitmap32.Width);
1065 end;
1066 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1067
1068 TT := RecTop;
1069 BB := RecTop + RadiusI;
1070 if BB > RecBottom then BB := RecBottom;
1071 ResetSumRecord(SumRec);
1072
1073 // update first in col ...
1074 for YY := TT to BB do
1075 with Pixels[YY] do
1076 begin
1077 Inc(SumRec.A, A);
1078 Inc(SumRec.R, R);
1079 Inc(SumRec.G, G);
1080 Inc(SumRec.B, B);
1081 Inc(SumRec.Sum, Sum);
1082 end;
1083 MaskClr.ARGB := Mask.Pixel[X - RecLeft, 0];
1084 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
1085 ImagePixel^ := DivideToColor32(SumRec);
1086
1087 // update remainder in col ...
1088 for Y := RecTop + 1 to RecBottom do
1089 begin
1090 Inc(ImagePixel, Bitmap32.Width);
1091 TT := Y - RadiusI - 1;
1092 BB := Y + RadiusI;
1093
1094 if TT >= RecTop then
1095 with Pixels[TT] do
1096 begin
1097 Dec(SumRec.A, A);
1098 Dec(SumRec.R, R);
1099 Dec(SumRec.G, G);
1100 Dec(SumRec.B, B);
1101 Dec(SumRec.Sum, Sum);
1102 end;
1103 if BB <= RecBottom then
1104 with Pixels[BB] do
1105 begin
1106 Inc(SumRec.A, A);
1107 Inc(SumRec.R, R);
1108 Inc(SumRec.G, G);
1109 Inc(SumRec.B, B);
1110 Inc(SumRec.Sum, Sum);
1111 end;
1112 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
1113 if (SumRec.Sum = 0) or (MaskClr.A = 0) then
1114 // do nothing
1115 else if (I = Passes) then
1116 begin
1117 Clr := DivideToColor32(SumRec);
1118 BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
1119 end
1120 else if (MaskClr.A = 255) then
1121 ImagePixel^ := DivideToColor32(SumRec);
1122 end;
1123 EMMS;
1124 end;
1125 end;
1126
1127 // extract alphas ...
1128 for Y := RecTop to RecBottom do
1129 begin
1130 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
1131 Inc(ImgPixel, RecLeft);
1132 for X := RecLeft to RecRight do
1133 begin
1134 ImgPixel.R := RcTable[ImgPixel.A, ImgPixel.R];
1135 ImgPixel.G := RcTable[ImgPixel.A, ImgPixel.G];
1136 ImgPixel.B := RcTable[ImgPixel.A, ImgPixel.B];
1137 Inc(ImgPixel);
1138 end;
1139 end;
1140 finally
1141 Mask.Free;
1142 end;
1143end;
1144
1145procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat);
1146begin
1147 FastBlurGamma(Bitmap32, Radius, Bitmap32.BoundsRect);
1148end;
1149
1150procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const Bounds: TRect);
1151var
1152 LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
1153 RecLeft, RecTop, RecRight, RecBottom: Integer;
1154 ImagePixel: PColor32Entry;
1155 SumRec: TSumRecord;
1156 ImgPixel: PColor32Entry;
1157 Pixels: array of TColor32Entry;
1158begin
1159 if Radius < 1 then
1160 Exit
1161 else if Radius > 256 then
1162 Radius := 256;
1163
1164 RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
1165 if RadiusI < 2 then
1166 begin
1167 Passes := Round(Radius);
1168 RadiusI := 1;
1169 end else
1170 Passes := 3;
1171
1172 RecLeft := Max(Bounds.Left, 0);
1173 RecTop := Max(Bounds.Top, 0);
1174 RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
1175 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
1176
1177 SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
1178
1179 // pre-multiply alphas ...
1180 for Y := RecTop to RecBottom do
1181 begin
1182 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
1183 Inc(ImgPixel, RecLeft);
1184 for X := RecLeft to RecRight do
1185 with ImgPixel^ do
1186 begin
1187 R := DivTable[GAMMA_DECODING_TABLE[R], A];
1188 G := DivTable[GAMMA_DECODING_TABLE[G], A];
1189 B := DivTable[GAMMA_DECODING_TABLE[B], A];
1190 Inc(ImgPixel);
1191 end;
1192 end;
1193
1194 for I := 1 to Passes do
1195 begin
1196
1197 // horizontal pass...
1198 for Y := RecTop to RecBottom do
1199 begin
1200 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
1201 // fill the Pixels buffer with a copy of the row's pixels ...
1202 MoveLongword(ImagePixel^, Pixels[RecLeft], RecRight - RecLeft + 1);
1203
1204 ResetSumRecord(SumRec);
1205
1206 LL := RecLeft;
1207 RR := RecLeft + RadiusI;
1208 if RR > RecRight then RR := RecRight;
1209 // update first in row ...
1210 for XX := LL to RR do
1211 with Pixels[XX] do
1212 begin
1213 Inc(SumRec.A, A);
1214 Inc(SumRec.R, R);
1215 Inc(SumRec.G, G);
1216 Inc(SumRec.B, B);
1217 Inc(SumRec.Sum);
1218 end;
1219 ImagePixel^ := DivideToColor32(SumRec);
1220
1221 // update the remaining pixels in the row ...
1222 for X := RecLeft + 1 to RecRight do
1223 begin
1224 Inc(ImagePixel);
1225 LL := X - RadiusI - 1;
1226 RR := X + RadiusI;
1227 if LL >= RecLeft then
1228 with Pixels[LL] do
1229 begin
1230 Dec(SumRec.A, A);
1231 Dec(SumRec.R, R);
1232 Dec(SumRec.G, G);
1233 Dec(SumRec.B, B);
1234 Dec(SumRec.Sum);
1235 end;
1236 if RR <= RecRight then
1237 with Pixels[RR] do
1238 begin
1239 Inc(SumRec.A, A);
1240 Inc(SumRec.R, R);
1241 Inc(SumRec.G, G);
1242 Inc(SumRec.B, B);
1243 Inc(SumRec.Sum);
1244 end;
1245
1246 ImagePixel^ := DivideToColor32(SumRec);
1247 end;
1248 end;
1249
1250 // vertical pass...
1251 for X := RecLeft to RecRight do
1252 begin
1253 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1254 for J := RecTop to RecBottom do
1255 begin
1256 Pixels[J] := ImagePixel^;
1257 Inc(ImagePixel, Bitmap32.Width);
1258 end;
1259 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1260
1261 TT := RecTop;
1262 BB := RecTop + RadiusI;
1263 if BB > RecBottom then BB := RecBottom;
1264 ResetSumRecord(SumRec);
1265
1266 // update first in col ...
1267 for YY := TT to BB do
1268 with Pixels[YY] do
1269 begin
1270 Inc(SumRec.A, A);
1271 Inc(SumRec.R, R);
1272 Inc(SumRec.G, G);
1273 Inc(SumRec.B, B);
1274 Inc(SumRec.Sum);
1275 end;
1276
1277 ImagePixel^ := DivideToColor32(SumRec);
1278
1279 // update remainder in col ...
1280 for Y := RecTop + 1 to RecBottom do
1281 begin
1282 Inc(ImagePixel, Bitmap32.Width);
1283 TT := Y - RadiusI - 1;
1284 BB := Y + RadiusI;
1285
1286 if TT >= RecTop then
1287 with Pixels[TT] do
1288 begin
1289 Dec(SumRec.A, A);
1290 Dec(SumRec.R, R);
1291 Dec(SumRec.G, G);
1292 Dec(SumRec.B, B);
1293 Dec(SumRec.Sum);
1294 end;
1295 if BB <= RecBottom then
1296 with Pixels[BB] do
1297 begin
1298 Inc(SumRec.A, A);
1299 Inc(SumRec.R, R);
1300 Inc(SumRec.G, G);
1301 Inc(SumRec.B, B);
1302 Inc(SumRec.Sum);
1303 end;
1304
1305 ImagePixel^ := DivideToColor32(SumRec);
1306 end;
1307 end;
1308 end;
1309
1310 // extract alphas ...
1311 for Y := RecTop to RecBottom do
1312 begin
1313 ImgPixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
1314 for X := RecLeft to RecRight do
1315 begin
1316 ImgPixel.R := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.R]];
1317 ImgPixel.G := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.G]];
1318 ImgPixel.B := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.B]];
1319 Inc(ImgPixel);
1320 end;
1321 end;
1322end;
1323
1324procedure FastBlurGamma(Bitmap32: TBitmap32; Radius: TFloat; const BlurRegion: TArrayOfFloatPoint);
1325var
1326 LL, RR, TT, BB, XX, YY, I, J, X, Y, RadiusI, Passes: Integer;
1327 RecLeft, RecTop, RecRight, RecBottom: Integer;
1328 ImagePixel: PColor32Entry;
1329 SumRec: TSumRecord;
1330 ImgPixel: PColor32Entry;
1331 Pixels: array of TSumRecord;
1332
1333 Mask: TBitmap32;
1334 Clr, MaskClr: TColor32Entry;
1335 Pts: TArrayOfFloatPoint;
1336 Bounds: TRect;
1337begin
1338 if Radius < 1 then
1339 Exit
1340 else if Radius > 256 then
1341 Radius := 256;
1342
1343 RadiusI := Round(Radius / Sqrt(-2 * Ln(COne255th)));
1344 if RadiusI < 2 then
1345 begin
1346 Passes := Round(Radius);
1347 RadiusI := 1;
1348 end else
1349 Passes := 3;
1350
1351 with PolygonBounds(BlurRegion) do
1352 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
1353 if Bounds.Left < 0 then Bounds.Left := 0;
1354 if Bounds.Top < 0 then Bounds.Top := 0;
1355 if Bounds.Right >= Bitmap32.Width then Bounds.Right := Bitmap32.Width - 1;
1356 if Bounds.Bottom >= Bitmap32.Height then Bounds.Bottom := Bitmap32.Height - 1;
1357 RecLeft := Max(Bounds.Left, 0);
1358 RecTop := Max(Bounds.Top, 0);
1359 RecRight := Min(Bounds.Right, Bitmap32.Width - 1);
1360 RecBottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
1361
1362 SetLength(Pixels, Max(Bitmap32.Width, Bitmap32.Height) + 1);
1363
1364 // pre-multiply alphas ...
1365 for Y := RecTop to RecBottom do
1366 begin
1367 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
1368 Inc(ImgPixel, RecLeft);
1369 for X := RecLeft to RecRight do
1370 begin
1371 ImgPixel.R := DivTable[GAMMA_DECODING_TABLE[ImgPixel.R], ImgPixel.A];
1372 ImgPixel.G := DivTable[GAMMA_DECODING_TABLE[ImgPixel.G], ImgPixel.A];
1373 ImgPixel.B := DivTable[GAMMA_DECODING_TABLE[ImgPixel.B], ImgPixel.A];
1374 Inc(ImgPixel);
1375 end;
1376 end;
1377
1378 Mask := TBitmap32.Create;
1379 try
1380 Mask.SetSize(Bounds.Right - Bounds.Left + 1, Bounds.Bottom - Bounds.Top + 1);
1381 SetLength(Pts, Length(BlurRegion));
1382 for I := 0 to High(BlurRegion) do
1383 begin
1384 Pts[I].X := BlurRegion[I].X - Bounds.Left;
1385 Pts[I].Y := BlurRegion[I].Y - Bounds.Top;
1386 end;
1387 PolygonFS(Mask, Pts, clWhite32);
1388
1389 for I := 1 to Passes do
1390 begin
1391 // horizontal pass...
1392 for Y := RecTop to RecBottom do
1393 begin
1394 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
1395 // fill the Pixels buffer with a copy of the row's pixels ...
1396 for J := RecLeft to RecRight do
1397 begin
1398 MaskClr.ARGB := Mask.Pixel[J - RecLeft, Y - RecTop];
1399 if (MaskClr.A = 0) then
1400 begin
1401 Pixels[J].A := 0;
1402 Pixels[J].R := 0;
1403 Pixels[J].G := 0;
1404 Pixels[J].B := 0;
1405 Pixels[J].Sum := 0;
1406 end else
1407 with ImagePixel^ do
1408 begin
1409 Pixels[J].A := A;
1410 Pixels[J].R := R;
1411 Pixels[J].G := G;
1412 Pixels[J].B := B;
1413 Pixels[J].Sum := 1;
1414 end;
1415 Inc(ImagePixel);
1416 end;
1417 LL := RecLeft;
1418 RR := RecLeft + RadiusI;
1419 if RR > RecRight then RR := RecRight;
1420 ResetSumRecord(SumRec);
1421
1422 // update first in row ...
1423 for XX := LL to RR do
1424 with Pixels[XX] do
1425 begin
1426 Inc(SumRec.A, A);
1427 Inc(SumRec.R, R);
1428 Inc(SumRec.G, G);
1429 Inc(SumRec.B, B);
1430 Inc(SumRec.Sum, Sum);
1431 end;
1432
1433 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y][RecLeft]);
1434 MaskClr.ARGB := Mask.Pixel[0, Y - RecTop];
1435 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
1436 ImagePixel^ := DivideToColor32(SumRec);
1437
1438 // update the remaining pixels in the row ...
1439 for X := RecLeft + 1 to RecRight do
1440 begin
1441 Inc(ImagePixel);
1442 LL := X - RadiusI - 1;
1443 RR := X + RadiusI;
1444 if LL >= RecLeft then
1445 with Pixels[LL] do
1446 begin
1447 Dec(SumRec.A, A);
1448 Dec(SumRec.R, R);
1449 Dec(SumRec.G, G);
1450 Dec(SumRec.B, B);
1451 Dec(SumRec.Sum, Sum);
1452 end;
1453 if RR <= RecRight then
1454 with Pixels[RR] do
1455 begin
1456 Inc(SumRec.A, A);
1457 Inc(SumRec.R, R);
1458 Inc(SumRec.G, G);
1459 Inc(SumRec.B, B);
1460 Inc(SumRec.Sum, Sum);
1461 end;
1462
1463 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
1464 if (SumRec.Sum > 0) and (MaskClr.A = 255) then
1465 ImagePixel^ := DivideToColor32(SumRec);
1466 end;
1467 end;
1468
1469 // vertical pass...
1470 for X := RecLeft to RecRight do
1471 begin
1472 // fill the Pixels buffer with a copy of the col's pixels ...
1473 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1474 for J := RecTop to RecBottom do
1475 begin
1476 MaskClr.ARGB := Mask.Pixel[X - RecLeft, J - RecTop];
1477 if (MaskClr.A = 0) then
1478 begin
1479 Pixels[J].A := 0;
1480 Pixels[J].R := 0;
1481 Pixels[J].G := 0;
1482 Pixels[J].B := 0;
1483 Pixels[J].Sum := 0;
1484 end else
1485 with ImagePixel^ do
1486 begin
1487 Pixels[J].A := A;
1488 Pixels[J].R := R;
1489 Pixels[J].G := G;
1490 Pixels[J].B := B;
1491 Pixels[J].Sum := 1;
1492 end;
1493 Inc(ImagePixel, Bitmap32.Width);
1494 end;
1495 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[RecTop][X]);
1496
1497 TT := RecTop;
1498 BB := RecTop + RadiusI;
1499 if BB > RecBottom then BB := RecBottom;
1500 ResetSumRecord(SumRec);
1501
1502 // update first in col ...
1503 for YY := TT to BB do
1504 with Pixels[YY] do
1505 begin
1506 Inc(SumRec.A, A);
1507 Inc(SumRec.R, R);
1508 Inc(SumRec.G, G);
1509 Inc(SumRec.B, B);
1510 Inc(SumRec.Sum, Sum);
1511 end;
1512 MaskClr.ARGB := Mask.Pixel[X - RecLeft, 0];
1513 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
1514 ImagePixel^ := DivideToColor32(SumRec);
1515
1516 // update remainder in col ...
1517 for Y := RecTop + 1 to RecBottom do
1518 begin
1519 Inc(ImagePixel, Bitmap32.Width);
1520 TT := Y - RadiusI - 1;
1521 BB := Y + RadiusI;
1522
1523 if TT >= RecTop then
1524 with Pixels[TT] do
1525 begin
1526 Dec(SumRec.A, A);
1527 Dec(SumRec.R, R);
1528 Dec(SumRec.G, G);
1529 Dec(SumRec.B, B);
1530 Dec(SumRec.Sum, Sum);
1531 end;
1532 if BB <= RecBottom then
1533 with Pixels[BB] do
1534 begin
1535 Inc(SumRec.A, A);
1536 Inc(SumRec.R, R);
1537 Inc(SumRec.G, G);
1538 Inc(SumRec.B, B);
1539 Inc(SumRec.Sum, Sum);
1540 end;
1541 MaskClr.ARGB := Mask.Pixel[X - RecLeft, Y - RecTop];
1542 if (SumRec.Sum = 0) or (MaskClr.A = 0) then
1543 // do nothing
1544 else if (I = Passes) then
1545 begin
1546 Clr := DivideToColor32(SumRec);
1547 BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
1548 end
1549 else if (MaskClr.A = 255) then
1550 ImagePixel^ := DivideToColor32(SumRec);
1551 end;
1552 EMMS;
1553 end;
1554 end;
1555
1556 // extract alphas ...
1557 for Y := RecTop to RecBottom do
1558 begin
1559 ImgPixel := PColor32Entry(Bitmap32.ScanLine[Y]);
1560 Inc(ImgPixel, RecLeft);
1561 for X := RecLeft to RecRight do
1562 begin
1563 ImgPixel.R := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.R]];
1564 ImgPixel.G := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.G]];
1565 ImgPixel.B := GAMMA_ENCODING_TABLE[RcTable[ImgPixel.A, ImgPixel.B]];
1566 Inc(ImgPixel);
1567 end;
1568 end;
1569 finally
1570 Mask.Free;
1571 end;
1572end;
1573
1574
1575{ MotionBlur }
1576
1577procedure MotionBlur(Bitmap32: TBitmap32;
1578 Dist, AngleDeg: TFloat; Bidirectional: Boolean = True);
1579var
1580 Pts: TArrayOfFloatPoint;
1581begin
1582 SetLength(Pts, 4);
1583 with Bitmap32.BoundsRect do
1584 begin
1585 Pts[0] := FloatPoint(Left, Top);
1586 Pts[1] := FloatPoint(Right, Top);
1587 Pts[2] := FloatPoint(Right, Bottom);
1588 Pts[3] := FloatPoint(Left, Bottom);
1589 end;
1590 MotionBlur(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
1591end;
1592
1593procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
1594 const Bounds: TRect; Bidirectional: Boolean = True);
1595var
1596 Pts: TArrayOfFloatPoint;
1597begin
1598 SetLength(Pts, 4);
1599 with Bounds do
1600 begin
1601 Pts[0] := FloatPoint(Left, Top);
1602 Pts[1] := FloatPoint(Right, Top);
1603 Pts[2] := FloatPoint(Right, Bottom);
1604 Pts[3] := FloatPoint(Left, Bottom);
1605 end;
1606 MotionBlur(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
1607end;
1608
1609procedure MotionBlur(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
1610 const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True);
1611var
1612 LL, RR, XX, I, X, Y, RadiusI, Passes: Integer;
1613 ImagePixel, ImagePixel2, ImagePixel3: PColor32Entry;
1614 ImagePixels, ImagePixels2: PColor32EntryArray;
1615 SumRec: TSumRecord;
1616 Pixels: array of TSumRecord;
1617 Mask: TBitmap32;
1618 Clr, MaskClr: TColor32Entry;
1619 Pts: TArrayOfFloatPoint;
1620 Bounds: TRect;
1621 Dx, Dy: Double;
1622 Affine: TAffineTransformation;
1623 BmpCutout: TBitmap32;
1624 BmpRotated: TBitmap32;
1625 PrevIsBlank, ThisIsBlank: boolean;
1626begin
1627 if Dist < 1 then
1628 Exit
1629 else if Dist > 256 then
1630 Dist := 256;
1631
1632 RadiusI := Round(Sqrt(-Dist * Dist / (2 * Ln(COne255th))));
1633 if RadiusI < 2 then
1634 begin
1635 Passes := Round(Dist);
1636 RadiusI := 1;
1637 end else
1638 Passes := 3;
1639
1640
1641 with PolygonBounds(BlurRegion) do
1642 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
1643 Bounds.Left := Max(Bounds.Left, 0);
1644 Bounds.Top := Max(Bounds.Top, 0);
1645 Bounds.Right := Min(Bounds.Right, Bitmap32.Width - 1);
1646 Bounds.Bottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
1647
1648 Affine := TAffineTransformation.Create;
1649 BmpCutout := TBitmap32.Create;
1650 BmpRotated := TBitmap32.Create;
1651 BmpRotated.Resampler := TLinearResampler.Create(BmpRotated);
1652 Mask := TBitmap32.Create;
1653 try
1654 // copy the region to be blurred into the BmpCutout image buffer ...
1655 BmpCutout.SetSize(Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top);
1656 for Y := 0 to BmpCutout.Height - 1 do
1657 begin
1658 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
1659 ImagePixel2 := PColor32Entry(BmpCutout.ScanLine[Y]);
1660 MoveLongword(ImagePixel^, ImagePixel2^, BmpCutout.Width);
1661 end;
1662
1663 // pre-multiply alphas in BmpCutout ...
1664 for Y := 0 to BmpCutout.Height - 1 do
1665 begin
1666 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
1667 for X := 0 to BmpCutout.Width - 1 do
1668 begin
1669 ImagePixel.R := DivTable[ImagePixel.R, ImagePixel.A];
1670 ImagePixel.G := DivTable[ImagePixel.G, ImagePixel.A];
1671 ImagePixel.B := DivTable[ImagePixel.B, ImagePixel.A];
1672 Inc(ImagePixel);
1673 end;
1674 end;
1675
1676 // Rotate BmpCutout into BmpRotated ...
1677 Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
1678 Affine.Rotate(180 - AngleDeg);
1679 with Affine.GetTransformedBounds do
1680 begin
1681 Mask.SetSize(Round(Right - Left) + 1, Round(Bottom - Top) + 1);
1682 BmpRotated.SetSize(Mask.Width, Mask.Height);
1683 Dx := Left; Dy := Top;
1684 Affine.Translate(-Dx, -Dy);
1685 end;
1686 Transform(BmpRotated, BmpCutout, Affine);
1687
1688 // Create a rotated mask ...
1689 Affine.Clear;
1690 Affine.Translate(-Bounds.Left, -Bounds.Top);
1691 Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
1692 Affine.Rotate(180 - AngleDeg);
1693 Affine.Translate(-Dx, -Dy);
1694 Pts := TransformPolygon(BlurRegion, Affine);
1695 PolygonFS(Mask, Pts, clWhite32);
1696 SetLength(Pixels, BmpRotated.Width);
1697
1698 // Now blur horizontally the rotated image ...
1699 for I := 1 to Passes do
1700 // Horizontal blur only ...
1701 for Y := 0 to BmpRotated.Height - 1 do
1702 begin
1703 ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
1704 // fill the Pixels buffer with a copy of the row's pixels ...
1705 for X := 0 to BmpRotated.Width - 1 do
1706 begin
1707 MaskClr.ARGB := Mask.Pixel[X, Y];
1708 if (MaskClr.A = 0) then
1709 begin
1710 Pixels[X].A := 0;
1711 Pixels[X].R := 0;
1712 Pixels[X].G := 0;
1713 Pixels[X].B := 0;
1714 Pixels[X].Sum := 0;
1715 end else
1716 with ImagePixel^ do
1717 begin
1718 Pixels[X].A := A;
1719 Pixels[X].R := R;
1720 Pixels[X].G := G;
1721 Pixels[X].B := B;
1722 Pixels[X].Sum := 1;
1723 end;
1724 Inc(ImagePixel);
1725 end;
1726
1727 LL := 0;
1728 RR := RadiusI;
1729 if RR >= BmpRotated.Width then RR := BmpRotated.Width - 1;
1730 ResetSumRecord(SumRec);
1731
1732 // update first in row ...
1733 for XX := LL to RR do
1734 with Pixels[XX] do
1735 begin
1736 Inc(SumRec.A, A);
1737 Inc(SumRec.R, R);
1738 Inc(SumRec.G, G);
1739 Inc(SumRec.B, B);
1740 Inc(SumRec.Sum, Sum);
1741 end;
1742
1743 ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
1744 MaskClr.ARGB := Mask.Pixel[0, Y];
1745 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
1746 ImagePixel^ := DivideToColor32(SumRec);
1747
1748 // update the remaining pixels in the row ...
1749 for X := 1 to BmpRotated.Width - 1 do
1750 begin
1751 Inc(ImagePixel);
1752 if Bidirectional then
1753 LL := X - RadiusI - 1
1754 else
1755 LL := X - 1;
1756 RR := X + RadiusI;
1757 if LL >= 0 then
1758 with Pixels[LL] do
1759 begin
1760 Dec(SumRec.A, A);
1761 Dec(SumRec.R, R);
1762 Dec(SumRec.G, G);
1763 Dec(SumRec.B, B);
1764 Dec(SumRec.Sum, Sum);
1765 end;
1766 if RR < BmpRotated.Width then
1767 with Pixels[RR] do
1768 begin
1769 Inc(SumRec.A, A);
1770 Inc(SumRec.R, R);
1771 Inc(SumRec.G, G);
1772 Inc(SumRec.B, B);
1773 Inc(SumRec.Sum, Sum);
1774 end;
1775
1776 MaskClr.ARGB := Mask.Pixel[X, Y];
1777
1778 if (SumRec.Sum = 0) or (MaskClr.A = 0) then
1779 Continue
1780 else if (I = Passes) then
1781 begin
1782 Clr := DivideToColor32(SumRec);
1783 BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
1784 end
1785 else if (MaskClr.A = 255) then
1786 ImagePixel^ := DivideToColor32(SumRec);
1787 end;
1788 EMMS;
1789 end;
1790
1791 // un-rotate the now blurred image back into BmpCutout ...
1792 Affine.Clear;
1793 Affine.SrcRect := FloatRect(BmpRotated.BoundsRect);
1794 Affine.Translate(Dx, Dy);
1795 Affine.Rotate(AngleDeg + 180);
1796 Transform(BmpCutout, BmpRotated, Affine);
1797
1798 // extract alphas ...
1799 for Y := 0 to BmpCutout.Height - 1 do
1800 begin
1801 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
1802 for X := 0 to BmpCutout.Width - 1 do
1803 begin
1804 ImagePixel.R := RcTable[ImagePixel.A, ImagePixel.R];
1805 ImagePixel.G := RcTable[ImagePixel.A, ImagePixel.G];
1806 ImagePixel.B := RcTable[ImagePixel.A, ImagePixel.B];
1807 Inc(ImagePixel);
1808 end;
1809 end;
1810
1811 // Create an un-rotated mask and copy masked pixels from BmpCutout
1812 // back to the original image (Bitmap32) ...
1813 Mask.SetSize(BmpCutout.Width, BmpCutout.Height);
1814 Pts := TranslatePolygon(BlurRegion, -Bounds.Left, -Bounds.Top);
1815 PolygonFS(Mask, Pts, clWhite32);
1816
1817 for Y := 0 to BmpCutout.Height - 1 do
1818 begin
1819 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
1820 ImagePixel2 := PColor32Entry(Mask.ScanLine[Y]);
1821 ImagePixel3 := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
1822 for X := 0 to BmpCutout.Width - 1 do
1823 begin
1824 if ImagePixel2.A > 0 then
1825 ImagePixel3.ARGB := ImagePixel.ARGB;
1826 Inc(ImagePixel);
1827 Inc(ImagePixel2);
1828 Inc(ImagePixel3);
1829 end;
1830 end;
1831
1832 finally
1833 Affine.Free;
1834 BmpCutout.Free;
1835 BmpRotated.Free;
1836 Mask.Free;
1837 end;
1838end;
1839
1840procedure MotionBlurGamma(Bitmap32: TBitmap32;
1841 Dist, AngleDeg: TFloat; Bidirectional: Boolean = True);
1842var
1843 Pts: TArrayOfFloatPoint;
1844begin
1845 SetLength(Pts, 4);
1846 with Bitmap32.BoundsRect do
1847 begin
1848 Pts[0] := FloatPoint(Left, Top);
1849 Pts[1] := FloatPoint(Right, Top);
1850 Pts[2] := FloatPoint(Right, Bottom);
1851 Pts[3] := FloatPoint(Left, Bottom);
1852 end;
1853 MotionBlurGamma(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
1854end;
1855
1856procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
1857 const Bounds: TRect; Bidirectional: Boolean = True);
1858var
1859 Pts: TArrayOfFloatPoint;
1860begin
1861 SetLength(Pts, 4);
1862 with Bounds do
1863 begin
1864 Pts[0] := FloatPoint(Left, Top);
1865 Pts[1] := FloatPoint(Right, Top);
1866 Pts[2] := FloatPoint(Right, Bottom);
1867 Pts[3] := FloatPoint(Left, Bottom);
1868 end;
1869 MotionBlurGamma(Bitmap32, Dist, AngleDeg, Pts, Bidirectional);
1870end;
1871
1872procedure MotionBlurGamma(Bitmap32: TBitmap32; Dist, AngleDeg: TFloat;
1873 const BlurRegion: TArrayOfFloatPoint; Bidirectional: Boolean = True);
1874var
1875 LL, RR, XX, I, X, Y, RadiusI, Passes: Integer;
1876 ImagePixel, ImagePixel2, ImagePixel3: PColor32Entry;
1877 ImagePixels, ImagePixels2: PColor32EntryArray;
1878 SumRec: TSumRecord;
1879 Pixels: array of TSumRecord;
1880 Mask: TBitmap32;
1881 Clr, MaskClr: TColor32Entry;
1882 Pts: TArrayOfFloatPoint;
1883 Bounds: TRect;
1884 Dx, Dy: Double;
1885 Affine: TAffineTransformation;
1886 BmpCutout: TBitmap32;
1887 BmpRotated: TBitmap32;
1888 PrevIsBlank, ThisIsBlank: boolean;
1889begin
1890 if Dist < 1 then
1891 Exit
1892 else if Dist > 256 then
1893 Dist := 256;
1894
1895 RadiusI := Round(Sqrt(-Dist * Dist / (2 * Ln(COne255th))));
1896 if RadiusI < 2 then
1897 begin
1898 Passes := Round(Dist);
1899 RadiusI := 1;
1900 end else
1901 Passes := 3;
1902
1903
1904 with PolygonBounds(BlurRegion) do
1905 Bounds := Rect(Floor(Left), Floor(Top), Ceil(Right), Ceil(Bottom));
1906 Bounds.Left := Max(Bounds.Left, 0);
1907 Bounds.Top := Max(Bounds.Top, 0);
1908 Bounds.Right := Min(Bounds.Right, Bitmap32.Width - 1);
1909 Bounds.Bottom := Min(Bounds.Bottom, Bitmap32.Height - 1);
1910
1911 Affine := TAffineTransformation.Create;
1912 BmpCutout := TBitmap32.Create;
1913 BmpRotated := TBitmap32.Create;
1914 BmpRotated.Resampler := TLinearResampler.Create(BmpRotated);
1915 Mask := TBitmap32.Create;
1916 try
1917 // copy the region to be blurred into the BmpCutout image buffer ...
1918 BmpCutout.SetSize(Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top);
1919 for Y := 0 to BmpCutout.Height - 1 do
1920 begin
1921 ImagePixel := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
1922 ImagePixel2 := PColor32Entry(BmpCutout.ScanLine[Y]);
1923 MoveLongword(ImagePixel^, ImagePixel2^, BmpCutout.Width);
1924 end;
1925
1926 // pre-multiply alphas in BmpCutout ...
1927 for Y := 0 to BmpCutout.Height - 1 do
1928 begin
1929 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
1930 for X := 0 to BmpCutout.Width - 1 do
1931 begin
1932 ImagePixel.R := DivTable[GAMMA_DECODING_TABLE[ImagePixel.R], ImagePixel.A];
1933 ImagePixel.G := DivTable[GAMMA_DECODING_TABLE[ImagePixel.G], ImagePixel.A];
1934 ImagePixel.B := DivTable[GAMMA_DECODING_TABLE[ImagePixel.B], ImagePixel.A];
1935 Inc(ImagePixel);
1936 end;
1937 end;
1938
1939 // Rotate BmpCutout into BmpRotated ...
1940 Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
1941 Affine.Rotate(180 - AngleDeg);
1942 with Affine.GetTransformedBounds do
1943 begin
1944 Mask.SetSize(Round(Right - Left) + 1, Round(Bottom - Top) + 1);
1945 BmpRotated.SetSize(Mask.Width, Mask.Height);
1946 Dx := Left; Dy := Top;
1947 Affine.Translate(-Dx, -Dy);
1948 end;
1949 Transform(BmpRotated, BmpCutout, Affine);
1950
1951 // Create a rotated mask ...
1952 Affine.Clear;
1953 Affine.Translate(-Bounds.Left, -Bounds.Top);
1954 Affine.SrcRect := FloatRect(BmpCutout.BoundsRect);
1955 Affine.Rotate(180 - AngleDeg);
1956 Affine.Translate(-Dx, -Dy);
1957 Pts := TransformPolygon(BlurRegion, Affine);
1958 PolygonFS(Mask, Pts, clWhite32);
1959 SetLength(Pixels, BmpRotated.Width);
1960
1961 // Now blur horizontally the rotated image ...
1962 for I := 1 to Passes do
1963 // Horizontal blur only ...
1964 for Y := 0 to BmpRotated.Height - 1 do
1965 begin
1966 ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
1967 // fill the Pixels buffer with a copy of the row's pixels ...
1968 for X := 0 to BmpRotated.Width - 1 do
1969 begin
1970 MaskClr.ARGB := Mask.Pixel[X, Y];
1971 if (MaskClr.A = 0) then
1972 begin
1973 Pixels[X].A := 0;
1974 Pixels[X].R := 0;
1975 Pixels[X].G := 0;
1976 Pixels[X].B := 0;
1977 Pixels[X].Sum := 0;
1978 end else
1979 with ImagePixel^ do
1980 begin
1981 Pixels[X].A := A;
1982 Pixels[X].R := R;
1983 Pixels[X].G := G;
1984 Pixels[X].B := B;
1985 Pixels[X].Sum := 1;
1986 end;
1987 Inc(ImagePixel);
1988 end;
1989
1990 LL := 0;
1991 RR := RadiusI;
1992 if RR >= BmpRotated.Width then RR := BmpRotated.Width - 1;
1993 ResetSumRecord(SumRec);
1994
1995 // update first in row ...
1996 for XX := LL to RR do
1997 with Pixels[XX] do
1998 begin
1999 Inc(SumRec.A, A);
2000 Inc(SumRec.R, R);
2001 Inc(SumRec.G, G);
2002 Inc(SumRec.B, B);
2003 Inc(SumRec.Sum, Sum);
2004 end;
2005
2006 ImagePixel := PColor32Entry(BmpRotated.ScanLine[Y]);
2007 MaskClr.ARGB := Mask.Pixel[0, Y];
2008 if (MaskClr.A > 0) and (SumRec.Sum > 0) then
2009 ImagePixel^ := DivideToColor32(SumRec);
2010
2011 // update the remaining pixels in the row ...
2012 for X := 1 to BmpRotated.Width - 1 do
2013 begin
2014 Inc(ImagePixel);
2015 if Bidirectional then
2016 LL := X - RadiusI - 1
2017 else
2018 LL := X - 1;
2019 RR := X + RadiusI;
2020 if LL >= 0 then
2021 with Pixels[LL] do
2022 begin
2023 Dec(SumRec.A, A);
2024 Dec(SumRec.R, R);
2025 Dec(SumRec.G, G);
2026 Dec(SumRec.B, B);
2027 Dec(SumRec.Sum, Sum);
2028 end;
2029 if RR < BmpRotated.Width then
2030 with Pixels[RR] do
2031 begin
2032 Inc(SumRec.A, A);
2033 Inc(SumRec.R, R);
2034 Inc(SumRec.G, G);
2035 Inc(SumRec.B, B);
2036 Inc(SumRec.Sum, Sum);
2037 end;
2038
2039 MaskClr.ARGB := Mask.Pixel[X, Y];
2040
2041 if (SumRec.Sum = 0) or (MaskClr.A = 0) then
2042 Continue
2043 else if (I = Passes) then
2044 begin
2045 Clr := DivideToColor32(SumRec);
2046 BlendMemEx(Clr.ARGB, ImagePixel^.ARGB, MaskClr.A);
2047 end
2048 else if (MaskClr.A = 255) then
2049 ImagePixel^ := DivideToColor32(SumRec);
2050 end;
2051 EMMS;
2052 end;
2053
2054 // un-rotate the now blurred image back into BmpCutout ...
2055 Affine.Clear;
2056 Affine.SrcRect := FloatRect(BmpRotated.BoundsRect);
2057 Affine.Translate(Dx, Dy);
2058 Affine.Rotate(AngleDeg + 180);
2059 Transform(BmpCutout, BmpRotated, Affine);
2060
2061 // extract alphas ...
2062 for Y := 0 to BmpCutout.Height - 1 do
2063 begin
2064 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
2065 for X := 0 to BmpCutout.Width - 1 do
2066 begin
2067 ImagePixel.R := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.R]];
2068 ImagePixel.G := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.G]];
2069 ImagePixel.B := GAMMA_ENCODING_TABLE[RcTable[ImagePixel.A, ImagePixel.B]];
2070 Inc(ImagePixel);
2071 end;
2072 end;
2073
2074 // Create an un-rotated mask and copy masked pixels from BmpCutout
2075 // back to the original image (Bitmap32) ...
2076 Mask.SetSize(BmpCutout.Width, BmpCutout.Height);
2077 Pts := TranslatePolygon(BlurRegion, -Bounds.Left, -Bounds.Top);
2078 PolygonFS(Mask, Pts, clWhite32);
2079
2080 for Y := 0 to BmpCutout.Height - 1 do
2081 begin
2082 ImagePixel := PColor32Entry(BmpCutout.ScanLine[Y]);
2083 ImagePixel2 := PColor32Entry(Mask.ScanLine[Y]);
2084 ImagePixel3 := PColor32Entry(@Bitmap32.ScanLine[Y + Bounds.Top][Bounds.Left]);
2085 for X := 0 to BmpCutout.Width - 1 do
2086 begin
2087 if ImagePixel2.A > 0 then
2088 ImagePixel3.ARGB := ImagePixel.ARGB;
2089 Inc(ImagePixel);
2090 Inc(ImagePixel2);
2091 Inc(ImagePixel3);
2092 end;
2093 end;
2094
2095 finally
2096 Affine.Free;
2097 BmpCutout.Free;
2098 BmpRotated.Free;
2099 Mask.Free;
2100 end;
2101end;
2102
2103end.
Note: See TracBrowser for help on using the repository browser.