Changeset 317 for GraphicTest/BGRABitmap/bgrablend.pas
- Timestamp:
- Feb 1, 2012, 3:02:33 PM (13 years ago)
- Location:
- GraphicTest/BGRABitmap
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/BGRABitmap
-
Property svn:ignore
set to
lib
-
Property svn:ignore
set to
-
GraphicTest/BGRABitmap/bgrablend.pas
r210 r317 1 1 unit BGRABlend; 2 3 { This unit contains pixel blending functions. They take a destination adress as parameter, 4 and draw pixels at this address with different blending modes. These functions are used 5 by many functions in BGRABitmap library to do the low level drawing. } 2 6 3 7 {$mode objfpc}{$H+} … … 8 12 Classes, SysUtils, BGRABitmapTypes; 9 13 14 { Draw one pixel with alpha blending } 15 procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; 16 procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; 17 procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); inline; overload; 18 procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); inline; overload; //alpha in 'c' parameter 19 procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; 20 procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; calpha: byte); inline; overload; 21 22 procedure CopyPixelsWithOpacity(dest,src: PBGRAPixel; opacity: byte; Count: integer); inline; 23 function ApplyOpacity(opacity1,opacity2: byte): byte; inline; 24 function FastRoundDiv255(value: cardinal): cardinal; inline; 25 26 { Draw a series of pixels with alpha blending } 27 procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; overload; 28 procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; Count: integer); inline; overload; 29 procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer); inline; overload; //alpha in 'c' parameter 30 31 { Draw one pixel with linear alpha blending } 32 procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); inline; overload; 33 procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); inline; overload; 34 35 { Draw a series of pixels with linear alpha blending } 36 procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; 37 38 { Replace a series of pixels } 39 procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; 40 41 { Xor a series of pixels } 42 procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline; 43 procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); 44 45 { Set alpha value for a series of pixels } 46 procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline; 47 48 { Erase a series of pixels, i.e. decrease alpha value } 49 procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline; 50 51 { Draw a pixel to the extent the current pixel is close enough to compare value. 52 It should not be called on pixels that have not been checked to be close enough } 53 procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; 54 maxDiff: byte); inline; 55 { Draw a series of pixel to the extent the current pixel is close enough to compare value } 56 procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel; 57 Count: integer; compare: TBGRAPixel; maxDiff: byte); inline; 58 59 { Blend pixels with scanner content } 60 procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); 61 62 { Perform advanced blending operation } 10 63 procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; 11 64 blendOp: TBlendOperation; Count: integer); 12 65 13 procedure DrawPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;14 procedure DrawPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;15 16 procedure FillInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;17 procedure AlphaFillInline(dest: PBGRAPixel; alpha: byte; Count: integer); inline;18 procedure ErasePixelInline(dest: PBGRAPixel; alpha: byte); inline;19 20 procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;21 procedure FastBlendPixelsInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); inline;22 23 procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel;24 maxDiff: byte); inline;25 procedure DrawPixelsInlineDiff(dest: PBGRAPixel; c: TBGRAPixel;26 Count: integer; compare: TBGRAPixel; maxDiff: byte); inline;27 28 66 //layer blend modes ( http://www.pegtop.net/delphi/articles/blendmodes/ ) 29 procedure MultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;30 67 procedure LinearMultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 31 68 procedure AddPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; … … 34 71 procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 35 72 procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 73 procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 36 74 procedure GlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 75 procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 37 76 procedure OverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 77 procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 38 78 procedure DifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 39 79 procedure LinearDifferencePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; … … 47 87 implementation 48 88 89 procedure ScannerPutPixels(scan: IBGRAScanner; pdest: PBGRAPixel; count: integer; mode: TDrawMode); 90 var c : TBGRAPixel; 91 i: Integer; 92 scanNextFunc: function(): TBGRAPixel of object; 93 begin 94 if scan.IsScanPutPixelsDefined then 95 scan.ScanPutPixels(pdest,count,mode) else 96 begin 97 scanNextFunc := @scan.ScanNextPixel; 98 case mode of 99 dmLinearBlend: 100 for i := 0 to count-1 do 101 begin 102 FastBlendPixelInline(pdest, scanNextFunc()); 103 inc(pdest); 104 end; 105 dmDrawWithTransparency: 106 for i := 0 to count-1 do 107 begin 108 DrawPixelInlineWithAlphaCheck(pdest, scanNextFunc()); 109 inc(pdest); 110 end; 111 dmSet: 112 for i := 0 to count-1 do 113 begin 114 pdest^ := scanNextFunc(); 115 inc(pdest); 116 end; 117 dmXor: 118 for i := 0 to count-1 do 119 begin 120 PDWord(pdest)^ := PDWord(pdest)^ xor DWord(scanNextFunc()); 121 inc(pdest); 122 end; 123 dmSetExceptTransparent: 124 for i := 0 to count-1 do 125 begin 126 c := scanNextFunc(); 127 if c.alpha = 255 then pdest^ := c; 128 inc(pdest); 129 end; 130 end; 131 end; 132 end; 133 49 134 procedure BlendPixels(pdest: PBGRAPixel; psrc: PBGRAPixel; 50 135 blendOp: TBlendOperation; Count: integer); … … 61 146 boTransparent: while Count > 0 do 62 147 begin 63 DrawPixelInline (pdest, psrc^);148 DrawPixelInlineWithAlphaCheck(pdest, psrc^); 64 149 Inc(pdest); 65 150 Inc(psrc); … … 69 154 boMultiply: while Count > 0 do 70 155 begin 71 MultiplyPixelInline(pdest, psrc^); 72 Inc(pdest); 73 Inc(psrc); 74 Dec(Count); 75 end; 76 77 boLinearMultiply: while Count > 0 do 78 begin 79 LinearMultiplyPixelInline(pdest, psrc^); 156 LinearMultiplyPixelInline(pdest, psrc^); //same look with non linear 80 157 Inc(pdest); 81 158 Inc(psrc); … … 131 208 end; 132 209 210 boNiceGlow: while Count > 0 do 211 begin 212 NiceGlowPixelInline(pdest, psrc^); 213 Inc(pdest); 214 Inc(psrc); 215 Dec(Count); 216 end; 217 133 218 boOverlay: while Count > 0 do 134 219 begin 220 LinearOverlayPixelInline(pdest, psrc^); 221 Inc(pdest); 222 Inc(psrc); 223 Dec(Count); 224 end; 225 226 boDarkOverlay: while Count > 0 do 227 begin 135 228 OverlayPixelInline(pdest, psrc^); 136 229 Inc(pdest); … … 202 295 Dec(Count); 203 296 end; 297 end; 298 end; 299 300 procedure XorInline(dest: PBGRAPixel; c: TBGRAPixel; Count: integer); 301 begin 302 while Count > 0 do 303 begin 304 PDWord(dest)^ := PDWord(dest)^ xor DWord(c); 305 Inc(dest); 306 Dec(Count); 307 end; 308 end; 309 310 procedure XorPixels(pdest, psrc: PBGRAPixel; count: integer); 311 begin 312 while Count > 0 do 313 begin 314 PDWord(pdest)^ := PDWord(psrc)^ xor PDWord(pdest)^; 315 Inc(pdest); 316 Inc(psrc); 317 Dec(Count); 204 318 end; 205 319 end; … … 224 338 n: integer; 225 339 begin 340 if c.alpha = 0 then exit; 226 341 for n := Count - 1 downto 0 do 227 342 begin … … 234 349 var 235 350 n: integer; 236 begin 351 ec: TExpandedPixel; 352 begin 353 if c.alpha = 0 then exit; 354 if c.alpha = 255 then 355 begin 356 filldword(dest^,count,longword(c)); 357 exit; 358 end; 359 ec := GammaExpansion(c); 237 360 for n := Count - 1 downto 0 do 238 361 begin 239 DrawPixelInline(dest, c); 362 DrawExpandedPixelInlineNoAlphaCheck(dest, ec,c.alpha); 363 Inc(dest); 364 end; 365 end; 366 367 procedure DrawExpandedPixelsInline(dest: PBGRAPixel; ec: TExpandedPixel; 368 Count: integer); 369 var 370 n: integer; 371 c: TBGRAPixel; 372 begin 373 if ec.alpha < $0100 then exit; 374 if ec.alpha >= $FF00 then 375 begin 376 c := GammaCompression(ec); 377 filldword(dest^,count,longword(c)); 378 exit; 379 end; 380 for n := Count - 1 downto 0 do 381 begin 382 DrawExpandedPixelInlineNoAlphaCheck(dest, ec, ec.alpha shr 8); 383 Inc(dest); 384 end; 385 end; 386 387 procedure DrawPixelsInlineExpandedOrNot(dest: PBGRAPixel; ec: TExpandedPixel; c: TBGRAPixel; Count: integer 388 ); 389 var 390 n: integer; 391 begin 392 if c.alpha = 0 then exit; 393 if c.alpha = 255 then 394 begin 395 filldword(dest^,count,longword(c)); 396 exit; 397 end; 398 for n := Count - 1 downto 0 do 399 begin 400 DrawExpandedPixelInlineNoAlphaCheck(dest, ec, c.alpha); 240 401 Inc(dest); 241 402 end; … … 255 416 256 417 {$hints off} 257 procedure DrawPixelInline(dest: PBGRAPixel; c: TBGRAPixel); 418 procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); 419 begin 420 if c.alpha = 0 then 421 exit; 422 if c.alpha = 255 then 423 begin 424 dest^ := c; 425 exit; 426 end; 427 DrawPixelInlineNoAlphaCheck(dest,c); 428 end; 429 430 procedure DrawPixelInlineWithAlphaCheck(dest: PBGRAPixel; c: TBGRAPixel; appliedOpacity: byte); 431 begin 432 c.alpha := ApplyOpacity(c.alpha,appliedOpacity); 433 if c.alpha = 0 then 434 exit; 435 if c.alpha = 255 then 436 begin 437 dest^ := c; 438 exit; 439 end; 440 DrawPixelInlineNoAlphaCheck(dest,c); 441 end; 442 443 procedure CopyPixelsWithOpacity(dest, src: PBGRAPixel; opacity: byte; 444 Count: integer); 445 var c: TBGRAPixel; 446 begin 447 while count > 0 do 448 begin 449 c := src^; 450 c.alpha := ApplyOpacity(c.alpha,opacity); 451 dest^ := c; 452 inc(src); 453 inc(dest); 454 dec(count); 455 end; 456 end; 457 458 function ApplyOpacity(opacity1, opacity2: byte): byte; 459 begin 460 result := opacity1*(opacity2+1) shr 8; 461 end; 462 463 function FastRoundDiv255(value: cardinal): cardinal; inline; 464 begin 465 result := (value + (value shr 7)) shr 8; 466 end; 467 468 procedure DrawExpandedPixelInlineWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel); 469 var 470 calpha: byte; 471 begin 472 calpha := ec.alpha shr 8; 473 if calpha = 0 then 474 exit; 475 if calpha = 255 then 476 begin 477 dest^ := GammaCompression(ec); 478 exit; 479 end; 480 DrawExpandedPixelInlineNoAlphaCheck(dest,ec,calpha); 481 end; 482 483 procedure DrawPixelInlineExpandedOrNotWithAlphaCheck(dest: PBGRAPixel; const ec: TExpandedPixel; c: TBGRAPixel); 484 begin 485 if c.alpha = 0 then 486 exit; 487 if c.alpha = 255 then 488 begin 489 dest^ := c; 490 exit; 491 end; 492 DrawExpandedPixelInlineNoAlphaCheck(dest,ec,c.alpha); 493 end; 494 495 procedure DrawPixelInlineNoAlphaCheck(dest: PBGRAPixel; const c: TBGRAPixel); 258 496 var 259 497 p: PByte; 260 498 a1f, a2f, a12, a12m: cardinal; 261 499 begin 262 if c.alpha = 0 then263 exit;264 if c.alpha = 255 then265 begin266 dest^ := c;267 exit;268 end;269 270 500 a12 := 65025 - (not dest^.alpha) * (not c.alpha); 271 501 a12m := a12 shr 1; … … 289 519 end; 290 520 291 procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel); 521 procedure DrawExpandedPixelInlineNoAlphaCheck(dest: PBGRAPixel; 522 const ec: TExpandedPixel; calpha: byte); 523 var 524 p: PByte; 525 a1f, a2f, a12, a12m: cardinal; 526 begin 527 a12 := 65025 - (not dest^.alpha) * (not calpha); 528 a12m := a12 shr 1; 529 530 a1f := dest^.alpha * (not calpha); 531 a2f := (calpha shl 8) - calpha; 532 533 p := PByte(dest); 534 535 p^ := GammaCompressionTab[(GammaExpansionTab[dest^.blue] * a1f + 536 ec.blue * a2f + a12m) div a12]; 537 Inc(p); 538 p^ := GammaCompressionTab[(GammaExpansionTab[dest^.green] * a1f + 539 ec.green * a2f + a12m) div a12]; 540 Inc(p); 541 p^ := GammaCompressionTab[(GammaExpansionTab[dest^.red] * a1f + 542 ec.red * a2f + a12m) div a12]; 543 Inc(p); 544 545 p^ := (a12 + a12 shr 7) shr 8; 546 end; 547 548 procedure FastBlendPixelInline(dest: PBGRAPixel; const c: TBGRAPixel); 292 549 var 293 550 p: PByte; … … 320 577 end; 321 578 579 procedure FastBlendPixelInline(dest: PBGRAPixel; c: TBGRAPixel; 580 appliedOpacity: byte); 581 begin 582 c.alpha := ApplyOpacity(c.alpha,appliedOpacity); 583 FastBlendPixelInline(dest,c); 584 end; 585 322 586 procedure DrawPixelInlineDiff(dest: PBGRAPixel; c, compare: TBGRAPixel; 323 587 maxDiff: byte); inline; 324 588 begin 325 DrawPixelInline (dest, BGRA(c.red, c.green, c.blue,589 DrawPixelInlineWithAlphaCheck(dest, BGRA(c.red, c.green, c.blue, 326 590 (c.alpha * (maxDiff + 1 - BGRADiff(dest^, compare)) + (maxDiff + 1) shr 1) div 327 591 (maxDiff + 1))); … … 332 596 newAlpha: byte; 333 597 begin 334 newAlpha := dest^.alpha * (255 - alpha) div 255;598 newAlpha := ApplyOpacity(dest^.alpha, not alpha); 335 599 if newAlpha = 0 then 336 600 dest^ := BGRAPixelTransparent … … 343 607 {--------------------------------------- Layer blending -----------------------------------------} 344 608 345 function ByteMultiplyInline(a, b: byte): byte;346 begin347 Result := GammaCompressionTab[GammaExpansionTab[a] * GammaExpansionTab[b] shr 16];348 end;349 350 609 function ByteLinearMultiplyInline(a, b: byte): byte; 351 610 begin 352 611 Result := (a * b) shr 8; 353 end;354 355 procedure MultiplyPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline;356 var357 destalpha: byte;358 begin359 destalpha := dest^.alpha;360 dest^.red := (ByteMultiplyInline(dest^.red, c.red) * destalpha +361 c.red * (not destalpha)) shr 8;362 dest^.green := (ByteMultiplyInline(dest^.green, c.green) * destalpha +363 c.green * (not destalpha)) shr 8;364 dest^.blue := (ByteMultiplyInline(dest^.blue, c.blue) * destalpha +365 c.blue * (not destalpha)) shr 8;366 dest^.alpha := c.alpha;367 612 end; 368 613 … … 456 701 end; 457 702 703 {$hints off} 458 704 function ByteDodgeInline(a, b: byte): byte; inline; 459 705 var … … 464 710 else 465 711 begin 466 temp := (a shl 8) div ( 255 -b);712 temp := (a shl 8) div (not b); 467 713 if temp > 255 then 468 714 Result := 255 … … 471 717 end; 472 718 end; 719 {$hints on} 473 720 474 721 procedure ColorDodgePixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; … … 486 733 end; 487 734 488 function ByteReflectInline(a, b: byte): byte; inline; 489 var 490 temp: integer; 735 {$hints off} 736 function ByteNonLinearReflectInline(a, b: byte): byte; inline; 737 var 738 temp: longword; 739 wa,wb: word; 491 740 begin 492 741 if b = 255 then … … 494 743 else 495 744 begin 496 temp := a * a div (255 - b); 745 wa := GammaExpansionTab[a]; 746 wb := GammaExpansionTab[b]; 747 temp := wa * wa div (not wb); 748 if temp >= 65535 then 749 Result := 255 750 else 751 Result := GammaCompressionTab[ temp ]; 752 end; 753 end; 754 755 function ByteReflectInline(a, b: byte): byte; inline; 756 var 757 temp: integer; 758 begin 759 if b = 255 then 760 Result := 255 761 else 762 begin 763 temp := a * a div (not b); 497 764 if temp > 255 then 498 765 Result := 255 … … 501 768 end; 502 769 end; 770 {$hints on} 771 503 772 504 773 procedure ReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; … … 526 795 c.green * (not destalpha)) shr 8; 527 796 dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + 797 c.blue * (not destalpha)) shr 8; 798 dest^.alpha := c.alpha; 799 end; 800 801 procedure NiceGlowPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 802 var 803 destalpha: byte; 804 begin 805 destalpha := dest^.alpha; 806 dest^.red := (ByteReflectInline(c.red, dest^.red) * destalpha + 807 c.red * (not destalpha)) shr 8; 808 dest^.green := (ByteReflectInline(c.green, dest^.green) * destalpha + 809 c.green * (not destalpha)) shr 8; 810 dest^.blue := (ByteReflectInline(c.blue, dest^.blue) * destalpha + 811 c.blue * (not destalpha)) shr 8; 812 813 if (c.red > c.green) and (c.red > c.blue) then 814 dest^.alpha := c.red else 815 if (c.green > c.blue) then 816 dest^.alpha := c.green else 817 dest^.alpha := c.blue; 818 dest^.alpha := ApplyOpacity(GammaExpansionTab[dest^.alpha] shr 8,c.alpha); 819 end; 820 821 procedure NonLinearReflectPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 822 var 823 destalpha: byte; 824 begin 825 destalpha := dest^.alpha; 826 dest^.red := (ByteNonLinearReflectInline(dest^.red, c.red) * destalpha + 827 c.red * (not destalpha)) shr 8; 828 dest^.green := (ByteNonLinearReflectInline(dest^.green, c.green) * destalpha + 829 c.green * (not destalpha)) shr 8; 830 dest^.blue := (ByteNonLinearReflectInline(dest^.blue, c.blue) * destalpha + 528 831 c.blue * (not destalpha)) shr 8; 529 832 dest^.alpha := c.alpha; … … 532 835 {$hints off} 533 836 function ByteOverlayInline(a, b: byte): byte; inline; 837 var wa,wb: word; 838 begin 839 wa := GammaExpansionTab[a]; 840 wb := GammaExpansionTab[b]; 841 if wa < 32768 then 842 Result := GammaCompressionTab[ (wa * wb) shr 15 ] 843 else 844 Result := GammaCompressionTab[ 65535 - ((not wa) * (not wb) shr 15) ]; 845 end; 846 847 function ByteLinearOverlayInline(a, b: byte): byte; inline; 534 848 begin 535 849 if a < 128 then 536 850 Result := (a * b) shr 7 537 851 else 538 Result := 255 - (( 255 - a) * (255 -b) shr 7);852 Result := 255 - ((not a) * (not b) shr 7); 539 853 end; 540 854 … … 551 865 c.green * (not destalpha)) shr 8; 552 866 dest^.blue := (ByteOverlayInline(dest^.blue, c.blue) * destalpha + 867 c.blue * (not destalpha)) shr 8; 868 dest^.alpha := c.alpha; 869 end; 870 871 procedure LinearOverlayPixelInline(dest: PBGRAPixel; c: TBGRAPixel); inline; 872 var 873 destalpha: byte; 874 begin 875 destalpha := dest^.alpha; 876 dest^.red := (ByteLinearOverlayInline(dest^.red, c.red) * destalpha + 877 c.red * (not destalpha)) shr 8; 878 dest^.green := (ByteLinearOverlayInline(dest^.green, c.green) * destalpha + 879 c.green * (not destalpha)) shr 8; 880 dest^.blue := (ByteLinearOverlayInline(dest^.blue, c.blue) * destalpha + 553 881 c.blue * (not destalpha)) shr 8; 554 882 dest^.alpha := c.alpha;
Note:
See TracChangeset
for help on using the changeset viewer.