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

fpvectorial: Disables the new layer tools code as it proved too little for SVG and re-enables the old system. Also found and fixed the SVG wrong colors: It was a wrong order of reading RGB values

Browse Source 
git-svn-id: trunk@40783 -
This commit is contained in:
sekelsenmat 2013-04-10 13:25:15 +00:00
parent f5a1a29ff0
commit 882739042e
2 changed files with 111 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
components/fpvectorial/fpvectorial.pas
View File

@ -623,15 +623,22 @@ type
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
{@@
A EntityWithSubEntities may have Pen, Brush and/or Font data associated with it, but it is disabled by default
This data can be active recursively in all children of the group if set in the field
SetPenBrushAndFontElements
}
{ TvEntityWithSubEntities }
TvEntityWithSubEntities = class(TvNamedEntity)
TvEntityWithSubEntities = class(TvEntityWithPenBrushAndFont)
private
FCurIndex: Integer;
procedure CallbackDeleteElement(data,arg:pointer);
protected
FElements: TFPList; // of TvEntity
public
SetPenBrushAndFontElements: TvSetPenBrushAndFontElements;
constructor Create; override;
destructor Destroy; override;
//
@ -675,20 +682,12 @@ type
Layers are groups of elements.
Layers are similar to blocks and the diference is that the layer draws
its contents, while the block doesnt, and it cannot be pasted with an TvInsert.
A EntityWithSubEntities may have Pen, Brush and/or Font data associated with it, but it is disabled by default
This data can be active recursively in all children of the layer if set in the field
SetPenBrushAndFontElements
}
{ TvLayer }
TvLayer = class(TvEntityWithSubEntities)
public
Pen: TvPen;
Brush: TvBrush;
Font: TvFont;
SetPenBrushAndFontElements: TvSetPenBrushAndFontElements;
end;
{ TvVectorialDocument }
@ -1129,12 +1128,22 @@ var
lParent: TvEntity;
lAsLayer: TvLayer;
begin
if AEntity is TvEntityWithPen then
AFinalPen := (AEntity as TvEntityWithPen).Pen;
if AEntity is TvEntityWithPenAndBrush then
AFinalBrush := (AEntity as TvEntityWithPenAndBrush).Brush;
if AEntity is TvEntityWithPenBrushAndFont then
AFinalFont := (AEntity as TvEntityWithPenBrushAndFont).Font;
// Recurse through all parents
lParent := AEntity.Parent;
if lParent <> nil then
CreateFinalDrawingTools(lParent, AFinalPen, AFinalBrush, AFinalFont);
// And after that add our own data, since our own data has a higher priority
// then parent's data
if not (AEntity is TvLayer) then
begin
if AEntity is TvEntityWithPen then
AFinalPen := (AEntity as TvEntityWithPen).Pen;
if AEntity is TvEntityWithPenAndBrush then
AFinalBrush := (AEntity as TvEntityWithPenAndBrush).Brush;
if AEntity is TvEntityWithPenBrushAndFont then
AFinalFont := (AEntity as TvEntityWithPenBrushAndFont).Font;
end;
if AEntity is TvLayer then
begin
@ -1157,11 +1166,6 @@ begin
if spbfFontSize in lAsLayer.SetPenBrushAndFontElements then
AFinalFont.Size := lAsLayer.Font.Size;
end;
// Recurse through all parents
lParent := AEntity.Parent;
if lParent <> nil then
CreateFinalDrawingTools(lParent, AFinalPen, AFinalBrush, AFinalFont);
end;
function TvEntity.GetNormalizedPos(APage: TvVectorialPage; ANewMin,
@ -1598,25 +1602,20 @@ var
ClipRegion, OldClipRegion: HRGN;
ACanvas: TCanvas absolute ADest;
{$endif}
// Calculated tools
lPen: TvPen;
lBrush: TvBrush;
lFont: TvFont;
begin
PosX := 0;
PosY := 0;
ADest.Brush.Style := bsClear;
CreateFinalDrawingTools(Self, lPen, lBrush, lFont);
ADest.MoveTo(ADestX, ADestY);
// Set the path Pen and Brush options
ADest.Pen.Style := lPen.Style;
ADest.Pen.Width := Round(lPen.Width * AMulX);
ADest.Pen.Style := Pen.Style;
ADest.Pen.Width := Round(Pen.Width * AMulX);
if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
if (lPen.Width <= 2) and (ADest.Pen.Width > 2) then ADest.Pen.Width := 2;
if (lPen.Width <= 5) and (ADest.Pen.Width > 5) then ADest.Pen.Width := 5;
ADest.Pen.FPColor := AdjustColorToBackground(lPen.Color, ARenderInfo);
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);
ADest.Brush.FPColor := Brush.Color;
// Prepare the Clipping Region, if any
@ -1677,7 +1676,7 @@ begin
//
// For other paths, draw more carefully
//
ADest.Pen.Style := lPen.Style;
ADest.Pen.Style := Pen.Style;
PrepareForSequentialReading;
for j := 0 to Len - 1 do
@ -1711,7 +1710,7 @@ begin
PosX := Cur2DSegment.X;
PosY := Cur2DSegment.Y;
ADest.Pen.FPColor := lPen.Color;
ADest.Pen.FPColor := Pen.Color;
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
Write(Format(' L%d,%d', [CoordToCanvasX(Cur2DSegment.X), CoordToCanvasY(Cur2DSegment.Y)]));
@ -1751,7 +1750,7 @@ begin
Points
);
ADest.Brush.Style := lBrush.Style;
ADest.Brush.Style := Brush.Style;
if Length(Points) >= 3 then
ADest.Polygon(Points);
@ -3227,8 +3226,29 @@ var
lStr: string;
lCurEntity: TvEntity;
begin
lStr := Format('[%s] Name=%s', [Self.ClassName, Self.Name]);
lStr := Format('[%s] Name="%s"', [Self.ClassName, Self.Name]);
// Add styles
// Pen
if spbfPenColor in SetPenBrushAndFontElements then
lStr := lStr + Format(' Pen.Color=%s', [GenerateDebugStrForFPColor(Pen.Color)]);
if spbfPenStyle in SetPenBrushAndFontElements then
lStr := lStr + Format(' Pen.Style=%s', [GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style))]);
if spbfPenWidth in SetPenBrushAndFontElements then
lStr := lStr + Format(' Pen.Width=%d', [Pen.Width]);
// Brush
if spbfBrushColor in SetPenBrushAndFontElements then
lStr := lStr + Format(' Brush.Color=%s', [GenerateDebugStrForFPColor(Brush.Color)]);
if spbfBrushStyle in SetPenBrushAndFontElements then
lStr := lStr + Format(' Brush.Style=%s', [GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style))]);
// Font
if spbfFontColor in SetPenBrushAndFontElements then
lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]);
if spbfFontSize in SetPenBrushAndFontElements then
lStr := lStr + Format(' Font.Size=%d', [Font.Size]);
Result := ADestRoutine(lStr, APageItem);
// Add sub-entities
lCurEntity := GetFirstEntity();
while lCurEntity <> nil do

