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

fpvectorial: Correct calculation of ellipse center of elliptical arc path segment

Browse Source 
git-svn-id: trunk@51004 -
This commit is contained in:
wp 2015-12-23 09:58:24 +00:00
parent 6ff3d6e96d
commit 884fddbf00
3 changed files with 179 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
components/fpvectorial/fpvectorial.pas
View File

@ -24,6 +24,7 @@ unit fpvectorial;
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
{.$define FPVECTORIAL_DEBUG_BLOCKS}
{$define FPVECTORIAL_AUTOFIT_DEBUG}
{.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
interface
@ -1452,6 +1453,7 @@ type
procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
procedure AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
procedure AddEllipticalArcWithCenterToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
procedure SetBrushColor(AColor: TFPColor);
procedure SetBrushStyle(AStyle: TFPBrushStyle);
procedure SetPenColor(AColor: TFPColor);
@ -2625,6 +2627,7 @@ end;
{ T2DEllipticalArcSegment }
// wp: no longer needed...
function T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1(
AParam: Double): Double;
var
@ -2639,6 +2642,7 @@ begin
if Result < 0 then Result := -1* Result;
end;
// wp: no longer needed...
procedure T2DEllipticalArcSegment.CalculateCenter;
var
XStart, YStart, lT1: Double;
@ -2694,7 +2698,7 @@ begin
CX1 := RotatedCenter.X;
CY1 := RotatedCenter.Y;
// The other ellipse is simetrically positioned
// The other ellipse is symmetrically positioned
if (CX1 > Xstart) then
CX2 := X - (CX1-Xstart)
else
@ -2777,8 +2781,8 @@ begin
begin
ALeft := CX-RX;
ARight := CX+RX;
ATop := CY-RY;
ABottom := CY+RY;
ATop := CY+RY;
ABottom := CY-RY;
end
else
begin
@ -2807,11 +2811,18 @@ begin
y2 := CY + RY*Sin(t2)*Cos(XRotation)+RX*Cos(t2)*Sin(XRotation);
y3 := CY + RY*Sin(t3)*Cos(XRotation)+RX*Cos(t3)*Sin(XRotation);
ATop := Max(y1, y2);
ATop := Max(ATop, y3);
ABottom := Min(y1, y2);
ABottom := Min(ABottom, y3);
{
ATop := Min(y1, y2);
ATop := Min(ATop, y3);
ABottom := Max(y1, y2);
ABottom := Max(ABottom, y3);
}
end;
end;
@ -4004,7 +4015,7 @@ end;
procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
function HasStraightSegmentsOnly: Boolean;
function CanFill: Boolean;
var
seg: TPathSegment;
j: Integer;
@ -4087,33 +4098,40 @@ begin
if ADoDraw then
RenderInternalPolygon(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
{$IFDEF USE_LCL_CANVAS}
if ADoDraw and (Brush.Kind in [bkHorizontalGradient, bkVerticalGradient]) and
HasStraightSegmentsOnly then
if CanFill then
begin
x1 := MaxInt;
y1 := MaxInt;
x2 := -MaxInt;
y2 := -MaxInt;
PrepareForSequentialReading;
for j := 0 to Len - 1 do
// Manually fill polygon with gradient
{$IFDEF USE_LCL_CANVAS}
if ADoDraw and (Brush.Kind in [bkHorizontalGradient, bkVerticalGradient]) then
begin
CurSegment := TPathSegment(Next);
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
x1 := Min(x1, CoordX);
y1 := Min(y1, CoordY);
x2 := Max(x2, CoordX);
y2 := Max(y2, CoordY);
x1 := MaxInt;
y1 := MaxInt;
x2 := -MaxInt;
y2 := -MaxInt;
PrepareForSequentialReading;
for j := 0 to Len - 1 do
begin
CurSegment := TPathSegment(Next);
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
x1 := Min(x1, CoordX);
y1 := Min(y1, CoordY);
x2 := Max(x2, CoordX);
y2 := Max(y2, CoordY);
end;
DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
end;
DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
end;
{$ENDIF}
{$ENDIF}
end
else
// Paths with curved segments cannot be filled properly at the moment.
// Better to have no fill at all...
Brush.Style := bsClear;
//
// For other paths, draw more carefully
//
ApplyPenToCanvas(ADest, ARenderInfo, Pen);
ApplyPenToCanvas(ADest, ARenderInfo, Pen); // Restore pen
PrepareForSequentialReading;
for j := 0 to Len - 1 do
@ -4253,7 +4271,8 @@ begin
{$endif}
ADest.Brush.Style := Brush.Style;
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX4, CoordY4);
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
if ADoDraw then
begin
@ -7692,6 +7711,27 @@ begin
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.AddEllipticalArcWithCenterToPath(ARadX, ARadY,
AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double;
AClockwiseArcFlag: Boolean);
var
segment: T2DEllipticalArcSegment;
begin
segment := T2DEllipticalArcSegment.Create;
segment.SegmentType := st2DEllipticalArc;
segment.X := ADestX;
segment.Y := ADestY;
segment.RX := ARadX;
segment.RY := ARadY;
segment.XRotation := AXAxisRotation;
segment.CX := ACenterX;
segment.CY := ACenterY;
segment.ClockwiseArcFlag := AClockwiseArcFlag;
segment.CenterSetByUser := true;
AppendSegmentToTmpPath(segment);
end;
procedure TvVectorialPage.SetBrushColor(AColor: TFPColor);
begin
FTmPPath.Brush.Color := AColor;

73
components/fpvectorial/fpvutils.pas
View File

@ -60,6 +60,8 @@ function BezierEquation_GetLength(P1, P2, P3, P4: T3DPoint; AMaxT: Double = 1; A
function BezierEquation_GetT_ForLength(P1, P2, P3, P4: T3DPoint; ALength: Double; ASteps: Integer = 30): Double;
function BezierEquation_GetPointAndTangentForLength(P1, P2, P3, P4: T3DPoint;
ADistance: Double; out AX, AY, ATangentAngle: Double; ASteps: Integer = 30): Boolean;
function CalcEllipseCenter(x1,y1, x2,y2, rx,ry, phi: Double; fa, fs: Boolean;
out cx,cy, lambda: Double): Boolean;
procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
function Rotate2DPoint(P, RotCenter: TPoint; alpha:double): TPoint;
function Rotate3DPointInXY(P, RotCenter: T3DPoint; alpha:double): T3DPoint;
@ -376,6 +378,73 @@ begin
Result := True;
end;
// Calculate center of ellipse defined by two points on its perimeter, the
// major and minor axes, and the "sweep" and "large-angle" flags.
// Calculation follows the SVG implementation notes
// see: http://www.w3.org/TR/SVG/implnote.html#ArcImplementationNotes
// - (x1, y1) absolute coordinates of start point of arc
// - (x2, y2) absolute coordinates of end point of arc
// - rx, ry: radii of major and minor ellipse axes. Must be > 0. Use abs() if necessary.
// - phi: rotation angle of ellipse
// - fa: large arc flag (false = small arc, true = large arc)
// - fs: sweep flag (false = counterclockwise, true = clockwise)
// - cx, cy: Center coordinates of ellipse
// - Function result is false if the center cannot be calculated
function CalcEllipseCenter(x1,y1, x2,y2, rx,ry, phi: Double; fa, fs: Boolean;
out cx,cy, lambda: Double): Boolean;
const
EPS = 1E-9;
var
sinphi, cosphi: Extended;
x1p, x2p, y1p, y2p: Double; // x1', x2', y1', y2'
cxp, cyp: Double; // cx', cy'
m: Double;
begin
Result := false;
if (rx = 0) or (ry = 0) then
exit;
rx := abs(rx); // only positive radii!
ry := abs(ry);
SinCos(phi, sinphi, cosphi);
// (F.6.5.1) in above document
x1p := (cosphi*(x1-x2) + sinphi*(y1-y2)) / 2;
y1p := -(sinphi*(x1-x2) + cosphi*(y1-y2)) / 2;
lambda := sqr(x1p/rx) + sqr(y1p/ry);
if lambda > 1 then
begin
// If the distance of the points is too large in relation to the ellipse
// size there is no solution. SVG Implemantation Notes request in this case
// that the ellipse is magnified so much that a solution exists.
lambda := sqrt(lambda);
rx := rx * lambda;
ry := ry * lambda;
end else
lambda := 1.0;
// (F.6.5.2)
m := (sqr(rx)*sqr(Ry) - sqr(rx)*sqr(y1p) - sqr(ry)*sqr(x1p)) / (sqr(rx)*sqr(y1p) + sqr(ry)*sqr(x1p));
if SameValue(m, 0.0, EPS) then
m := 0
else if m < 0 then
exit;
// Exit if point distance is too large and return "false" - but this
// should no happen after having applied lambda!
m := sqrt(m); // Positive root for fa <> fs
if fa = fs then m := -m; // Negative root for fa = fs.
cxp := m * rx / ry * y1p;
cyp := m * ry / rx * x1p;
// (F.6.5.3)
cx := cosphi*cxp - sinphi*cyp + (x1 + x2) / 2;
cy := sinphi*cxp + cosphi*cyp + (y1 + y2) / 2;
// If the function gets here we have a valid ellipse center in cx,cy
Result := true;
end;
procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
var
i, LastPoint: Integer;
@ -508,14 +577,12 @@ function SolveNumericallyAngle(ANumericalEquation: TNumericalEquation;
var
lError, lErr1, lErr2, lErr3, lErr4: Double;
lParam1, lParam2: Double;
lIterations: Integer;
lCount: Integer;
begin
lErr1 := ANumericalEquation(0);
lErr2 := ANumericalEquation(Pi/2);
lErr3 := ANumericalEquation(Pi);
lErr4 := ANumericalEquation(3*Pi/2);
// Choose the place to start
if (lErr1 < lErr2) and (lErr1 < lErr3) and (lErr1 < lErr4) then
begin
@ -527,7 +594,7 @@ begin
lParam1 := 0;
lParam2 := Pi;
end
else if (lErr2 < lErr3) and (lErr2 < lErr4) then
else if (lErr2 < lErr3) and (lErr2 < lErr4) then // wp: same as above!
begin
lParam1 := Pi/2;
lParam2 := 3*Pi/2;

52
components/fpvectorial/svgvectorialreader.pas
View File

@ -1981,7 +1981,7 @@ procedure TvSVGVectorialReader.ReadNextPathCommand(ACurTokenType: TSVGTokenType;
var i: Integer; var CurX, CurY: Double; AData: TvVectorialPage;
ADoc: TvVectorialDocument);
var
X, Y, X2, Y2, X3, Y3, XQ, YQ, tmp: Double;
X, Y, X2, Y2, X3, Y3, XQ, YQ, Xnew, Ynew, cx, cy, phi, tmp: Double;
LargeArcFlag, SweepFlag, LeftmostEllipse, ClockwiseArc: Boolean;
lCurTokenType: TSVGTokenType;
lDebugStr: String;
@ -2225,29 +2225,64 @@ begin
begin
X2 := FSVGPathTokenizer.Tokens.Items[i+1].Value; // RX
Y2 := FSVGPathTokenizer.Tokens.Items[i+2].Value; // RY
X3 := FSVGPathTokenizer.Tokens.Items[i+3].Value; // RotationX
X3 := X3 * Pi / 180; // degrees to radians conversion
phi := FSVGPathTokenizer.Tokens.Items[i+3].Value; // RotationX
phi := DegToRad(phi); // degrees to radians conversion
LargeArcFlag := Round(FSVGPathTokenizer.Tokens.Items[i+4].Value) = 1;
SweepFlag := Round(FSVGPathTokenizer.Tokens.Items[i+5].Value) = 1;
X := FSVGPathTokenizer.Tokens.Items[i+6].Value; // X
Y := FSVGPathTokenizer.Tokens.Items[i+7].Value; // Y
// non-coordinate values
{
if lCurTokenType = sttRelativeEllipticArcTo then
begin
Xnew := CurX + X;
Ynew := CurY + Y;
end else
begin
Xnew := CurX;
Ynew := CurY;
end;
CalcEllipseCenter(CurX, CurY, Xnew, Ynew, X2, Y2, phi, LargeArcFlag, SweepFlag, cx, cy, tmp);
ConvertSVGCoordinatesToFPVCoordinates(AData, cx, cy, cx, cy);
}
// non-coordinate values (radii)
ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2);
if X2 < 0 then X2 := -X2;
if Y2 < 0 then Y2 := -Y2;
// Careful that absolute coordinates require using ConvertSVGCoordinatesToFPVCoordinates
if lCurTokenType in [sttRelativeEllipticArcTo] then
begin
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
end
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y)
else
begin
ConvertSVGCoordinatesToFPVCoordinates(AData, X, Y, X, Y);
if lCurTokenType = sttRelativeEllipticArcTo then
begin
Xnew := CurX + X;
Ynew := CurY + Y;
end else
begin
Xnew := CurX;
Ynew := CurY;
end;
if CalcEllipseCenter(CurX, CurY, Xnew, Ynew, X2, Y2, -phi, LargeArcFlag, SweepFlag, cx, cy, tmp) then
AData.AddEllipticalArcWithCenterToPath(X2*tmp, Y2*tmp, -phi, Xnew, Ynew, cx, cy, SweepFlag)
else
// Use a straight segment in case of no solution existing for the ellipse center
AData.AddLineToPath(Xnew, Ynew);
CurX := Xnew;
CurY := Ynew;
{
// Convert SVG flags to fpvectorial flags
LeftmostEllipse := (LargeArcFlag and (not SweepFlag))
or ((not LargeArcFlag) and SweepFlag);
if (Y > CurY) or ((Y = CurY) and (X > CurX)) then
LeftMostEllipse := not LeftMostEllipse;
// if Y = CurY then "LeftMost" is to be understood as "TopMost"
ClockwiseArc := SweepFlag;
if lCurTokenType = sttRelativeEllipticArcTo then
@ -2262,6 +2297,7 @@ begin
CurX := X;
CurY := Y;
end;
}
Inc(i, 8);
end