source: trunk/Packages/bgrabitmap/bgrafilters.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 33.1 KB
Line 
1unit BGRAFilters;
2
3{$mode objfpc}{$H+}
4
5interface
6
7{ Here are some filters that can be applied to a bitmap. The filters
8 take a source image as a parameter and gives a filtered image as
9 a result. }
10
11uses
12 Classes, BGRABitmapTypes, BGRAFilterType, BGRAFilterBlur;
13
14type
15 TFilterTask = BGRAFilterType.TFilterTask;
16
17/////////////////////// PIXELWISE FILTERS ////////////////////////////////
18type
19 { TGrayscaleTask }
20 { Grayscale converts colored pixel into grayscale with same luminosity }
21 TGrayscaleTask = class(TFilterTask)
22 private
23 FBounds: TRect;
24 public
25 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect);
26 protected
27 procedure DoExecute; override;
28 end;
29
30{ Grayscale converts colored pixel into grayscale with same luminosity }
31function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; overload;
32function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; overload;
33function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
34
35{ Normalize use the whole available range of values, making dark colors darkest possible
36 and light colors lightest possible }
37function FilterNormalize(bmp: TBGRACustomBitmap;
38 eachChannel: boolean = True): TBGRACustomBitmap; overload;
39function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
40 eachChannel: boolean = True): TBGRACustomBitmap; overload;
41
42////////////////////// 3X3 FILTERS ////////////////////////////////////////////
43
44{ Sharpen filter add more contrast between pixels }
45function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap; overload;
46function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; overload;
47
48{ Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil }
49function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
50
51{ Emboss filter compute a color difference in the angle direction }
52function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload;
53function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer= 64; AOptions: TEmbossOptions = []): TBGRACustomBitmap; overload;
54
55{ Emboss highlight computes a sort of emboss with 45 degrees angle and
56 with standard selection color (white/black and filled with blue) }
57function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
58 FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
59function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
60 FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
61
62{ The median filter consist in calculating the median value of pixels. Here
63 a square of 9x9 pixel is considered. The median allow to select the most
64 representative colors. The option parameter allow to choose to smooth the
65 result or not. }
66function FilterMedian(bmp: TBGRACustomBitmap; Option: TMedianOption): TBGRACustomBitmap;
67
68//////////////////////// DEFORMATION FILTERS /////////////////////////////////
69
70{ Distort the image as if it were on a sphere }
71function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
72
73{ Twirl distortion, i.e. a progressive rotation }
74function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload;
75function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; overload;
76
77{ Distort the image as if it were on a vertical cylinder }
78function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
79
80{ Compute a plane projection towards infinity (SLOW) }
81function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
82
83{ Rotate filter rotate the image and clip it in the bounding rectangle }
84function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
85 angle: single; correctBlur: boolean = false): TBGRACustomBitmap;
86
87///////////////////////// BLUR FILTERS //////////////////////////////////////
88
89{ A radial blur applies a blur with a circular influence, i.e, each pixel
90 is merged with pixels within the specified radius. There is an exception
91 with rbFast blur, the optimization entails an hyperbolic shape. }
92type TRadialBlurTask = BGRAFilterBlur.TRadialBlurTask;
93function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
94function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap; overload;
95function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload;
96function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask; overload;
97
98{ The precise blur allow to specify the blur radius with subpixel accuracy }
99function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; deprecated 'Use FilterBlurRadial with blurType:=rbPrecise and radius multiplied by 10';
100function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask; deprecated 'Use CreateRadialBlurTask with blurType:=rbPrecise and radius multiplied by 10';
101
102{ Motion blur merge pixels in a direction. The oriented parameter specifies
103 if the weights of the pixels are the same along the line or not. }
104type TMotionBlurTask = BGRAFilterBlur.TMotionBlurTask;
105function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
106function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TMotionBlurTask;
107
108{ General purpose blur filter, with a blur mask as parameter to describe
109 how pixels influence each other }
110function FilterBlur(bmp: TBGRACustomBitmap; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
111function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
112
113////////////////////////////// OTHER FILTERS /////////////////////////////////
114
115{ SmartZoom x3 is a filter that upsizes 3 times the picture and add
116 pixels that could be logically expected (horizontal, vertical, diagonal lines) }
117function FilterSmartZoom3(bmp: TBGRACustomBitmap;
118 Option: TMedianOption): TBGRACustomBitmap;
119
120function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap;
121
122implementation
123
124uses Math, BGRATransform, Types, SysUtils, BGRAFilterScanner;
125
126/////////////////////// PIXELWISE FILTERS ////////////////////////////////
127
128{ TGrayscaleTask }
129
130constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect);
131begin
132 SetSource(bmp);
133 FBounds := ABounds;
134end;
135
136procedure TGrayscaleTask.DoExecute;
137var
138 yb: LongInt;
139begin
140 if IsRectEmpty(FBounds) then exit;
141 for yb := FBounds.Top to FBounds.bottom - 1 do
142 begin
143 if GetShouldStop(yb) then break;
144 TBGRAFilterScannerGrayscale.ComputeFilterAt(FSource.scanline[yb] + FBounds.left,
145 Destination.scanline[yb] + FBounds.left, FBounds.right-FBounds.left, true);
146 end;
147 Destination.InvalidateBitmap;
148end;
149
150{ Filter grayscale applies BGRAToGrayscale function to all pixels }
151function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
152begin
153 result := FilterGrayscale(bmp,rect(0,0,bmp.width,bmp.Height));
154end;
155
156function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
157var scanner: TBGRAFilterScannerGrayscale;
158begin
159 result := bmp.NewBitmap(bmp.Width,bmp.Height);
160 scanner := TBGRAFilterScannerGrayscale.Create(bmp,Point(0,0),True);
161 result.FillRect(ABounds,scanner,dmSet);
162 scanner.Free;
163end;
164
165function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask;
166begin
167 result := TGrayscaleTask.Create(bmp,ABounds);
168end;
169
170function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean
171 ): TBGRACustomBitmap;
172begin
173 result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel);
174end;
175
176{ Normalize compute min-max of specified channel and apply an affine transformation
177 to make it use the full range of values }
178function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect;
179 eachChannel: boolean = True): TBGRACustomBitmap;
180var scanner: TBGRAFilterScannerNormalize;
181 remain: TRect;
182begin
183 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
184 remain := EmptyRect;
185 if not IntersectRect(remain,ABounds,rect(0,0,bmp.Width,bmp.Height)) then exit;
186 scanner := TBGRAFilterScannerNormalize.Create(bmp,Point(0,0),remain,eachChannel);
187 result.FillRect(remain,scanner,dmSet);
188 scanner.Free;
189end;
190
191////////////////////// 3X3 FILTERS ////////////////////////////////////////////
192
193{ This filter compute for each pixel the mean of the eight surrounding pixels,
194 then the difference between this average pixel and the pixel at the center
195 of the square. Finally the difference is added to the new pixel, exagerating
196 its difference with its neighbours. }
197function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap;
198var scanner: TBGRAFilterScanner;
199begin
200 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
201 if IsRectEmpty(ABounds) then exit;
202 scanner := TBGRASharpenScanner.Create(bmp,ABounds,AAmount);
203 result.FillRect(ABounds,scanner,dmSet);
204 scanner.Free;
205end;
206
207function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer
208 ): TBGRACustomBitmap;
209begin
210 result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount);
211end;
212
213{ Filter contour computes for each pixel
214 the grayscale difference with surrounding pixels (in intensity and alpha)
215 and draw black pixels when there is a difference }
216function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
217var scanner: TBGRAContourScanner;
218begin
219 result := bmp.NewBitmap(bmp.Width, bmp.Height);
220 scanner := TBGRAContourScanner.Create(bmp,rect(0,0,bmp.width,bmp.height));
221 result.Fill(scanner);
222 scanner.Free;
223end;
224
225function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
226begin
227 result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height), AStrength, AOptions);
228end;
229
230{ Emboss filter computes the difference between each pixel and the surrounding pixels
231 in the specified direction. }
232function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect; AStrength: integer; AOptions: TEmbossOptions): TBGRACustomBitmap;
233var
234 yb, xb: NativeInt;
235 dx, dy: single;
236 idx, idy: NativeInt;
237 x256,y256: NativeInt;
238 cMiddle: TBGRAPixel;
239 hMiddle: THSLAPixel;
240
241 tempPixel, refPixel: TBGRAPixel;
242 pdest: PBGRAPixel;
243
244 bounds: TRect;
245 psrc: PBGRAPixel;
246 redDiff,greenDiff,blueDiff: NativeUInt;
247 diff: NativeInt;
248begin
249 //compute pixel position and weight
250 dx := cos(angle * Pi / 180);
251 dy := sin(angle * Pi / 180);
252 idx := floor(dx);
253 idy := floor(dy);
254 x256 := trunc((dx-idx)*256);
255 y256 := trunc((dy-idy)*256);
256
257 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
258 if IsRectEmpty(ABounds) then exit;
259
260 bounds := bmp.GetImageBounds;
261
262 if not IntersectRect(bounds, bounds, ABounds) then exit;
263 bounds.Left := max(0, bounds.Left - 1);
264 bounds.Top := max(0, bounds.Top - 1);
265 bounds.Right := min(bmp.Width, bounds.Right + 1);
266 bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
267
268 if not (eoTransparent in AOptions) then
269 begin
270 if eoPreserveHue in AOptions then
271 Result.PutImagePart(ABounds.left,ABounds.top,bmp,ABounds,dmSet)
272 else
273 Result.FillRect(ABounds,BGRA(128, 128, 128, 255),dmSet);
274 end;
275
276 //loop through destination
277 for yb := bounds.Top to bounds.bottom - 1 do
278 begin
279 pdest := Result.scanline[yb] + bounds.Left;
280 psrc := bmp.ScanLine[yb]+bounds.Left;
281
282 for xb := bounds.Left+idx to bounds.Right-1+idx do
283 begin
284 refPixel := bmp.GetPixel256(xb,yb+idy,x256,y256);
285 cMiddle := psrc^;
286 inc(psrc);
287
288 if eoPreserveHue in AOptions then
289 begin
290 {$push}{$hints off}
291 diff := ((refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha)+
292 (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha)+
293 (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha))* AStrength div 128;
294 {$pop}
295 if diff > 0 then
296 hMiddle := BGRAToHSLA(refPixel)
297 else
298 hMiddle := BGRAToHSLA(cMiddle);
299 hMiddle.lightness := min(65535,max(0,hMiddle.lightness+diff));
300 if eoTransparent in AOptions then
301 hMiddle.alpha := min(65535,abs(diff));
302 pdest^ := HSLAToBGRA(hMiddle);
303 end else
304 begin
305 {$push}{$hints off}
306 redDiff := NativeUInt(max(0, 65536 + (refPixel.red * refPixel.alpha - cMiddle.red * cMiddle.alpha) * AStrength div 64)) shr 9;
307 greenDiff := NativeUInt(max(0, 65536 + (refPixel.green * refPixel.alpha - cMiddle.green * cMiddle.alpha) * AStrength div 64)) shr 9;
308 blueDiff := NativeUInt(max(0, 65536 + (refPixel.blue * refPixel.alpha - cMiddle.blue * cMiddle.alpha) * AStrength div 64)) shr 9;
309 {$pop}
310 if (redDiff <> 128) or (greenDiff <> 128) or (blueDiff <> 128) then
311 begin
312 tempPixel.red := min(255, redDiff);
313 tempPixel.green := min(255, greenDiff);
314 tempPixel.blue := min(255, blueDiff);
315 if eoTransparent in AOptions then
316 begin
317 tempPixel.alpha := min(255,abs(NativeInt(redDiff-128))+abs(NativeInt(greenDiff-128))+abs(NativeInt(blueDiff-128)));
318 pdest^ := tempPixel;
319 end else
320 begin
321 tempPixel.alpha := 255;
322 pdest^ := tempPixel;
323 end;
324 end;
325 end;
326
327 Inc(pdest);
328 end;
329 end;
330 Result.InvalidateBitmap;
331end;
332
333{ Like general emboss, but with fixed direction and automatic color with transparency }
334function FilterEmbossHighlight(bmp: TBGRACustomBitmap;
335 FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap;
336var
337 bounds: TRect;
338 borderColorOverride: boolean;
339 borderColorLevel: Int32or64;
340 scan: TBGRAEmbossHightlightScanner;
341begin
342 borderColorOverride := DefineBorderColor.alpha <> 0;
343 borderColorLevel := DefineBorderColor.red;
344
345 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
346
347 if borderColorOverride then
348 bounds := bmp.GetImageBounds(cRed, borderColorLevel)
349 else
350 bounds := bmp.GetImageBounds(cRed);
351 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
352 exit;
353 bounds.Left := max(0, bounds.Left - 1);
354 bounds.Top := max(0, bounds.Top - 1);
355 bounds.Right := min(bmp.Width, bounds.Right + 1);
356 bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
357
358 scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
359 scan.AllowDirectRead := true;
360 scan.FillSelection := FillSelection;
361 if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
362 Result.FillRect(bounds, scan, dmSet);
363 scan.Free;
364end;
365
366function FilterEmbossHighlightOffset(bmp: TBGRACustomBitmap;
367 FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap;
368var
369 bounds: TRect;
370 borderColorOverride: boolean;
371 borderColorLevel: int32or64;
372 scan: TBGRAEmbossHightlightScanner;
373begin
374 borderColorOverride := DefineBorderColor.alpha <> 0;
375 borderColorLevel := DefineBorderColor.red;
376
377 if borderColorOverride then
378 bounds := bmp.GetImageBounds(cRed, borderColorLevel)
379 else
380 bounds := bmp.GetImageBounds(cRed);
381 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
382 begin
383 Result := bmp.NewBitmap(0, 0);
384 exit;
385 end;
386 bounds.Left := max(0, bounds.Left - 1);
387 bounds.Top := max(0, bounds.Top - 1);
388 bounds.Right := min(bmp.Width, bounds.Right + 1);
389 bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
390
391 Result := bmp.NewBitmap(bounds.Right-Bounds.Left+1, bounds.Bottom-Bounds.Top+1);
392 inc(Offset.X, bounds.Left);
393 inc(Offset.Y, bounds.Top);
394
395 scan := TBGRAEmbossHightlightScanner.Create(bmp, bounds, borderColorOverride);
396 scan.AllowDirectRead := true;
397 scan.FillSelection := FillSelection;
398 if borderColorOverride then scan.SourceBorderColor := DefineBorderColor;
399 Result.FillRect(rect(0,0,result.Width,result.Height), scan, dmSet, Offset);
400 scan.Free;
401end;
402
403{ For each component, sort values to get the median }
404function FilterMedian(bmp: TBGRACustomBitmap;
405 Option: TMedianOption): TBGRACustomBitmap;
406
407 function ComparePixLt(p1, p2: TBGRAPixel): boolean;
408 begin
409 if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then
410 Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) +
411 int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) +
412 int32or64(p2.blue)
413 else
414 Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue);
415 end;
416
417const
418 nbpix = 9;
419var
420 yb, xb: int32or64;
421 dx, dy, n, i, j, k: int32or64;
422 a_pixels: array[0..nbpix - 1] of TBGRAPixel;
423 tempPixel, refPixel: TBGRAPixel;
424 tempValue: byte;
425 sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64;
426 tempAlpha: word;
427 bounds: TRect;
428 pdest: PBGRAPixel;
429begin
430 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
431
432 bounds := bmp.GetImageBounds;
433 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
434 exit;
435 bounds.Left := max(0, bounds.Left - 1);
436 bounds.Top := max(0, bounds.Top - 1);
437 bounds.Right := min(bmp.Width, bounds.Right + 1);
438 bounds.Bottom := min(bmp.Height, bounds.Bottom + 1);
439
440 for yb := bounds.Top to bounds.bottom - 1 do
441 begin
442 pdest := Result.scanline[yb] + bounds.left;
443 for xb := bounds.left to bounds.right - 1 do
444 begin
445 n := 0;
446 for dy := -1 to 1 do
447 for dx := -1 to 1 do
448 begin
449 a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy);
450 if a_pixels[n].alpha = 0 then
451 a_pixels[n] := BGRAPixelTransparent;
452 Inc(n);
453 end;
454 for i := 1 to n - 1 do
455 begin
456 j := i;
457 while (j > 1) and (a_pixels[j].alpha < a_pixels[j - 1].alpha) do
458 begin
459 tempValue := a_pixels[j].alpha;
460 a_pixels[j].alpha := a_pixels[j - 1].alpha;
461 a_pixels[j - 1].alpha := tempValue;
462 Dec(j);
463 end;
464 j := i;
465 while (j > 1) and (a_pixels[j].red < a_pixels[j - 1].red) do
466 begin
467 tempValue := a_pixels[j].red;
468 a_pixels[j].red := a_pixels[j - 1].red;
469 a_pixels[j - 1].red := tempValue;
470 Dec(j);
471 end;
472 j := i;
473 while (j > 1) and (a_pixels[j].green < a_pixels[j - 1].green) do
474 begin
475 tempValue := a_pixels[j].green;
476 a_pixels[j].green := a_pixels[j - 1].green;
477 a_pixels[j - 1].green := tempValue;
478 Dec(j);
479 end;
480 j := i;
481 while (j > 1) and (a_pixels[j].blue < a_pixels[j - 1].blue) do
482 begin
483 tempValue := a_pixels[j].blue;
484 a_pixels[j].blue := a_pixels[j - 1].blue;
485 a_pixels[j - 1].blue := tempValue;
486 Dec(j);
487 end;
488 end;
489
490 refPixel := a_pixels[n div 2];
491
492 if option in [moLowSmooth, moMediumSmooth, moHighSmooth] then
493 begin
494 sumR := 0;
495 sumG := 0;
496 sumB := 0;
497 sumA := 0;
498 BGRAdiv := 0;
499 nbA := 0;
500
501 case option of
502 moHighSmooth, moMediumSmooth:
503 begin
504 j := 2;
505 k := 2;
506 end;
507 else
508 begin
509 j := 1;
510 k := 1;
511 end;
512 end;
513
514 {$hints off}
515 for i := -k to j do
516 begin
517 tempPixel := a_pixels[n div 2 + i];
518 tempAlpha := tempPixel.alpha;
519 if (option = moMediumSmooth) and ((i = -k) or (i = j)) then
520 tempAlpha := tempAlpha div 2;
521
522 sumR += tempPixel.red * tempAlpha;
523 sumG += tempPixel.green * tempAlpha;
524 sumB += tempPixel.blue * tempAlpha;
525 BGRAdiv += tempAlpha;
526
527 sumA += tempAlpha;
528 Inc(nbA);
529 end;
530 {$hints on}
531 if option = moMediumSmooth then
532 Dec(nbA);
533
534 if (BGRAdiv = 0) then
535 refPixel := BGRAPixelTransparent
536 else
537 begin
538 refPixel.red := round(sumR / BGRAdiv);
539 refPixel.green := round(sumG / BGRAdiv);
540 refPixel.blue := round(sumB / BGRAdiv);
541 refPixel.alpha := round(sumA / nbA);
542 end;
543 end;
544
545 pdest^ := refPixel;
546 Inc(pdest);
547 end;
548 end;
549end;
550
551//////////////////////// DEFORMATION FILTERS /////////////////////////////////
552
553{ Compute the distance for each pixel to the center of the bitmap,
554 calculate the corresponding angle with arcsin, use this angle
555 to determine a distance from the center in the source bitmap }
556function FilterSphere(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
557var
558 cx, cy: single;
559 scanner: TBGRASphereDeformationScanner;
560begin
561 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
562 cx := bmp.Width / 2 - 0.5;
563 cy := bmp.Height / 2 - 0.5;
564 scanner := TBGRASphereDeformationScanner.Create(bmp,PointF(cx,cy),bmp.Width/2,bmp.Height/2);
565 result.FillEllipseAntialias(cx,cy,bmp.Width/2-0.5,bmp.Height/2-0.5,scanner);
566 scanner.Free;
567end;
568
569{ Applies twirl scanner. See TBGRATwirlScanner }
570function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;
571var twirl: TBGRATwirlScanner;
572begin
573 twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent);
574 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
575 result.FillRect(ABounds, twirl, dmSet);
576 twirl.free;
577end;
578
579function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint;
580 ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap;
581begin
582 result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent);
583end;
584
585{ Compute the distance for each pixel to the vertical axis of the bitmap,
586 calculate the corresponding angle with arcsin, use this angle
587 to determine a distance from the vertical axis in the source bitmap }
588function FilterCylinder(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
589var
590 cx: single;
591 scanner: TBGRAVerticalCylinderDeformationScanner;
592begin
593 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
594 cx := bmp.Width / 2 - 0.5;
595 scanner := TBGRAVerticalCylinderDeformationScanner.Create(bmp,cx,bmp.Width/2);
596 result.Fill(scanner);
597 scanner.Free;
598end;
599
600function FilterPlane(bmp: TBGRACustomBitmap): TBGRACustomBitmap;
601const resampleGap=0.6;
602var
603 cy, x1, x2, y1, y2, z1, z2, h: single;
604 yb: int32or64;
605 resampledBmp: TBGRACustomBitmap;
606 resampledBmpWidth: int32or64;
607 resampledFactor,newResampleFactor: single;
608 sub,resampledSub: TBGRACustomBitmap;
609 partRect: TRect;
610 resampleSizeY : int32or64;
611begin
612 resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch);
613 resampledBmpWidth := resampledBmp.Width;
614 resampledFactor := 2;
615 Result := bmp.NewBitmap(bmp.Width, bmp.Height*2);
616 cy := result.Height / 2 - 0.5;
617 h := 1;
618 for yb := 0 to ((Result.Height-1) div 2) do
619 begin
620 y1 := (cy - (yb-0.5)) / (cy+0.5);
621 y2 := (cy - (yb+0.5)) / (cy+0.5);
622 if y2 <= 0 then continue;
623 z1 := h/y1;
624 z2 := h/y2;
625 newResampleFactor := 1/(z2-z1)*1.5;
626
627 x1 := (z1+1)/2;
628 x2 := (z2+1)/2;
629 if newResampleFactor <= resampledFactor*resampleGap then
630 begin
631 resampledFactor := newResampleFactor;
632 if resampledBmp <> bmp then resampledBmp.Free;
633 if (x2-x1 >= 1) then resampleSizeY := 1 else
634 resampleSizeY := round(1+((x2-x1)-1)/(1/bmp.Height-1)*(bmp.Height-1));
635 resampledBmp := bmp.Resample(max(1,round(bmp.Width*resampledFactor)),resampleSizeY,rmSimpleStretch);
636 resampledBmpWidth := resampledBmp.Width;
637 end;
638
639 partRect := Rect(round(-resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x1*resampledBmp.Height),
640 round(resampledBmpWidth/2*z1+resampledBmpWidth/2),floor(x2*resampledBmp.Height)+1);
641 if x2-x1 > 1 then
642 begin
643 partRect.Top := 0;
644 partRect.Bottom := 1;
645 end;
646 sub := resampledBmp.GetPart(partRect);
647 if sub <> nil then
648 begin
649 resampledSub := sub.Resample(bmp.Width,1,rmFineResample);
650 result.PutImage(0,yb,resampledSub,dmSet);
651 result.PutImage(0,Result.Height-1-yb,resampledSub,dmSet);
652 resampledSub.free;
653 sub.free;
654 end;
655 end;
656 if resampledBmp <> bmp then resampledBmp.Free;
657
658 if result.Height <> bmp.Height then
659 begin
660 resampledBmp := result.Resample(bmp.Width,bmp.Height,rmSimpleStretch);
661 result.free;
662 result := resampledBmp;
663 end;
664end;
665
666{ Rotates the image. To do this, loop through the destination and
667 calculates the position in the source bitmap with an affine transformation }
668function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF;
669 angle: single; correctBlur: boolean): TBGRACustomBitmap;
670begin
671 Result := bmp.NewBitmap(bmp.Width, bmp.Height);
672 Result.PutImageAngle(0,0,bmp,angle,origin.x,origin.y,255,true,correctBlur);
673end;
674
675///////////////////////// BLUR FILTERS //////////////////////////////////////
676
677function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: single; blurType: TRadialBlurType): TBGRACustomBitmap;
678var task: TFilterTask;
679begin
680 task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius,blurTYpe);
681 result := task.Execute;
682 task.Free;
683end;
684
685function FilterBlurRadial(bmp: TBGRACustomBitmap; radiusX: single; radiusY: single; blurType: TRadialBlurType): TBGRACustomBitmap;
686var task: TFilterTask;
687begin
688 task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radiusX,radiusY,blurTYpe);
689 result := task.Execute;
690 task.Free;
691end;
692
693function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single; ABlurType: TRadialBlurType): TRadialBlurTask;
694begin
695 result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType);
696end;
697
698function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
699 ARadiusX,ARadiusY: single; ABlurType: TRadialBlurType): TRadialBlurTask;
700begin
701 result := TRadialBlurTask.Create(ABmp,ABounds,ARadiusX,ARadiusY,ABlurType);
702end;
703
704{ Precise blur }
705
706function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap;
707var task: TRadialBlurTask;
708begin
709 task := CreateRadialBlurTask(bmp,rect(0,0,bmp.Width,bmp.Height),radius*10,rbPrecise);
710 result := task.Execute;
711 task.Free;
712end;
713
714function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TRadialBlurTask;
715begin
716 result := TRadialBlurTask.Create(ABmp,ABounds,ARadius*10,rbPrecise);
717end;
718
719function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; angle: single; oriented: boolean): TBGRACustomBitmap;
720var task: TFilterTask;
721begin
722 task := CreateMotionBlurTask(bmp, rect(0,0,bmp.Width,bmp.Height), distance, angle, oriented);
723 result := task.Execute;
724 task.Free;
725end;
726
727function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
728 ADistance, AAngle: single; AOriented: boolean): TMotionBlurTask;
729begin
730 result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented);
731end;
732
733function FilterBlur(bmp: TBGRACustomBitmap; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TBGRACustomBitmap;
734var task: TFilterTask;
735begin
736 task := TCustomBlurTask.Create(bmp,rect(0,0,bmp.Width,bmp.Height), AMask, AMaskIsThreadSafe);
737 result := task.Execute;
738 task.Free;
739end;
740
741function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect;
742 AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask;
743begin
744 result := TCustomBlurTask.Create(ABmp, ABounds, AMask, AMaskIsThreadSafe);
745end;
746
747///////////////////////////////////// OTHER FILTERS ///////////////////////////
748
749function FilterSmartZoom3(bmp: TBGRACustomBitmap;
750 Option: TMedianOption): TBGRACustomBitmap;
751type
752 TSmartDiff = record
753 d, cd, sd, b, a: single;
754 end;
755
756var
757 xb, yb: Int32or64;
758 diag1, diag2, h1, h2, v1, v2: TSmartDiff;
759 c,c1,c2: TBGRAPixel;
760 temp, median: TBGRACustomBitmap;
761
762 function ColorDiff(c1, c2: TBGRAPixel): single;
763 var
764 max1, max2: Int32or64;
765 begin
766 if (c1.alpha = 0) and (c2.alpha = 0) then
767 begin
768 Result := 0;
769 exit;
770 end
771 else
772 if (c1.alpha = 0) or (c2.alpha = 0) then
773 begin
774 Result := 1;
775 exit;
776 end;
777 max1 := c1.red;
778 if c1.green > max1 then
779 max1 := c1.green;
780 if c1.blue > max1 then
781 max1 := c1.blue;
782
783 max2 := c2.red;
784 if c2.green > max2 then
785 max2 := c2.green;
786 if c2.blue > max2 then
787 max2 := c2.blue;
788
789 if (max1 = 0) or (max2 = 0) then
790 begin
791 Result := 0;
792 exit;
793 end;
794 Result := (abs(c1.red / max1 - c2.red / max2) +
795 abs(c1.green / max1 - c2.green / max2) + abs(c1.blue / max1 - c2.blue / max2)) / 3;
796 end;
797
798 function RGBDiff(c1, c2: TBGRAPixel): single;
799 begin
800 if (c1.alpha = 0) and (c2.alpha = 0) then
801 begin
802 Result := 0;
803 exit;
804 end
805 else
806 if (c1.alpha = 0) or (c2.alpha = 0) then
807 begin
808 Result := 1;
809 exit;
810 end;
811 Result := (abs(c1.red - c2.red) + abs(c1.green - c2.green) +
812 abs(c1.blue - c2.blue)) / 3 / 255;
813 end;
814
815 function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff;
816 var
817 c1, c2, c1m, c2m: TBGRAPixel;
818 begin
819 c1 := bmp.GetPixel(x1, y1);
820 c2 := bmp.GetPixel(x2, y2);
821 c1m := median.GetPixel(x1, y1);
822 c2m := median.GetPixel(x2, y2);
823 Result.d := RGBDiff(c1, c2);
824 Result.cd := ColorDiff(c1, c2);
825 Result.a := c1.alpha / 255 * c2.alpha / 255;
826 Result.d := Result.d * Result.a + (1 - Result.a) *
827 (1 + abs(c1.alpha - c2.alpha) / 255) / 5;
828 Result.b := RGBDiff(c1, c1m) * c1.alpha / 255 * c1m.alpha / 255 +
829 RGBDiff(c2, c2m) * c2.alpha / 255 * c2m.alpha / 255 +
830 (abs(c1.alpha - c1m.alpha) + abs(c2.alpha - c2m.alpha)) / 255 / 4;
831 Result.sd := Result.d + Result.cd * 3;
832 end;
833
834var
835 diff: single;
836
837begin
838 median := FilterMedian(bmp, moNone);
839
840 temp := bmp.Resample(bmp.Width * 3, bmp.Height * 3, rmSimpleStretch);
841 Result := FilterMedian(temp, Option);
842 temp.Free;
843
844 for yb := 0 to bmp.Height - 2 do
845 for xb := 0 to bmp.Width - 2 do
846 begin
847 diag1 := smartDiff(xb, yb, xb + 1, yb + 1);
848 diag2 := smartDiff(xb, yb + 1, xb + 1, yb);
849
850 h1 := smartDiff(xb, yb, xb + 1, yb);
851 h2 := smartDiff(xb, yb + 1, xb + 1, yb + 1);
852 v1 := smartDiff(xb, yb, xb, yb + 1);
853 v2 := smartDiff(xb + 1, yb, xb + 1, yb + 1);
854
855 diff := diag1.sd - diag2.sd;
856 if abs(diff) < 3 then
857 diff -= (diag1.b - diag2.b) * (3 - abs(diff)) / 2;
858 //which diagonal to highlight?
859 if abs(diff) < 0.2 then
860 diff := 0;
861
862 if diff < 0 then
863 begin
864 //same color?
865 if diag1.cd < 0.3 then
866 begin
867 c1 := bmp.GetPixel(xb, yb);
868 c2 := bmp.GetPixel(xb + 1, yb + 1);
869 c := MergeBGRA(c1, c2);
870 //restore
871 Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb));
872 Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1));
873
874 if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then
875 Result.SetPixel(xb * 3 + 3, yb * 3 + 2, c);
876 if (diag1.sd < h2.sd) and (diag1.sd < v1.sd) then
877 Result.SetPixel(xb * 3 + 2, yb * 3 + 3, c);
878 end;
879 end
880 else
881 if diff > 0 then
882 begin
883 //same color?
884 if diag2.cd < 0.3 then
885 begin
886 c1 := bmp.GetPixel(xb, yb + 1);
887 c2 := bmp.GetPixel(xb + 1, yb);
888 c := MergeBGRA(c1, c2);
889 //restore
890 Result.SetPixel(xb * 3 + 3, yb * 3 + 2, bmp.GetPixel(xb + 1, yb));
891 Result.SetPixel(xb * 3 + 2, yb * 3 + 3, bmp.GetPixel(xb, yb + 1));
892
893 if (diag2.sd < h1.sd) and (diag2.sd < v1.sd) then
894 Result.SetPixel(xb * 3 + 2, yb * 3 + 2, c);
895 if (diag2.sd < h2.sd) and (diag2.sd < v2.sd) then
896 Result.SetPixel(xb * 3 + 3, yb * 3 + 3, c);
897
898 end;
899 end;
900 end;
901
902 median.Free;
903end;
904
905function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer;
906 useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap;
907var yb,xb, xs,ys, tx,ty: Int32or64;
908 psrc,pdest: PBGRAPixel;
909 temp,stretched: TBGRACustomBitmap;
910 oldfilter: TResampleFilter;
911begin
912 if pixelSize < 1 then
913 begin
914 result := bmp.Duplicate;
915 exit;
916 end;
917 result := bmp.NewBitmap(bmp.Width,bmp.Height);
918
919 tx := (bmp.Width+pixelSize-1) div pixelSize;
920 ty := (bmp.Height+pixelSize-1) div pixelSize;
921 if not useResample then
922 begin
923 temp := bmp.NewBitmap(tx,ty);
924
925 xs := (bmp.Width mod pixelSize) div 2;
926 ys := (bmp.Height mod pixelSize) div 2;
927
928 for yb := 0 to temp.height-1 do
929 begin
930 pdest := temp.ScanLine[yb];
931 psrc := bmp.scanline[ys]+xs;
932 inc(ys,pixelSize);
933 for xb := temp.width-1 downto 0 do
934 begin
935 pdest^ := psrc^;
936 inc(pdest);
937 inc(psrc,pixelSize);
938 end;
939 end;
940 temp.InvalidateBitmap;
941 end else
942 begin
943 oldfilter := bmp.ResampleFilter;
944 bmp.ResampleFilter := filter;
945 temp := bmp.Resample(tx,ty,rmFineResample);
946 bmp.ResampleFilter := oldfilter;
947 end;
948 stretched := temp.Resample(temp.Width*pixelSize,temp.Height*pixelSize,rmSimpleStretch);
949 temp.free;
950 if bmp.Width mod pixelSize = 0 then
951 xs := 0
952 else
953 xs := (-pixelSize+(bmp.Width mod pixelSize)) div 2;
954 if bmp.Height mod pixelSize = 0 then
955 ys := 0
956 else
957 ys := (-pixelSize+(bmp.Height mod pixelSize)) div 2;
958 result.PutImage(xs,ys,stretched,dmSet);
959 stretched.Free;
960end;
961
962end.
963
Note: See TracBrowser for help on using the repository browser.