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

fpvectorial: Fixes setting the font info for formulas and improves SVG layer and text reading

Browse Source 
git-svn-id: trunk@39727 -
This commit is contained in:
sekelsenmat 2013-01-02 10:33:09 +00:00
parent ba73becf3e
commit 865a07f674
2 changed files with 106 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
components/fpvectorial/fpvectorial.pas
View File

@ -110,6 +110,10 @@ type
Zero is the normal, horizontal, orientation, directed to the right.
}
Orientation: Double;
Bold: boolean;
Italic: boolean;
Underline: boolean;
StrikeTrough: boolean;
end;
{ Coordinates and polyline segments }
@ -275,6 +279,17 @@ type
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
{ TvEntityWithPenBrushAndFont }
TvEntityWithPenBrushAndFont = class(TvEntityWithPenAndBrush)
public
Font: TvFont;
constructor Create; override;
procedure ApplyFontToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; AMulX: Double = 1.0);
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
TPath = class(TvEntityWithPenAndBrush)
@ -319,10 +334,9 @@ type
{ TvText }
TvText = class(TvEntityWithPenAndBrush)
TvText = class(TvEntityWithPenBrushAndFont)
public
Value: TStringList;
Font: TvFont;
constructor Create; override;
destructor Destroy; override;
function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
@ -528,7 +542,7 @@ type
{ TvFormula }
TvFormula = class(TvEntityWithPenAndBrush)
TvFormula = class(TvEntityWithPenBrushAndFont)
private
FCurIndex: Integer;
SpacingBetweenElementsX: Integer;
@ -1123,6 +1137,43 @@ begin
ApplyBrushToCanvas(ADest);
end;
{ TvEntityWithPenBrushAndFont }
constructor TvEntityWithPenBrushAndFont.Create;
begin
inherited Create;
Font.Color := colBlack;
end;
procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; AMulX: Double = 1.0);
var
i: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas absolute ADest;
{$endif}
//
LowerDim: T3DPoint;
begin
ADest.Font.Size := Round(AmulX * Font.Size);
ADest.Font.Bold := Font.Bold;
ADest.Font.Italic := Font.Italic;
ADest.Font.Underline := Font.Underline;
ADest.Font.StrikeTrough := Font.StrikeTrough;
{$ifdef USE_LCL_CANVAS}
ALCLDest.Font.Orientation := Round(Font.Orientation * 16);
{$endif}
ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
end;
procedure TvEntityWithPenBrushAndFont.Render(ADest: TFPCustomCanvas;
ARenderInfo: TvRenderInfo; ADestX: Integer; ADestY: Integer; AMulX: Double;
AMulY: Double);
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
ApplyFontToCanvas(ADest, ARenderInfo, AMulX);
end;
{ TPath }
constructor TPath.Create;
@ -1584,6 +1635,7 @@ constructor TvText.Create;
begin
inherited Create;
Value := TStringList.Create;
Font.Color := colBlack;
end;
destructor TvText.Destroy;
@ -1618,21 +1670,13 @@ procedure TvText.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADest
var
i: Integer;
{$ifdef USE_LCL_CANVAS}
ALCLDest: TCanvas absolute ADest;
{$endif}
//
LowerDim: T3DPoint;
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
ADest.Font.Size := Round(AmulX * Font.Size);
{ ADest.Pen.Style := psSolid;
ADest.Pen.FPColor := colBlack;
ADest.Brush.Style := bsClear;}
{$ifdef USE_LCL_CANVAS}
ALCLDest.Font.Orientation := Round(Font.Orientation * 16);
{$endif}
// Don't draw anything if we have alpha=zero
if Font.Color.Alpha = 0 then Exit;
// TvText supports multiple lines
for i := 0 to Value.Count - 1 do
@ -2684,6 +2728,8 @@ procedure TvFormula.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; AD
var
lElement: TvFormulaElement;
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
// First position all elements
PositionSubparts(ADest, Left, Top);
@ -3321,6 +3367,7 @@ end;
function TvVectorialPage.AddLayer(AName: string): TvLayer;
begin
Result := TvLayer.Create;
Result.Name := AName;
AddEntity(Result);
end;