74
components/fpvectorial/svgvectorialreader.pas
View File

@ -9,6 +9,7 @@ AUTHORS: Felipe Monteiro de Carvalho
unit svgvectorialreader;
{$mode objfpc}{$H+}
{$define SVG_MERGE_LAYER_STYLES}
interface
@ -63,7 +64,7 @@ type
FSVGPathTokenizer: TSVGPathTokenizer;
FLayerStylesKeys, FLayerStylesValues: TFPList; // of TStringList;
function ReadSVGColor(AValue: string): TFPColor;
procedure ReadSVGStyle(AValue: string; ADestEntity: TvEntityWithPen; AUseFillAsPen: Boolean = False);
function ReadSVGStyle(AValue: string; ADestEntity: TvEntityWithPen; AUseFillAsPen: Boolean = False): TvSetPenBrushAndFontElements;
function ReadSVGPenStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPen): TvSetPenBrushAndFontElements;
function ReadSVGBrushStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPenAndBrush): TvSetPenBrushAndFontElements;
function ReadSVGFontStyleWithKeyAndValue(AKey, AValue: string; ADestEntity: TvEntityWithPenBrushAndFont): TvSetPenBrushAndFontElements;
@ -309,8 +310,8 @@ begin
if lStrings.Count = 3 then
begin
Result.Red := StrToInt(lStrings.Strings[0]) * $101;
Result.Blue := StrToInt(lStrings.Strings[1]) * $101;
Result.Green := StrToInt(lStrings.Strings[2]) * $101;
Result.Green := StrToInt(lStrings.Strings[1]) * $101;
Result.Blue := StrToInt(lStrings.Strings[2]) * $101;
end
else
raise Exception.Create(Format('[TvSVGVectorialReader.ReadSVGColor] An unexpected number of channels was found: %d', [lStrings.Count]));
@ -663,13 +664,14 @@ floralwhite #FFFAF0
end;
// style="fill:none;stroke:black;stroke-width:3"
procedure TvSVGVectorialReader.ReadSVGStyle(AValue: string;
ADestEntity: TvEntityWithPen; AUseFillAsPen: Boolean = False);
function TvSVGVectorialReader.ReadSVGStyle(AValue: string;
ADestEntity: TvEntityWithPen; AUseFillAsPen: Boolean = False): TvSetPenBrushAndFontElements;
var
lStr, lStyleKeyStr, lStyleValueStr: String;
lStrings: TStringList;
i, lPosEqual: Integer;
begin
Result := [];
if AValue = '' then Exit;
// Now split using ";" separator
@ -685,11 +687,11 @@ begin
lStyleValueStr := Copy(lStr, lPosEqual+1, Length(lStr));
ReadSVGPenStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity);
if AUseFillAsPen and (lStyleKeyStr = 'fill') then
ReadSVGPenStyleWithKeyAndValue('stroke', lStyleValueStr, ADestEntity)
Result := Result + ReadSVGPenStyleWithKeyAndValue('stroke', lStyleValueStr, ADestEntity)
else if ADestEntity is TvText then
ReadSVGFontStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity as TvText)
Result := Result + ReadSVGFontStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity as TvText)
else if ADestEntity is TvEntityWithPenAndBrush then
ReadSVGBrushStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity as TvEntityWithPenAndBrush);
Result := Result + ReadSVGBrushStyleWithKeyAndValue(lStyleKeyStr, lStyleValueStr, ADestEntity as TvEntityWithPenAndBrush);
end;
finally
lStrings.Free;
@ -714,11 +716,17 @@ begin
ADestEntity.Pen.Color := ReadSVGColor(AValue);
ADestEntity.Pen.Color.Alpha := OldAlpha;
end;
Result := Result + [spbfPenColor, spbfPenStyle];
end
else if AKey = 'stroke-width' then
ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue))
begin
ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue));
Result := Result + [spbfPenWidth];
end
else if AKey = 'stroke-opacity' then
begin
ADestEntity.Pen.Color.Alpha := StrToInt(AValue)*$101
end
else if AKey = 'stroke-linecap' then
begin
{case LowerCase(AValue) of
@ -747,6 +755,8 @@ begin
ADestEntity.Brush.Color := ReadSVGColor(AValue);
ADestEntity.Brush.Color.Alpha := OldAlpha;
end;
Result := Result + [spbfBrushColor, spbfBrushStyle];
end
else if AKey = 'fill-opacity' then
ADestEntity.Brush.Color.Alpha := StrToInt(AValue)*$101;
@ -759,11 +769,17 @@ begin
// SVG text uses "fill" to indicate the pen color of the text, very unintuitive as
// "fill" is usually for brush in other elements
if AKey = 'fill' then
ADestEntity.Font.Color := ReadSVGColor(AValue)
begin
ADestEntity.Font.Color := ReadSVGColor(AValue);
Result := Result + [spbfFontColor];
end
else if AKey = 'fill-opacity' then
ADestEntity.Font.Color.Alpha := StrToInt(AValue)*$101
else if AKey = 'font-size' then
ADestEntity.Font.Size := Round(StringWithUnitToFloat(AValue))
begin
ADestEntity.Font.Size := Round(StringWithUnitToFloat(AValue));
Result := Result + [spbfFontSize];
end
else if AKey = 'font-family' then
ADestEntity.Font.Name := AValue
else if AKey = 'font-weight' then
@ -931,29 +947,51 @@ var
lCurNode, lLayerNameNode: TDOMNode;
lLayer, lParentLayer: TvLayer;
i: Integer;
{$ifdef SVG_MERGE_LAYER_STYLES}
lLayerStyleKeys, lLayerStyleValues: TStringList;
{$endif}
begin
// Store the style of this layer in the list
{$ifdef SVG_MERGE_LAYER_STYLES}
lLayerStyleKeys := TStringList.Create;
lLayerStyleValues := TStringList.Create;
FLayerStylesKeys.Add(lLayerStyleKeys);
FLayerStylesValues.Add(lLayerStyleValues);
{$endif}
// first attribute reader, there is a second one
for i := 0 to ANode.Attributes.Length - 1 do
begin
lNodeName := ANode.Attributes.Item[i].NodeName;
if lNodeName = 'id' then
lLayerName := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue)
else if IsAttributeFromStyle(lNodeName) then
begin
lLayerStyleKeys.Add(lNodeName);
lLayerStyleValues.Add(UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue));
end;
lLayerName := UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue);
end;
lParentLayer := AData.GetCurrentLayer();
lLayer := AData.AddLayerAndSetAsCurrent(lLayerName);
// attribute reading again after getting the object
for i := 0 to ANode.Attributes.Length - 1 do
begin
lNodeName := ANode.Attributes.Item[i].NodeName;
if lNodeName = 'style' then
begin
{$ifndef SVG_MERGE_LAYER_STYLES}
lLayer.SetPenBrushAndFontElements += ReadSVGStyle(ANode.Attributes.Item[i].NodeValue, lLayer)
{$endif}
end
else if IsAttributeFromStyle(lNodeName) then
begin
{$ifdef SVG_MERGE_LAYER_STYLES}
lLayerStyleKeys.Add(lNodeName);
lLayerStyleValues.Add(UTF16ToUTF8(ANode.Attributes.Item[i].NodeValue));
{$else}
lLayer.SetPenBrushAndFontElements += ReadSVGPenStyleWithKeyAndValue(lNodeName, ANode.Attributes.Item[i].NodeValue, lLayer);
lLayer.SetPenBrushAndFontElements += ReadSVGBrushStyleWithKeyAndValue(lNodeName, ANode.Attributes.Item[i].NodeValue, lLayer);
{$endif}
end;
end;
lCurNode := ANode.FirstChild;
while Assigned(lCurNode) do
begin
@ -961,11 +999,13 @@ begin
lCurNode := lCurNode.NextSibling;
end;
{$ifdef SVG_MERGE_LAYER_STYLES}
// Now remove the style from this layer
FLayerStylesKeys.Remove(lLayerStyleKeys);
lLayerStyleKeys.Free;
FLayerStylesValues.Remove(lLayerStyleValues);
lLayerStyleValues.Free;
{$endif}
// Set the current layer to the parent node,
// or else items read next will be put as children of this layer