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

fpvectorial: svg reader detects pen styles & patterns now. Fix rendering of lines with the specified pen styles & patterns.

Browse Source 
git-svn-id: trunk@50875 -
This commit is contained in:
wp 2015-12-17 21:20:37 +00:00
parent 66ddbe063a
commit 506bdbde54
2 changed files with 60 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/fpvectorial/fpvectorial.pas
View File

@ -117,6 +117,7 @@ type
Color: TFPColor;
Style: TFPPenStyle;
Width: Integer;
Pattern: array of LongWord;
end;
PvPen = ^TvPen;
@ -3343,8 +3344,15 @@ procedure TvEntityWithPen.ApplyPenToCanvas(ADest: TFPCustomCanvas;
ARenderInfo: TvRenderInfo; APen: TvPen);
begin
ADest.Pen.FPColor := AdjustColorToBackground(APen.Color, ARenderInfo);
ADest.Pen.Width := 1;//APen.Width;
ADest.Pen.Width := Max(1, APen.Width); // wp: why was here "1;//APen.Width;" ???
ADest.Pen.Style := APen.Style;
{$ifdef USE_LCL_CANVAS}
if (APen.Style = psPattern) then
begin
TCanvas(ADest).Pen.SetPattern(APen.Pattern);
if APen.Width = 1 then TCanvas(ADest).Pen.Cosmetic := false;
end;
{$endif}
end;
procedure TvEntityWithPen.AssignPen(APen: TvPen);
@ -3949,7 +3957,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);
@ -3957,8 +3965,12 @@ begin
if (Pen.Width <= 2) and (ADest.Pen.Width > 2) then ADest.Pen.Width := 2;
if (Pen.Width <= 5) and (ADest.Pen.Width > 5) then ADest.Pen.Width := 5;
ADest.Pen.FPColor := AdjustColorToBackground(Pen.Color, ARenderInfo);
{$ifdef USE_LCL_CANVAS}
if (Pen.Style = psPattern) then
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

49
components/fpvectorial/svgvectorialreader.pas
View File

@ -130,9 +130,11 @@ type
function ReadTextFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument): TvEntity;
function ReadUseFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument): TvEntity;
//
procedure StringToPenPattern(const AStr: String; var APen: TvPen);
function StringWithUnitToFloat(AStr: string; ACoordKind: TSVGCoordinateKind = sckUnknown;
ADefaultUnit: TSVGUnit = suPX; ATargetUnit: TSVGUnit = suPX): Double;
function StringFloatZeroToOneToWord(AStr: string): Word;
procedure ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage;
const ASrcX, ASrcY: Double; var ADestX, ADestY: Double;
@ -147,6 +149,7 @@ type
ADoViewBoxAdjust: Boolean = True);
procedure AutoDetectDocSize(var ALeft, ATop, ARight, ABottom: Double; ABaseNode: TDOMNode);
function SVGColorValueStrToWord(AStr: string): Word;
public
{ General reading methods }
constructor Create; override;
@ -909,7 +912,6 @@ function TvSVGVectorialReader.ReadSVGPenStyleWithKeyAndValue(AKey,
AValue: string; ADestEntity: TvEntityWithPen): TvSetPenBrushAndFontElements;
var
OldAlpha: Word;
arr: TDoubleArray;
begin
Result := [];
if AKey = 'stroke' then
@ -944,9 +946,7 @@ begin
end;}
end
else if AKey = 'stroke-dasharray' then
begin
arr := ReadSpaceSeparatedFloats(AValue, ',');
end;
StringToPenPattern(AValue, ADestEntity.Pen);
end;
function TvSVGVectorialReader.ReadSVGBrushStyleWithKeyAndValue(AKey,
@ -2851,6 +2851,47 @@ begin
Result := lInsert;
end;
procedure TvSVGVectorialReader.StringToPenPattern(const AStr: String;
var APen: TvPen);
var
float_patt: TDoubleArray;
patt: array of LongWord;
i: Integer;
begin
float_patt := ReadSpaceSeparatedFloats(AStr, ',');
if Length(float_patt) < 2 then
exit;
SetLength(patt, Length(float_patt));
for i:=0 to High(patt) do
begin
if float_patt[i] < 0 then
raise Exception.CreateFmt('Incorrect value in stroke-dasharray "%s"', [AStr]);
patt[i] := round(float_patt[i]);
end;
case Length(patt) of
2: if patt[1] = 5 then
case patt[0] of
3: begin APen.Style := psDot; exit; end; // stroke-dasharray: 3, 5
9: begin APen.Style := psDash; exit; end; // stroke-dasharray: 9, 5
end;
4: if (patt[0] = 9) and (patt[1] = 5) and (patt[2] = 3) and (patt[3] = 5) then
begin // stroke-dasharray: 9, 5, 3, 5
APen.Style := psDashDot;
exit;
end;
6: if (patt[0] = 9) and (patt[1] = 5) and (patt[2] = 3) and (patt[3] = 5) and
(patt[4] = 3) and (patt[5] = 5)
then begin // stroke-dasharray: 9, 5, 3, 5, 3, 5
APen.Style := psDashDotDot;
exit;
end;
end;
APen.Style := psPattern;
APen.Pattern := patt;
end;
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string;
ACoordKind: TSVGCoordinateKind = sckUnknown; ADefaultUnit: TSVGUnit = suPX;
ATargetUnit: TSVGUnit = suPX): Double;