source: trunk/Packages/bgrabitmap/bgrafilterblur.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 21.9 KB
Line 
1unit BGRAFilterBlur;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, BGRABitmapTypes, BGRAFilterType;
9
10type
11 { TCustomBlurTask }
12
13 TCustomBlurTask = class(TFilterTask)
14 private
15 FBounds: TRect;
16 FMask: TBGRACustomBitmap;
17 FMaskOwned: boolean;
18 public
19 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false);
20 destructor Destroy; override;
21 protected
22 procedure DoExecute; override;
23 end;
24
25 { TRadialBlurTask }
26
27 TRadialBlurTask = class(TFilterTask)
28 private
29 FBounds: TRect;
30 FRadiusX,FRadiusY: single;
31 FBlurType: TRadialBlurType;
32 public
33 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single;
34 blurType: TRadialBlurType); overload;
35 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single;
36 blurType: TRadialBlurType); overload;
37 protected
38 procedure DoExecute; override;
39 end;
40
41 { TMotionBlurTask }
42
43 TMotionBlurTask = class(TFilterTask)
44 private
45 FBounds: TRect;
46 FDistance,FAngle: single;
47 FOriented: boolean;
48 public
49 constructor Create(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance, AAngle: single; AOriented: boolean);
50 protected
51 procedure DoExecute; override;
52 end;
53
54implementation
55
56uses Types, Math, SysUtils;
57
58procedure FilterBlur(bmp: TBGRACustomBitmap; ABounds: TRect;
59 blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; overload;
60procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single;
61 angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; overload;
62procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single;
63 blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; overload;
64
65type
66 { TBoxBlurTask }
67
68 TBoxBlurTask = class(TFilterTask)
69 private
70 FBounds: TRect;
71 FRadiusX,FRadiusY: single;
72 public
73 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single); overload;
74 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single); overload;
75 protected
76 {$IFNDEF CPU64}
77 procedure DoExecuteNormal;
78 {$ENDIF}
79 procedure DoExecute64;
80 procedure DoExecute; override;
81 end;
82
83{ TCustomBlurTask }
84
85constructor TCustomBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
86 AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean);
87begin
88 SetSource(bmp);
89 FBounds := ABounds;
90 if AMaskIsThreadSafe then
91 begin
92 FMask := AMask;
93 FMaskOwned := false;
94 end else
95 begin
96 FMask := AMask.Duplicate;
97 FMaskOwned := true;
98 end;
99end;
100
101destructor TCustomBlurTask.Destroy;
102begin
103 If FMaskOwned then FreeAndNil(FMask);
104 inherited Destroy;
105end;
106
107procedure TCustomBlurTask.DoExecute;
108begin
109 FilterBlur(FSource,FBounds,FMask,Destination,@GetShouldStop);
110end;
111
112{ TMotionBlurTask }
113
114constructor TMotionBlurTask.Create(ABmp: TBGRACustomBitmap; ABounds: TRect;
115 ADistance, AAngle: single; AOriented: boolean);
116begin
117 SetSource(ABmp);
118 FBounds := ABounds;
119 FDistance := ADistance;
120 FAngle := AAngle;
121 FOriented:= AOriented;
122end;
123
124procedure TMotionBlurTask.DoExecute;
125begin
126 FilterBlurMotion(FSource,FBounds,FDistance,FAngle,FOriented,Destination,@GetShouldStop);
127end;
128
129{ TRadialBlurTask }
130
131constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
132 radius: single; blurType: TRadialBlurType);
133begin
134 SetSource(bmp);
135 FBounds := ABounds;
136 FRadiusX := radius;
137 FRadiusY := radius;
138 FBlurType:= blurType;
139end;
140
141constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
142 radiusX, radiusY: single; blurType: TRadialBlurType);
143begin
144 SetSource(bmp);
145 FBounds := ABounds;
146 FRadiusX := radiusX;
147 FRadiusY := radiusY;
148 FBlurType:= blurType;
149end;
150
151procedure TRadialBlurTask.DoExecute;
152begin
153 FilterBlurRadial(FSource,FBounds,FRadiusX,FRadiusY,FBlurType,Destination,@GetShouldStop);
154end;
155
156function FilterBlurBox(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single;
157 ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc=nil): TBGRACustomBitmap;
158var task: TBoxBlurTask;
159begin
160 task := TBoxBlurTask.Create(bmp, ABounds, radiusX,radiusY);
161 task.CheckShouldStop := ACheckShouldStop;
162 task.Destination := ADestination;
163 result := task.Execute;
164 task.Free;
165end;
166
167{ This is a clever solution for fast computing of the blur
168 effect : it stores an array of vertical sums forming a square
169 around the pixel which moves with it. For each new pixel,
170 the vertical sums are kept except for the last column of
171 the square }
172procedure FilterBlurFast(bmp: TBGRACustomBitmap; ABounds: TRect;
173 radiusX,radiusY: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
174 {$IFDEF CPU64}{$DEFINE FASTBLUR_DOUBLE}{$ENDIF}
175 type
176 PRowSum = ^TRowSum;
177 TRowSum = record
178 sumR,sumG,sumB,rgbDiv,sumA,aDiv: NativeUInt;
179 end;
180 TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF};
181 TExtendedRowSum = record
182 sumR,sumG,sumB,rgbDiv,sumA,aDiv: TExtendedRowValue;
183 end;
184
185 function ComputeExtendedAverage(const sum: TExtendedRowSum): TBGRAPixel; inline;
186 {$IFDEF FASTBLUR_DOUBLE}
187 var v: uint32or64;
188 {$ELSE}
189 var rgbDivShr1: TExtendedRowValue;
190 {$ENDIF}
191 begin
192 {$IFDEF FASTBLUR_DOUBLE}
193 v := round(sum.sumA/sum.aDiv);
194 if v > 255 then result.alpha := 255 else result.alpha := v;
195 v := round(sum.sumR/sum.rgbDiv);
196 if v > 255 then result.red := 255 else result.red := v;
197 v := round(sum.sumG/sum.rgbDiv);
198 if v > 255 then result.green := 255 else result.green := v;
199 v := round(sum.sumB/sum.rgbDiv);
200 if v > 255 then result.blue := 255 else result.blue := v;
201 {$ELSE}
202 rgbDivShr1:= sum.rgbDiv shr 1;
203 DWord(result) := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift)
204 or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift)
205 or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift)
206 or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift);
207 {$ENDIF}
208 end;
209
210 function ComputeClampedAverage(const sum: TRowSum): TBGRAPixel;
211 var v: UInt32or64;
212 begin
213 v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv;
214 if v > 255 then result.alpha := 255 else result.alpha := v;
215 v := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv;
216 if v > 255 then result.red := 255 else result.red := v;
217 v := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv;
218 if v > 255 then result.green := 255 else result.green := v;
219 v := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv;
220 if v > 255 then result.blue := 255 else result.blue := v;
221 end;
222
223 function ComputeAverage(const sum: TRowSum): TBGRAPixel; inline;
224 var rgbDivShr1: NativeUInt;
225 begin
226 rgbDivShr1:= sum.rgbDiv shr 1;
227 DWord(result) := (((sum.sumA+sum.aDiv shr 1) div sum.aDiv) shl TBGRAPixel_AlphaShift)
228 or (((sum.sumR+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_RedShift)
229 or (((sum.sumG+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_GreenShift)
230 or (((sum.sumB+rgbDivShr1) div sum.rgbDiv) shl TBGRAPixel_BlueShift);
231 end;
232
233 {$I blurfast.inc}
234
235{ Normal radial blur compute a blur mask with a GradientFill and
236 then posterize to optimize general purpose blur }
237procedure FilterBlurRadialNormal(bmp: TBGRACustomBitmap;
238 ABounds: TRect; radiusX,radiusY: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
239var
240 blurShape: TBGRACustomBitmap;
241 n: Int32or64;
242 p: PBGRAPixel;
243 maxRadius: single;
244 temp: TBGRACustomBitmap;
245begin
246 if (radiusX <= 0) and (radiusY <= 0) then
247 begin
248 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
249 exit;
250 end;
251 maxRadius:= max(radiusX,radiusY);
252 blurShape := bmp.NewBitmap(2 * ceil(maxRadius) + 1, 2 * ceil(maxRadius) + 1);
253 blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite,
254 BGRABlack, gtRadial, pointF(ceil(maxRadius), ceil(maxRadius)), pointF(ceil(maxRadius)-maxRadius-0.5, ceil(maxRadius)), dmSet);
255 if (ceil(radiusX)<>ceil(radiusY)) then
256 begin
257 temp := blurShape.Resample(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1);
258 blurShape.Free;
259 blurShape := temp;
260 temp := nil;
261 end;
262 if (radiusX > 10) or (radiusY > 10) then
263 begin
264 p := blurShape.Data;
265 for n := 0 to blurShape.NbPixels-1 do
266 begin
267 p^.red := p^.red and $F0;
268 p^.green := p^.red;
269 p^.blue := p^.red;
270 inc(p);
271 end;
272 end;
273 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
274 blurShape.Free;
275end;
276
277{ Blur disk creates a disk mask with a FillEllipse }
278procedure FilterBlurDisk(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
279var
280 blurShape: TBGRACustomBitmap;
281begin
282 if (radiusX <= 0) and (radiusY <= 0) then
283 begin
284 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
285 exit;
286 end;
287 blurShape := bmp.NewBitmap(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1);
288 blurShape.Fill(BGRABlack);
289 blurShape.FillEllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX + 0.5, radiusY + 0.5, BGRAWhite);
290 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
291 blurShape.Free;
292end;
293
294{ Corona blur use a circle as mask }
295procedure FilterBlurCorona(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
296var
297 blurShape: TBGRACustomBitmap;
298begin
299 if (radiusX <= 0) and (radiusY <= 0) then
300 begin
301 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
302 exit;
303 end;
304 blurShape := bmp.NewBitmap(2 * ceil(radiusX) + 1, 2 * ceil(radiusY) + 1);
305 blurShape.Fill(BGRABlack);
306 blurShape.EllipseAntialias(ceil(radiusX), ceil(radiusY), radiusX, radiusY, BGRAWhite, 1);
307 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
308 blurShape.Free;
309end;
310
311procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single;
312 blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); overload;
313begin
314 if radius = 0 then
315 begin
316 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
317 exit;
318 end;
319 case blurType of
320 rbCorona: FilterBlurCorona(bmp, ABounds, radius,radius, ADestination, ACheckShouldStop);
321 rbDisk: FilterBlurDisk(bmp, ABounds, radius,radius, ADestination, ACheckShouldStop);
322 rbNormal: FilterBlurRadialNormal(bmp, ABounds, radius,radius, ADestination, ACheckShouldStop);
323 rbFast: FilterBlurFast(bmp, ABounds, radius,radius, ADestination, ACheckShouldStop);
324 rbPrecise: FilterBlurRadialNormal(bmp, ABounds, radius / 10 + 0.5, radius / 10 + 0.5, ADestination, ACheckShouldStop);
325 rbBox: FilterBlurBox(bmp, ABounds, radius,radius, ADestination, ACheckShouldStop);
326 end;
327end;
328
329procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radiusX,radiusY: single;
330 blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
331begin
332 if (radiusX <= 0) and (radiusY <= 0) then
333 begin
334 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
335 exit;
336 end;
337 if radiusX < 0 then radiusX := 0;
338 if radiusY < 0 then radiusY := 0;
339 case blurType of
340 rbCorona: FilterBlurCorona(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop);
341 rbDisk: FilterBlurDisk(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop);
342 rbNormal: FilterBlurRadialNormal(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop);
343 rbFast: FilterBlurFast(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop);
344 rbPrecise: FilterBlurRadialNormal(bmp, ABounds, radiusX / 10 + 0.5, radiusY/10 + 0.5, ADestination, ACheckShouldStop);
345 rbBox: FilterBlurBox(bmp, ABounds, radiusX,radiusY, ADestination, ACheckShouldStop);
346 end;
347end;
348
349function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
350begin
351 if blurType = rbBox then
352 begin
353 result := FilterBlurBox(bmp,rect(0,0,bmp.Width,bmp.Height),radius,radius,nil);
354 end else
355 begin
356 result := bmp.NewBitmap(bmp.width,bmp.Height);
357 FilterBlurRadial(bmp, rect(0,0,bmp.Width,bmp.height), radius, blurType,result,nil);
358 end;
359end;
360
361function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single;
362 radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
363begin
364 if blurType = rbBox then
365 begin
366 result := FilterBlurBox(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,nil);
367 end else
368 begin
369 result := bmp.NewBitmap(bmp.width,bmp.Height);
370 FilterBlurRadial(bmp, rect(0,0,bmp.Width,bmp.height), radiusX,radiusY, blurType,result,nil);
371 end;
372end;
373
374function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single;
375 ABlurType: TRadialBlurType): TFilterTask; overload;
376begin
377 if ABlurType = rbBox then
378 result := TBoxBlurTask.Create(ABmp,ABounds,ARadius)
379 else
380 result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType);
381end;
382
383function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
384 ARadiusX, ARadiusY: single; ABlurType: TRadialBlurType): TFilterTask; overload;
385begin
386 if ABlurType = rbBox then
387 result := TBoxBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY)
388 else
389 result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType);
390end;
391
392{ This filter draws an antialiased line to make the mask, and
393 if the motion blur is oriented, does a GradientFill to orient it }
394procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single;
395 angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
396var
397 blurShape: TBGRACustomBitmap;
398 intRadius: integer;
399 dx, dy, r: single;
400begin
401 if distance < 1e-6 then
402 begin
403 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet);
404 exit;
405 end;
406 dx := cos(angle * Pi / 180);
407 dy := sin(angle * Pi / 180);
408 if not oriented and (abs(dx)<1e-6) then
409 FilterBlurBox(bmp, ABounds,0,distance/2, ADestination, ACheckShouldStop)
410 else if not oriented and (abs(dy)<1e-6) then
411 FilterBlurBox(bmp, ABounds,distance/2,0, ADestination, ACheckShouldStop)
412 else
413 begin
414 r := distance / 2;
415 intRadius := ceil(r);
416 blurShape := bmp.NewBitmap(2 * intRadius + 1, 2 * intRadius + 1);
417
418 blurShape.Fill(BGRABlack);
419 blurShape.DrawLineAntialias(intRadius - dx * r, intRadius - dy *
420 r, intRadius + dx * r, intRadius + dy * r, BGRAWhite, 1, True);
421 if oriented then
422 blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height,
423 BGRAPixelTransparent, BGRABlack, gtRadial, pointF(intRadius -
424 dx * r, intRadius - dy * r),
425 pointF(intRadius + dx * (r + 0.5), intRadius + dy * (r + 0.5)),
426 dmFastBlend, False);
427 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop);
428 blurShape.Free;
429 end;
430end;
431
432function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;
433 angle: single; oriented: boolean): TBGRACustomBitmap; overload;
434begin
435 result := bmp.NewBitmap(bmp.Width,bmp.Height);
436 FilterBlurMotion(bmp,rect(0,0,bmp.Width,bmp.Height),distance,angle,oriented,result,nil);
437end;
438
439function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
440 ADistance, AAngle: single; AOriented: boolean): TFilterTask;
441begin
442 result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented);
443end;
444
445{ General purpose blur : compute pixel sum according to the mask and then
446 compute only difference while scanning from the left to the right }
447procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap;
448 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
449procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
450 blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
451procedure FilterBlurBigMask(bmp: TBGRACustomBitmap;
452 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
453procedure FilterBlurMask64(bmp: TBGRACustomBitmap;
454 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward;
455
456//make sure value is in the range 0..255
457function clampByte(value: NativeInt): NativeUInt; inline;
458begin
459 if value <= 0 then result := 0 else
460 if value >= 255 then result := 255 else
461 result := value;
462end;
463
464function FilterBlur(bmp: TBGRACustomBitmap; blurMask: TBGRACustomBitmap): TBGRACustomBitmap; overload;
465begin
466 result := bmp.NewBitmap(bmp.Width,bmp.Height);
467 FilterBlur(bmp,rect(0,0,bmp.Width,bmp.Height),blurMask,result,nil);
468end;
469
470function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
471 AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean): TFilterTask;
472begin
473 result := TCustomBlurTask.Create(ABmp,ABounds,AMask,AMaskIsThreadSafe);
474end;
475
476procedure FilterBlur(bmp: TBGRACustomBitmap;
477 ABounds: TRect; blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
478{$IFDEF CPU64}
479begin
480 FilterBlurMask64(bmp,blurMask,ABounds,ADestination,ACheckShouldStop);
481end;
482{$ELSE}
483var
484 maskSum: int64;
485 i: Int32or64;
486 p: PBGRAPixel;
487 maskShift: integer;
488begin
489 maskSum := 0;
490 p := blurMask.data;
491 for i := 0 to blurMask.NbPixels-1 do
492 begin
493 inc(maskSum,p^.red);
494 inc(p);
495 end;
496 maskShift := 0;
497 while maskSum > 32768 do
498 begin
499 inc(maskShift);
500 maskSum := maskSum shr 1;
501 end;
502 //check if sum can be stored in a 32-bit signed integer
503 if maskShift = 0 then
504 FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else
505 {$IFDEF CPU32}
506 if maskShift < 8 then
507 FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else
508 {$ENDIF}
509 FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop);
510end;
511{$ENDIF}
512
513//32-bit blur with shift
514procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;
515 blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
516
517 var
518 sumR, sumG, sumB, sumA, Adiv, RGBdiv : NativeInt;
519
520 function ComputeAverage: TBGRAPixel; inline;
521 var temp,rgbDivShr1: NativeInt;
522 begin
523 temp := sumA + Adiv shr 1;
524 if temp < Adiv then
525 result := BGRAPixelTransparent
526 else
527 begin
528 rgbDivShr1 := RGBdiv shr 1;
529 result.alpha := temp div Adiv;
530 result.red := clampByte((sumR + rgbDivShr1) div RGBdiv);
531 result.green := clampByte((sumG + rgbDivShr1) div RGBdiv);
532 result.blue := clampByte((sumB + rgbDivShr1) div RGBdiv);
533 end;
534 end;
535
536 {$define PARAM_MASKSHIFT}
537 {$I blurnormal.inc}
538
539//32-bit blur
540procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap;
541 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
542
543 var
544 sumR, sumG, sumB, sumA, Adiv : NativeInt;
545
546 function ComputeAverage: TBGRAPixel; inline;
547 var temp,sumAShr1: NativeInt;
548 begin
549 temp := sumA + Adiv shr 1;
550 if temp < Adiv then
551 result := BGRAPixelTransparent
552 else
553 begin
554 sumAShr1 := sumA shr 1;
555 result.alpha := temp div Adiv;
556 result.red := clampByte((sumR + sumAShr1) div sumA);
557 result.green := clampByte((sumG + sumAShr1) div sumA);
558 result.blue := clampByte((sumB + sumAShr1) div sumA);
559 end;
560 end;
561
562 {$I blurnormal.inc}
563
564//64-bit blur
565procedure FilterBlurMask64(bmp: TBGRACustomBitmap;
566 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
567
568 var
569 sumR, sumG, sumB, sumA, Adiv : int64;
570
571 function ComputeAverage: TBGRAPixel; inline;
572 begin
573 result.alpha := (sumA + Adiv shr 1) div Adiv;
574 if result.alpha = 0 then
575 result := BGRAPixelTransparent
576 else
577 begin
578 result.red := clampByte((sumR + sumA shr 1) div sumA);
579 result.green := clampByte((sumG + sumA shr 1) div sumA);
580 result.blue := clampByte((sumB + sumA shr 1) div sumA);
581 end;
582 end;
583
584 {$I blurnormal.inc}
585
586//floating point blur
587procedure FilterBlurBigMask(bmp: TBGRACustomBitmap;
588 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc);
589
590 var
591 sumR, sumG, sumB, sumA, Adiv : single;
592
593 function ComputeAverage: TBGRAPixel; inline;
594 begin
595 result.alpha := round(sumA/Adiv);
596 if result.alpha = 0 then
597 result := BGRAPixelTransparent
598 else
599 begin
600 result.red := clampByte(round(sumR/sumA));
601 result.green := clampByte(round(sumG/sumA));
602 result.blue := clampByte(round(sumB/sumA));
603 end;
604 end;
605
606 {$I blurnormal.inc}
607
608constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
609 radius: single);
610begin
611 SetSource(bmp);
612 FBounds := ABounds;
613 FRadiusX := radius;
614 FRadiusY := radius;
615end;
616
617constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect;
618 radiusX, radiusY: single);
619begin
620 SetSource(bmp);
621 FBounds := ABounds;
622 FRadiusX := max(radiusX,0);
623 FRadiusY := max(radiusY,0);
624end;
625
626procedure TBoxBlurTask.DoExecute64;
627const
628 factMainX = 16;
629 factMainY = 16;
630type
631 TAccumulator = UInt64;
632{$i blurbox.inc}
633
634{$IFNDEF CPU64}
635procedure TBoxBlurTask.DoExecuteNormal;
636const
637 factMainX = 16;
638 factMainY = 16;
639type
640 TAccumulator = NativeUInt;
641{$i blurbox.inc}
642{$ENDIF}
643
644procedure TBoxBlurTask.DoExecute;
645{$IFDEF CPU64}
646begin
647 DoExecute64;
648end;
649{$ELSE}
650const
651 factMainX = 16;
652 factMainY = 16;
653var totalSum: UInt64;
654 factExtraX,factExtraY: NativeUInt;
655begin
656 totalSum := (2*ceil(FRadiusX)+1)*(2*ceil(FRadiusY)+1);
657 factExtraX := trunc(frac(FRadiusX+0.5/factMainX)*factMainX);
658 factExtraY := trunc(frac(FRadiusY+0.5/factMainY)*factMainY);
659 if factExtraX > 0 then totalSum *= factMainX;
660 if factExtraY > 0 then totalSum *= factMainY;
661 totalSum *= 256*256;
662 if totalSum > high(NativeUInt) then
663 DoExecute64
664 else
665 DoExecuteNormal;
666end;
667{$ENDIF}
668
669end.
670
Note: See TracBrowser for help on using the repository browser.