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

fpvectorial: Advances the support for rotation and adds support for DXF LWPOLYLINE closed flag

Browse Source 
git-svn-id: trunk@41505 -
This commit is contained in:
sekelsenmat 2013-06-03 08:51:35 +00:00
parent 38d3882f1f
commit b1a1f310b0
3 changed files with 100 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/fpvectorial/dxfvectorialreader.pas
View File

@ -1622,7 +1622,7 @@ var
lName: string;
lBlock: TvBlock;
PosX, PosY, PosZ: Double;
lRotationAngle: Double;
lRotationAngle: Double = 0.0;
begin
PosX := 0.0;
PosY := 0.0;
@ -1645,7 +1645,7 @@ begin
10: PosX := CurToken.FloatValue;
20: PosY := CurToken.FloatValue;
30: PosZ := CurToken.FloatValue;
50: lRotationAngle := CurToken.FloatValue;
50: lRotationAngle := -1 * CurToken.FloatValue * Pi / 180;
end;
end;
@ -1744,6 +1744,24 @@ begin
end;
{.$define FPVECTORIALDEBUG_LWPOLYLINE}
{
100 Subclass marker (AcDbPolyline)
90 Number of vertices
70 Polyline flag (bit-coded); default is 0:
1 = Closed; 128 = Plinegen
43 Constant width (optional; default = 0). Not used if variable width (codes 40 and/or 41) is set
38 Elevation (optional; default = 0)
39 Thickness (optional; default = 0)
10 Vertex coordinates (in OCS), multiple entries; one entry for each vertex
DXF: X value; APP: 2D point
20 DXF: Y value of vertex coordinates (in OCS), multiple entries; one entry for each vertex
40 Starting width (multiple entries; one entry for each vertex) (optional; default = 0; multiple entries). Not used if constant width (code 43) is set
41 End width (multiple entries; one entry for each vertex) (optional; default = 0; multiple entries). Not used if constant width (code 43) is set
42 Bulge (multiple entries; one entry for each vertex) (optional; default = 0)
210 Extrusion direction (optional; default = 0, 0, 1)
DXF: X value; APP: 3D vector
220, 230 DXF: Y and Z values of extrusion direction (optional)
}
function TvDXFVectorialReader.ReadENTITIES_LWPOLYLINE(ATokens: TDXFTokens;
AData: TvVectorialPage; ADoc: TvVectorialDocument; AOnlyCreate: Boolean = False): TPath;
var
@ -1751,6 +1769,7 @@ var
i, curPoint: Integer;
// LINE
LWPolyline: array of TLWPOLYLINEElement;
LWFlags: Integer = 0;
begin
curPoint := -1;
Result := nil;
@ -1761,7 +1780,7 @@ begin
CurToken := TDXFToken(ATokens.Items[i]);
// Avoid an exception by previously checking if the conversion can be made
if CurToken.GroupCode in [10, 20, 30, 11, 21, 31] then
if CurToken.GroupCode in [10, 20, 30, 11, 21, 31, 70] then
begin
CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator);
end;
@ -1778,9 +1797,19 @@ begin
LWPolyline[curPoint].X := CurToken.FloatValue - DOC_OFFSET.X;
end;
20: LWPolyline[curPoint].Y := CurToken.FloatValue - DOC_OFFSET.Y;
70: LWFlags := Round(CurToken.FloatValue);
end;
end;
// In case of a Flag="Closed" then we need to close the line
if LWFlags = 1 then
begin
Inc(curPoint);
SetLength(LWPolyline, curPoint+1);
LWPolyline[curPoint].X := LWPolyline[0].X;
LWPolyline[curPoint].Y := LWPolyline[0].Y;
end;
// And now write it
if curPoint >= 0 then // otherwise the polyline is empty of points
begin

73
components/fpvectorial/fpvectorial.pas
View File

