Changeset 472 for GraphicTest/Packages/bgrabitmap/bgracanvas2d.pas
- Timestamp:
- Apr 9, 2015, 9:58:36 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/Packages/bgrabitmap/bgracanvas2d.pas
r452 r472 3 3 { To do : 4 4 5 draw text with a different precision if the matrix is scaled 6 drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh) 7 -> using FillPoly with texture coordinates 5 8 linear gradient any transformation 6 9 clearPath clipping 7 10 createRadialGradient 8 text functions9 11 globalCompositeOperation 10 drawImage(in image, in double sx, in double sy, in double sw, in double sh, in double dx, in double dy, in double dw, in double dh)11 12 image data functions 12 13 } … … 17 18 18 19 uses 19 Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATransform, BGRAGradientScanner ;20 Classes, SysUtils, Graphics, BGRABitmapTypes, BGRATransform, BGRAGradientScanner, BGRAPath; 20 21 21 22 type … … 47 48 globalAlpha: byte; 48 49 50 fontName: string; 51 fontStyle: TFontStyles; 52 fontEmHeight: single; 53 textAlign: TAlignment; 54 textBaseline: string; 55 49 56 lineWidth: single; 50 57 lineCap: TPenEndCap; … … 55 62 shadowOffsetX,shadowOffsetY,shadowBlur: single; 56 63 shadowColor: TBGRAPixel; 64 shadowFastest: boolean; 57 65 58 66 matrix: TAffineMatrix; … … 63 71 end; 64 72 73 TCanvas2dTextSize = record 74 width,height: single; 75 end; 76 65 77 { TBGRACanvas2D } 66 78 67 TBGRACanvas2D = class 79 TBGRACanvas2D = class(IBGRAPath) 68 80 private 69 81 FSurface: TBGRACustomBitmap; … … 74 86 FPathPoints: array of TPointF; 75 87 FPathPointCount: integer; 88 FFontRenderer: TBGRACustomFontRenderer; 89 FLastCoord, FStartCoord: TPointF; 90 function GetCurrentPath: ArrayOfTPointF; 91 function GetFontName: string; 92 function GetFontRenderer: TBGRACustomFontRenderer; 93 function GetFontEmHeight: single; 94 function GetFontString: string; 95 function GetFontStyle: TFontStyles; 76 96 function GetGlobalAlpha: single; 77 97 function GetHasShadow: boolean; 78 98 function GetHeight: Integer; 79 99 function GetLineCap: string; 100 function GetLineCapLCL: TPenEndCap; 80 101 function GetlineJoin: string; 102 function GetlineJoinLCL: TPenJoinStyle; 81 103 function GetLineWidth: single; 104 function GetMatrix: TAffineMatrix; 82 105 function GetMiterLimit: single; 83 106 function GetPixelCenteredCoordinates: boolean; 84 107 function GetShadowBlur: single; 108 function GetShadowFastest: boolean; 85 109 function GetShadowOffset: TPointF; 86 110 function GetShadowOffsetX: single; 87 111 function GetShadowOffsetY: single; 112 function GetTextAlign: string; 113 function GetTextAlignLCL: TAlignment; 114 function GetTextBaseline: string; 88 115 function GetWidth: Integer; 116 procedure SetFontName(AValue: string); 117 procedure SetFontRenderer(AValue: TBGRACustomFontRenderer); 118 procedure SetFontEmHeight(AValue: single); 119 procedure SetFontString(AValue: string); 120 procedure SetFontStyle(AValue: TFontStyles); 89 121 procedure SetGlobalAlpha(const AValue: single); 90 122 procedure SetLineCap(const AValue: string); 123 procedure SetLineCapLCL(AValue: TPenEndCap); 91 124 procedure SetLineJoin(const AValue: string); 92 125 procedure FillPoly(const points: array of TPointF); 93 126 procedure FillStrokePoly(const points: array of TPointF; fillOver: boolean); 127 procedure SetLineJoinLCL(AValue: TPenJoinStyle); 94 128 procedure SetLineWidth(const AValue: single); 129 procedure SetMatrix(AValue: TAffineMatrix); 95 130 procedure SetMiterLimit(const AValue: single); 96 131 procedure SetPixelCenteredCoordinates(const AValue: boolean); 97 132 procedure SetShadowBlur(const AValue: single); 133 procedure SetShadowFastest(AValue: boolean); 98 134 procedure SetShadowOffset(const AValue: TPointF); 99 135 procedure SetShadowOffsetX(const AValue: single); 100 136 procedure SetShadowOffsetY(const AValue: single); 137 procedure SetTextAlign(AValue: string); 138 procedure SetTextAlignLCL(AValue: TAlignment); 139 procedure SetTextBaseine(AValue: string); 101 140 procedure StrokePoly(const points: array of TPointF); 102 141 procedure DrawShadow(const points, points2: array of TPointF); … … 105 144 function ApplyTransform(const points: array of TPointF): ArrayOfTPointF; overload; 106 145 function ApplyTransform(point: TPointF): TPointF; overload; 107 function GetPenPos: TPointF; 146 function GetPenPos(defaultX, defaultY: single): TPointF; 147 function GetPenPos(defaultPt: TPointF): TPointF; 108 148 procedure AddPoint(point: TPointF); 109 149 procedure AddPoints(const points: array of TPointF); 110 150 procedure AddPointsRev(const points: array of TPointF); 111 151 function ApplyGlobalAlpha(color: TBGRAPixel): TBGRAPixel; 152 function GetDrawMode: TDrawMode; 153 procedure copyTo({%H-}dest: IBGRAPath); //IBGRAPath 112 154 public 155 antialiasing, linearBlend: boolean; 113 156 constructor Create(ASurface: TBGRACustomBitmap); 114 157 destructor Destroy; override; … … 118 161 procedure save; 119 162 procedure restore; 120 procedure scale(x,y: single); 121 procedure rotate(angleRad: single); 163 procedure scale(x,y: single); overload; 164 procedure scale(factor: single); overload; 165 procedure rotate(angleRadCW: single); 122 166 procedure translate(x,y: single); 123 procedure transform(a,b,c,d,e,f: single); 167 procedure transform(a,b,c,d,e,f: single); overload; 168 procedure transform(AMatrix: TAffineMatrix); overload; 124 169 procedure setTransform(a,b,c,d,e,f: single); 125 170 procedure resetTransform; … … 137 182 procedure shadowColor(color: TColor); overload; 138 183 procedure shadowColor(color: string); overload; 184 procedure shadowNone; 139 185 function getShadowColor: TBGRAPixel; 140 186 function createLinearGradient(x0,y0,x1,y1: single): IBGRACanvasGradient2D; overload; … … 149 195 procedure clearRect(x,y,w,h: single); 150 196 197 procedure addPath(APath: IBGRAPath); overload; 198 procedure addPath(ASvgPath: string); overload; 199 procedure path(APath: IBGRAPath); overload; 200 procedure path(ASvgPath: string); overload; 151 201 procedure beginPath; 152 202 procedure closePath; … … 154 204 procedure moveTo(x,y: single); overload; 155 205 procedure lineTo(x,y: single); overload; 156 procedure moveTo( pt: TPointF); overload;157 procedure lineTo( pt: TPointF); overload;206 procedure moveTo(const pt: TPointF); overload; 207 procedure lineTo(const pt: TPointF); overload; 158 208 procedure polylineTo(const pts: array of TPointF); 159 209 procedure quadraticCurveTo(cpx,cpy,x,y: single); overload; 160 procedure quadraticCurveTo(c p,pt: TPointF); overload;210 procedure quadraticCurveTo(const cp,pt: TPointF); overload; 161 211 procedure bezierCurveTo(cp1x,cp1y,cp2x,cp2y,x,y: single); overload; 162 procedure bezierCurveTo(c p1,cp2,pt: TPointF); overload;212 procedure bezierCurveTo(const cp1,cp2,pt: TPointF); overload; 163 213 procedure rect(x,y,w,h: single); 164 procedure roundRect(x,y,w,h,radius: single); 214 procedure roundRect(x,y,w,h,radius: single); overload; 215 procedure roundRect(x,y,w,h,rx,ry: single); overload; 165 216 procedure spline(const pts: array of TPointF; style: TSplineStyle= ssOutside); 166 217 procedure splineTo(const pts: array of TPointF; style: TSplineStyle= ssOutside); 167 procedure arc(x, y, radius, startAngle, endAngle: single; anticlockwise: boolean); overload; 168 procedure arc(x, y, radius, startAngle, endAngle: single); overload; 218 procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; 219 procedure arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); overload; 220 procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; anticlockwise: boolean); overload; 221 procedure arc(cx, cy, rx,ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); overload; 222 procedure arc(const arcDef: TArcDef); overload; 169 223 procedure arcTo(x1, y1, x2, y2, radius: single); overload; 170 224 procedure arcTo(p1,p2: TPointF; radius: single); overload; 225 procedure arcTo(rx, ry, xAngleRadCW: single; largeArc,anticlockwise: boolean; x, y: single); 226 procedure circle(x,y,r: single); 227 procedure ellipse(x,y,rx,ry: single); 228 procedure text(AText: string; x,y: single); 229 procedure fillText(AText: string; x,y: single); 230 procedure strokeText(AText: string; x,y: single); 231 function measureText(AText: string): TCanvas2dTextSize; 232 171 233 procedure fill; 172 234 procedure stroke; … … 183 245 184 246 function getLineStyle: TBGRAPenStyle; 185 procedure lineStyle(const AValue: array of single); 247 procedure lineStyle(const AValue: array of single); overload; 248 procedure lineStyle(AStyle: TPenStyle); overload; 186 249 187 250 property surface: TBGRACustomBitmap read FSurface; … … 190 253 property pixelCenteredCoordinates: boolean read GetPixelCenteredCoordinates write SetPixelCenteredCoordinates; 191 254 property globalAlpha: single read GetGlobalAlpha write SetGlobalAlpha; 255 property matrix: TAffineMatrix read GetMatrix write SetMatrix; 192 256 193 257 property lineWidth: single read GetLineWidth write SetLineWidth; 194 258 property lineCap: string read GetLineCap write SetLineCap; 259 property lineCapLCL: TPenEndCap read GetLineCapLCL write SetLineCapLCL; 195 260 property lineJoin: string read GetlineJoin write SetLineJoin; 261 property lineJoinLCL: TPenJoinStyle read GetlineJoinLCL write SetLineJoinLCL; 196 262 property miterLimit: single read GetMiterLimit write SetMiterLimit; 197 263 … … 200 266 property shadowOffset: TPointF read GetShadowOffset write SetShadowOffset; 201 267 property shadowBlur: single read GetShadowBlur write SetShadowBlur; 268 property shadowFastest: boolean read GetShadowFastest write SetShadowFastest; 202 269 property hasShadow: boolean read GetHasShadow; 270 271 property fontName: string read GetFontName write SetFontName; 272 property fontEmHeight: single read GetFontEmHeight write SetFontEmHeight; 273 property fontStyle: TFontStyles read GetFontStyle write SetFontStyle; 274 property font: string read GetFontString write SetFontString; 275 property textAlignLCL: TAlignment read GetTextAlignLCL write SetTextAlignLCL; 276 property textAlign: string read GetTextAlign write SetTextAlign; 277 property textBaseline: string read GetTextBaseline write SetTextBaseine; 278 279 property currentPath: ArrayOfTPointF read GetCurrentPath; 280 property fontRenderer: TBGRACustomFontRenderer read GetFontRenderer write SetFontRenderer; 281 282 protected 283 function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 284 function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 285 function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 203 286 end; 204 287 205 288 implementation 206 289 207 uses Math, BGRAPen, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64;290 uses Types, Math, BGRAPen, BGRAFillInfo, BGRAPolygon, BGRABlend, FPWriteJPEG, FPWriteBMP, base64; 208 291 209 292 type … … 446 529 globalAlpha := 255; 447 530 531 fontName := 'Arial'; 532 fontEmHeight := 10; 533 fontStyle := []; 534 textAlign:= taLeftJustify; 535 textBaseline := 'alphabetic'; 536 448 537 lineWidth := 1; 449 538 lineCap := pecFlat; … … 456 545 shadowBlur := 0; 457 546 shadowColor := BGRAPixelTransparent; 547 shadowFastest:= false; 458 548 459 549 matrix := AMatrix; … … 473 563 result.globalAlpha := globalAlpha; 474 564 565 result.fontName:= fontName; 566 result.fontEmHeight := fontEmHeight; 567 result.fontStyle := fontStyle; 568 475 569 result.lineWidth := lineWidth; 476 570 result.lineCap := lineCap; … … 483 577 result.shadowBlur := shadowBlur; 484 578 result.shadowColor := shadowColor; 579 result.shadowFastest := shadowFastest; 485 580 end; 486 581 … … 495 590 function TBGRACanvas2D.GetHeight: Integer; 496 591 begin 497 result := Surface.Height; 592 if Assigned(surface) then 593 result := Surface.Height 594 else 595 result := 0; 498 596 end; 499 597 … … 507 605 end; 508 606 607 function TBGRACanvas2D.GetLineCapLCL: TPenEndCap; 608 begin 609 result := currentState.lineCap; 610 end; 611 509 612 function TBGRACanvas2D.GetlineJoin: string; 510 613 begin … … 516 619 end; 517 620 621 function TBGRACanvas2D.GetlineJoinLCL: TPenJoinStyle; 622 begin 623 result := currentState.lineJoin; 624 end; 625 518 626 function TBGRACanvas2D.getLineStyle: TBGRAPenStyle; 519 627 begin … … 526 634 end; 527 635 636 function TBGRACanvas2D.GetMatrix: TAffineMatrix; 637 begin 638 result := currentState.matrix; 639 end; 640 528 641 function TBGRACanvas2D.GetMiterLimit: single; 529 642 begin … … 541 654 end; 542 655 656 function TBGRACanvas2D.GetShadowFastest: boolean; 657 begin 658 result := currentState.shadowFastest; 659 end; 660 543 661 function TBGRACanvas2D.GetShadowOffset: TPointF; 544 662 begin … … 556 674 end; 557 675 676 function TBGRACanvas2D.GetTextAlign: string; 677 begin 678 case currentState.textAlign of 679 taRightJustify: result := 'right'; 680 taCenter: result := 'center'; 681 else 682 result := 'left'; 683 end; 684 end; 685 686 function TBGRACanvas2D.GetTextAlignLCL: TAlignment; 687 begin 688 result := currentState.textAlign; 689 end; 690 691 function TBGRACanvas2D.GetTextBaseline: string; 692 begin 693 result := currentState.textBaseline; 694 end; 695 558 696 function TBGRACanvas2D.GetGlobalAlpha: single; 559 697 begin 560 698 result := currentState.globalAlpha/255; 699 end; 700 701 function TBGRACanvas2D.GetCurrentPath: ArrayOfTPointF; 702 var i: integer; 703 begin 704 setlength(result, FPathPointCount); 705 for i := 0 to high(result) do 706 result[i] := FPathPoints[i]; 707 end; 708 709 function TBGRACanvas2D.GetFontName: string; 710 begin 711 result := currentState.fontName; 712 end; 713 714 function TBGRACanvas2D.GetFontRenderer: TBGRACustomFontRenderer; 715 var zoom1,zoom2,zoom: single; 716 begin 717 if FFontRenderer = nil then 718 begin 719 if FSurface <> nil then 720 result := FSurface.FontRenderer 721 else 722 result := nil; 723 end else 724 result := FFontRenderer; 725 if Assigned(result) then 726 begin 727 result.FontName := currentState.fontName; 728 result.FontStyle := currentState.fontStyle; 729 if antialiasing then 730 result.FontQuality:= fqFineAntialiasing 731 else 732 result.FontQuality := fqSystem; 733 result.FontOrientation := 0; 734 zoom1 := VectLen(currentState.matrix[1,1],currentState.matrix[2,1]); 735 zoom2 := VectLen(currentState.matrix[1,2],currentState.matrix[2,2]); 736 if zoom1>zoom2 then zoom := zoom1 else zoom := zoom2; 737 result.FontEmHeight := round(currentState.fontEmHeight*zoom); 738 end; 739 end; 740 741 function TBGRACanvas2D.GetFontEmHeight: single; 742 begin 743 result := currentState.fontEmHeight; 744 end; 745 746 function TBGRACanvas2D.GetFontString: string; 747 var formats: TFormatSettings; 748 begin 749 formats := DefaultFormatSettings; 750 formats.DecimalSeparator := '.'; 751 752 result := ''; 753 if fsItalic in currentState.fontStyle then 754 result := result+'italic '; 755 if fsBold in currentState.fontStyle then 756 result += 'bold '; 757 result += FloatToStrF(currentState.fontEmHeight,ffGeneral,6,0,formats)+'px '; 758 result += currentState.fontName; 759 result := trim(result); 760 end; 761 762 function TBGRACanvas2D.GetFontStyle: TFontStyles; 763 begin 764 result := currentState.fontStyle; 561 765 end; 562 766 … … 570 774 function TBGRACanvas2D.GetWidth: Integer; 571 775 begin 572 result := Surface.Width; 776 if Assigned(Surface) then 777 result := Surface.Width 778 else 779 result := 0; 780 end; 781 782 procedure TBGRACanvas2D.SetFontName(AValue: string); 783 begin 784 currentState.fontName := AValue; 785 end; 786 787 procedure TBGRACanvas2D.SetFontRenderer(AValue: TBGRACustomFontRenderer); 788 begin 789 if AValue = FFontRenderer then exit; 790 FreeAndNil(FFontRenderer); 791 FFontRenderer := AValue; 792 end; 793 794 procedure TBGRACanvas2D.SetFontEmHeight(AValue: single); 795 begin 796 currentState.fontEmHeight := AValue; 797 end; 798 799 procedure TBGRACanvas2D.SetFontString(AValue: string); 800 var idxSpace,errPos: integer; 801 attrib,u: string; 802 value: single; 803 begin 804 currentState.fontStyle := []; 805 currentState.fontEmHeight := 10; 806 currentState.fontName := 'Arial'; 807 AValue := trim(AValue); 808 while AValue <> '' do 809 begin 810 while (AValue <> '') and (AValue[1]in [#0..#32]) do delete(AValue,1,1); 811 idxSpace := pos(' ',AValue); 812 if idxSpace = 0 then 813 attrib := AValue 814 else 815 attrib := copy(AValue,1,idxSpace-1); 816 attrib := lowerCase(attrib); 817 if attrib = '' then break; 818 if (attrib = 'normal') or (attrib = 'small-caps') or (attrib = 'lighter') then 819 begin 820 //nothing 821 end else 822 if (attrib = 'italic') or (attrib = 'oblique') then 823 begin 824 currentState.fontStyle += [fsItalic]; 825 end else 826 if (attrib = 'bold') or (attrib = 'bolder') then 827 begin 828 currentState.fontStyle += [fsBold]; 829 end else 830 if (attrib[1] in ['.','0'..'9']) then 831 begin 832 u := ''; 833 while (length(attrib)>0) and (attrib[length(attrib)] in['a'..'z']) do 834 begin 835 u := attrib[length(attrib)]+u; 836 delete(attrib,length(attrib),1); 837 end; 838 val(attrib,value,errPos); 839 if errPos = 0 then 840 begin 841 if u = '' then //weight 842 begin 843 if value >= 600 then currentState.fontStyle += [fsBold]; 844 end else 845 if u = 'px' then currentState.fontEmHeight := value else 846 if u = 'pt' then currentState.fontEmHeight:= value/72*96 else 847 if u = 'in' then currentState.fontEmHeight:= value*96 else 848 if u = 'mm' then currentState.fontEmHeight:= value/25.4*96 else 849 if u = 'cm' then currentState.fontEmHeight:= value/2.54*96; 850 end; 851 end else 852 break; 853 delete(AValue,1,length(attrib)+1); 854 end; 855 AValue := trim(AValue); 856 if AValue <> '' then currentState.fontName := AValue; 857 end; 858 859 procedure TBGRACanvas2D.SetFontStyle(AValue: TFontStyles); 860 begin 861 currentState.fontStyle:= AValue; 573 862 end; 574 863 … … 590 879 end; 591 880 881 procedure TBGRACanvas2D.SetLineCapLCL(AValue: TPenEndCap); 882 begin 883 currentState.lineCap := AValue; 884 end; 885 592 886 procedure TBGRACanvas2D.SetLineJoin(const AValue: string); 593 887 begin … … 604 898 tempScan: TBGRACustomScanner; 605 899 begin 606 if length(points) = 0then exit;900 if (length(points) = 0) or (surface = nil) then exit; 607 901 If hasShadow then DrawShadow(points,[]); 608 902 if currentState.clipMask <> nil then … … 612 906 else 613 907 tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.fillColor)); 614 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true); 908 if self.antialiasing then 909 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true, linearBlend) 910 else 911 BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, true, GetDrawMode); 615 912 tempScan.free; 616 913 end else … … 621 918 begin 622 919 tempScan := TBGRAOpacityScanner.Create(currentState.fillTextureProvider.texture, currentState.globalAlpha); 623 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true); 920 if self.antialiasing then 921 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, tempScan, true, linearBlend) 922 else 923 BGRAPolygon.FillPolyAliasedWithTexture(surface, points, tempScan, true, GetDrawMode); 624 924 tempScan.Free; 625 925 end else 626 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, true) 926 begin 927 if self.antialiasing then 928 BGRAPolygon.FillPolyAntialiasWithTexture(surface, points, currentState.fillTextureProvider.texture, true, linearBlend) 929 else 930 BGRAPolygon.FillPolyAliasedWithTexture(surface, points, currentState.fillTextureProvider.texture, true, GetDrawMode); 931 end 627 932 end 628 933 else 629 BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true); 934 begin 935 if self.antialiasing then 936 BGRAPolygon.FillPolyAntialias(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true, linearBlend) 937 else 938 BGRAPolygon.FillPolyAliased(surface, points, ApplyGlobalAlpha(currentState.fillColor), false, true, GetDrawMode) 939 end 630 940 end; 631 941 end; … … 639 949 texture: IBGRAScanner; 640 950 begin 641 if length(points) = 0then exit;951 if (length(points) = 0) or (surface = nil) then exit; 642 952 tempScan := nil; 643 953 tempScan2 := nil; … … 693 1003 694 1004 if fillOver then multi.PolygonOrder := poFirstOnTop else multi.PolygonOrder:= poLastOnTop; 1005 multi.Antialiasing := self.antialiasing; 695 1006 multi.Draw(surface); 696 1007 tempScan.free; … … 699 1010 end; 700 1011 1012 procedure TBGRACanvas2D.SetLineJoinLCL(AValue: TPenJoinStyle); 1013 begin 1014 currentState.lineJoin := AValue; 1015 end; 1016 701 1017 procedure TBGRACanvas2D.lineStyle(const AValue: array of single); 702 1018 begin … … 704 1020 end; 705 1021 1022 procedure TBGRACanvas2D.lineStyle(AStyle: TPenStyle); 1023 begin 1024 case AStyle of 1025 psSolid: lineStyle(SolidPenStyle); 1026 psDash: lineStyle(DashPenStyle); 1027 psDot: lineStyle(DotPenStyle); 1028 psDashDot: lineStyle(DashDotPenStyle); 1029 psDashDotDot: lineStyle(DashDotDotPenStyle); 1030 psClear: lineStyle(ClearPenStyle); 1031 end; 1032 end; 1033 1034 function TBGRACanvas2D.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 1035 begin 1036 if GetInterface(iid, obj) then 1037 Result := S_OK 1038 else 1039 Result := longint(E_NOINTERFACE); 1040 end; 1041 1042 { There is no automatic reference counting, but it is compulsory to define these functions } 1043 function TBGRACanvas2D._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 1044 begin 1045 result := 0; 1046 end; 1047 1048 function TBGRACanvas2D._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND}; 1049 begin 1050 result := 0; 1051 end; 1052 706 1053 procedure TBGRACanvas2D.SetLineWidth(const AValue: single); 707 1054 begin 708 1055 currentState.lineWidth := AValue; 1056 end; 1057 1058 procedure TBGRACanvas2D.SetMatrix(AValue: TAffineMatrix); 1059 begin 1060 currentState.matrix := AValue; 709 1061 end; 710 1062 … … 728 1080 end; 729 1081 1082 procedure TBGRACanvas2D.SetShadowFastest(AValue: boolean); 1083 begin 1084 currentState.shadowFastest := AValue; 1085 end; 1086 730 1087 procedure TBGRACanvas2D.SetShadowOffset(const AValue: TPointF); 731 1088 begin … … 742 1099 begin 743 1100 currentState.shadowOffsetY := AValue; 1101 end; 1102 1103 procedure TBGRACanvas2D.SetTextAlign(AValue: string); 1104 begin 1105 AValue := trim(LowerCase(AValue)); 1106 if (AValue = 'left') or (AValue = 'start') then 1107 textAlignLCL := taLeftJustify else 1108 if (AValue = 'right') or (AValue = 'end') then 1109 textAlignLCL := taRightJustify else 1110 if AValue = 'center' then 1111 textAlignLCL := taCenter; 1112 end; 1113 1114 procedure TBGRACanvas2D.SetTextAlignLCL(AValue: TAlignment); 1115 begin 1116 currentState.textAlign := AValue; 1117 end; 1118 1119 procedure TBGRACanvas2D.SetTextBaseine(AValue: string); 1120 begin 1121 currentState.textBaseline := trim(lowercase(AValue)); 744 1122 end; 745 1123 … … 750 1128 contour: array of TPointF; 751 1129 begin 752 if (length(points)= 0) or (currentState.lineWidth = 0) then exit;1130 if (length(points)= 0) or (currentState.lineWidth = 0) or (surface = nil) then exit; 753 1131 contour := ComputeWidePolylinePoints(points,currentState.lineWidth,BGRAPixelTransparent, 754 1132 currentState.lineCap,currentState.lineJoin,currentState.lineStyle,[plAutoCycle],miterLimit); … … 761 1139 else 762 1140 tempScan := TBGRASolidColorMaskScanner.Create(currentState.clipMask,Point(0,0),ApplyGlobalAlpha(currentState.strokeColor)); 763 BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True); 1141 if self.antialiasing then 1142 BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,tempScan,True, linearBlend) 1143 else 1144 BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,tempScan,True,GetDrawMode); 764 1145 tempScan.free; 765 1146 end else … … 769 1150 texture := nil; 770 1151 if texture = nil then 771 BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True) 1152 begin 1153 if self.antialiasing then 1154 BGRAPolygon.FillPolyAntialias(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True, linearBlend) 1155 else 1156 BGRAPolygon.FillPolyAliased(Surface,contour,ApplyGlobalAlpha(currentState.strokeColor),false,True,GetDrawMode) 1157 end 772 1158 else 773 BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True); 1159 begin 1160 if self.antialiasing then 1161 BGRAPolygon.FillPolyAntialiasWithTexture(Surface,contour,texture,True, linearBlend) 1162 else 1163 BGRAPolygon.FillPolyAliasedWithTexture(Surface,contour,texture,True,GetDrawMode) 1164 end; 774 1165 end; 775 1166 end; 776 1167 777 1168 procedure TBGRACanvas2D.DrawShadow(const points, points2: array of TPointF); 1169 const invSqrt2 = 1/sqrt(2); 778 1170 var ofsPts,ofsPts2: array of TPointF; 779 1171 offset: TPointF; 780 1172 i: Integer; 781 1173 tempBmp,blurred: TBGRACustomBitmap; 782 begin 783 if not hasShadow then exit; 1174 maxRect: TRect; 1175 foundRect: TRect; 1176 firstFound: boolean; 1177 1178 procedure AddPt(const coord: TPointF); 1179 var pixRect: TRect; 1180 begin 1181 if isEmptyPointF(coord) then exit; 1182 pixRect := Types.Rect(round(floor(coord.x)),round(floor(coord.y)),round(ceil(coord.x+0.999))+1,round(ceil(coord.y+0.999))+1); 1183 if firstFound then 1184 begin 1185 foundRect := pixRect; 1186 firstFound := false 1187 end 1188 else 1189 begin 1190 if pixRect.left < foundRect.left then foundRect.left := pixRect.Left; 1191 if pixRect.top < foundRect.top then foundRect.top := pixRect.top; 1192 if pixRect.right > foundRect.right then foundRect.right := pixRect.right; 1193 if pixRect.bottom > foundRect.bottom then foundRect.bottom := pixRect.bottom; 1194 end; 1195 end; 1196 1197 begin 1198 if not hasShadow or (surface = nil) then exit; 784 1199 offset := PointF(shadowOffsetX,shadowOffsetY); 785 1200 setlength(ofsPts, length(points)); … … 789 1204 for i := 0 to high(ofsPts2) do 790 1205 ofsPts2[i] := points2[i]+offset; 791 tempBmp := surface.NewBitmap(width,height,BGRAPixelTransparent); 1206 1207 maxRect := Types.Rect(0,0,width,height); 1208 if currentState.clipMask <> nil then 1209 foundRect := maxRect 1210 else 1211 begin 1212 firstFound := true; 1213 for i := 0 to high(ofsPts) do 1214 AddPt(ofsPts[i]); 1215 for i := 0 to high(ofsPts2) do 1216 AddPt(ofsPts2[i]); 1217 if firstFound then exit; 1218 InflateRect(foundRect, ceil(shadowBlur),ceil(shadowBlur)); 1219 if not IntersectRect(foundRect, foundRect,maxRect) then exit; 1220 offset := PointF(-foundRect.Left,-foundRect.Top); 1221 for i := 0 to high(ofsPts) do 1222 ofsPts[i] += offset; 1223 for i := 0 to high(ofsPts2) do 1224 ofsPts2[i] += offset; 1225 end; 1226 1227 tempBmp := surface.NewBitmap(foundRect.Right-foundRect.Left,foundRect.Bottom-foundRect.Top,BGRAPixelTransparent); 792 1228 tempBmp.FillMode := fmWinding; 793 1229 tempBmp.FillPolyAntialias(ofsPts, getShadowColor); … … 795 1231 if shadowBlur > 0 then 796 1232 begin 797 if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then 798 blurred := tempBmp.FilterBlurRadial(round(shadowBlur*10),rbPrecise) 1233 if shadowFastest then 1234 begin 1235 if shadowBlur*invSqrt2 >= 0.5 then 1236 begin 1237 blurred := tempBmp.FilterBlurRadial(round(shadowBlur*invSqrt2),rbBox); 1238 tempBmp.Free; 1239 tempBmp := blurred; 1240 end; 1241 end 799 1242 else 800 blurred := tempBmp.FilterBlurRadial(round(shadowBlur),rbFast); 801 tempBmp.Free; 802 tempBmp := blurred; 1243 begin 1244 if (shadowBlur < 5) and (abs(shadowBlur-round(shadowBlur)) > 1e-6) then 1245 blurred := tempBmp.FilterBlurRadial(round(shadowBlur*10),rbPrecise) 1246 else 1247 blurred := tempBmp.FilterBlurRadial(round(shadowBlur),rbFast); 1248 tempBmp.Free; 1249 tempBmp := blurred; 1250 end; 803 1251 end; 804 1252 if currentState.clipMask <> nil then 805 1253 tempBmp.ApplyMask(currentState.clipMask); 806 surface.PutImage( 0,0,tempBmp,dmDrawWithTransparency,currentState.globalAlpha);1254 surface.PutImage(foundRect.Left,foundRect.Top,tempBmp,GetDrawMode,currentState.globalAlpha); 807 1255 tempBmp.Free; 808 1256 end; … … 810 1258 procedure TBGRACanvas2D.ClearPoly(const points: array of TPointF); 811 1259 begin 812 BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true) 1260 if surface = nil then exit; 1261 if self.antialiasing then 1262 BGRAPolygon.FillPolyAntialias(surface, points, BGRA(0,0,0,255), true, true, linearBlend) 1263 else 1264 BGRAPolygon.FillPolyAliased(surface, points, BGRA(0,0,0,255), true, true, dmSet); 813 1265 end; 814 1266 … … 844 1296 end; 845 1297 846 function TBGRACanvas2D.GetPenPos : TPointF;847 begin 848 if FPathPointCount = 0then849 result := PointF( 0,0)1298 function TBGRACanvas2D.GetPenPos(defaultX,defaultY: single): TPointF; 1299 begin 1300 if isEmptyPointF(FLastCoord) then 1301 result := PointF(defaultX,defaultY) 850 1302 else 851 result := FPathPoints[FPathPointCount-1]; 1303 result := FLastCoord; 1304 end; 1305 1306 function TBGRACanvas2D.GetPenPos(defaultPt: TPointF): TPointF; 1307 begin 1308 result := GetPenPos(defaultPt.x,defaultPt.y); 852 1309 end; 853 1310 … … 889 1346 end; 890 1347 1348 function TBGRACanvas2D.GetDrawMode: TDrawMode; 1349 begin 1350 if linearBlend then result := dmLinearBlend else result := dmDrawWithTransparency; 1351 end; 1352 1353 procedure TBGRACanvas2D.copyTo(dest: IBGRAPath); 1354 begin 1355 //nothing 1356 end; 1357 891 1358 constructor TBGRACanvas2D.Create(ASurface: TBGRACustomBitmap); 892 1359 begin … … 894 1361 StateStack := TList.Create; 895 1362 FPathPointCount := 0; 1363 FLastCoord := EmptyPointF; 1364 FStartCoord := EmptyPointF; 896 1365 currentState := TBGRACanvasState2D.Create(AffineMatrixIdentity,nil); 897 1366 pixelCenteredCoordinates := false; 1367 antialiasing := true; 898 1368 end; 899 1369 … … 906 1376 StateStack.Free; 907 1377 currentState.Free; 1378 FreeAndNil(FFontRenderer); 908 1379 inherited Destroy; 909 1380 end; … … 917 1388 encode64: TBase64EncodingStream; 918 1389 begin 1390 if surface = nil then exit; 919 1391 stream := TMemoryStream.Create; 920 1392 if mimeType='image/jpeg' then … … 967 1439 end; 968 1440 969 procedure TBGRACanvas2D.rotate(angleRad: single); 970 begin 971 currentState.matrix *= AffineMatrixRotationRad(-angleRad); 1441 procedure TBGRACanvas2D.scale(factor: single); 1442 begin 1443 currentState.matrix *= AffineMatrixScale(factor,factor); 1444 end; 1445 1446 procedure TBGRACanvas2D.rotate(angleRadCW: single); 1447 begin 1448 currentState.matrix *= AffineMatrixRotationRad(-angleRadCW); 972 1449 end; 973 1450 … … 980 1457 begin 981 1458 currentState.matrix *= AffineMatrix(a,c,e,b,d,f); 1459 end; 1460 1461 procedure TBGRACanvas2D.transform(AMatrix: TAffineMatrix); 1462 begin 1463 currentState.matrix *= AMatrix; 982 1464 end; 983 1465 … … 1063 1545 begin 1064 1546 shadowColor(StrToBGRA(color)); 1547 end; 1548 1549 procedure TBGRACanvas2D.shadowNone; 1550 begin 1551 shadowColor(BGRAPixelTransparent); 1065 1552 end; 1066 1553 … … 1145 1632 end; 1146 1633 1634 procedure TBGRACanvas2D.addPath(APath: IBGRAPath); 1635 begin 1636 if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then 1637 begin 1638 AddPoint(EmptyPointF); 1639 FLastCoord := EmptyPointF; 1640 FStartCoord := EmptyPointF; 1641 end; 1642 APath.copyTo(self); 1643 end; 1644 1645 procedure TBGRACanvas2D.addPath(ASvgPath: string); 1646 var p: TBGRAPath; 1647 begin 1648 p := TBGRAPath.Create(ASvgPath); 1649 addPath(p); 1650 p.Free; 1651 end; 1652 1653 procedure TBGRACanvas2D.path(APath: IBGRAPath); 1654 begin 1655 beginPath; 1656 addPath(APath); 1657 end; 1658 1659 procedure TBGRACanvas2D.path(ASvgPath: string); 1660 begin 1661 beginPath; 1662 addPath(ASvgPath); 1663 end; 1664 1147 1665 procedure TBGRACanvas2D.beginPath; 1148 1666 begin 1149 1667 FPathPointCount := 0; 1668 FLastCoord := EmptyPointF; 1669 FStartCoord := EmptyPointF; 1150 1670 end; 1151 1671 … … 1158 1678 while (i > 0) and not isEmptyPointF(FPathPoints[i-1]) do dec(i); 1159 1679 AddPoint(FPathPoints[i]); 1680 FLastCoord := FStartCoord; 1160 1681 end; 1161 1682 end; … … 1175 1696 pts[j] := FPathPoints[i+j]; 1176 1697 if closed then 1177 splinePts := surface.ComputeClosedSpline(pts,style)1698 splinePts := BGRAPath.ComputeClosedSpline(pts,style) 1178 1699 else 1179 splinePts := surface.ComputeOpenedSpline(pts,style);1700 splinePts := BGRAPath.ComputeOpenedSpline(pts,style); 1180 1701 dec(FPathPointCount,nb); 1181 1702 AddPoints(splinePts); … … 1193 1714 end; 1194 1715 1195 procedure TBGRACanvas2D.moveTo( pt: TPointF);1196 begin 1197 if FPathPointCount <> 0then1716 procedure TBGRACanvas2D.moveTo(const pt: TPointF); 1717 begin 1718 if (FPathPointCount <> 0) and not isEmptyPointF(FPathPoints[FPathPointCount-1]) then 1198 1719 AddPoint(EmptyPointF); 1199 1720 AddPoint(ApplyTransform(pt)); 1200 end; 1201 1202 procedure TBGRACanvas2D.lineTo(pt: TPointF); 1721 FStartCoord := pt; 1722 FLastCoord := pt; 1723 end; 1724 1725 procedure TBGRACanvas2D.lineTo(const pt: TPointF); 1203 1726 begin 1204 1727 AddPoint(ApplyTransform(pt)); 1728 FLastCoord := pt; 1205 1729 end; 1206 1730 1207 1731 procedure TBGRACanvas2D.polylineTo(const pts: array of TPointF); 1208 1732 begin 1209 AddPoints(ApplyTransform(pts)); 1733 if length(pts)> 0 then 1734 begin 1735 AddPoints(ApplyTransform(pts)); 1736 FLastCoord := pts[high(pts)]; 1737 end; 1210 1738 end; 1211 1739 … … 1215 1743 pts : array of TPointF; 1216 1744 begin 1217 curve := BezierCurve( GetPenPos,ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y)));1218 pts := Surface.ComputeBezierCurve(curve);1745 curve := BezierCurve(ApplyTransform(GetPenPos(cpx,cpy)),ApplyTransform(PointF(cpx,cpy)),ApplyTransform(PointF(x,y))); 1746 pts := BGRAPath.ComputeBezierCurve(curve); 1219 1747 AddPoints(pts); 1220 end; 1221 1222 procedure TBGRACanvas2D.quadraticCurveTo(cp, pt: TPointF); 1748 FLastCoord := PointF(x,y); 1749 end; 1750 1751 procedure TBGRACanvas2D.quadraticCurveTo(const cp, pt: TPointF); 1223 1752 begin 1224 1753 quadraticCurveTo(cp.x,cp.y,pt.x,pt.y); … … 1230 1759 pts : array of TPointF; 1231 1760 begin 1232 curve := BezierCurve( GetPenPos,ApplyTransform(PointF(cp1x,cp1y)),1761 curve := BezierCurve(ApplyTransform(GetPenPos(cp1x,cp1y)),ApplyTransform(PointF(cp1x,cp1y)), 1233 1762 ApplyTransform(PointF(cp2x,cp2y)),ApplyTransform(PointF(x,y))); 1234 pts := Surface.ComputeBezierCurve(curve);1763 pts := BGRAPath.ComputeBezierCurve(curve); 1235 1764 AddPoints(pts); 1236 end; 1237 1238 procedure TBGRACanvas2D.bezierCurveTo(cp1, cp2, pt: TPointF); 1765 FLastCoord := PointF(x,y); 1766 end; 1767 1768 procedure TBGRACanvas2D.bezierCurveTo(const cp1, cp2, pt: TPointF); 1239 1769 begin 1240 1770 bezierCurveTo(cp1.x,cp1.y,cp2.x,cp2.y,pt.x,pt.y); … … 1247 1777 LineTo(x+w,y+h); 1248 1778 LineTo(x,y+h); 1249 LineTo(x,y);1779 closePath; 1250 1780 end; 1251 1781 … … 1265 1795 arcTo(PointF(x,y+h),PointF(x,y), radius); 1266 1796 arcTo(PointF(x,y),PointF(x+w,y), radius); 1797 closePath; 1798 end; 1799 1800 procedure TBGRACanvas2D.roundRect(x, y, w, h, rx, ry: single); 1801 begin 1802 if (w <= 0) or (h <= 0) then exit; 1803 if rx < 0 then rx := 0; 1804 if ry < 0 then ry := 0; 1805 if (rx = 0) and (ry = 0) then 1806 begin 1807 rect(x,y,w,h); 1808 exit; 1809 end; 1810 if rx*2 > w then rx := w/2; 1811 if ry*2 > h then ry := h/2; 1812 moveTo(x+rx,y); 1813 lineTo(x+w-rx,y); 1814 arcTo(rx,ry,0,false,false,x+w,y+ry); 1815 lineTo(x+w,y+h-ry); 1816 arcTo(rx,ry,0,false,false,x+w-rx,y+h); 1817 lineTo(x+rx,y+h); 1818 arcTo(rx,ry,0,false,false,x,y+h-ry); 1819 lineTo(x,y+ry); 1820 arcTo(rx,ry,0,false,false,x+rx,y); 1821 closePath; 1267 1822 end; 1268 1823 … … 1273 1828 transf := ApplyTransform(pts); 1274 1829 if (pts[0] = pts[high(pts)]) and (length(pts) > 1) then 1275 transf := surface.ComputeClosedSpline(slice(transf, length(transf)-1),style)1830 transf := BGRAPath.ComputeClosedSpline(slice(transf, length(transf)-1),style) 1276 1831 else 1277 transf := surface.ComputeOpenedSpline(transf,style);1832 transf := BGRAPath.ComputeOpenedSpline(transf,style); 1278 1833 AddPoints(transf); 1834 FLastCoord := pts[high(pts)]; 1279 1835 end; 1280 1836 … … 1284 1840 i: Integer; 1285 1841 begin 1842 if length(pts) = 0 then exit; 1286 1843 transf := ApplyTransform(pts); 1287 1844 if FPathPointCount <> 0 then … … 1290 1847 for i := high(transf) downto 1 do 1291 1848 transf[i]:= transf[i-1]; 1292 transf[0] := GetPenPos;1293 end; 1294 transf := surface.ComputeOpenedSpline(transf,style);1849 transf[0] := ApplyTransform(GetPenPos(pts[0].x,pts[0].y)); 1850 end; 1851 transf := BGRAPath.ComputeOpenedSpline(transf,style); 1295 1852 AddPoints(transf); 1296 end; 1297 1298 procedure TBGRACanvas2D.arc(x, y, radius, startAngle, endAngle: single; 1853 FLastCoord := pts[high(pts)]; 1854 end; 1855 1856 procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single; 1299 1857 anticlockwise: boolean); 1300 1858 var pts: array of TPointF; … … 1305 1863 unitAffine: TAffineMatrix; 1306 1864 v1orig,v2orig,v1ortho,v2ortho: TPointF; 1865 startRadCCW,endRadCCW: single; 1307 1866 begin 1308 1867 v1orig := PointF(currentState.matrix[1,1],currentState.matrix[2,1]); … … 1317 1876 unitAffine := AffineMatrix(v1ortho.x, v2ortho.x, pt.x, 1318 1877 v1ortho.y, v2ortho.y, pt.y); 1319 start Angle := -startAngle;1320 end Angle := -endAngle;1878 startRadCCW := -startAngleRadCW; 1879 endRadCCW := -endAngleRadCW; 1321 1880 if not anticlockwise then 1322 1881 begin 1323 temp := start Angle;1324 start Angle := endAngle;1325 end Angle:= temp;1326 pts := surface.ComputeArcRad(0,0,rx,ry,startAngle,endAngle);1882 temp := startRadCCW; 1883 startRadCCW := endRadCCW; 1884 endRadCCW:= temp; 1885 pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); 1327 1886 pts := ApplyTransform(pts,unitAffine); 1328 1887 AddPointsRev(pts); 1329 1888 end else 1330 1889 begin 1331 pts := surface.ComputeArcRad(0,0,rx,ry,startAngle,endAngle);1890 pts := BGRAPath.ComputeArcRad(0,0,rx,ry,startRadCCW,endRadCCW); 1332 1891 pts := ApplyTransform(pts,unitAffine); 1333 1892 AddPoints(pts); 1334 1893 end; 1335 end; 1336 1337 procedure TBGRACanvas2D.arc(x, y, radius, startAngle, endAngle: single); 1338 begin 1339 arc(x,y,radius,startAngle,endAngle,false); 1894 FLastCoord := ArcEndPoint(ArcDef(x,y,radius,radius,0,startAngleRadCW,endAngleRadCW,anticlockwise)); 1895 end; 1896 1897 procedure TBGRACanvas2D.arc(x, y, radius, startAngleRadCW, endAngleRadCW: single); 1898 begin 1899 arc(x,y,radius,startAngleRadCW,endAngleRadCW,false); 1900 end; 1901 1902 procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single; 1903 anticlockwise: boolean); 1904 begin 1905 arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,anticlockwise)) 1906 end; 1907 1908 procedure TBGRACanvas2D.arc(cx, cy, rx, ry, xAngleRadCW, startAngleRadCW, endAngleRadCW: single); 1909 begin 1910 arc(ArcDef(cx,cy,rx,ry,xAngleRadCW,startAngleRadCW,endAngleRadCW,false)) 1911 end; 1912 1913 procedure TBGRACanvas2D.arc(const arcDef: TArcDef); 1914 var previousMatrix: TAffineMatrix; 1915 begin 1916 if (arcDef.radius.x = 0) and (arcDef.radius.y = 0) then 1917 lineTo(arcDef.center) else 1918 begin 1919 previousMatrix := currentState.matrix; 1920 translate(arcDef.center.x,arcDef.center.y); 1921 rotate(arcDef.xAngleRadCW); 1922 scale(arcDef.radius.x,arcDef.radius.y); 1923 arc(0,0,1,arcDef.startAngleRadCW,arcDef.endAngleRadCW,arcDef.anticlockwise); 1924 currentState.matrix := previousMatrix; 1925 FLastCoord := ArcEndPoint(arcDef); 1926 end; 1340 1927 end; 1341 1928 1342 1929 procedure TBGRACanvas2D.arcTo(x1, y1, x2, y2, radius: single); 1343 var p0,p1,p2,p3,p4,an,bn,cn,c: TPointF; 1344 dir, a2, b2, c2, cosx, sinx, d, 1345 angle0, angle1: single; 1346 anticlockwise: boolean; 1347 begin 1348 if FPathPointCount = 0 then 1349 moveTo(x1,y1); 1350 radius := abs(radius); 1351 p0 := GetPenPos; 1352 p1 := PointF(x1,y1); 1353 p2 := PointF(x2,y2); 1354 1355 if (p0 = p1) or (p1 = p2) or (radius = 0) then 1356 begin 1357 lineto(x1,y1); 1358 exit; 1359 end; 1360 1361 dir := (x2-x1)*(p0.y-y1) + (y2-y1)*(x1-p0.x); 1362 if dir = 0 then 1363 begin 1364 lineto(x1,y1); 1365 exit; 1366 end; 1367 1368 a2 := (p0.x-x1)*(p0.x-x1) + (p0.y-y1)*(p0.y-y1); 1369 b2 := (x1-x2)*(x1-x2) + (y1-y2)*(y1-y2); 1370 c2 := (p0.x-x2)*(p0.x-x2) + (p0.y-y2)*(p0.y-y2); 1371 cosx := (a2+b2-c2)/(2*sqrt(a2*b2)); 1372 1373 sinx := sqrt(1 - cosx*cosx); 1374 if (sinx = 0) or (cosx = 1) then 1375 begin 1376 lineto(x1,y1); 1377 exit; 1378 end; 1379 d := radius / ((1 - cosx) / sinx); 1380 1381 an := (p1-p0)*(1/sqrt(a2)); 1382 bn := (p1-p2)*(1/sqrt(b2)); 1383 p3 := p1 - an*d; 1384 p4 := p1 - bn*d; 1385 anticlockwise := (dir < 0); 1386 1387 cn := PointF(an.y,-an.x)*radius; 1388 if not anticlockwise then cn := -cn; 1389 c := p3 + cn; 1390 angle0 := arctan2((p3.y-c.y), (p3.x-c.x)); 1391 angle1 := arctan2((p4.y-c.y), (p4.x-c.x)); 1392 1393 lineTo(p3.x,p3.y); 1394 arc(c.x,c.y, radius, angle0, angle1, anticlockwise); 1930 var p0: TPointF; 1931 begin 1932 p0 := GetPenPos(x1,y1); 1933 arc(Html5ArcTo(p0,PointF(x1,y1),PointF(x2,y2),radius)); 1395 1934 end; 1396 1935 … … 1398 1937 begin 1399 1938 arcTo(p1.x,p1.y,p2.x,p2.y,radius); 1939 end; 1940 1941 procedure TBGRACanvas2D.arcTo(rx, ry, xAngleRadCW: single; largeArc, 1942 anticlockwise: boolean; x, y: single); 1943 begin 1944 arc(SvgArcTo(GetPenPos(x,y), rx,ry, xAngleRadCW, largeArc, anticlockwise, PointF(x,y))); 1945 FLastCoord := PointF(x,y); 1946 end; 1947 1948 procedure TBGRACanvas2D.circle(x, y, r: single); 1949 begin 1950 arc(x,y,r,0,0); 1951 end; 1952 1953 procedure TBGRACanvas2D.ellipse(x, y, rx, ry: single); 1954 begin 1955 arc(x,y,rx,ry,0,0,0); 1956 end; 1957 1958 procedure TBGRACanvas2D.text(AText: string; x, y: single); 1959 var renderer : TBGRACustomFontRenderer; 1960 previousMatrix: TAffineMatrix; 1961 begin 1962 renderer := fontRenderer; 1963 if renderer.FontEmHeight <= 0 then exit; 1964 previousMatrix := currentState.matrix; 1965 1966 scale(currentState.fontEmHeight/renderer.FontEmHeight); 1967 if (currentState.textBaseline <> 'top') and 1968 (currentState.textBaseline <> 'hanging') then 1969 with renderer.GetFontPixelMetric do 1970 begin 1971 if currentState.textBaseline = 'bottom' then 1972 translate(0,-Lineheight) 1973 else if currentState.textBaseline = 'middle' then 1974 translate(0,-Lineheight/2) 1975 else if currentState.textBaseline = 'alphabetic' then 1976 translate(0,-baseline); 1977 end; 1978 1979 if renderer <> nil then 1980 renderer.CopyTextPathTo(self, x,y, AText, taLeftJustify); 1981 1982 currentState.matrix := previousMatrix; 1983 FLastCoord := EmptyPointF; 1984 FStartCoord := EmptyPointF; 1985 end; 1986 1987 procedure TBGRACanvas2D.fillText(AText: string; x, y: single); 1988 begin 1989 beginPath; 1990 text(AText,x,y); 1991 fill; 1992 beginPath; 1993 end; 1994 1995 procedure TBGRACanvas2D.strokeText(AText: string; x, y: single); 1996 begin 1997 beginPath; 1998 text(AText,x,y); 1999 stroke; 2000 beginPath; 2001 end; 2002 2003 function TBGRACanvas2D.measureText(AText: string): TCanvas2dTextSize; 2004 var renderer: TBGRACustomFontRenderer; 2005 begin 2006 renderer := fontRenderer; 2007 if renderer <> nil then 2008 begin 2009 with renderer.TextSize(AText) do 2010 begin 2011 result.width := cx; 2012 result.height:= cy; 2013 end; 2014 end 2015 else 2016 begin 2017 result.width := 0; 2018 result.height := 0; 2019 end; 1400 2020 end; 1401 2021 … … 1442 2062 currentState.clipMask := surface.NewBitmap(width,height,BGRAWhite); 1443 2063 tempBmp := surface.NewBitmap(width,height,BGRABlack); 1444 tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite); 2064 if antialiasing then 2065 tempBmp.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) 2066 else 2067 tempBmp.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet); 1445 2068 currentState.clipMask.BlendImage(0,0,tempBmp,boDarken); 1446 2069 tempBmp.Free; … … 1451 2074 if FPathPointCount = 0 then exit; 1452 2075 if currentState.clipMask = nil then exit; 1453 currentState.clipMask.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite); 2076 if antialiasing then 2077 currentState.clipMask.FillPolyAntialias(slice(FPathPoints,FPathPointCount),BGRAWhite) 2078 else 2079 currentState.clipMask.FillPoly(slice(FPathPoints,FPathPointCount),BGRAWhite,dmSet); 1454 2080 if currentState.clipMask.Equals(BGRAWhite) then 1455 2081 FreeAndNil(currentState.clipMask);
Note:
See TracChangeset
for help on using the changeset viewer.