Changeset 472 for GraphicTest/Packages/bgrabitmap/bgrafilters.pas
- Timestamp:
- Apr 9, 2015, 9:58:36 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/Packages/bgrabitmap/bgrafilters.pas
r452 r472 11 11 uses 12 12 Classes, BGRABitmapTypes; 13 14 type 15 TCheckShouldStopFunc = function(ACurrentY: integer) : boolean of object; 16 17 { TFilterTask } 18 19 TFilterTask = class 20 private 21 FCheckShouldStop: TCheckShouldStopFunc; 22 procedure SetDestination(AValue: TBGRACustomBitmap); 23 protected 24 FDestination: TBGRACustomBitmap; 25 FSource: TBGRACustomBitmap; 26 FCurrentY: integer; 27 function GetShouldStop(ACurrentY: integer): boolean; 28 procedure DoExecute; virtual; abstract; 29 public 30 function Execute: TBGRACustomBitmap; 31 property Destination: TBGRACustomBitmap read FDestination write SetDestination; 32 property CheckShouldStop: TCheckShouldStopFunc read FCheckShouldStop write FCheckShouldStop; 33 property CurrentY: integer read FCurrentY; 34 end; 13 35 14 36 { The median filter consist in calculating the median value of pixels. Here … … 25 47 26 48 { Sharpen filter add more contrast between pixels } 27 function FilterSharpen(bmp: TBGRACustomBitmap): TBGRACustomBitmap; 49 function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer = 256): TBGRACustomBitmap; 50 function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; 28 51 29 52 { A radial blur applies a blur with a circular influence, i.e, each pixel … … 32 55 function FilterBlurRadial(bmp: TBGRACustomBitmap; radius: integer; 33 56 blurType: TRadialBlurType): TBGRACustomBitmap; 57 function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: integer; 58 ABlurType: TRadialBlurType): TFilterTask; 34 59 35 60 { The precise blur allow to specify the blur radius with subpixel accuracy } 36 function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; 37 radius: single): TBGRACustomBitmap;61 function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single): TBGRACustomBitmap; 62 function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: single): TFilterTask; 38 63 39 64 { Motion blur merge pixels in a direction. The oriented parameter specifies … … 41 66 function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; 42 67 angle: single; oriented: boolean): TBGRACustomBitmap; 43 44 function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; 68 function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance,AAngle: single; AOriented: boolean): TFilterTask; 45 69 46 70 { General purpose blur filter, with a blur mask as parameter to describe 47 71 how pixels influence each other } 48 function FilterBlur(bmp: TBGRACustomBitmap; 49 blurMask: TBGRACustomBitmap): TBGRACustomBitmap; 72 function FilterBlur(bmp: TBGRACustomBitmap; blurMask: TBGRACustomBitmap): TBGRACustomBitmap; 73 function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false): TFilterTask; 74 75 function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; useResample: boolean; filter: TResampleFilter = rfLinear): TBGRACustomBitmap; 50 76 51 77 { Emboss filter compute a color difference in the angle direction } 52 78 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap; 79 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect): TBGRACustomBitmap; 53 80 54 81 { Emboss highlight computes a sort of emboss with 45 degrees angle and … … 63 90 function FilterNormalize(bmp: TBGRACustomBitmap; 64 91 eachChannel: boolean = True): TBGRACustomBitmap; 92 function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; 93 eachChannel: boolean = True): TBGRACustomBitmap; 65 94 66 95 { Rotate filter rotate the image and clip it in the bounding rectangle } 67 96 function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; 68 angle: single ): TBGRACustomBitmap;97 angle: single; correctBlur: boolean = false): TBGRACustomBitmap; 69 98 70 99 { Grayscale converts colored pixel into grayscale with same luminosity } 71 100 function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; 101 function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; 102 function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect): TFilterTask; 72 103 73 104 { Compute a contour, as if the image was drawn with a 2 pixels-wide black pencil } … … 79 110 { Twirl distortion, i.e. a progressive rotation } 80 111 function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; 112 function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; 81 113 82 114 { Distort the image as if it were on a vertical cylinder } … … 88 120 implementation 89 121 90 uses Math, GraphType, Dialogs, BGRATransform; 122 uses Math, GraphType, Dialogs, BGRATransform, Types, SysUtils; 123 124 type 125 { TGrayscaleTask } 126 127 TGrayscaleTask = class(TFilterTask) 128 private 129 FBounds: TRect; 130 public 131 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect); 132 protected 133 procedure DoExecute; override; 134 end; 135 136 { TBoxBlurTask } 137 138 TBoxBlurTask = class(TFilterTask) 139 private 140 FBounds: TRect; 141 FRadius: integer; 142 public 143 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer); 144 protected 145 procedure DoExecute; override; 146 end; 147 148 { TRadialBlurTask } 149 150 TRadialBlurTask = class(TFilterTask) 151 private 152 FBounds: TRect; 153 FRadius: integer; 154 FBlurType: TRadialBlurType; 155 public 156 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; 157 blurType: TRadialBlurType); 158 protected 159 procedure DoExecute; override; 160 end; 161 162 { TCustomBlurTask } 163 164 TCustomBlurTask = class(TFilterTask) 165 private 166 FBounds: TRect; 167 FMask: TBGRACustomBitmap; 168 FMaskOwned: boolean; 169 public 170 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean = false); 171 destructor Destroy; override; 172 protected 173 procedure DoExecute; override; 174 end; 175 176 { TRadialPreciseBlurTask } 177 178 TRadialPreciseBlurTask = class(TFilterTask) 179 private 180 FBounds: TRect; 181 FRadius: Single; 182 public 183 constructor Create(bmp: TBGRACustomBitmap; ABounds: TRect; radius: single); 184 protected 185 procedure DoExecute; override; 186 end; 187 188 { TMotionBlurTask } 189 190 TMotionBlurTask = class(TFilterTask) 191 private 192 FBounds: TRect; 193 FDistance,FAngle: single; 194 FOriented: boolean; 195 public 196 constructor Create(ABmp: TBGRACustomBitmap; ABounds: TRect; ADistance, AAngle: single; AOriented: boolean); 197 protected 198 procedure DoExecute; override; 199 end; 200 201 procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; 202 blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 203 procedure FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; ABounds: TRect; 204 radius: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 205 procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single; 206 angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 207 procedure FilterBlur(bmp: TBGRACustomBitmap; ABounds: TRect; 208 blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 91 209 92 210 function FilterSmartZoom3(bmp: TBGRACustomBitmap; … … 98 216 99 217 var 100 xb, yb: integer;218 xb, yb: Int32or64; 101 219 diag1, diag2, h1, h2, v1, v2: TSmartDiff; 102 220 c,c1,c2: TBGRAPixel; … … 105 223 function ColorDiff(c1, c2: TBGRAPixel): single; 106 224 var 107 max1, max2: integer;225 max1, max2: Int32or64; 108 226 begin 109 227 if (c1.alpha = 0) and (c2.alpha = 0) then … … 156 274 end; 157 275 158 function smartDiff(x1, y1, x2, y2: integer): TSmartDiff;276 function smartDiff(x1, y1, x2, y2: Int32or64): TSmartDiff; 159 277 var 160 278 c1, c2, c1m, c2m: TBGRAPixel; … … 209 327 begin 210 328 c1 := bmp.GetPixel(xb, yb); 211 c2 := bmp.GetPixel( integer(xb + 1), integer(yb + 1));329 c2 := bmp.GetPixel(xb + 1, yb + 1); 212 330 c := MergeBGRA(c1, c2); 213 331 //restore 214 332 Result.SetPixel(xb * 3 + 2, yb * 3 + 2, bmp.GetPixel(xb, yb)); 215 Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel( integer(xb + 1), integer(yb + 1)));333 Result.SetPixel(xb * 3 + 3, yb * 3 + 3, bmp.GetPixel(xb + 1, yb + 1)); 216 334 217 335 if (diag1.sd < h1.sd) and (diag1.sd < v2.sd) then … … 250 368 of the square. Finally the difference is added to the new pixel, exagerating 251 369 its difference with its neighbours. } 252 function FilterSharpen(bmp: TBGRACustomBitmap): TBGRACustomBitmap; 253 const 254 nbpix = 8; 370 function FilterSharpen(bmp: TBGRACustomBitmap; ABounds: TRect; AAmount: integer = 256): TBGRACustomBitmap; 255 371 var 256 yb, x b: integer;257 dx, dy , n, j: integer;258 a_pixels: array[ 0..nbpix - 1] of TBGRAPixel;259 sumR, sumG, sumB, sumA, RGBdiv, nbA: cardinal;260 tempPixel,refPixel: TBGRAPixel;261 pdest : PBGRAPixel;372 yb, xcount: Int32or64; 373 dx, dy: Int32or64; 374 a_pixels: array[-2..1,-2..1] of PBGRAPixel; 375 sumR, sumG, sumB, sumA, {RGBdiv, }nbA: UInt32or64; 376 refPixel: TBGRAPixel; 377 pdest,ptempPixel: PBGRAPixel; 262 378 bounds: TRect; 263 begin 379 Amount256: boolean; 380 lastXincluded: boolean; 381 alpha,rgbDivShr1: uint32or64; 382 begin 383 if IsRectEmpty(ABounds) then exit; 384 Amount256 := AAmount = 256; 264 385 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 265 386 266 387 //determine where pixels are in the bitmap 267 388 bounds := bmp.GetImageBounds; 268 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then 269 exit; 389 if not IntersectRect(bounds, bounds,ABounds) then exit; 270 390 bounds.Left := max(0, bounds.Left - 1); 271 391 bounds.Top := max(0, bounds.Top - 1); 272 392 bounds.Right := min(bmp.Width, bounds.Right + 1); 273 393 bounds.Bottom := min(bmp.Height, bounds.Bottom + 1); 394 lastXincluded:= bounds.Right < bmp.Width; 274 395 275 396 //loop through the destination bitmap … … 277 398 begin 278 399 pdest := Result.scanline[yb] + bounds.Left; 279 for xb := bounds.Left to bounds.Right - 1 do 280 begin 400 fillchar({%H-}a_pixels,sizeof(a_pixels),0); 401 for dy := -1 to 1 do 402 if (yb+dy >= bounds.Top) and (yb+dy < bounds.Bottom) then 403 a_pixels[dy,1] := bmp.ScanLine[yb+dy]+bounds.Left else 404 a_pixels[dy,1] := nil; 405 xcount := bounds.right-bounds.left; 406 while xcount > 0 do 407 begin 408 dec(xcount); 409 281 410 //for each pixel, read eight surrounding pixels in the source bitmap 282 n := 0;283 411 for dy := -1 to 1 do 284 for dx := -1 to 1 do 285 if (dx <> 0) or (dy <> 0) then 286 begin 287 a_pixels[n] := bmp.GetPixel(integer(xb + dx), integer(yb + dy)); 288 Inc(n); 289 end; 412 for dx := -1 to 0 do 413 a_pixels[dy,dx] := a_pixels[dy,dx+1]; 414 if (xcount > 0) or lastXincluded then 415 begin 416 for dy := -1 to 1 do 417 if a_pixels[dy,0] <> nil then a_pixels[dy,1] := a_pixels[dy,0]+1; 418 end; 290 419 291 420 //compute sum … … 294 423 sumB := 0; 295 424 sumA := 0; 296 RGBdiv := 0;425 //RGBdiv := 0; 297 426 nbA := 0; 298 427 299 428 {$hints off} 300 for j := 0 to n - 1 do 301 begin 302 tempPixel := a_pixels[j]; 303 sumR += tempPixel.red * tempPixel.alpha; 304 sumG += tempPixel.green * tempPixel.alpha; 305 sumB += tempPixel.blue * tempPixel.alpha; 306 RGBdiv += tempPixel.alpha; 307 sumA += tempPixel.alpha; 308 Inc(nbA); 309 end; 429 for dy := -1 to 1 do 430 for dx := -1 to 1 do 431 if (dx<>0) or (dy<>0) then 432 begin 433 ptempPixel := a_pixels[dy,dx]; 434 if ptempPixel <> nil then 435 begin 436 alpha := ptempPixel^.alpha; 437 sumR += ptempPixel^.red * alpha; 438 sumG += ptempPixel^.green * alpha; 439 sumB += ptempPixel^.blue * alpha; 440 //RGBdiv += alpha; 441 sumA += alpha; 442 Inc(nbA); 443 end; 444 end; 310 445 {$hints on} 311 446 312 447 //we finally have an average pixel 313 if ( RGBdiv= 0) then448 if ({RGBdiv}sumA = 0) then 314 449 refPixel := BGRAPixelTransparent 315 450 else 316 451 begin 317 refPixel.red := (sumR + RGBdiv shr 1) div RGBdiv; 318 refPixel.green := (sumG + RGBdiv shr 1) div RGBdiv; 319 refPixel.blue := (sumB + RGBdiv shr 1) div RGBdiv; 452 rgbDivShr1:= {RGBDiv}sumA shr 1; 453 refPixel.red := (sumR + rgbDivShr1) div {RGBdiv}sumA; 454 refPixel.green := (sumG + rgbDivShr1) div {RGBdiv}sumA; 455 refPixel.blue := (sumB + rgbDivShr1) div {RGBdiv}sumA; 320 456 refPixel.alpha := (sumA + nbA shr 1) div nbA; 321 457 end; 322 458 323 459 //read the pixel at the center of the square 324 tempPixel := bmp.GetPixel(xb, yb);460 ptempPixel := a_pixels[0,0]; 325 461 if refPixel <> BGRAPixelTransparent then 326 462 begin 327 463 //compute sharpened pixel by adding the difference 328 tempPixel.red := max(0, min(255, tempPixel.red + 329 integer(tempPixel.red - refPixel.red))); 330 tempPixel.green := max(0, min(255, tempPixel.green + 331 integer(tempPixel.green - refPixel.green))); 332 tempPixel.blue := max(0, min(255, tempPixel.blue + 333 integer(tempPixel.blue - refPixel.blue))); 334 tempPixel.alpha := max(0, min(255, tempPixel.alpha + 335 integer(tempPixel.alpha - refPixel.alpha))); 336 end; 337 pdest^ := tempPixel; 464 if not Amount256 then 465 pdest^ := BGRA( max(0, min($FFFF, Int32or64(ptempPixel^.red shl 8) + 466 AAmount*(ptempPixel^.red - refPixel.red))) shr 8, 467 max(0, min($FFFF, Int32or64(ptempPixel^.green shl 8) + 468 AAmount*(ptempPixel^.green - refPixel.green))) shr 8, 469 max(0, min($FFFF, Int32or64(ptempPixel^.blue shl 8) + 470 AAmount*(ptempPixel^.blue - refPixel.blue))) shr 8, 471 max(0, min($FFFF, Int32or64(ptempPixel^.alpha shl 8) + 472 AAmount*(ptempPixel^.alpha - refPixel.alpha))) shr 8 ) 473 else 474 pdest^ := BGRA( max(0, min(255, (ptempPixel^.red shl 1) - refPixel.red)), 475 max(0, min(255, (ptempPixel^.green shl 1) - refPixel.green)), 476 max(0, min(255, (ptempPixel^.blue shl 1) - refPixel.blue)), 477 max(0, min(255, (ptempPixel^.alpha shl 1) - refPixel.alpha))); 478 end else 479 pdest^ := ptempPixel^; 338 480 Inc(pdest); 339 481 end; 340 482 end; 341 483 Result.InvalidateBitmap; 484 end; 485 486 function FilterSharpen(bmp: TBGRACustomBitmap; AAmount: integer 487 ): TBGRACustomBitmap; 488 begin 489 result := FilterSharpen(bmp,rect(0,0,bmp.Width,bmp.Height),AAmount); 342 490 end; 343 491 344 492 { Precise blur builds a blur mask with a gradient fill and use 345 493 general purpose blur } 346 functionFilterBlurRadialPrecise(bmp: TBGRACustomBitmap;347 radius: single): TBGRACustomBitmap;494 procedure FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; 495 ABounds: TRect; radius: single; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 348 496 var 349 497 blurShape: TBGRACustomBitmap; … … 352 500 if radius = 0 then 353 501 begin 354 result := bmp.Duplicate;502 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 355 503 exit; 356 504 end; … … 360 508 BGRABlack, gtRadial, pointF(intRadius, intRadius), pointF( 361 509 intRadius - radius - 1, intRadius), dmSet); 362 Result := FilterBlur(bmp, blurShape);510 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); 363 511 blurShape.Free; 512 end; 513 514 function FilterBlurRadialPrecise(bmp: TBGRACustomBitmap; radius: single 515 ): TBGRACustomBitmap; 516 begin 517 result := bmp.NewBitmap(bmp.Width,bmp.Height); 518 FilterBlurRadialPrecise(bmp, rect(0,0,bmp.Width,bmp.Height), radius, result, nil); 519 end; 520 521 function CreateRadialPreciseBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; 522 ARadius: single): TFilterTask; 523 begin 524 result := TRadialPreciseBlurTask.Create(ABmp,ABounds,ARadius); 364 525 end; 365 526 … … 369 530 the vertical sums are kept except for the last column of 370 531 the square } 371 function FilterBlurFast(bmp: TBGRACustomBitmap;372 radius: integer ): TBGRACustomBitmap;373 532 procedure FilterBlurFast(bmp: TBGRACustomBitmap; ABounds: TRect; 533 radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 534 {$IFDEF CPU64}{$DEFINE FASTBLUR_DOUBLE}{$ENDIF} 374 535 type 375 536 TRowSum = record 376 sumR,sumG,sumB,rgbDiv,sumA,aDiv: cardinal; 377 end; 378 379 function ComputeAverage(sum: TRowSum): TBGRAPixel; 380 begin 537 sumR,sumG,sumB,rgbDiv,sumA,aDiv: uint32or64; 538 end; 539 TExtendedRowValue = {$IFDEF FASTBLUR_DOUBLE}double{$ELSE}uint64{$ENDIF}; 540 TExtendedRowSum = record 541 sumR,sumG,sumB,rgbDiv,sumA,aDiv: TExtendedRowValue; 542 end; 543 544 function ComputeExtendedAverage(sum: TExtendedRowSum): TBGRAPixel; 545 {$IFDEF FASTBLUR_DOUBLE} 546 var v: uint32or64; 547 {$ENDIF} 548 begin 549 {$IFDEF FASTBLUR_DOUBLE} 550 v := round(sum.sumA/sum.aDiv); 551 if v > 255 then result.alpha := 255 else result.alpha := v; 552 v := round(sum.sumR/sum.rgbDiv); 553 if v > 255 then result.red := 255 else result.red := v; 554 v := round(sum.sumG/sum.rgbDiv); 555 if v > 255 then result.green := 255 else result.green := v; 556 v := round(sum.sumB/sum.rgbDiv); 557 if v > 255 then result.blue := 255 else result.blue := v; 558 {$ELSE} 381 559 result.alpha:= (sum.sumA+sum.aDiv shr 1) div sum.aDiv; 382 560 result.red := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv; 383 561 result.green := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv; 384 562 result.blue := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv; 563 {$ENDIF} 564 end; 565 566 function ComputeClampedAverage(sum: TRowSum): TBGRAPixel; 567 var v: UInt32or64; 568 begin 569 v := (sum.sumA+sum.aDiv shr 1) div sum.aDiv; 570 if v > 255 then result.alpha := 255 else result.alpha := v; 571 v := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv; 572 if v > 255 then result.red := 255 else result.red := v; 573 v := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv; 574 if v > 255 then result.green := 255 else result.green := v; 575 v := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv; 576 if v > 255 then result.blue := 255 else result.blue := v; 577 end; 578 579 function ComputeAverage(sum: TRowSum): TBGRAPixel; 580 begin 581 result.alpha:= (sum.sumA+sum.aDiv shr 1) div sum.aDiv; 582 result.red := (sum.sumR+sum.rgbDiv shr 1) div sum.rgbDiv; 583 result.green := (sum.sumG+sum.rgbDiv shr 1) div sum.rgbDiv; 584 result.blue := (sum.sumB+sum.rgbDiv shr 1) div sum.rgbDiv; 385 585 end; 386 586 … … 389 589 { Normal radial blur compute a blur mask with a GradientFill and 390 590 then posterize to optimize general purpose blur } 391 functionFilterBlurRadialNormal(bmp: TBGRACustomBitmap;392 radius: integer): TBGRACustomBitmap;591 procedure FilterBlurRadialNormal(bmp: TBGRACustomBitmap; 592 ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 393 593 var 394 594 blurShape: TBGRACustomBitmap; 395 n: Int eger;595 n: Int32or64; 396 596 p: PBGRAPixel; 397 597 begin 598 if radius = 0 then 599 begin 600 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 601 exit; 602 end; 398 603 blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1); 399 604 blurShape.GradientFill(0, 0, blurShape.Width, blurShape.Height, BGRAWhite, … … 407 612 inc(p); 408 613 end; 409 Result := FilterBlur(bmp, blurShape);614 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); 410 615 blurShape.Free; 411 616 end; 412 617 413 618 { Blur disk creates a disk mask with a FillEllipse } 414 function FilterBlurDisk(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;619 procedure FilterBlurDisk(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 415 620 var 416 621 blurShape: TBGRACustomBitmap; 417 622 begin 623 if radius = 0 then 624 begin 625 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 626 exit; 627 end; 418 628 blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1); 419 629 blurShape.Fill(BGRABlack); 420 630 blurShape.FillEllipseAntialias(radius, radius, radius + 0.5, radius + 0.5, BGRAWhite); 421 Result := FilterBlur(bmp, blurShape);631 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); 422 632 blurShape.Free; 423 633 end; 424 634 425 635 { Corona blur use a circle as mask } 426 function FilterBlurCorona(bmp: TBGRACustomBitmap; radius: integer): TBGRACustomBitmap;636 procedure FilterBlurCorona(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 427 637 var 428 638 blurShape: TBGRACustomBitmap; 429 639 begin 640 if radius = 0 then 641 begin 642 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 643 exit; 644 end; 430 645 blurShape := bmp.NewBitmap(2 * radius + 1, 2 * radius + 1); 431 646 blurShape.Fill(BGRABlack); 432 647 blurShape.EllipseAntialias(radius, radius, radius, radius, BGRAWhite, 1); 433 Result := FilterBlur(bmp, blurShape);648 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); 434 649 blurShape.Free; 650 end; 651 652 function FilterBlurBox(bmp: TBGRACustomBitmap; radius: integer; ADestination: TBGRACustomBitmap): TBGRACustomBitmap; 653 var task: TBoxBlurTask; 654 begin 655 task := TBoxBlurTask.Create(bmp, rect(0,0,bmp.Width,bmp.Height), radius); 656 task.Destination := ADestination; 657 result := task.Execute; 658 task.Free; 659 end; 660 661 procedure FilterBlurRadial(bmp: TBGRACustomBitmap; ABounds: TRect; radius: integer; 662 blurType: TRadialBlurType; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 663 begin 664 if radius = 0 then 665 begin 666 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 667 exit; 668 end; 669 case blurType of 670 rbCorona: FilterBlurCorona(bmp, ABounds, radius, ADestination, ACheckShouldStop); 671 rbDisk: FilterBlurDisk(bmp, ABounds, radius, ADestination, ACheckShouldStop); 672 rbNormal: FilterBlurRadialNormal(bmp, ABounds, radius, ADestination, ACheckShouldStop); 673 rbFast: FilterBlurFast(bmp, ABounds, radius, ADestination, ACheckShouldStop); 674 rbPrecise: FilterBlurRadialPrecise(bmp, ABounds, radius / 10, ADestination, ACheckShouldStop); 675 rbBox: FilterBlurBox(bmp, radius, ADestination); 676 end; 435 677 end; 436 678 … … 438 680 blurType: TRadialBlurType): TBGRACustomBitmap; 439 681 begin 440 if radius = 0 then 441 begin 442 result := bmp.Duplicate; 443 exit; 444 end; 445 case blurType of 446 rbCorona: Result := FilterBlurCorona(bmp, radius); 447 rbDisk: Result := FilterBlurDisk(bmp, radius); 448 rbNormal: Result := FilterBlurRadialNormal(bmp, radius); 449 rbFast: Result := FilterBlurFast(bmp, radius); 450 rbPrecise: Result := FilterBlurRadialPrecise(bmp, radius / 10); 451 else 452 Result := nil; 453 end; 682 if blurType = rbBox then 683 begin 684 result := FilterBlurBox(bmp,radius,nil); 685 end else 686 begin 687 result := bmp.NewBitmap(bmp.width,bmp.Height); 688 FilterBlurRadial(bmp, rect(0,0,bmp.Width,bmp.height), radius, blurType,result,nil); 689 end; 690 end; 691 692 function CreateRadialBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; ARadius: integer; 693 ABlurType: TRadialBlurType): TFilterTask; 694 begin 695 if ABlurType = rbBox then 696 result := TBoxBlurTask.Create(ABmp,ABounds,ARadius) 697 else 698 result := TRadialBlurTask.Create(ABmp,ABounds,ARadius,ABlurType); 454 699 end; 455 700 456 701 { This filter draws an antialiased line to make the mask, and 457 702 if the motion blur is oriented, does a GradientFill to orient it } 458 function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single;459 angle: single; oriented: boolean ): TBGRACustomBitmap;703 procedure FilterBlurMotion(bmp: TBGRACustomBitmap; ABounds: TRect; distance: single; 704 angle: single; oriented: boolean; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 460 705 var 461 706 blurShape: TBGRACustomBitmap; … … 463 708 dx, dy, d: single; 464 709 begin 465 if distance = 0then466 begin 467 result := bmp.Duplicate;710 if distance < 1e-6 then 711 begin 712 ADestination.PutImagePart(ABounds.Left,ABounds.Top,bmp,ABounds,dmSet); 468 713 exit; 469 714 end; … … 482 727 pointF(intRadius + dx * (d + 0.5), intRadius + dy * (d + 0.5)), 483 728 dmFastBlend, False); 484 Result := FilterBlur(bmp, blurShape);729 FilterBlur(bmp, ABounds, blurShape, ADestination, ACheckShouldStop); 485 730 blurShape.Free; 731 end; 732 733 function FilterBlurMotion(bmp: TBGRACustomBitmap; distance: single; 734 angle: single; oriented: boolean): TBGRACustomBitmap; 735 begin 736 result := bmp.NewBitmap(bmp.Width,bmp.Height); 737 FilterBlurMotion(bmp,rect(0,0,bmp.Width,bmp.Height),distance,angle,oriented,result,nil); 738 end; 739 740 function CreateMotionBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; 741 ADistance, AAngle: single; AOriented: boolean): TFilterTask; 742 begin 743 result := TMotionBlurTask.Create(ABmp,ABounds,ADistance,AAngle,AOriented); 486 744 end; 487 745 488 746 { General purpose blur : compute pixel sum according to the mask and then 489 747 compute only difference while scanning from the left to the right } 490 function FilterBlurSmallMask(bmp: TBGRACustomBitmap; 491 blurMask: TBGRACustomBitmap): TBGRACustomBitmap; forward; 492 function FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap; 493 blurMask: TBGRACustomBitmap; maskShift: integer): TBGRACustomBitmap; forward; 494 function FilterBlurBigMask(bmp: TBGRACustomBitmap; 495 blurMask: TBGRACustomBitmap): TBGRACustomBitmap; forward; 748 procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap; 749 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 750 procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap; 751 blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 752 procedure FilterBlurBigMask(bmp: TBGRACustomBitmap; 753 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 754 procedure FilterBlurMask64(bmp: TBGRACustomBitmap; 755 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); forward; 496 756 497 757 //make sure value is in the range 0..255 498 function clampByte(value: integer): byte; inline;758 function clampByte(value: Int32or64): byte; inline; 499 759 begin 500 760 if value < 0 then result := 0 else … … 505 765 function FilterPixelate(bmp: TBGRACustomBitmap; pixelSize: integer; 506 766 useResample: boolean; filter: TResampleFilter): TBGRACustomBitmap; 507 var yb,xb, xs,ys, tx,ty: integer;767 var yb,xb, xs,ys, tx,ty: Int32or64; 508 768 psrc,pdest: PBGRAPixel; 509 769 temp,stretched: TBGRACustomBitmap; … … 531 791 psrc := bmp.scanline[ys]+xs; 532 792 inc(ys,pixelSize); 533 for xb := 0 to temp.width-1do793 for xb := temp.width-1 downto 0 do 534 794 begin 535 795 pdest^ := psrc^; … … 560 820 end; 561 821 562 function FilterBlur(bmp: TBGRACustomBitmap; 563 blurMask: TBGRACustomBitmap): TBGRACustomBitmap; 822 function FilterBlur(bmp: TBGRACustomBitmap; blurMask: TBGRACustomBitmap): TBGRACustomBitmap; 823 begin 824 result := bmp.NewBitmap(bmp.Width,bmp.Height); 825 FilterBlur(bmp,rect(0,0,bmp.Width,bmp.Height),blurMask,result,nil); 826 end; 827 828 function CreateBlurTask(ABmp: TBGRACustomBitmap; ABounds: TRect; 829 AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean): TFilterTask; 830 begin 831 result := TCustomBlurTask.Create(ABmp,ABounds,AMask,AMaskIsThreadSafe); 832 end; 833 834 procedure FilterBlur(bmp: TBGRACustomBitmap; 835 ABounds: TRect; blurMask: TBGRACustomBitmap; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 836 {$IFDEF CPU64} 837 begin 838 FilterBlurMask64(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); 839 end; 840 {$ELSE} 564 841 var 565 842 maskSum: int64; 566 i: Int eger;843 i: Int32or64; 567 844 p: PBGRAPixel; 568 845 maskShift: integer; … … 583 860 //check if sum can be stored in a 32-bit signed integer 584 861 if maskShift = 0 then 585 result := FilterBlurSmallMask(bmp,blurMask) else 862 FilterBlurSmallMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop) else 863 {$IFDEF CPU32} 586 864 if maskShift < 8 then 587 result := FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift) else 588 result := FilterBlurBigMask(bmp,blurMask); 589 end; 865 FilterBlurSmallMaskWithShift(bmp,blurMask,maskShift,ABounds,ADestination,ACheckShouldStop) else 866 {$ENDIF} 867 FilterBlurBigMask(bmp,blurMask,ABounds,ADestination,ACheckShouldStop); 868 end; 869 {$ENDIF} 590 870 591 871 //32-bit blur with shift 592 functionFilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap;593 blurMask: TBGRACustomBitmap; maskShift: integer ): TBGRACustomBitmap;872 procedure FilterBlurSmallMaskWithShift(bmp: TBGRACustomBitmap; 873 blurMask: TBGRACustomBitmap; maskShift: integer; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 594 874 595 875 var … … 613 893 614 894 //32-bit blur 615 functionFilterBlurSmallMask(bmp: TBGRACustomBitmap;616 blurMask: TBGRACustomBitmap ): TBGRACustomBitmap;895 procedure FilterBlurSmallMask(bmp: TBGRACustomBitmap; 896 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 617 897 618 898 var … … 634 914 {$I blurnormal.inc} 635 915 916 //64-bit blur 917 procedure FilterBlurMask64(bmp: TBGRACustomBitmap; 918 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 919 920 var 921 sumR, sumG, sumB, sumA, Adiv : int64; 922 923 function ComputeAverage: TBGRAPixel; inline; 924 begin 925 result.alpha := (sumA + Adiv shr 1) div Adiv; 926 if result.alpha = 0 then 927 result := BGRAPixelTransparent 928 else 929 begin 930 result.red := clampByte((sumR + sumA shr 1) div sumA); 931 result.green := clampByte((sumG + sumA shr 1) div sumA); 932 result.blue := clampByte((sumB + sumA shr 1) div sumA); 933 end; 934 end; 935 936 {$I blurnormal.inc} 937 636 938 //floating point blur 637 functionFilterBlurBigMask(bmp: TBGRACustomBitmap;638 blurMask: TBGRACustomBitmap ): TBGRACustomBitmap;939 procedure FilterBlurBigMask(bmp: TBGRACustomBitmap; 940 blurMask: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 639 941 640 942 var … … 655 957 656 958 {$I blurnormal.inc} 959 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single): TBGRACustomBitmap; 960 begin 961 result := FilterEmboss(bmp, angle, rect(0,0,bmp.Width,bmp.Height)); 962 end; 657 963 658 964 { Emboss filter computes the difference between each pixel and the surrounding pixels 659 965 in the specified direction. } 660 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single ): TBGRACustomBitmap;966 function FilterEmboss(bmp: TBGRACustomBitmap; angle: single; ABounds: TRect): TBGRACustomBitmap; 661 967 var 662 yb, xb: integer;968 yb, xb: Int32or64; 663 969 dx, dy: single; 664 idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: integer;970 idx1, idy1, idx2, idy2, idx3, idy3, idx4, idy4: Int32or64; 665 971 w: array[1..4] of single; 666 iw: cardinal;972 iw: uint32or64; 667 973 c: array[0..4] of TBGRAPixel; 668 974 669 i: integer;670 sumR, sumG, sumB, sumA, RGBdiv, Adiv: cardinal;975 i: Int32or64; 976 sumR, sumG, sumB, sumA, RGBdiv, Adiv: UInt32or64; 671 977 tempPixel, refPixel: TBGRAPixel; 672 978 pdest: PBGRAPixel; 673 979 674 980 bounds: TRect; 675 begin 981 onHorizBorder: boolean; 982 psrc: array[-1..1] of PBGRAPixel; 983 begin 984 if IsRectEmpty(ABounds) then exit; 676 985 //compute pixel position and weight 677 986 dx := cos(angle * Pi / 180); … … 696 1005 697 1006 bounds := bmp.GetImageBounds; 698 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then 699 exit; 1007 if not IntersectRect(bounds, bounds, ABounds) then exit; 700 1008 bounds.Left := max(0, bounds.Left - 1); 701 1009 bounds.Top := max(0, bounds.Top - 1); … … 707 1015 begin 708 1016 pdest := Result.scanline[yb] + bounds.Left; 1017 onHorizBorder:= (yb=0) or (yb=bmp.Height-1); 1018 psrc[0] := bmp.ScanLine[yb]+bounds.Left; 1019 if (yb>0) then psrc[-1] := bmp.ScanLine[yb-1]+bounds.Left else psrc[-1] := nil; 1020 if (yb<bmp.Height-1) then psrc[1] := bmp.ScanLine[yb+1]+bounds.Left else psrc[1] := nil; 709 1021 for xb := bounds.Left to bounds.Right - 1 do 710 1022 begin 711 c[0] := bmp.getPixel(xb, yb); 712 c[1] := bmp.getPixel(integer(xb + idx1), integer(yb + idy1)); 713 c[2] := bmp.getPixel(integer(xb + idx2), integer(yb + idy2)); 714 c[3] := bmp.getPixel(integer(xb + idx3), integer(yb + idy3)); 715 c[4] := bmp.getPixel(integer(xb + idx4), integer(yb + idy4)); 1023 c[0] := psrc[0]^; 1024 if onHorizBorder or (xb=0) or (xb=bmp.Width-1) then 1025 begin 1026 c[1] := bmp.getPixel(xb + idx1, yb + idy1); 1027 c[2] := bmp.getPixel(xb + idx2, yb + idy2); 1028 c[3] := bmp.getPixel(xb + idx3, yb + idy3); 1029 c[4] := bmp.getPixel(xb + idx4, yb + idy4); 1030 end else 1031 begin 1032 c[1] := (psrc[idy1]+idx1)^; 1033 c[2] := (psrc[idy2]+idx2)^; 1034 c[3] := (psrc[idy3]+idx3)^; 1035 c[4] := (psrc[idy4]+idx4)^; 1036 end; 716 1037 717 1038 sumR := 0; … … 762 1083 pdest^ := tempPixel; 763 1084 Inc(pdest); 1085 inc(psrc[0]); 1086 if psrc[-1] <> nil then inc(psrc[-1]); 1087 if psrc[1] <> nil then inc(psrc[1]); 764 1088 end; 765 1089 end; … … 771 1095 FillSelection: boolean; DefineBorderColor: TBGRAPixel): TBGRACustomBitmap; 772 1096 var 773 yb, xb: integer;774 c0,c1,c2,c3,c4,c5,c6: integer;775 776 bmpWidth, bmpHeight: integer;1097 yb, xb: Int32or64; 1098 c0,c1,c2,c3,c4,c5,c6: Int32or64; 1099 1100 bmpWidth, bmpHeight: Int32or64; 777 1101 slope, h: byte; 778 sum: integer;1102 sum: Int32or64; 779 1103 tempPixel, highlight: TBGRAPixel; 780 1104 pdest, psrcUp, psrc, psrcDown: PBGRAPixel; … … 782 1106 bounds: TRect; 783 1107 borderColorOverride: boolean; 784 borderColorLevel: integer;785 786 currentBorderColor: integer;1108 borderColorLevel: Int32or64; 1109 1110 currentBorderColor: Int32or64; 787 1111 begin 788 1112 borderColorOverride := DefineBorderColor.alpha <> 0; … … 905 1229 FillSelection: boolean; DefineBorderColor: TBGRAPixel; var Offset: TPoint): TBGRACustomBitmap; 906 1230 var 907 yb, xb: int eger;908 c0,c1,c2,c3,c4,c5,c6: int eger;909 910 bmpWidth, bmpHeight: int eger;1231 yb, xb: int32or64; 1232 c0,c1,c2,c3,c4,c5,c6: int32or64; 1233 1234 bmpWidth, bmpHeight: int32or64; 911 1235 slope, h: byte; 912 sum: int eger;1236 sum: int32or64; 913 1237 tempPixel, highlight: TBGRAPixel; 914 1238 pdest, psrcUp, psrc, psrcDown: PBGRAPixel; … … 916 1240 bounds: TRect; 917 1241 borderColorOverride: boolean; 918 borderColorLevel: int eger;919 920 currentBorderColor: int eger;1242 borderColorLevel: int32or64; 1243 1244 currentBorderColor: int32or64; 921 1245 begin 922 1246 borderColorOverride := DefineBorderColor.alpha <> 0; … … 1042 1366 end; 1043 1367 1368 function FilterNormalize(bmp: TBGRACustomBitmap; eachChannel: boolean 1369 ): TBGRACustomBitmap; 1370 begin 1371 result := FilterNormalize(bmp, rect(0,0,bmp.Width,bmp.Height), eachChannel); 1372 end; 1373 1044 1374 { Normalize compute min-max of specified channel and apply an affine transformation 1045 1375 to make it use the full range of values } 1046 function FilterNormalize(bmp: TBGRACustomBitmap; 1376 function FilterNormalize(bmp: TBGRACustomBitmap; ABounds: TRect; 1047 1377 eachChannel: boolean = True): TBGRACustomBitmap; 1048 1378 var 1049 1379 psrc, pdest: PBGRAPixel; 1050 1380 c: TExpandedPixel; 1051 n: integer;1381 xcount,xb,yb: int32or64; 1052 1382 minValRed, maxValRed, minValGreen, maxValGreen, minValBlue, maxValBlue, 1053 1383 minAlpha, maxAlpha, addValRed, addValGreen, addValBlue, addAlpha: word; 1054 factorValRed, factorValGreen, factorValBlue, factorAlpha: integer; 1055 begin 1384 factorValRed, factorValGreen, factorValBlue, factorAlpha: int32or64; 1385 begin 1386 if not IntersectRect(ABounds,ABounds,rect(0,0,bmp.Width,bmp.Height)) then exit; 1056 1387 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 1057 1388 bmp.LoadFromBitmapIfNeeded; 1058 psrc := bmp.Data;1059 1389 maxValRed := 0; 1060 1390 minValRed := 65535; … … 1065 1395 maxAlpha := 0; 1066 1396 minAlpha := 65535; 1067 for n := bmp.Width * bmp.Height - 1 downto 0 do 1068 begin 1069 c := GammaExpansion(psrc^); 1070 Inc(psrc); 1071 if c.red > maxValRed then 1072 maxValRed := c.red; 1073 if c.green > maxValGreen then 1074 maxValGreen := c.green; 1075 if c.blue > maxValBlue then 1076 maxValBlue := c.blue; 1077 if c.red < minValRed then 1078 minValRed := c.red; 1079 if c.green < minValGreen then 1080 minValGreen := c.green; 1081 if c.blue < minValBlue then 1082 minValBlue := c.blue; 1083 1084 if c.alpha > maxAlpha then 1085 maxAlpha := c.alpha; 1086 if c.alpha < minAlpha then 1087 minAlpha := c.alpha; 1397 xcount := ABounds.Right-ABounds.Left; 1398 for yb := ABounds.Top to ABounds.Bottom-1 do 1399 begin 1400 psrc := bmp.ScanLine[yb]+ABounds.Left; 1401 for xb := xcount-1 downto 0 do 1402 begin 1403 c := GammaExpansion(psrc^); 1404 Inc(psrc); 1405 if c.red > maxValRed then 1406 maxValRed := c.red; 1407 if c.green > maxValGreen then 1408 maxValGreen := c.green; 1409 if c.blue > maxValBlue then 1410 maxValBlue := c.blue; 1411 if c.red < minValRed then 1412 minValRed := c.red; 1413 if c.green < minValGreen then 1414 minValGreen := c.green; 1415 if c.blue < minValBlue then 1416 minValBlue := c.blue; 1417 1418 if c.alpha > maxAlpha then 1419 maxAlpha := c.alpha; 1420 if c.alpha < minAlpha then 1421 minAlpha := c.alpha; 1422 end; 1088 1423 end; 1089 1424 if not eachChannel then … … 1149 1484 end; 1150 1485 1151 psrc := bmp.Data; 1152 pdest := Result.Data; 1153 for n := bmp.Width * bmp.Height - 1 downto 0 do 1154 begin 1155 c := GammaExpansion(psrc^); 1156 Inc(psrc); 1157 c.red := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed; 1158 c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen; 1159 c.blue := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue; 1160 c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha; 1161 pdest^ := GammaCompression(c); 1162 Inc(pdest); 1486 for yb := ABounds.Top to ABounds.Bottom-1 do 1487 begin 1488 psrc := bmp.ScanLine[yb]+ABounds.Left; 1489 pdest := Result.ScanLine[yb]+ABounds.Left; 1490 for xb := xcount-1 downto 0 do 1491 begin 1492 c := GammaExpansion(psrc^); 1493 Inc(psrc); 1494 c.red := ((c.red - minValRed) * factorValRed + 2047) shr 12 + addValRed; 1495 c.green := ((c.green - minValGreen) * factorValGreen + 2047) shr 12 + addValGreen; 1496 c.blue := ((c.blue - minValBlue) * factorValBlue + 2047) shr 12 + addValBlue; 1497 c.alpha := ((c.alpha - minAlpha) * factorAlpha + 2047) shr 12 + addAlpha; 1498 pdest^ := GammaCompression(c); 1499 Inc(pdest); 1500 end; 1163 1501 end; 1164 1502 Result.InvalidateBitmap; … … 1168 1506 calculates the position in the source bitmap with an affine transformation } 1169 1507 function FilterRotate(bmp: TBGRACustomBitmap; origin: TPointF; 1170 angle: single ): TBGRACustomBitmap;1508 angle: single; correctBlur: boolean): TBGRACustomBitmap; 1171 1509 var 1172 1510 bounds: TRect; … … 1175 1513 savexysrc, pt: TPointF; 1176 1514 dx, dy: single; 1177 xb, yb: int eger;1515 xb, yb: int32or64; 1178 1516 minx, miny, maxx, maxy: single; 1517 rf : TResampleFilter; 1179 1518 1180 1519 function RotatePos(x, y: single): TPointF; … … 1188 1527 1189 1528 begin 1190 Result := bmp.NewBitmap(bmp.Width, bmp.Height);1191 1529 bounds := bmp.GetImageBounds; 1192 1530 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then 1531 begin 1532 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 1193 1533 exit; 1534 end; 1535 1536 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 1537 if correctBlur then rf := rfHalfCosine else rf := rfLinear; 1194 1538 1195 1539 //compute new bounding rectangle … … 1251 1595 for xb := bounds.left to bounds.right - 1 do 1252 1596 begin 1253 pdest^ := bmp.GetPixel(xsrc, ysrc );1597 pdest^ := bmp.GetPixel(xsrc, ysrc, rf); 1254 1598 Inc(pdest); 1255 1599 xsrc += dx; … … 1263 1607 1264 1608 { Filter grayscale applies BGRAToGrayscale function to all pixels } 1265 function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap;1609 procedure FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect; ADestination: TBGRACustomBitmap; ACheckShouldStop: TCheckShouldStopFunc); 1266 1610 var 1267 bounds: TRect;1268 1611 pdest, psrc: PBGRAPixel; 1269 xb, yb: integer; 1270 1271 begin 1272 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 1273 bounds := bmp.GetImageBounds; 1274 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then 1275 exit; 1276 1277 for yb := bounds.Top to bounds.bottom - 1 do 1278 begin 1279 pdest := Result.scanline[yb] + bounds.left; 1280 psrc := bmp.scanline[yb] + bounds.left; 1281 for xb := bounds.left to bounds.right - 1 do 1612 xb, yb: int32or64; 1613 1614 begin 1615 if IsRectEmpty(ABounds) then exit; 1616 1617 for yb := ABounds.Top to ABounds.bottom - 1 do 1618 begin 1619 if Assigned(ACheckShouldStop) and ACheckShouldStop(yb) then break; 1620 pdest := ADestination.scanline[yb] + ABounds.left; 1621 psrc := bmp.scanline[yb] + ABounds.left; 1622 for xb := ABounds.left to ABounds.right - 1 do 1282 1623 begin 1283 1624 pdest^ := BGRAToGrayscale(psrc^); … … 1286 1627 end; 1287 1628 end; 1288 Result.InvalidateBitmap; 1629 ADestination.InvalidateBitmap; 1630 end; 1631 1632 function FilterGrayscale(bmp: TBGRACustomBitmap): TBGRACustomBitmap; 1633 begin 1634 result := FilterGrayscale(bmp, rect(0,0,bmp.width,bmp.Height)); 1635 end; 1636 1637 function FilterGrayscale(bmp: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; 1638 begin 1639 result := bmp.NewBitmap(bmp.Width,bmp.Height); 1640 FilterGrayscale(bmp,ABounds,result,nil); 1641 end; 1642 1643 function CreateGrayscaleTask(bmp: TBGRACustomBitmap; ABounds: TRect 1644 ): TFilterTask; 1645 begin 1646 result := TGrayscaleTask.Create(bmp,ABounds); 1289 1647 end; 1290 1648 … … 1294 1652 function FilterContour(bmp: TBGRACustomBitmap): TBGRACustomBitmap; 1295 1653 var 1296 yb, xb: int eger;1654 yb, xb: int32or64; 1297 1655 c: array[0..8] of TBGRAPixel; 1298 1656 1299 i, bmpWidth, bmpHeight: int eger;1657 i, bmpWidth, bmpHeight: int32or64; 1300 1658 slope: byte; 1301 sum: int eger;1659 sum: int32or64; 1302 1660 tempPixel: TBGRAPixel; 1303 1661 pdest, psrcUp, psrc, psrcDown: PBGRAPixel; … … 1412 1770 var 1413 1771 cx, cy, x, y, len, fact: single; 1414 xb, yb: int eger;1772 xb, yb: int32or64; 1415 1773 mask: TBGRACustomBitmap; 1416 1774 begin … … 1443 1801 1444 1802 { Applies twirl scanner. See TBGRATwirlScanner } 1445 function FilterTwirl(bmp: TBGRACustomBitmap; A Center: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap;1803 function FilterTwirl(bmp: TBGRACustomBitmap; ABounds: TRect; ACenter: TPoint; ARadius: Single; ATurn: Single=1; AExponent: Single=3): TBGRACustomBitmap; 1446 1804 var twirl: TBGRATwirlScanner; 1447 1805 begin 1448 1806 twirl := TBGRATwirlScanner.Create(bmp,ACenter,ARadius,ATurn,AExponent); 1449 1807 Result := bmp.NewBitmap(bmp.Width, bmp.Height); 1450 result.Fill (twirl);1808 result.FillRect(ABounds, twirl, dmSet); 1451 1809 twirl.free; 1810 end; 1811 1812 function FilterTwirl(bmp: TBGRACustomBitmap; ACenter: TPoint; 1813 ARadius: Single; ATurn: Single; AExponent: Single): TBGRACustomBitmap; 1814 begin 1815 result := FilterTwirl(bmp,rect(0,0,bmp.Width,bmp.Height),ACenter,ARadius,ATurn,AExponent); 1452 1816 end; 1453 1817 … … 1458 1822 var 1459 1823 cx, cy, x, y, len, fact: single; 1460 xb, yb: int eger;1824 xb, yb: int32or64; 1461 1825 begin 1462 1826 Result := bmp.NewBitmap(bmp.Width, bmp.Height); … … 1485 1849 var 1486 1850 cy, x1, x2, y1, y2, z1, z2, h: single; 1487 yb: int eger;1851 yb: int32or64; 1488 1852 resampledBmp: TBGRACustomBitmap; 1489 resampledBmpWidth: int eger;1853 resampledBmpWidth: int32or64; 1490 1854 resampledFactor,newResampleFactor: single; 1491 1855 sub,resampledSub: TBGRACustomBitmap; 1492 1856 partRect: TRect; 1493 resampleSizeY : int eger;1857 resampleSizeY : int32or64; 1494 1858 begin 1495 1859 resampledBmp := bmp.Resample(bmp.Width*2,bmp.Height*2,rmSimpleStretch); … … 1554 1918 begin 1555 1919 if (p1.red + p1.green + p1.blue = p2.red + p2.green + p2.blue) then 1556 Result := (int eger(p1.red) shl 8) + (integer(p1.green) shl 16) +1557 int eger(p1.blue) < (integer(p2.red) shl 8) + (integer(p2.green) shl 16) +1558 int eger(p2.blue)1920 Result := (int32or64(p1.red) shl 8) + (int32or64(p1.green) shl 16) + 1921 int32or64(p1.blue) < (int32or64(p2.red) shl 8) + (int32or64(p2.green) shl 16) + 1922 int32or64(p2.blue) 1559 1923 else 1560 1924 Result := (p1.red + p1.green + p1.blue) < (p2.red + p2.green + p2.blue); … … 1564 1928 nbpix = 9; 1565 1929 var 1566 yb, xb: int eger;1567 dx, dy, n, i, j, k: int eger;1930 yb, xb: int32or64; 1931 dx, dy, n, i, j, k: int32or64; 1568 1932 a_pixels: array[0..nbpix - 1] of TBGRAPixel; 1569 1933 tempPixel, refPixel: TBGRAPixel; 1570 1934 tempValue: byte; 1571 sumR, sumG, sumB, sumA, BGRAdiv, nbA: cardinal;1935 sumR, sumG, sumB, sumA, BGRAdiv, nbA: uint32or64; 1572 1936 tempAlpha: word; 1573 1937 bounds: TRect; … … 1593 1957 for dx := -1 to 1 do 1594 1958 begin 1595 a_pixels[n] := bmp.GetPixel( integer(xb + dx), integer(yb + dy));1959 a_pixels[n] := bmp.GetPixel(xb + dx, yb + dy); 1596 1960 if a_pixels[n].alpha = 0 then 1597 1961 a_pixels[n] := BGRAPixelTransparent; … … 1695 2059 end; 1696 2060 2061 constructor TBoxBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; 2062 radius: integer); 2063 begin 2064 FSource := bmp; 2065 FBounds := ABounds; 2066 FRadius := radius; 2067 end; 2068 2069 procedure TBoxBlurTask.DoExecute; 2070 type 2071 TVertical = record red,green,blue,alpha,count: NativeUint; end; 2072 PVertical = ^TVertical; 2073 var 2074 verticals: PVertical; 2075 left,right,width,height: NativeInt; 2076 delta: PtrInt; 2077 2078 procedure PrepareVerticals; 2079 var 2080 xb,yb: NativeInt; 2081 psrc,p: PBGRAPixel; 2082 pvert : PVertical; 2083 begin 2084 fillchar(verticals^, width*sizeof(TVertical), 0); 2085 psrc := FSource.ScanLine[FBounds.Top]; 2086 pvert := verticals; 2087 for xb := left to right-1 do 2088 begin 2089 p := psrc+xb; 2090 for yb := 0 to FRadius-1 do 2091 begin 2092 if yb = height then break; 2093 if p^.alpha <> 0 then 2094 begin 2095 pvert^.red += p^.red * p^.alpha; 2096 pvert^.green += p^.green * p^.alpha; 2097 pvert^.blue += p^.blue * p^.alpha; 2098 pvert^.alpha += p^.alpha; 2099 end; 2100 inc(pvert^.count); 2101 PByte(p) += delta; 2102 end; 2103 inc(pvert); 2104 end; 2105 end; 2106 2107 procedure NextVerticals(y: integer); 2108 var 2109 psrc1,psrc2: PBGRAPixel; 2110 pvert : PVertical; 2111 xb: NativeInt; 2112 begin 2113 pvert := verticals; 2114 if y-FRadius-1 >= 0 then 2115 psrc1 := FSource.ScanLine[y-FRadius-1] 2116 else 2117 psrc1 := nil; 2118 if y+FRadius < FSource.Height then 2119 psrc2 := FSource.ScanLine[y+FRadius] 2120 else 2121 psrc2 := nil; 2122 for xb := width-1 downto 0 do 2123 begin 2124 if psrc1 <> nil then 2125 begin 2126 if psrc1^.alpha <> 0 then 2127 begin 2128 {$HINTS OFF} 2129 pvert^.red -= psrc1^.red * psrc1^.alpha; 2130 pvert^.green -= psrc1^.green * psrc1^.alpha; 2131 pvert^.blue -= psrc1^.blue * psrc1^.alpha; 2132 pvert^.alpha -= psrc1^.alpha; 2133 {$HINTS ON} 2134 end; 2135 dec(pvert^.count); 2136 inc(psrc1); 2137 end; 2138 if psrc2 <> nil then 2139 begin 2140 if psrc2^.alpha <> 0 then 2141 begin 2142 pvert^.red += psrc2^.red * psrc2^.alpha; 2143 pvert^.green += psrc2^.green * psrc2^.alpha; 2144 pvert^.blue += psrc2^.blue * psrc2^.alpha; 2145 pvert^.alpha += psrc2^.alpha; 2146 end; 2147 inc(pvert^.count); 2148 inc(psrc2); 2149 end; 2150 inc(pvert); 2151 end; 2152 end; 2153 2154 procedure MainLoop; 2155 var 2156 xb,yb,xdest: NativeInt; 2157 pdest: PBGRAPixel; 2158 pvert : PVertical; 2159 sumRed,sumGreen,sumBlue,sumAlpha,sumCount: NativeUInt; 2160 begin 2161 for yb := FBounds.Top to FBounds.Bottom-1 do 2162 begin 2163 NextVerticals(yb); 2164 if GetShouldStop(yb) then exit; 2165 pdest := Destination.ScanLine[yb]+left; 2166 sumRed := 0; 2167 sumGreen := 0; 2168 sumBlue := 0; 2169 sumAlpha := 0; 2170 sumCount := 0; 2171 pvert := verticals; 2172 for xb := 0 to FRadius-1 do 2173 begin 2174 if xb = width then break; 2175 sumRed += pvert^.red; 2176 sumGreen += pvert^.green; 2177 sumBlue += pvert^.blue; 2178 sumAlpha += pvert^.alpha; 2179 sumCount += pvert^.count; 2180 inc(pvert); 2181 end; 2182 for xdest := 0 to width-1 do 2183 begin 2184 if xdest-FRadius-1 >= 0 then 2185 begin 2186 pvert := verticals+(xdest-FRadius-1); 2187 sumRed -= pvert^.red; 2188 sumGreen -= pvert^.green; 2189 sumBlue -= pvert^.blue; 2190 sumAlpha -= pvert^.alpha; 2191 sumCount -= pvert^.count; 2192 end; 2193 if xdest+FRadius < width then 2194 begin 2195 pvert := verticals+(xdest+FRadius); 2196 sumRed += pvert^.red; 2197 sumGreen += pvert^.green; 2198 sumBlue += pvert^.blue; 2199 sumAlpha += pvert^.alpha; 2200 sumCount += pvert^.count; 2201 end; 2202 if (sumCount > 0) and (sumAlpha >= (sumCount+1) shr 1) then 2203 begin 2204 pdest^.red := (sumRed+(sumAlpha shr 1)) div sumAlpha; 2205 pdest^.green := (sumGreen+(sumAlpha shr 1)) div sumAlpha; 2206 pdest^.blue := (sumBlue+(sumAlpha shr 1)) div sumAlpha; 2207 pdest^.alpha := (sumAlpha+(sumCount shr 1)) div sumCount; 2208 end else 2209 pdest^ := BGRAPixelTransparent; 2210 inc(pdest); 2211 end; 2212 end; 2213 end; 2214 2215 begin 2216 if (FBounds.Right <= FBounds.Left) or (FBounds.Bottom <= FBounds.Top) or (FRadius <= 0) then exit; 2217 left := FBounds.left; 2218 right := FBounds.right; 2219 width := right-left; 2220 height := FBounds.bottom-FBounds.top; 2221 delta := FSource.Width*SizeOf(TBGRAPixel); 2222 if FSource.LineOrder = riloBottomToTop then delta := -delta; 2223 2224 getmem(verticals, width*sizeof(TVertical)); 2225 try 2226 PrepareVerticals; 2227 MainLoop; 2228 finally 2229 freemem(verticals); 2230 end; 2231 end; 2232 2233 constructor TGrayscaleTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect); 2234 begin 2235 FSource := bmp; 2236 FBounds := ABounds; 2237 end; 2238 2239 procedure TGrayscaleTask.DoExecute; 2240 begin 2241 FilterGrayscale(FSource,FBounds,Destination,@GetShouldStop); 2242 end; 2243 2244 { TCustomBlurTask } 2245 2246 constructor TCustomBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; 2247 AMask: TBGRACustomBitmap; AMaskIsThreadSafe: boolean); 2248 begin 2249 FSource := bmp; 2250 FBounds := ABounds; 2251 if AMaskIsThreadSafe then 2252 begin 2253 FMask := AMask; 2254 FMaskOwned := false; 2255 end else 2256 begin 2257 FMask := AMask.Duplicate; 2258 FMaskOwned := true; 2259 end; 2260 end; 2261 2262 destructor TCustomBlurTask.Destroy; 2263 begin 2264 If FMaskOwned then FreeAndNil(FMask); 2265 inherited Destroy; 2266 end; 2267 2268 procedure TCustomBlurTask.DoExecute; 2269 begin 2270 FilterBlur(FSource,FBounds,FMask,Destination,@GetShouldStop); 2271 end; 2272 2273 constructor TMotionBlurTask.Create(ABmp: TBGRACustomBitmap; ABounds: TRect; 2274 ADistance, AAngle: single; AOriented: boolean); 2275 begin 2276 FSource := ABmp; 2277 FBounds := ABounds; 2278 FDistance := ADistance; 2279 FAngle := AAngle; 2280 FOriented:= AOriented; 2281 end; 2282 2283 procedure TMotionBlurTask.DoExecute; 2284 begin 2285 FilterBlurMotion(FSource,FBounds,FDistance,FAngle,FOriented,Destination,@GetShouldStop); 2286 end; 2287 2288 constructor TRadialPreciseBlurTask.Create(bmp: TBGRACustomBitmap; 2289 ABounds: TRect; radius: single); 2290 begin 2291 FSource := bmp; 2292 FBounds := ABounds; 2293 FRadius := radius; 2294 end; 2295 2296 procedure TRadialPreciseBlurTask.DoExecute; 2297 begin 2298 FilterBlurRadialPrecise(FSource,FBounds,FRadius,Destination,@GetShouldStop); 2299 end; 2300 2301 { TRadialBlurTask } 2302 2303 constructor TRadialBlurTask.Create(bmp: TBGRACustomBitmap; ABounds: TRect; 2304 radius: integer; blurType: TRadialBlurType); 2305 begin 2306 FSource := bmp; 2307 FBounds := ABounds; 2308 FRadius := radius; 2309 FBlurType:= blurType; 2310 end; 2311 2312 procedure TRadialBlurTask.DoExecute; 2313 begin 2314 FilterBlurRadial(FSource,FBounds,FRadius,FBlurType,Destination,@GetShouldStop); 2315 end; 2316 2317 { TFilterTask } 2318 2319 function TFilterTask.GetShouldStop(ACurrentY: integer): boolean; 2320 begin 2321 FCurrentY:= ACurrentY; 2322 if Assigned(FCheckShouldStop) then 2323 result := FCheckShouldStop(ACurrentY) 2324 else 2325 result := false; 2326 end; 2327 2328 function TFilterTask.Execute: TBGRACustomBitmap; 2329 var DestinationOwned: boolean; 2330 begin 2331 FCurrentY := 0; 2332 if Destination = nil then 2333 begin 2334 FDestination := FSource.NewBitmap(FSource.Width,FSource.Height); 2335 DestinationOwned:= true; 2336 end else 2337 DestinationOwned:= false; 2338 try 2339 DoExecute; 2340 result := Destination; 2341 FDestination := nil; 2342 except 2343 on ex: exception do 2344 begin 2345 if DestinationOwned then FreeAndNil(FDestination); 2346 raise ex; 2347 end; 2348 end; 2349 end; 2350 2351 procedure TFilterTask.SetDestination(AValue: TBGRACustomBitmap); 2352 begin 2353 if FDestination <> nil then 2354 raise exception.Create('Destination is already defined'); 2355 FDestination := AValue; 2356 end; 2357 1697 2358 end. 1698 2359
Note:
See TracChangeset
for help on using the changeset viewer.