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

fpvectorial: Starts adding support for aggpas rendering

Browse Source 
git-svn-id: trunk@55578 -
This commit is contained in:
sekelsenmat 2017-07-24 15:32:51 +00:00
parent 813eb2f8f1
commit 86efe3daa4
9 changed files with 497 additions and 134 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -1511,6 +1511,10 @@ components/fpvectorial/examples/wmfviewer.lpr svneol=native#text/plain
components/fpvectorial/fpvectbuildunit.pas svneol=native#text/plain
components/fpvectorial/fpvectorial.pas svneol=native#text/plain
components/fpvectorial/fpvectorial.xml svneol=native#text/plain
components/fpvectorial/fpvectorial2aggpas.pas svneol=native#text/plain
components/fpvectorial/fpvectorial2aggpaspkg.lpk svneol=native#text/plain
components/fpvectorial/fpvectorial2aggpaspkg.pas svneol=native#text/plain
components/fpvectorial/fpvectorial2canvas.pas svneol=native#text/plain
components/fpvectorial/fpvectorialpkg.lpk svneol=native#text/plain
components/fpvectorial/fpvectorialpkg.pas svneol=native#text/plain
components/fpvectorial/fpvtocanvas.pas svneol=native#text/plain

164
components/fpvectorial/fpvectorial.pas
View File

