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

fpvectorial: Generates a new system to allow more easily debugging fpvectorial. It shows the tree of elements

Browse Source 
git-svn-id: trunk@37744 -
This commit is contained in:
sekelsenmat 2012-06-23 13:21:27 +00:00
parent fd7b8d1b77
commit 988c686f40
1 changed files with 77 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
components/fpvectorial/fpvectorial.pas
View File

@ -53,6 +53,16 @@ type
vfRAW
);
TvProgressEvent = procedure (APercentage: Byte) of object;
{@@ This routine is called to add an item of caption AStr to an item
AParent, which is a pointer to another item as returned by a previous call
of this same proc. If AParent = nil then it should add the item to the
top of the tree. In all cases this routine should return a pointer to the
newly created item.
}
TvDebugAddItemProc = function (AStr: string; AParent: Pointer): Pointer of object;
const
{ Default extensions }
{ Multi-purpose document formats }
@ -195,6 +205,7 @@ type
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual;
function GetNormalizedPos(APage: TvVectorialPage; ANewMin, ANewMax: Double): T3DPoint;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
end;
{ TvEntityWithPen }
@ -423,7 +434,8 @@ type
function CalculateWidth(ADest: TFPCustomCanvas): Integer; // in pixels
function AsText: string;
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual;
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual;
end;
{ TvFormula }
@ -451,10 +463,9 @@ type
procedure CalculateBoundingBox(ADest: TFPCustomCanvas; var ALeft, ATop, ARight, ABottom: Double); override;
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0;
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
end;
TvProgressEvent = procedure (APercentage: Byte) of object;
{ TvVectorialDocument }
TvVectorialDocument = class
@ -496,6 +507,8 @@ type
function AddPage(): TvVectorialPage;
{ Data removing methods }
procedure Clear; virtual;
{ Debug methods }
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc);
{ Events }
property OnProgress: TvProgressEvent read FOnProgress write FOnprogress;
end;
@ -559,6 +572,8 @@ type
procedure AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint);
//
function AddPoint(AX, AY, AZ: Double): TvPoint;
{ Debug methods }
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
//
property Entities[AIndex: Cardinal]: TvEntity read GetEntity;
end;
@ -777,6 +792,15 @@ begin
Result.Z := (Z - APage.MinZ) * (ANewMax - ANewMin) / (APage.MaxZ - APage.MinZ) + ANewMin;
end;
function TvEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
var
lStr: string;
begin
lStr := Format('[%s]', [Self.ClassName]);
Result := ADestRoutine(lStr, APageItem);
end;
{ TvEntityWithPen }
constructor TvEntityWithPen.Create;
@ -1750,6 +1774,12 @@ begin
end;
end;
procedure TvFormulaElement.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer);
begin
ADestRoutine(Self.AsText(), APageItem);
end;
{ TvFormula }
procedure TvFormula.CallbackDeleteElement(data, arg: pointer);
@ -1808,7 +1838,7 @@ begin
end;
// Cache the result
if ADest <> nil then
Height := Round(Result * ADest.TextHeight('T'));
Height := Round(Result * TCanvas(ADest).TextHeight('T'));
end;
function TvFormula.CalculateWidth(ADest: TFPCustomCanvas): Integer;
@ -1887,6 +1917,22 @@ begin
end;
end;
function TvFormula.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer): Pointer;
var
lFormulaElement: TvFormulaElement;
begin
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
lFormulaElement := GetFirstElement();
while lFormulaElement <> nil do
begin
lFormulaElement.GenerateDebugTree(ADestRoutine, Result);
lFormulaElement := GetNextElement()
end;
end;
{ TvVectorialPage }
procedure TvVectorialPage.ClearTmpPath;
@ -2321,6 +2367,19 @@ begin
Result := lPoint;
end;
procedure TvVectorialPage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
APageItem: Pointer);
var
lCurEntity: TvEntity;
i: Integer;
begin
for i := 0 to FEntities.Count - 1 do
begin
lCurEntity := TvEntity(FEntities.Items[i]);
lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
end;
end;
{ TsWorksheet }
{@@
@ -2634,6 +2693,20 @@ begin
FCurrentPageIndex:=-1;
end;
procedure TvVectorialDocument.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc);
var
i: integer;
p: TvVectorialPage;
lPageItem: Pointer;
begin
for i:=0 to FPages.Count-1 do
begin
p := TvVectorialPage(FPages[i]);
lPageItem := ADestRoutine(Format('Page %d', [i]), nil);
p.GenerateDebugTree(ADestRoutine, lPageItem);
end;
end;
{ TvCustomVectorialReader }
constructor TvCustomVectorialReader.Create;