paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 02:28:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Add ArcTo function to TCanvas class. Issue #7230, patch from Howard Page-Clark

Browse Source 
git-svn-id: trunk@46246 -
This commit is contained in:
juha 2014-09-17 16:30:32 +00:00
parent 4ddd6b9e3d
commit 97c1246eea
2 changed files with 10 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/graphics.pp
View File

@ -1150,6 +1150,7 @@ type
// extra drawing methods (there are more in the ancestor TFPCustomCanvas)
procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual; {$IFDEF HasFPCanvas1}reintroduce;{$ENDIF}
procedure ArcTo(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual; //As Arc(), but updates pen position
procedure BrushCopy(ADestRect: TRect; ABitmap: TBitmap; ASourceRect: TRect;
ATransparentColor: TColor); virtual;
procedure Chord(x1, y1, x2, y2,

9
lcl/include/canvas.inc
View File

@ -670,6 +670,15 @@ begin
Changed;
end;
procedure TCanvas.ArcTo(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer);
var
r: TRect;
begin
Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY);
r:=Rect(ALeft, ATop, ARight, ABottom);
MoveTo(RadialPoint(EccentricAngle(Point(EX, EY), r), r));
end;
{------------------------------------------------------------------------------
Method: TCanvas.Arc
Params: ALeft, ATop, ARight, ABottom, sx, sy, ex, ey