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

Merged revision(s) 51108-51109 #bc906c5514-#bc906c5514, 51117 #de4fbfafc7, 51135 #1220d1bec2 from trunk:

Browse Source 
fpvectorial: Fix smooth bezier paths if previous segment is a relative bezier path
........
fpvectorial: Fix incorrect exception that paths must begin with a MoveTo command.
........
fpvectorial: Fix svgreader to accept "in" as known length unit
........
fpvectorial: Fix filling of multiple polygons in the same path. Fix svgreader to default to clear pen and brush styles.
........

git-svn-id: branches/fixes_1_6@51151 -
This commit is contained in:
maxim 2016-01-03 12:40:36 +00:00
parent 8372e32c07
commit 23f6da9120
3 changed files with 153 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
components/fpvectorial/fpvectorial.pas
View File

@ -283,7 +283,7 @@ type
st2DEllipticalArc);
{@@
The coordinates in fpvectorial are given in millimiters and
The coordinates in fpvectorial are given in millimeters and
the starting point is in the bottom-left corner of the document.
The X grows to the right and the Y grows to the top.
}
@ -521,7 +521,8 @@ type
procedure AssignBrush(ABrush: TvBrush);
procedure DrawBrushGradient(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
x1, y1, x2, y2: Integer;
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); overload;
// procedure DrawBrushGradient(ADest: TFPCustomCanvas; x1,y1,x2,y2: Integer); overload;
procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
@ -561,6 +562,9 @@ type
FCurMoveSubPartIndex: Integer;
FCurMoveSubPartSegment: TPathSegment;
//
protected
FPolyPoints: TPointsArray;
FPolyStarts: TIntegerDynArray;
public
Len: Integer;
Points: TPathSegment; // Beginning of the double-linked list
@ -3217,6 +3221,7 @@ var
pts: TPointsArray;
coordX, coordY, coord2X, coord2Y, coord3X, coord3Y, coord4X, coord4Y: Integer;
i, n: Integer;
prev: TPoint;
begin
if not (Previous is T2DSegment) then
raise Exception.Create('T2DBezierSegment must follow a T2DSegment.');
@ -3238,13 +3243,21 @@ begin
Make2DPoint(coord4X, coord4Y),
pts);
if Length(pts) = 0 then
exit;
n := Length(Points);
SetLength(Points, n + Length(pts) - 1); // we don't need the start point --> -1
for i:=1 to High(pts) do // begin at 1 to skip the start point
prev := Points[n-1];
SetLength(Points, n + Length(pts));
for i:=0 to High(pts) do
begin
if (pts[i].X = prev.X) and (pts[i].Y = prev.Y) then // skip subsequent coincident points
Continue;
Points[n] := pts[i];
prev := pts[i];
inc(n);
end;
SetLength(Points, n);
end;
{ T3DSegment }
@ -3595,7 +3608,63 @@ begin
Brush.Style := ABrush.Style;
Brush.Color := ABrush.Color;
end;
(*
{ Fills the entity with a gradient.
Assumes that the boundary is already in canvas units }
procedure TvEntityWithPenAndBrush.DrawBrushGradient(ADest: TFPCustomCanvas;
x1, y1, x2, y2: Integer);
var
lColor1, lColor2: TFPColor;
i, j: Integer;
begin
if not (Brush.Kind in [bkVerticalGradient, bkHorizontalGradient]) then
Exit;
lColor1 := Brush.Gradient_colors[1];
lColor2 := Brush.Gradient_colors[0];
if Brush.Kind = bkVerticalGradient then
begin
for i := y1 to y2 do
begin
lPoints := GetLineIntersectionPoints(CanvasToCoordY(i), False);
if Length(lPoints) < 2 then Continue;
lColor := MixColors(lColor1, lColor2, i-y1, y2-y1);
ADest.Pen.FPColor := lColor;
ADest.Pen.Style := psSolid;
j := 0;
while j < Length(lPoints) do
begin
lCanvasPts[0] := CoordToCanvasX(lPoints[j]);
lCanvasPts[1] := CoordToCanvasX(lPoints[j+1]);
ADest.Line(lCanvasPts[0], i, lCanvasPts[1], i);
inc(j, 2);
end;
end;
end
else if Brush.Kind = bkHorizontalGradient then
begin
for i := x1 to x2 do
begin
lPoints := GetLineIntersectionPoints(CanvasToCoordX(i), True);
if Length(lPoints) < 2 then Continue;
lColor := MixColors(lColor1, lColor2, i-x1, x2-x1);
ADest.Pen.FPColor := lColor;
ADest.Pen.Style := psSolid;
j := 0;
while (j+1 < Length(lPoints)) do
begin
lCanvasPts[0] := CoordToCanvasY(lPoints[j]);
lCanvasPts[1] := CoordToCanvasY(lPoints[j+1]);
ADest.Line(i, lCanvasPts[0], i, lCanvasPts[1]);
inc(j , 2);
end;
end;
end;
end; *)
{ Fills the entity's shape with a gradient.
Assumes that the boundary is in fpv units and provides parameters (ADestX,
ADestY, AMulX, AMulY) for conversion to canvas pixels. }
procedure TvEntityWithPenAndBrush.DrawBrushGradient(ADest: TFPCustomCanvas;
var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer;
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
@ -4203,11 +4272,10 @@ end;
procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
ADestX, ADestY: Integer; AMulX, AMulY: Double; ADoDraw: Boolean);
var
polygonPoints: TPointsArray;
polygonStart: TIntegerDynArray;
i: Integer;
j, n: Integer;
x1, y1, x2, y2: Integer;
pts: TPointsArray;
ACanvas: TCanvas absolute ADest;
coordX, coordY: Integer;
curSegment: TPathSegment;
@ -4215,17 +4283,17 @@ var
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
ConvertPathToPolygons(self, ADestX, ADestY, AMulX, AMulY, polygonPoints, polygonStart);
ConvertPathToPolygons(self, ADestX, ADestY, AMulX, AMulY, FPolyPoints, FPolyStarts);
x1 := MaxInt;
y1 := maxInt;
x2 := -MaxInt;
y2 := -MaxInt;
for i := 0 to High(polygonPoints) do
for i := 0 to High(FPolyPoints) do
begin
x1 := min(x1, polygonPoints[i].X);
y1 := min(y1, polygonPoints[i].Y);
x2 := max(x2, polygonPoints[i].X);
y2 := max(y2, polygonPoints[i].Y);
x1 := min(x1, FPolyPoints[i].X);
y1 := min(y1, FPolyPoints[i].Y);
x2 := max(x2, FPolyPoints[i].X);
y2 := max(y2, FPolyPoints[i].Y);
end;
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
@ -4233,23 +4301,23 @@ begin
begin
// (1) draw background only
ADest.Pen.Style := psClear;
if (Length(polygonPoints) > 2) then
if (Length(FPolyPoints) > 2) then
case Brush.Kind of
bkSimpleBrush:
if Brush.Style <> bsClear then
begin
{$IFDEF USE_LCL_CANVAS}
for i := 0 to High(polygonStart) do
for i := 0 to High(FPolyStarts) do
begin
j := polygonStart[i];
if i = High(polygonStart) then
n := Length(polygonPoints) - j
j := FPolyStarts[i];
if i = High(FPolyStarts) then
n := Length(FPolyPoints) - j
else
n := polygonStart[i+1] - polygonStart[i] + 1;
n := FPolyStarts[i+1] - FPolyStarts[i]; // + 1;
ACanvas.Polygon(@FPolyPoints[j], n, WindingRule = vcmNonZeroWindingRule);
end;
ACanvas.Polygon(@polygonPoints[j], n, WindingRule = vcmNonZeroWindingRule);
{$ELSE}
ADest.Polygon(polygonPoints);
ADest.Polygon(FPolyPoints);
{$ENDIF}
end;
else // gradients
@ -4291,13 +4359,14 @@ begin
begin
coordX := CoordToCanvasX(T2DSegment(curSegment.Previous).X, ADestX, AMulX);
coordY := CoordToCanvasY(T2DSegment(curSegment.Previous).Y, ADestY, AMulY);
SetLength(PolygonPoints, 1);
PolygonPoints[0] := Point(coordX, coordY);
curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, PolygonPoints);
ADest.PolyLine(PolygonPoints);
coordX := PolygonPoints[High(PolygonPoints)].X;
coordY := PolygonPoints[High(PolygonPoints)].Y;
ADest.MoveTo(coordX, coordY);
SetLength(pts, 1);
pts[0] := Point(coordX, coordY);
curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, pts);
if Length(pts) > 0 then
begin
ADest.PolyLine(pts);
ADest.MoveTo(pts[High(pts)].X, pts[High(pts)].Y);
end;
end;
end;
end;

