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

fpvectorial: Reorganize TPath.Render. Support polygon even-odd and non-zero winding rules for brush fill.

Browse Source 
git-svn-id: trunk@51058 -
This commit is contained in:
wp 2015-12-27 20:43:02 +00:00
parent e8bf2b6e97
commit c224456e7f
3 changed files with 303 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

211
components/fpvectorial/fpvectorial.pas
View File

@ -275,6 +275,7 @@ type
P3DPoint = ^T3DPoint;
T3DPointsArray = array of T3DPoint;
TPointsArray = array of TPoint;
TSegmentType = (
st2DLine, st2DLineWithPen, st2DBezier,
@ -303,6 +304,8 @@ type
procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
procedure CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double); virtual;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
// rendering
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); virtual;
end;
{@@
@ -325,6 +328,8 @@ type
procedure Move(ADeltaX, ADeltaY: Double); override;
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
// rendering
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
end;
T2DSegmentWithPen = class(T2DSegment)
@ -356,6 +361,8 @@ type
// edition methods
procedure Move(ADeltaX, ADeltaY: Double); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
// rendering
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
end;
{ T3DSegment }
@ -368,6 +375,8 @@ type
}
X, Y, Z: Double;
procedure Move(ADeltaX, ADeltaY: Double); override;
// rendering
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
end;
{ T3DBezierSegment }
@ -398,6 +407,7 @@ type
procedure CalculateCenter;
procedure CalculateEllipseBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double);
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
end;
TvFindEntityResult = (vfrNotFound, vfrFound, vfrSubpartFound);
@ -497,11 +507,14 @@ type
{ TvEntityWithPenAndBrush }
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
TvEntityWithPenAndBrush = class(TvEntityWithPen)
public
{@@ The global Brush for the entire entity. In the case of paths, individual
elements might be able to override this setting. }
Brush: TvBrush;
WindingRule: TvClipMode;
constructor Create(APage: TvPage); override;
procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas); overload;
procedure ApplyBrushToCanvas(ADest: TFPCustomCanvas; ABrush: TvBrush); overload;
@ -542,8 +555,6 @@ type
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True); override;
end;
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
TPath = class(TvEntityWithPenAndBrush)
private
// Used to speed up sequencial access in MoveSubpart
@ -2934,6 +2945,24 @@ begin
Result := ADestRoutine(lStr, APageItem);
end;
procedure T2DEllipticalArcSegment.AddToPoints(ADestX, ADestY: Integer;
AMulX, AMulY: Double; var Points: TPointsArray);
var
pts3D: T3DPointsArray;
i, n: Integer;
begin
SetLength(pts3d, 0);
PolyApproximate(pts3D);
n := Length(Points);
SetLength(Points, n + Length(pts3D) - 1); // we don't need the start point --> -1
for i:=1 to High(pts3D) do // i=0 is end point of prev segment -> we can skip it.
begin
Points[n].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
Points[n].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
inc(n);
end;
end;
{ TvVerticalFormulaStack }
function TvVerticalFormulaStack.CalculateHeight(ADest: TFPCustomCanvas): Double;
@ -3074,6 +3103,13 @@ begin
Result := ADestRoutine(lStr, APageItem);
end;
procedure TPathSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
var Points: TPointsArray);
begin
// Override by descendants
end;
{ T2DSegment }
function T2DSegment.GetLength: Double;
@ -3122,6 +3158,17 @@ begin
Result := ADestRoutine(lStr, APageItem);
end;
procedure T2DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
var Points: TPointsArray);
var
n: Integer;
begin
n := Length(Points);
SetLength(Points, n + 1);
Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
end;
{ T2DBezierSegment }
function T2DBezierSegment.GetLength: Double;
@ -3164,6 +3211,42 @@ begin
Result := ADestRoutine(lStr, APageItem);
end;
procedure T2DBezierSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
var Points: TPointsArray);
var
pts: TPointsArray;
coordX, coordY, coord2X, coord2Y, coord3X, coord3Y, coord4X, coord4Y: Integer;
i, n: Integer;
begin
if not (Previous is T2DSegment) then
raise Exception.Create('T2DBezierSegment must follow a T2DSegment.');
coordX := CoordToCanvasX(T2DSegment(Previous).X, ADestX, AMulX); // start pt
coordY := CoordToCanvasY(T2DSegment(Previous).Y, ADestY, AMulY);
coord4X := CoordToCanvasX(X, ADestX, AMulX); // end pt
coord4Y := CoordToCanvasY(Y, ADestY, AMulY);
coord2X := CoordToCanvasX(X2, ADestX, AMulX); // ctrl pt 1
coord2Y := CoordToCanvasY(Y2, ADestY, AMulY);
coord3X := CoordToCanvasX(X3, ADestX, AMulX); // ctrl pt 2
coord3Y := CoordToCanvasY(Y3, ADestY, AMulY);
SetLength(pts, 0);
AddBezierToPoints(
Make2DPoint(coordX, coordY),
Make2DPoint(coord2X, coord2Y),
Make2DPoint(coord3X, coord3Y),
Make2DPoint(coord4X, coord4Y),
pts);
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
begin
Points[n] := pts[i];
inc(n);
end;
end;
{ T3DSegment }
procedure T3DSegment.Move(ADeltaX, ADeltaY: Double);
@ -3172,6 +3255,18 @@ begin
Y := Y + ADeltaY;
end;
{ This is preliminary... }
procedure T3DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
var Points: TPointsArray);
var
n: Integer;
begin
n := Length(Points);
SetLength(Points, n + 1);
Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
end;
{ T3DBezierSegment }
procedure T3DBezierSegment.Move(ADeltaX, ADeltaY: Double);
@ -4105,6 +4200,112 @@ begin
SetLength(Result, n);
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;
ACanvas: TCanvas absolute ADest;
coordX, coordY: Integer;
curSegment: TPathSegment;
cur2DSegment: T2DSegment absolute curSegment;
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
ConvertPathToPolygons(self, ADestX, ADestY, AMulX, AMulY, polygonPoints, polygonStart);
x1 := MaxInt;
y1 := maxInt;
x2 := -MaxInt;
y2 := -MaxInt;
for i := 0 to High(polygonPoints) 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);
end;
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
if ADoDraw then
begin
// (1) draw background only
ADest.Pen.Style := psClear;
if (Length(polygonPoints) > 2) then
case Brush.Kind of
bkSimpleBrush:
if Brush.Style <> bsClear then
begin
{$IFDEF USE_LCL_CANVAS}
for i := 0 to High(polygonStart) do
begin
j := polygonStart[i];
if i = High(polygonStart) then
n := Length(polygonPoints) - j
else
n := polygonStart[i+1] - polygonStart[i] + 1;
end;
ACanvas.Polygon(@polygonPoints[j], n, WindingRule = vcmNonZeroWindingRule);
{$ELSE}
ADest.Polygon(polygonPoints);
{$ENDIF}
end;
else // gradients
DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
// to do: multiple polygons!
end;
// (2) draw border, take care of the segments with modified pen
ADest.Brush.Style := bsClear; // We will paint no background
ApplyPenToCanvas(ADest, ARenderInfo, Pen); // Restore pen
PrepareForSequentialReading;
for j := 0 to Len - 1 do
begin
curSegment := TPathSegment(Next);
case curSegment.SegmentType of
stMoveTo:
begin
inc(i);
coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
ADest.MoveTo(coordX, coordY);
end;
st2DLineWithPen, st2DLine, st3DLine:
begin
coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
if curSegment.SegmentType = st2DLineWithPen then
begin
ADest.Pen.FPColor := AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
ADest.Pen.Width := T2DSegmentWithPen(cur2DSegment).Pen.Width;
ADest.Pen.Style := T2DSegmentWithPen(cur2DSegment).Pen.Style;
ADest.LineTo(coordX, coordY);
ApplyPenToCanvas(ADest, ARenderInfo, Pen);
end else
ADest.LineTo(coordX, coordY);
end;
st2DBezier, st3DBezier, st2DEllipticalArc:
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);
end;
end;
end;
end;
end;
(*
procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
@ -4159,7 +4360,7 @@ begin
// ADest.Brush.Style := bsClear;
ADest.MoveTo(ADestX, ADestY);
(*
{
// Set the path Pen and Brush options
ADest.Pen.Style := Pen.Style;
ADest.Pen.Width := Round(Pen.Width * AMulX);
@ -4172,7 +4373,7 @@ begin
ACanvas.Pen.SetPattern(Pen.Pattern);
{$endif}
ADest.Brush.FPColor := Brush.Color;
*)
}
// Prepare the Clipping Region, if any
{$ifdef USE_CANVAS_CLIP_REGION}
if ClipPath <> nil then
@ -4499,7 +4700,7 @@ begin
end;
{$endif}
end;
*)
procedure TPath.RenderInternalPolygon(ADest: TFPCustomCanvas;
ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
AMulY: Double);

