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

fpvectorial: Starts preparing support for inserting any kind of entity, fixes setting the pen info for dimension drawings and implements rounded corners in TvRectangle

Browse Source 
git-svn-id: trunk@39731 -
This commit is contained in:
sekelsenmat 2013-01-02 14:41:14 +00:00
parent 899bdb7156
commit 5ddc2fce3c
3 changed files with 109 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpvectorial/dxfvectorialreader.pas
View File

@ -1487,7 +1487,7 @@ begin
Result.X := PosX;
Result.Y := PosY;
Result.Z := PosZ;
Result.Block := lBlock;
Result.InsertEntity := lBlock;
if not AOnlyCreate then AData.AddEntity(Result);
end;

69
components/fpvectorial/fpvectorial.pas
View File

@ -209,6 +209,7 @@ type
BackgroundColor: TFPColor;
AdjustPenColorToBackground: Boolean;
Selected: Boolean;
ForceRenderBlock: Boolean; // Blocks are usually invisible, but when rendering an insert, their drawing can be forced
end;
{ Now all elements }
@ -394,6 +395,8 @@ type
public
// Mandatory fields
CX, CY, CZ: Double;
// Corner rounding, zero indicates no rounding
RX, RY: Double;
procedure CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double); override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -605,14 +608,15 @@ type
end;
{@@
A "Insert" inserts a block into the drawing in the specified position
A "Insert" inserts a copy of any other element in the specified position.
Usually TvBlock entities are inserted, but any entity can be inserted.
}
{ TvInsert }
TvInsert = class(TvNamedEntity)
public
Block: TvBlock; // The block to be inserted
InsertEntity: TvEntity; // The entity to be inserted
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
@ -741,7 +745,7 @@ type
function AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
function AddEllipse(CenterX, CenterY, HorzHalfAxis, VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
function AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
function AddInsert(AX, AY, AZ: Double; ABlock: TvBlock): TvInsert;
function AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
// Layers
function AddLayer(AName: string): TvLayer;
function AddLayerAndSetAsCurrent(AName: string): TvLayer;
@ -1950,7 +1954,14 @@ begin
y1 := CoordToCanvasY(fy1);
y2 := CoordToCanvasY(fy2);
ADest.Rectangle(x1, y1, x2, y2);
{$ifdef USE_LCL_CANVAS}
if (RX = 0) and (RY = 0) then
ADest.Rectangle(x1, y1, x2, y2)
else
LCLIntf.RoundRect(TCanvas(ADest).Handle, x1, y1, x2, y2, Round(rx), Round(ry));
{$else}
ADest.Rectangle(x1, y1, x2, y2)
{$endif}
end;
{ TvAlignedDimension }
@ -1976,6 +1987,8 @@ var
{$endif}
begin
ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
ADest.Pen.Width := 1;
ADest.Pen.Style := psSolid;
//
// Draws this shape:
// horizontal vertical
@ -2088,6 +2101,8 @@ var
{$endif}
begin
ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
ADest.Pen.Width := 1;
ADest.Pen.Style := psSolid;
// The size of the radius of the circle
lRadius := sqrt(sqr(Center.X - DimensionLeft.X) + sqr(Center.Y - DimensionLeft.Y));
@ -2852,10 +2867,34 @@ procedure TvInsert.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADe
ADestY: Integer; AMulX: Double; AMulY: Double);
var
lEntity: TvEntity;
OldForceRenderBlock: Boolean;
begin
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
if Block = nil then Exit;
lEntity := Block.GetFirstEntity();
if InsertEntity = nil then Exit;
// If we are inserting a block, make sure it will render its contents
OldForceRenderBlock := ARenderInfo.ForceRenderBlock;
ARenderInfo.ForceRenderBlock := True;
// Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
InsertEntity.Move(X, Y);
// Render
InsertEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
// Change them back
InsertEntity.Move(-X, -Y);
ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
end;
{ TvBlock }
procedure TvBlock.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
var
lEntity: TvEntity;
begin
// blocks are invisible by themselves
//inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
if not ARenderInfo.ForceRenderBlock then Exit;
lEntity := GetFirstEntity();
while lEntity <> nil do
begin
{$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
@ -2864,24 +2903,16 @@ begin
{$ENDIF}
// Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
lEntity.Move(Block.X + X, Block.Y + Y);
lEntity.Move(X, Y);
// Render
lEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
// Change them back
lEntity.Move(- Block.X - X, - Block.Y - Y);
lEntity.Move(-X, -Y);
lEntity := Block.GetNextEntity();
lEntity := GetNextEntity();
end;
end;
{ TvBlock }
procedure TvBlock.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
begin
// TvBlock.Render must be empty! Because blocks are invisible by themselves
end;
{ TvVectorialPage }
procedure TvVectorialPage.ClearTmpPath;
@ -3352,14 +3383,14 @@ begin
Result := lBlock;
end;
function TvVectorialPage.AddInsert(AX, AY, AZ: Double; ABlock: TvBlock): TvInsert;
function TvVectorialPage.AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
var
lInsert: TvInsert;
begin
lInsert := TvInsert.Create;
lInsert.X := AX;
lInsert.Y := AY;
lInsert.Block := ABlock;
lInsert.InsertEntity := AInsertEntity;
AddEntity(lInsert);
Result := lInsert;
end;

65
components/fpvectorial/svgvectorialreader.pas
View File

@ -80,6 +80,7 @@ type
procedure ReadPolyFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadRectFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadTextFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
procedure ReadUseFromNode(ANode: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
function StringWithUnitToFloat(AStr: string): Double;
procedure ConvertSVGCoordinatesToFPVCoordinates(
const AData: TvVectorialPage;
@ -309,14 +310,17 @@ begin
// Support for RGB hex
// ex: #0000ff
// Another wierd valid variant: #000
if (Length(lValue) > 1) and (lValue[1] = '#') then
begin
lStr := Copy(lValue, 2, 2);
Result.Red := StrToInt('$'+lStr)*$101;
lStr := Copy(lValue, 4, 2);
Result.Green := StrToInt('$'+lStr)*$101;
if lStr = '' then Result.Green := 0
else Result.Green := StrToInt('$'+lStr)*$101;
lStr := Copy(lValue, 6, 2);
Result.Blue := StrToInt('$'+lStr)*$101;
if lStr = '' then Result.Blue := 0
else Result.Blue := StrToInt('$'+lStr)*$101;
Exit;
end;
@ -682,27 +686,53 @@ end;
procedure TvSVGVectorialReader.ReadSVGPenStyleWithKeyAndValue(AKey,
AValue: string; ADestEntity: TvEntityWithPen);
var
OldAlpha: Word;
begin
if AKey = 'stroke' then
begin
// We store and restore the old alpha to support the "-opacity" element
OldAlpha := ADestEntity.Pen.Color.Alpha;
if ADestEntity.Pen.Style = psClear then ADestEntity.Pen.Style := psSolid;
if AValue = 'none' then ADestEntity.Pen.Style := fpcanvas.psClear
else ADestEntity.Pen.Color := ReadSVGColor(AValue)
else
begin
ADestEntity.Pen.Color := ReadSVGColor(AValue);
ADestEntity.Pen.Color.Alpha := OldAlpha;
end;
end
else if AKey = 'stroke-width' then
ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue));
ADestEntity.Pen.Width := Round(StringWithUnitToFloat(AValue))
else if AKey = 'stroke-opacity' then
ADestEntity.Pen.Color.Alpha := StrToInt(AValue)*$101
else if AKey = 'stroke-linecap' then
begin
{case LowerCase(AValue) of
'butt':
'round':
'square': ADestEntity.Pen;
end;}
end;
end;
procedure TvSVGVectorialReader.ReadSVGBrushStyleWithKeyAndValue(AKey,
AValue: string; ADestEntity: TvEntityWithPenAndBrush);
var
OldAlpha: Word;
begin
if AKey = 'fill' then
begin
// We store and restore the old alpha to support the "-opacity" element
OldAlpha := ADestEntity.Brush.Color.Alpha;
if ADestEntity.Brush.Style = bsClear then ADestEntity.Brush.Style := bsSolid;
if AValue = 'none' then ADestEntity.Brush.Style := fpcanvas.bsClear
else ADestEntity.Brush.Color := ReadSVGColor(AValue)
else
begin
ADestEntity.Brush.Color := ReadSVGColor(AValue);
ADestEntity.Brush.Color.Alpha := OldAlpha;
end;
end
else if AKey = 'fill-opacity' then
ADestEntity.Brush.Color.Alpha := StrToInt(AValue)*$101;
@ -732,7 +762,11 @@ end;
function TvSVGVectorialReader.IsAttributeFromStyle(AStr: string): Boolean;
begin
Result := (AStr = 'stroke') or (AStr = 'stroke-width') or
(AStr = 'stroke-dasharray') or (AStr = 'stroke-opacity') or
(AStr = 'stroke-linecap') or
// brush
(AStr = 'fill') or (AStr = 'fill-opacity') or
// font
(AStr = 'font-size') or (AStr = 'fill-family') or
(AStr = 'font-weight');
end;
@ -767,12 +801,13 @@ begin
case lEntityName of
'circle': ReadCircleFromNode(ANode, AData, ADoc);
'ellipse': ReadEllipseFromNode(ANode, AData, ADoc);
'g': ReadLayerFromNode(ANode, AData, ADoc);
'line': ReadLineFromNode(ANode, AData, ADoc);
'path': ReadPathFromNode(ANode, AData, ADoc);
'polygon', 'polyline': ReadPolyFromNode(ANode, AData, ADoc);
'rect': ReadRectFromNode(ANode, AData, ADoc);
'text': ReadTextFromNode(ANode, AData, ADoc);
'g': ReadLayerFromNode(ANode, AData, ADoc);
'use': ReadUseFromNode(ANode, AData, ADoc);
end;
end;
@ -1278,7 +1313,7 @@ end;
procedure TvSVGVectorialReader.ReadRectFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
var
lx, ly, cx, cy: double;
lx, ly, cx, cy, lrx, lry: double;
lRect: TvRectangle;
i: Integer;
lNodeName: DOMString;
@ -1287,6 +1322,8 @@ begin
ly := 0.0;
cx := 0.0;
cy := 0.0;
lrx := 0.0;
lry := 0.0;
lRect := TvRectangle.Create;
// SVG entities start without any pen drawing, but with a black brush
@ -1302,6 +1339,10 @@ begin
lx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'y' then
ly := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'rx' then
lrx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'ry' then
lry := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'width' then
cx := StringWithUnitToFloat(ANode.Attributes.Item[i].NodeValue)
else if lNodeName = 'height' then
@ -1321,6 +1362,10 @@ begin
AData, lx, ly, lRect.X, lRect.Y);
ConvertSVGDeltaToFPVDelta(
AData, cx, cy, lRect.CX, lRect.CY);
ConvertSVGDeltaToFPVDelta(
AData, lrx, lry, lRect.RX, lRect.RY);
lRect.RX := Abs(lRect.RX) * 2;
lRect.RY := Abs(lRect.RY) * 2;
AData.AddEntity(lRect);
end;
@ -1388,6 +1433,12 @@ begin
AData.AddEntity(lText);
end;
procedure TvSVGVectorialReader.ReadUseFromNode(ANode: TDOMNode;
AData: TvVectorialPage; ADoc: TvVectorialDocument);
begin
end;
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Double;
var
UnitStr, ValueStr: string;