70
components/fpvectorial/svgvectorialreader.pas
View File

@ -70,6 +70,7 @@ type
procedure ReadEntityFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadCircleFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadEllipseFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadLayerFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadLineFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadPathFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadPathFromString(AStr: string; AData: TvVectorialPage; ADoc: TvVectorialDocument);
@ -700,7 +701,9 @@ begin
if AValue = 'none' then ADestEntity.Brush.Style := fpcanvas.bsClear
else ADestEntity.Brush.Color := ReadSVGColor(AValue)
end;
end
else if AKey = 'fill-opacity' then
ADestEntity.Brush.Color.Alpha := StrToInt(AValue)*$101;
end;
procedure TvSVGVectorialReader.ReadSVGFontStyleWithKeyAndValue(AKey,
@ -709,23 +712,33 @@ 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)
else if AKey = 'fill-opacity' then
ADestEntity.Font.Color.Alpha := StrToInt(AValue)*$101
else if AKey = 'font-size' then
ADestEntity.Font.Size := StrToInt(AValue)
else if AKey = 'font-family' then
ADestEntity.Font.Name := AValue
else if AKey = 'font-weight' then
begin
ADestEntity.Font.Color := ReadSVGColor(AValue);
case LowerCase(AValue) of
'bold': ADestEntity.Font.Bold := True;
end;
end;
end;
function TvSVGVectorialReader.IsAttributeFromStyle(AStr: string): Boolean;
begin
Result := (AStr = 'stroke') or (AStr = 'stroke-width') or
(AStr = 'fill');
(AStr = 'fill') or (AStr = 'fill-opacity') or
(AStr = 'font-size') or (AStr = 'fill-family') or
(AStr = 'font-weight');
end;
procedure TvSVGVectorialReader.ReadEntityFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lEntityName, lLayerName: DOMString;
lCurNode, lLayerNameNode: TDOMNode;
lLayer: TvLayer;
lEntityName: DOMString;
begin
lEntityName := LowerCase(ANode.NodeName);
case lEntityName of
@ -736,24 +749,7 @@ begin
'polygon', 'polyline': ReadPolyFromNode(ANode, AData, ADoc);
'rect': ReadRectFromNode(ANode, AData, ADoc);
'text': ReadTextFromNode(ANode, AData, ADoc);
// Layers
'g':
begin
// if we are already inside a layer, something may be wrong...
//if ALayer <> nil then raise Exception.Create('[TvSVGVectorialReader.ReadEntityFromNode] A layer inside a layer was found!');
lLayerNameNode := ANode.Attributes.GetNamedItem('id');
lLayerName := '';
if lLayerNameNode <> nil then lLayerName := lLayerNameNode.NodeValue;
lLayer := AData.AddLayerAndSetAsCurrent(lLayerName);
lCurNode := ANode.FirstChild;
while Assigned(lCurNode) do
begin
ReadEntityFromNode(lCurNode, AData, ADoc);
lCurNode := lCurNode.NextSibling;
end;
end;
'g': ReadLayerFromNode(ANode, AData, ADoc);
end;
end;
@ -854,6 +850,32 @@ begin
AData.AddEntity(lEllipse);
end;
procedure TvSVGVectorialReader.ReadLayerFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lNodeName: DOMString;
lLayerName: string = '';
lCurNode, lLayerNameNode: TDOMNode;
lLayer: TvLayer;
i: Integer;
begin
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);
end;
lLayer := AData.AddLayerAndSetAsCurrent(lLayerName);
lCurNode := ANode.FirstChild;
while Assigned(lCurNode) do
begin
ReadEntityFromNode(lCurNode, AData, ADoc);
lCurNode := lCurNode.NextSibling;
end;
end;
procedure TvSVGVectorialReader.ReadLineFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var