92
components/fpvectorial/fpvutils.pas
View File

@ -22,7 +22,7 @@ unit fpvutils;
interface
uses
Classes, SysUtils, Math,
Classes, SysUtils, Math, Types,
{$ifdef USE_LCL_CANVAS}
Graphics, LCLIntf, LCLType,
{$endif}
@ -31,7 +31,7 @@ uses
type
T10Strings = array[0..9] of shortstring;
TPointsArray = array of TPoint;
// TPointsArray = array of TPoint;
TFPVUByteArray = array of Byte;
TNumericalEquation = function (AParameter: Double): Double of object; // return the error
@ -64,6 +64,8 @@ function CalcEllipseCenter(x1,y1, x2,y2, rx,ry, phi: Double; fa, fs: Boolean;
out cx,cy, lambda: Double): Boolean;
function CalcEllipsePointAngle(x,y, rx,ry, cx,cy, phi: Double): Double;
procedure CalcEllipsePoint(angle, rx,ry, cx,cy, phi: Double; out x,y: Double);
procedure ConvertPathToPolygons(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double;
var PolygonPoints: TPointsArray; var PolygonStartIndexes: TIntegerDynArray);
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;
@ -485,6 +487,92 @@ begin
y := cy + ry*sint*cosphi + rx*cost*sinphi;
end;
{ Converts a path to one or more polygons. The polygon vertices are returned
in "PolygonPoints"; they are given in canvas units (pixels).
Since the path can contain several polygons the start index of each polygon
is returned in "PolygonStartIndexes". }
procedure ConvertPathToPolygons(APath: TPath;
ADestX, ADestY: Integer; AMulX, AMulY: Double;
var PolygonPoints: TPointsArray;
var PolygonStartIndexes: TIntegerDynArray);
const
POINT_BUFFER = 100;
var
i, j: Integer;
numPoints: Integer;
numPolygons: Integer;
coordX, coordY: Integer;
coordX2, coordY2, coordX3, coordY3, coordX4, coordY4: Integer;
// temporary point arrays
pts: array of TPoint;
pts3D: T3dPointsArray;
// Segments
curSegment: TPathSegment;
cur2DSegment: T2DSegment absolute curSegment;
cur2DBSegment: T2DBezierSegment absolute curSegment;
cur2DArcSegment: T2DEllipticalArcSegment absolute curSegment;
begin
if (APath = nil) then
begin
SetLength(PolygonPoints, 0);
SetLength(PolygonStartIndexes, 0);
exit;
end;
SetLength(PolygonPoints, POINT_BUFFER);
SetLength(PolygonStartIndexes, POINT_BUFFER);
numPoints := 0;
numPolygons := 0;
APath.PrepareForSequentialReading;
for i := 0 to APath.Len - 1 do
begin
curSegment := TPathSegment(APath.Next);
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);
PolygonStartIndexes[numPolygons] := numPoints;
inc(numPolygons);
// Store current point as first point of a new polygon
coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
if numPoints >= Length(PolygonPoints) then
SetLength(PolygonPoints, Length(PolygonPoints) + POINT_BUFFER);
PolygonPoints[numPoints] := Point(coordX, coordY);
inc(numPoints);
end;
st2DLine, st3DLine, st2DLineWithPen:
begin
// Add current point to current polygon
coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
if numPoints >= Length(PolygonPoints) then
SetLength(PolygonPoints, Length(PolygonPoints) + POINT_BUFFER);
PolygonPoints[numPoints] := Point(coordX, coordY);
inc(numPoints);
end;
st2DBezier, st3DBezier, st2DEllipticalArc:
begin
SetLength(PolygonPoints, numPoints);
curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, PolygonPoints);
numPoints := Length(PolygonPoints);
end;
end;
end;
SetLength(PolygonPoints, numPoints);
SetLength(PolygonStartIndexes, numPolygons);
end;
procedure ConvertPathToPoints(APath: TPath; ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray);
var
i, LastPoint: Integer;

7
components/fpvectorial/svgvectorialreader.pas
View File

@ -879,6 +879,13 @@ begin
Result := Result + [spbfBrushColor, spbfBrushStyle];
end
else if AKey = 'fill-rule' then
begin
if AValue = 'evenodd' then
ADestEntity.WindingRule := vcmEvenOddRule else
if AValue = 'nonzero' then
ADestEntity.WindingRule := vcmNonzeroWindingRule; // to do: "inherit" missing here
end
else if AKey = 'fill-opacity' then
ADestEntity.Brush.Color.Alpha := StringFloatZeroToOneToWord(AValue)
// For linear gradient => stop-color:rgb(255,255,0);stop-opacity:1