@ -151,6 +151,7 @@ type
Previous: TPathSegment;
Next: TPathSegment;
procedure Move(ADeltaX, ADeltaY: Double); virtual;
procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
end;
@ -168,6 +169,7 @@ type
public
X, Y: Double;
procedure Move(ADeltaX, ADeltaY: Double); override;
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
@ -246,7 +248,7 @@ type
procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); virtual;
function GetSubpartCount: Integer; virtual;
procedure PositionSubparts(ADest: TFPCustomCanvas; ABaseX, ABaseY: Double); virtual;
procedure Rotate(AAngle: Double); virtual;
procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual;
function AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
@ -260,6 +262,8 @@ type
{ TvNamedEntity }
TvNamedEntity = class(TvEntity)
protected
FExtraDebugStr: string;
public
Name: string;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
@ -336,6 +340,7 @@ type
procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); override;
function MoveToSubpart(ASubpart: Cardinal): TPathSegment;
function GetSubpartCount: Integer; override;
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
@ -661,7 +666,7 @@ type
function GetFirstEntity: TvEntity;
function GetNextEntity: TvEntity;
procedure AddEntity(AEntity: TvEntity);
procedure Rotate(AAngle: Double);
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
procedure Clear; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -691,9 +696,10 @@ type
TvInsert = class(TvNamedEntity)
public
InsertEntity: TvEntity; // The entity to be inserted
RotationAngle: Double; // in degrees, normal is zero
RotationAngle: Double; // in angles, normal is zero
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
{@@
@ -1077,6 +1083,11 @@ begin
end;
procedure TPathSegment.Rotate(AAngle: Double; ABase: T3DPoint);
begin
end;
function TPathSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
var
@ -1094,6 +1105,16 @@ begin
Y := Y + ADeltaY;
end;
procedure T2DSegment.Rotate(AAngle: Double; ABase: T3DPoint);
var
lRes: T3DPoint;
begin
inherited Rotate(AAngle, ABase);
lRes := fpvutils.Rotate3DPointInXY(Make3DPoint(X, Y, 0), ABase, AAngle);
X := lRes.X;
Y := lRes.Y;
end;
function T2DSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
var
@ -1192,7 +1213,7 @@ begin
end;
procedure TvEntity.Rotate(AAngle: Double);
procedure TvEntity.Rotate(AAngle: Double; ABase: T3DPoint);
begin
end;
@ -1249,7 +1270,7 @@ function TvNamedEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
var
lStr: string;
begin
lStr := Format('[%s] Name=%s X=%f Y=%f', [Self.ClassName, Name, X, Y]);
lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr, [Self.ClassName, Name, X, Y]);
Result := ADestRoutine(lStr, APageItem);
end;
@ -1622,6 +1643,21 @@ begin
Result := Len;
end;
procedure TPath.Rotate(AAngle: Double; ABase: T3DPoint);
var
i: Integer;
lCurPart: TPathSegment;
begin
inherited Rotate(AAngle, ABase);
for i := 0 to GetSubpartCount()-1 do
begin
// Move to the subpart
lCurPart := MoveToSubpart(i);
// Rotate it
lCurPart.Rotate(AAngle, ABase);
end;
end;
procedure TPath.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
@ -3278,13 +3314,13 @@ begin
FElements.Add(AEntity);
end;
procedure TvEntityWithSubEntities.Rotate(AAngle: Double);
procedure TvEntityWithSubEntities.Rotate(AAngle: Double; ABase: T3DPoint);
var
i: Integer;
begin
for i := 0 to FElements.Count-1 do
begin
TvEntity(FElements.Items[i]).Rotate(AAngle);
TvEntity(FElements.Items[i]).Rotate(AAngle, ABase);
end;
end;
@ -3322,7 +3358,7 @@ var
lStr: string;
lCurEntity: TvEntity;
begin
lStr := Format('[%s] Name="%s"', [Self.ClassName, Self.Name]);
lStr := Format('[%s] Name="%s"' + FExtraDebugStr, [Self.ClassName, Self.Name]);
// Add styles
// Pen
@ -3367,25 +3403,34 @@ begin
// 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);
// If necessary rotate the canvas
if RotationAngle <> 0 then
begin
InsertEntity.Rotate(RotationAngle, Make3DPoint(0, 0, 0));
end;
// 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);
// And unrotate it back again
if RotationAngle <> 0 then
begin
InsertEntity.Rotate(-1 * RotationAngle, Make3DPoint(0, 0, 0));
end;
// Change them back
InsertEntity.Move(-X, -Y);
ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
end;
function TvInsert.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
begin
FExtraDebugStr := Format(' RotationAngle(degrees)=%f', [RotationAngle * 180 / Pi]);
if (InsertEntity <> nil) and (InsertEntity is TvNamedEntity) then
FExtraDebugStr := FExtraDebugStr + Format(' InsertEntity="%s"', [TvNamedEntity(InsertEntity).Name]);
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
end;
{ TvBlock }
procedure TvBlock.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;

9
components/fpvectorial/fpvutils.pas
View File

@ -41,6 +41,7 @@ function CoordToCanvasX(ACoord: Double; ADestX: Integer; AMulX: Double): Integer
function CoordToCanvasY(ACoord: Double; ADestY: Integer; AMulY: Double): Integer; inline;
// Other routines
function SeparateString(AString: string; ASeparator: char): T10Strings;
function Make3DPoint(AX, AY, AZ: Double): T3DPoint;
// Mathematical routines
procedure EllipticalArcToBezier(Xc, Yc, Rx, Ry, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
procedure CircularArcToBezier(Xc, Yc, R, startAngle, endAngle: Double; var P1, P2, P3, P4: T3DPoint);
@ -141,6 +142,13 @@ begin
end;
end;
function Make3DPoint(AX, AY, AZ: Double): T3DPoint;
begin
Result.X := AX;
Result.Y := AY;
Result.Z := AZ;
end;
{ Considering a counter-clockwise arc, elliptical and alligned to the axises
An elliptical Arc can be converted to
@ -288,6 +296,7 @@ begin
end;
// Rotates a point P around RotCenter
// alpha angle in radians
function Rotate3DPointInXY(P, RotCenter: T3DPoint; alpha:double): T3DPoint;
var
sinus, cosinus : Extended;