@ -567,7 +567,7 @@ type
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
TvEntityWithPenAndBrush = class(TvEntityWithPen)
protected
public
procedure CalcGradientVector(out AGradientStart, AGradientEnd: T2dPoint;
const ARect: TRect; ADestX: Integer = 0; ADestY: Integer = 0;
AMulX: Double = 1.0; AMulY: Double = 1.0);
@ -629,7 +629,7 @@ type
FCurMoveSubPartIndex: Integer;
FCurMoveSubPartSegment: TPathSegment;
//
protected
public
FPolyPoints: TPointsArray;
FPolyStarts: TIntegerDynArray;
public
@ -1453,6 +1453,7 @@ type
{ Drawer selection methods }
function GetRenderer: TvRenderer;
procedure SetRenderer(ARenderer: TvRenderer);
procedure ClearRenderer();
{ Debug methods }
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer = nil);
{ Events }
@ -1689,7 +1690,13 @@ type
end;
TvRenderer = class
public
procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
// TPath
procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); virtual; abstract;
end;
TvRendererClass = class of TvRenderer;
var
GvVectorialFormats: array of TvVectorialFormatData;
@ -1707,6 +1714,7 @@ procedure RegisterVectorialWriter(
function Make2DPoint(AX, AY: Double): T3DPoint;
function Dimension(AValue : Double; AUnits : TvUnits) : TvDimension;
function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
implementation
@ -1722,6 +1730,9 @@ var
AutoFitDebug: TStrings = nil;
{$endif}
var
gDefaultRenderer: TvRendererClass = nil;
{@@
Registers a new reader for a format
}
@ -1828,6 +1839,11 @@ begin
end;
end;
procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
begin
gDefaultRenderer := ARenderer;
end;
{ TvStyle }
constructor TvStyle.Create;
@ -3664,6 +3680,7 @@ begin
ATo.MulY := AFrom.MulY;
ATo.Page := AFrom.Page;
ATo.Canvas := AFrom.Canvas;
ATo.Renderer := AFrom.Renderer;
ATo.AdjustPenColorToBackground := AFrom.AdjustPenColorToBackground;
ATo.BackgroundColor := AFrom.BackgroundColor;
ATo.Selected := AFrom.Selected;
@ -5053,134 +5070,9 @@ begin
end;
procedure TPath.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
var
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
ADestX: Integer absolute ARenderInfo.DestX;
ADestY: Integer absolute ARenderInfo.DestY;
AMulX: Double absolute ARenderInfo.MulX;
AMulY: Double absolute ARenderInfo.MulY;
//
i: Integer;
j, n: Integer;
x1, y1, x2, y2: Integer;
pts: TPointsArray;
ACanvas: TCanvas absolute ARenderInfo.Canvas;
coordX, coordY: Integer;
curSegment: TPathSegment;
cur2DSegment: T2DSegment absolute curSegment;
lRect: TRect;
gv1, gv2: T2DPoint;
begin
inherited Render(ARenderInfo, ADoDraw);
ConvertPathToPolygons(self, ADestX, ADestY, AMulX, AMulY, FPolyPoints, FPolyStarts);
x1 := MaxInt;
y1 := maxInt;
x2 := -MaxInt;
y2 := -MaxInt;
for i := 0 to High(FPolyPoints) do
begin
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
if AutoFitDebug <> nil then AutoFitDebug.Add(Format('==[%d=%d]', [FPolyPoints[i].X, FPolyPoints[i].Y]));
{$endif}
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);
// Boundary rect of shape filled with a gradient
lRect := Rect(x1, y1, x2, y2);
if ADoDraw then
begin
// (1) draw background only
ADest.Pen.Style := psClear;
if (Length(FPolyPoints) > 2) then
case Brush.Kind of
bkSimpleBrush:
if Brush.Style <> bsClear then
begin
if (Brush.Style = bsSolid) and (Length(FPolyStarts) > 1) then
// Non-contiguous polygon (polygon with "holes") --> use special procedure
// Disadvantage: it can only do solid fills!
DrawPolygon(ARenderInfo, FPolyPoints, FPolyStarts, lRect)
else
{$IFDEF USE_LCL_CANVAS}
for i := 0 to High(FPolyStarts) do
begin
j := FPolyStarts[i];
if i = High(FPolyStarts) then
n := Length(FPolyPoints) - j
else
n := FPolyStarts[i+1] - FPolyStarts[i]; // + 1;
ACanvas.Polygon(@FPolyPoints[j], n, WindingRule = vcmNonZeroWindingRule);
end;
{$ELSE}
ADest.Polygon(FPolyPoints);
{$ENDIF}
end;
bkHorizontalGradient,
bkVerticalGradient,
bkOtherLinearGradient:
begin
// calculate gradient vector
CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
// Draw the gradient
DrawPolygonBrushLinearGradient(ARenderInfo, FPolyPoints, FPolyStarts, lRect, gv1, gv2);
end;
bkRadialGradient:
DrawPolygonBrushRadialGradient(ARenderInfo, FPolyPoints, lRect);
end; // case Brush.Kind of...
// (2) draw border, take care of the segments with modified pen
ADest.Brush.Style := bsClear; // We will paint no background
ApplyPenToCanvas(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(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(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;
end;
ARenderInfo.Renderer.TPath_Render(ARenderInfo, ADoDraw, Self);
end;
@ -8962,6 +8854,7 @@ begin
TvEntity.InitializeRenderInfo(ARenderInfo, AEntity, True);
ARenderInfo.Canvas := ACanvas;
ARenderInfo.Page := Self;
ARenderInfo.Renderer := FOwner.FRenderer;
end;
constructor TvPage.Create(AOwner: TvVectorialDocument);
@ -9866,6 +9759,7 @@ begin
InitializeRenderInfo(RenderInfo, ADest, nil);
InitializeRenderInfo(rInfo, ADest, nil);
TvEntity.CopyAndInitDocumentRenderInfo(rInfo, RenderInfo, False, False);
if Assigned(FOwner.FRenderer) then FOwner.FRenderer.BeginRender(RenderInfo, ADoDraw);
for i := 0 to GetEntitiesCount - 1 do
begin
@ -9895,6 +9789,7 @@ begin
end;
end;
if Assigned(FOwner.FRenderer) then FOwner.FRenderer.EndRender(RenderInfo, ADoDraw);
TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, rInfo, True, False);
{$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
@ -10147,6 +10042,8 @@ begin
FCurrentPageIndex := -1;
FStyles := TFPList.Create;
FListStyles := TFPList.Create;
if gDefaultRenderer <> nil then
FRenderer := gDefaultRenderer.Create;
end;
{@@
@ -10154,7 +10051,7 @@ end;
}
destructor TvVectorialDocument.Destroy;
begin
Clear;
Clear();
FPages.Free;
FPages := nil;
@ -10163,8 +10060,7 @@ begin
FListStyles.Free;
FListStyles := nil;
if FRenderer <> nil then
FreeAndNil(FRenderer);
ClearRenderer();
inherited Destroy;
end;
@ -10816,9 +10712,15 @@ end;
procedure TvVectorialDocument.SetRenderer(ARenderer: TvRenderer);
begin
ClearRenderer();
FRenderer := ARenderer;
end;
procedure TvVectorialDocument.ClearRenderer;
begin
if FRenderer <> nil then FreeAndNil(FRenderer);
end;
procedure TvVectorialDocument.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
var
i, lTmpInt: integer;

184
components/fpvectorial/fpvectorial2aggpas.pas Normal file
View File

@ -0,0 +1,184 @@
{
Implements support for drawing to the LCL TCanvas via AggPas
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
}
unit fpvectorial2aggpas;
{$ifdef fpc}
{$mode objfpc}{$h+}
{$endif}
{$define USE_CANVAS_CLIP_REGION}
{.$define DEBUG_CANVAS_CLIP_REGION}
{.$define FPVECTORIAL_DEBUG_DIMENSIONS}
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
{.$define FPVECTORIAL_DEBUG_BLOCKS}
{.$define FPVECTORIAL_AUTOFIT_DEBUG}
{.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
// visual debugs
{.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
{.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
interface
uses
Classes, SysUtils, Math, TypInfo, contnrs, types,
// FCL-Image
fpcanvas, fpimage, fpwritebmp,
// lazutils
laz2_dom,
// LCL
lazutf8, lazregions,
Graphics, LCLIntf, LCLType, intfgraphics, graphtype, interfacebase,
// AggPas
agg_fpimage, Agg_LCL,
// fpvectorial
fpvutils, fpvectorial;
type
{ TFPVAggPasRenderer }
TFPVAggPasRenderer = class(TvRenderer)
private
Bitmap: TBitmap;
AggLCLCanvas: TAggLCLCanvas;
public
procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
// TPath
procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); override;
end;
implementation
{ TFPVAggPasRenderer }
procedure TFPVAggPasRenderer.BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
var
HasFont: Boolean;
FontFilename: String;
begin
Bitmap := TBitmap.Create;
AggLCLCanvas:=TAggLCLCanvas.Create;
AggLCLCanvas.Image.PixelFormat:=afpimRGBA32;
AggLCLCanvas.Image.SetSize(2000, 2000);
{$IFDEF LCLGtk2}
{HasFont:=true;
FontFilename:=SetDirSeparators('../../verdana.ttf');
if not FileExistsUTF8(FontFilename) then begin
ShowMessage('file not found: '+FontFilename+' CurDir='+GetCurrentDirUTF8);
HasFont:=false;
end; }
// paint to agg canvas
{with AggLCLCanvas do begin
if HasFont then begin
Font.LoadFromFile(FontFilename);
Font.Size:=10;
Font.Color:=clBlack;
end;}
{$ELSE}
//HasFont:=false;
{$ENDIF}
// solid white background
AggLCLCanvas.Brush.Color:=clWhite;
AggLCLCanvas.FillRect(0, 0, AggLCLCanvas.Width, AggLCLCanvas.Height);
end;
procedure TFPVAggPasRenderer.EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
begin
// convert to LCL native pixel format
Bitmap.LoadFromIntfImage(AggLCLCanvas.Image.IntfImg);
TCanvas(ARenderInfo.Canvas).Draw(0, 0, Bitmap);
AggLCLCanvas.Free;
Bitmap.Free;
end;
procedure TFPVAggPasRenderer.TPath_Render(var ARenderInfo: TvRenderInfo;
ADoDraw: Boolean; APath: TPath);
var
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
ADestX: Integer absolute ARenderInfo.DestX;
ADestY: Integer absolute ARenderInfo.DestY;
AMulX: Double absolute ARenderInfo.MulX;
AMulY: Double absolute ARenderInfo.MulY;
//
i, j, curPt: Integer;
coordX, coordY: Integer;
curSegment: TPathSegment;
cur2DSegment: T2DSegment absolute curSegment;
pts: TPointsArray;
begin
if not ADoDraw then Exit;
AggLCLCanvas.Pen.Style := APath.Pen.Style;
AggLCLCanvas.Pen.Width := APath.Pen.Width;
AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
AggLCLCanvas.Brush.Style := APath.Brush.Style;
AggLCLCanvas.Brush.FPColor := APath.Brush.Color;
AggLCLCanvas.Brush.AggFillEvenOdd := APath.ClipMode = vcmEvenOddRule;
AggLCLCanvas.AggResetPath;
APath.PrepareForSequentialReading;
for j := 0 to APath.Len - 1 do
begin
curSegment := TPathSegment(APath.Next);
case curSegment.SegmentType of
stMoveTo:
begin
inc(i);
coordX := CoordToCanvasX(cur2DSegment.X, ADestX, AMulX);
coordY := CoordToCanvasY(cur2DSegment.Y, ADestY, AMulY);
AggLCLCanvas.AggMoveTo(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
AggLCLCanvas.Pen.FPColor := APath.AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
AggLCLCanvas.Pen.Width := T2DSegmentWithPen(cur2DSegment).Pen.Width;
AggLCLCanvas.Pen.Style := T2DSegmentWithPen(cur2DSegment).Pen.Style;
AggLCLCanvas.AggLineTo(coordX, coordY);
AggLCLCanvas.Pen.Style := APath.Pen.Style;
AggLCLCanvas.Pen.Width := APath.Pen.Width;
AggLCLCanvas.Pen.FPColor := APath.Pen.Color;
end
else
AggLCLCanvas.AggLineTo(coordX, coordY);
end;
st2DBezier, st3DBezier, st2DEllipticalArc:
begin
coordX := CoordToCanvasX(T2DSegment(curSegment.Previous).X, ADestX, AMulX);
coordY := CoordToCanvasY(T2DSegment(curSegment.Previous).Y, ADestY, AMulY);
SetLength(pts, 1);
pts[0] := Point(coordX, coordY);
curSegment.AddToPoints(ADestX, ADestY, AMulX, AMulY, pts);
for curPt := 0 to Length(pts)-1 do
begin
AggLCLCanvas.AggLineTo(pts[curPt].X, pts[curPt].Y);
end;
AggLCLCanvas.AggMoveTo(pts[High(pts)].X, pts[High(pts)].Y);
end;
end;
end;
if APath.Len > 0 then
begin
AggLCLCanvas.AggClosePolygon;
AggLCLCanvas.AggDrawPath(AGG_FillAndStroke, False);
end;
end;
end.

38
components/fpvectorial/fpvectorial2aggpaspkg.lpk Normal file
View File

@ -0,0 +1,38 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="fpvectorial2aggpaspkg"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
</SearchPaths>
</CompilerOptions>
<Files Count="1">
<Item1>
<Filename Value="fpvectorial2aggpas.pas"/>
<UnitName Value="fpvectorial2aggpas"/>
</Item1>
</Files>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="aggpaslcl"/>
</Item1>
<Item2>
<PackageName Value="fpvectorialpkg"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

21
components/fpvectorial/fpvectorial2aggpaspkg.pas Normal file
View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit fpvectorial2aggpaspkg;
{$warn 5023 off : no warning about unused units}
interface
uses
fpvectorial2aggpas, LazarusPackageIntf;
implementation
procedure Register;
begin
end;
initialization
RegisterPackage('fpvectorial2aggpaspkg', @Register);
end.

207
components/fpvectorial/fpvectorial2canvas.pas Normal file
View File

@ -0,0 +1,207 @@
{
Implements support for drawing to the LCL TCanvas
License: The same modified LGPL as the Free Pascal RTL
See the file COPYING.modifiedLGPL for more details
AUTHORS: Felipe Monteiro de Carvalho
}
unit fpvectorial2canvas;
{$ifdef fpc}
{$mode objfpc}{$h+}
{$endif}
{$define USE_CANVAS_CLIP_REGION}
{.$define DEBUG_CANVAS_CLIP_REGION}
{$define USE_LCL_CANVAS}
{.$define FPVECTORIAL_DEBUG_DIMENSIONS}
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
{.$define FPVECTORIAL_DEBUG_BLOCKS}
{.$define FPVECTORIAL_AUTOFIT_DEBUG}
{.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
// visual debugs
{.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
{.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
interface
uses
Classes, SysUtils, Math, TypInfo, contnrs, types,
// FCL-Image
fpcanvas, fpimage, fpwritebmp,
// lazutils
laz2_dom,
// LCL
lazutf8, lazregions,
Graphics, LCLIntf, LCLType, intfgraphics, graphtype, interfacebase,
// fpvectorial
fpvutils, fpvectorial;
type
{ TFPVCanvasRenderer }
TFPVCanvasRenderer = class(TvRenderer)
public
procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); override;
// TPath
procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); override;
end;
implementation
{ TFPVCanvasRenderer }
procedure TFPVCanvasRenderer.BeginRender(var ARenderInfo: TvRenderInfo;
ADoDraw: Boolean);
begin
end;
procedure TFPVCanvasRenderer.EndRender(var ARenderInfo: TvRenderInfo;
ADoDraw: Boolean);
begin
end;
procedure TFPVCanvasRenderer.TPath_Render(var ARenderInfo: TvRenderInfo;
ADoDraw: Boolean; APath: TPath);
var
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
ADestX: Integer absolute ARenderInfo.DestX;
ADestY: Integer absolute ARenderInfo.DestY;
AMulX: Double absolute ARenderInfo.MulX;
AMulY: Double absolute ARenderInfo.MulY;
//
i: Integer;
j, n: Integer;
x1, y1, x2, y2: Integer;
pts: TPointsArray;
ACanvas: TCanvas absolute ARenderInfo.Canvas;
coordX, coordY: Integer;
curSegment: TPathSegment;
cur2DSegment: T2DSegment absolute curSegment;
lRect: TRect;
gv1, gv2: T2DPoint;
begin
with APath do begin
ConvertPathToPolygons(APath, ADestX, ADestY, AMulX, AMulY, FPolyPoints, FPolyStarts);
x1 := MaxInt;
y1 := maxInt;
x2 := -MaxInt;
y2 := -MaxInt;
for i := 0 to High(FPolyPoints) do
begin
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
if AutoFitDebug <> nil then AutoFitDebug.Add(Format('==[%d=%d]', [FPolyPoints[i].X, FPolyPoints[i].Y]));
{$endif}
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);
// Boundary rect of shape filled with a gradient
lRect := Rect(x1, y1, x2, y2);
if ADoDraw then
begin
// (1) draw background only
ADest.Pen.Style := psClear;
if (Length(FPolyPoints) > 2) then
case Brush.Kind of
bkSimpleBrush:
if Brush.Style <> bsClear then
begin
if (Brush.Style = bsSolid) and (Length(FPolyStarts) > 1) then
// Non-contiguous polygon (polygon with "holes") --> use special procedure
// Disadvantage: it can only do solid fills!
APath.DrawPolygon(ARenderInfo, FPolyPoints, FPolyStarts, lRect)
else
{$IFDEF USE_LCL_CANVAS}
for i := 0 to High(FPolyStarts) do
begin
j := FPolyStarts[i];
if i = High(FPolyStarts) then
n := Length(FPolyPoints) - j
else
n := FPolyStarts[i+1] - FPolyStarts[i]; // + 1;
ACanvas.Polygon(@FPolyPoints[j], n, WindingRule = vcmNonZeroWindingRule);
end;
{$ELSE}
ADest.Polygon(FPolyPoints);
{$ENDIF}
end;
bkHorizontalGradient,
bkVerticalGradient,
bkOtherLinearGradient:
begin
// calculate gradient vector
CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
// Draw the gradient
DrawPolygonBrushLinearGradient(ARenderInfo, FPolyPoints, FPolyStarts, lRect, gv1, gv2);
end;
bkRadialGradient:
DrawPolygonBrushRadialGradient(ARenderInfo, FPolyPoints, lRect);
end; // case Brush.Kind of...
// (2) draw border, take care of the segments with modified pen
ADest.Brush.Style := bsClear; // We will paint no background
ApplyPenToCanvas(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(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(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;
end;
end;
end;
initialization
RegisterDefaultRenderer(TFPVCanvasRenderer);
end.

6
components/fpvectorial/fpvectorialpkg.lpk
View File

@ -9,7 +9,7 @@
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="25">
<Files Count="26">
<Item1>
<Filename Value="fpvectorial.pas"/>
<UnitName Value="fpvectorial"/>
@ -110,6 +110,10 @@
<Filename Value="wmfvectorialwriter.pas"/>
<UnitName Value="wmfvectorialwriter"/>
</Item25>
<Item26>
<Filename Value="fpvectorial2canvas.pas"/>
<UnitName Value="fpvectorial2canvas"/>
</Item26>
</Files>
<RequiredPkgs Count="2">
<Item1>

2
components/fpvectorial/fpvectorialpkg.pas
View File

@ -15,7 +15,7 @@ uses
rawvectorialreadwrite, svgvectorialreader_rsvg, svgvectorialwriter,
svgzvectorialreader, odtvectorialwriter, docxvectorialwriter,
htmlvectorialreader, svgvectorialreader, fpvWMF, wmfvectorialreader,
wmfvectorialwriter;
wmfvectorialwriter, fpvectorial2canvas;
implementation

5
components/fpvectorial/svgvectorialreader.pas
View File

@ -48,6 +48,7 @@ unit svgvectorialreader;
{$mode objfpc}{$H+}
{$define SVG_MERGE_LAYER_STYLES}
{$define FPVECTORIAL_SVG_SPLIT_PATHS}
interface
@ -2468,10 +2469,12 @@ begin
APaths.LastPathStart.X := 0;
APaths.LastPathStart.Y := 0;
APaths.Data.AddLineToPath(PathEndX, PathEndY);
{$IFDEF FPVECTORIAL_SVG_SPLIT_PATHS}
APaths.LastPathClosed := True;
APaths.IsFirstPathMove := True;
APaths.Add(AData.EndPath(True));
AData.StartPath();
{$ENDIF}
Inc(APaths.CurTokenIndex, 1);
end
@ -3583,7 +3586,7 @@ begin
if lStr[Length(lStr)] = '%' then
begin
lStr := Copy(lStr, 1, Length(lStr)-1);
Result := Round(StrToFloat(lStr) * $FFFF / 100);
Result := Round(StrToFloat(lStr, FPointSeparator) * $FFFF / 100);
end
else Result := StrToInt(lStr) * $101;
end;