8
components/fpvectorial/fpvutils.pas
View File

@ -254,7 +254,7 @@ begin
EllipticalArcToBezier(Xc, Yc, R, R, startAngle, endAngle, P1, P2, P3, P4);
end;
{ This routine converts a Bezier to a Polygon and adds the points of this poligon
{ This routine converts a Bezier to a Polygon and adds the points of this polygon
to the end of the provided Points output variables }
procedure AddBezierToPoints(P1, P2, P3, P4: T3DPoint; var Points: TPointsArray);
var
@ -529,12 +529,12 @@ begin
begin
curSegment := TPathSegment(APath.Next);
if (i = 0) and (curSegment.SegmentType <> stMoveTo) then
raise Exception.Create('Path must start with a "MoveTo" command');
case curSegment.SegmentType of
stMoveTo:
begin
if i <> 0 then
raise Exception.Create('Path must start with a "MoveTo" command');
// Store current length of points array as polygon start index
if numPolygons >= Length(PolygonStartIndexes) then
SetLength(PolygonstartIndexes, Length(PolygonStartIndexes) + POINT_BUFFER);

70
components/fpvectorial/svgvectorialreader.pas
View File

@ -221,11 +221,12 @@ var
lToken: TSVGToken;
lStr: string;
begin
lToken := TSVGToken.Create;
// lToken := TSVGToken.Create;
lStr := Trim(AStr);
if lStr = '' then Exit;
lToken := TSVGToken.Create;
// Moves
if lStr[1] = 'M' then lToken.TokenType := sttMoveTo
else if lStr[1] = 'm' then lToken.TokenType := sttRelativeMoveTo
@ -1887,6 +1888,9 @@ begin
AData.AddLineToPath(vx2, vy2);
lPath := AData.EndPath(True);
// Add default SVG pen/brush
lPath.Pen.Style := psClear;
// Apply the layer style
ApplyLayerStyles(lPath);
@ -1930,7 +1934,7 @@ begin
// Add default SVG pen/brush
lPath.Pen.Style := psClear;
lPath.Brush.Color := colBlack;
lPath.Brush.Style := bsSolid;
lPath.Brush.Style := bsClear;
// Apply the layer style
ApplyLayerStyles(lPath);
// Add the pen/brush/name
@ -2001,6 +2005,7 @@ var
lDebugStr: String;
lToken5Before, lToken7Before: TSVGTokenType;
lCorrectPreviousToken: Boolean;
lPrevRelative, lCurRelative: Boolean;
begin
lCurTokenType := ACurTokenType;
// --------------
@ -2043,7 +2048,8 @@ begin
CurY := Y;
AData.AddLineToPath(CurX, CurY);
Inc(i, 3);
Inc(i, 1);
// Inc(i, 3);
end
// --------------
// Lines
@ -2091,6 +2097,7 @@ begin
else if lCurTokenType in [sttBezierTo, sttRelativeBezierTo,
sttSmoothBezierTo, sttRelativeSmoothBezierTo] then
begin
lPrevRelative := false;
if lCurTokenType in [sttBezierTo, sttRelativeBezierTo] then
begin
X2 := FSVGPathTokenizer.Tokens.Items[i+1].Value;
@ -2116,10 +2123,11 @@ begin
lCorrectPreviousToken := lToken5Before in [sttSmoothBezierTo, sttRelativeSmoothBezierTo];
lCorrectPreviousToken := lCorrectPreviousToken or
(lToken7Before in [sttBezierTo, sttRelativeBezierTo]);
lPrevRelative := (lToken5Before = sttRelativeSmoothBezierTo) or (lToken7Before = sttRelativeBezierTo);
end;
if (i >= 7) and (lCorrectPreviousToken) then
begin
if lCurTokenType = sttRelativeSmoothBezierTo then
if (lCurTokenType = sttRelativeSmoothBezierTo) or lPrevRelative then
begin
X2 := FSVGPathTokenizer.Tokens.Items[i-2].Value - FSVGPathTokenizer.Tokens.Items[i-4].Value;
Y2 := FSVGPathTokenizer.Tokens.Items[i-1].Value - FSVGPathTokenizer.Tokens.Items[i-3].Value;
@ -2138,17 +2146,32 @@ begin
end;
// Careful that absolute coordinates require using ConvertSVGCoordinatesToFPVCoordinates
if lCurTokenType in [sttRelativeBezierTo, sttRelativeSmoothBezierTo] then
lCurRelative := lCurTokenType in [sttRelativeBezierTo, sttRelativeSmoothBezierTo];
if lPrevRelative then
begin
ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2);
ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3);
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
end
else
if lCurRelative then
begin
ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3);
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
end else
begin
ConvertSVGCoordinatesToFPVCoordinates(AData, X3, Y3, X3, Y3);
ConvertSVGCoordinatesToFPVCoordinates(AData, X, Y, X, Y);
end;
end else
begin
ConvertSVGCoordinatesToFPVCoordinates(AData, X2, Y2, X2, Y2);
ConvertSVGCoordinatesToFPVCoordinates(AData, X3, Y3, X3, Y3);
ConvertSVGCoordinatesToFPVCoordinates(AData, X, Y, X, Y);
if lCurRelative then
begin
ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2);
ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3);
ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
end else
begin
ConvertSVGCoordinatesToFPVCoordinates(AData, X2, Y2, X2, Y2);
ConvertSVGCoordinatesToFPVCoordinates(AData, X3, Y3, X3, Y3);
ConvertSVGCoordinatesToFPVCoordinates(AData, X, Y, X, Y);
end;
end;
// Covers the case where there is no valid first control point in smooth bezier
@ -2177,14 +2200,16 @@ begin
end
else
begin
AData.AddBezierToPath(X2, Y2, X3, Y3, X, Y);
if lPrevRelative then
AData.AddBezierToPath(X2 + CurX, Y2 + CurY, X3, Y3, X, Y) else
AData.AddBezierToPath(X2, Y2, X3, Y3, X, Y);
CurX := X;
CurY := Y;
end;
if lCurTokenType in [sttBezierTo, sttRelativeBezierTo] then
Inc(i, 7)
else Inc(i, 5);
Inc(i, 7) else
Inc(i, 5);
end
// --------------
// Quadratic Bezier
@ -2381,7 +2406,7 @@ begin
for i := 0 to ANode.Attributes.Length - 1 do
begin
lNodeName := ANode.Attributes.Item[i].NodeName;
if lNodeName = 'points' then
if lNodeName = 'points' then
lPointsStr := ANode.Attributes.Item[i].NodeValue;
end;
@ -2390,6 +2415,10 @@ begin
lPath := AData.EndPath(True);
Result := lPath;
// Add default SVG pen/brush
lPath.Pen.Style := psClear;
lPath.Brush.Style := bsClear;
// Apply the layer style
ApplyLayerStyles(lPath);
@ -2913,6 +2942,13 @@ begin
Result := Result * 10;
DoProcessMM_End();
end
else if UnitStr = 'in' then
begin
ValueStr := Copy(AStr, 1, Len-2);
Result := StrToFloat(ValueStr, FPointSeparator);
Result := Result * 25.4;
DoProcessMM_End();
end
else if UnitStr = 'px' then
begin
ValueStr := Copy(AStr, 1, Len-2);
@ -3194,7 +3230,7 @@ begin
AData.Height := ly2 - ly;
end;
// Make sure the latest page size is syncronized with auto-detected
// Make sure the latest page size is synchronized with auto-detected
// or ViewBox-only obtained size
Page_Width := AData.Width;
Page_Height := AData.Height;