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

fpvectorial: Starts rotation support

Browse Source 
git-svn-id: trunk@41503 -
This commit is contained in:
sekelsenmat 2013-06-03 08:09:00 +00:00
parent aab787525a
commit 957f9973d0
2 changed files with 32 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/fpvectorial/dxfvectorialreader.pas
View File

@ -1622,6 +1622,7 @@ var
lName: string;
lBlock: TvBlock;
PosX, PosY, PosZ: Double;
lRotationAngle: Double;
begin
PosX := 0.0;
PosY := 0.0;
@ -1634,7 +1635,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] then
if CurToken.GroupCode in [10, 20, 30, 50] then
begin
CurToken.FloatValue := StrToFloat(Trim(CurToken.StrValue), FPointSeparator);
end;
@ -1644,6 +1645,7 @@ begin
10: PosX := CurToken.FloatValue;
20: PosY := CurToken.FloatValue;
30: PosZ := CurToken.FloatValue;
50: lRotationAngle := CurToken.FloatValue;
end;
end;
@ -1657,6 +1659,7 @@ begin
Result.Y := PosY;
Result.Z := PosZ;
Result.InsertEntity := lBlock;
Result.RotationAngle := lRotationAngle;
if not AOnlyCreate then AData.AddEntity(Result);
end;

28
components/fpvectorial/fpvectorial.pas
View File

@ -246,6 +246,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 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;
@ -660,6 +661,7 @@ type
function GetFirstEntity: TvEntity;
function GetNextEntity: TvEntity;
procedure AddEntity(AEntity: TvEntity);
procedure Rotate(AAngle: Double);
procedure Clear; override;
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
@ -689,6 +691,7 @@ type
TvInsert = class(TvNamedEntity)
public
InsertEntity: TvEntity; // The entity to be inserted
RotationAngle: Double; // in degrees, normal is zero
procedure Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
end;
@ -1189,6 +1192,11 @@ begin
end;
procedure TvEntity.Rotate(AAngle: Double);
begin
end;
procedure TvEntity.Render(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo; ADestX: Integer;
ADestY: Integer; AMulX: Double; AMulY: Double);
begin
@ -3270,6 +3278,16 @@ begin
FElements.Add(AEntity);
end;
procedure TvEntityWithSubEntities.Rotate(AAngle: Double);
var
i: Integer;
begin
for i := 0 to FElements.Count-1 do
begin
TvEntity(FElements.Items[i]).Rotate(AAngle);
end;
end;
procedure TvEntityWithSubEntities.Clear;
begin
inherited Clear;
@ -3351,8 +3369,18 @@ begin
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
end;
// Render
InsertEntity.Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMuly);
// And unrotate it back again
if RotationAngle <> 0 then
begin
end;
// Change them back
InsertEntity.Move(-X, -Y);
ARenderInfo.ForceRenderBlock := OldForceRenderBlock;