📄 uvectorgraphics.pas
字号:
//draw its box
FFormatHandler.DrawBoxedText(FRunner^.InternalFileName,
PRunner^.x, PRunner^.y, FBoxSize);
Inc(FRunner); //next file and position
Inc(PRunner);
end;
finally
FFormatHandler.FinalizeImageObjects; //let the drawer object finish
end;
finally
FreeMem(Files); //free list of the files
end;
finally
FreeMem(Positions); //free list of their positions
end;
end;
{Draws the whole diagram and saves it into a file. }
procedure TVectorFileDrawer.DrawFile;
begin
FBoxSize := CalculateBoxSize; //calculate size of the boxes
DrawFiles; //draw figure
end;
{Creates the drawer of diagrams and saves the parameters. TopLevelClasses is a
list classes with no parent or that are unknown. It is the root of all
classes. The string contains the name of the class, the object contains either
a ~[link TIdentifierList] of all inheriting classes if the class is unknown,
or the identifier (of class ~[link TIdentifier]) of the class.
~param TopLevelClasses the list of classes with no parent or that are unknown
~param FormatHandler the object to be used to do the actual drawing in a
specific graphic format
~param URLCallBack method pointer to get the target of links for each
class }
constructor TVectorClassDrawer.Create(TopLevelClasses: TStrings;
FormatHandler: TVectorFormatHandler;
URLCallBack: TGetClassURLCallBack);
begin
Assert(TopLevelClasses.Count <> 0);
inherited Create; //create the object
FTopLevelClasses := TopLevelClasses; //save the parameters
FFormatHandler := FormatHandler;
FURLCallBack := URLCallBack;
end;
{Frees the drawer of diagrams and the drawing object. }
destructor TVectorClassDrawer.Destroy;
begin
FFormatHandler.Free; //free handler for the format
inherited Destroy; //and this object
end;
{Draws the whole diagram and saves it into a file. }
procedure TVectorClassDrawer.DrawFile;
begin
//calculate the size of the boxes for each class
FBoxSize := CalculateBoxSize;
FMaxDepth := 1; //need at least a depth of one
//calculate the maximum width by using the position of the next class after
FCanvasSize.cx := CalcDraw(cdsCalculate) - FBoxSize.cx div 3; //the last
//and calculating the maximum height by using the maximum depth
FCanvasSize.cy := (FMaxDepth - 1) * FBoxSize.cy * 4 + FBoxSize.cy;
//inititialize image with the size
FFormatHandler.InitImageObjects(FCanvasSize.cx, FCanvasSize.cy,
'Figure of the Inheritance Tree');
try
CalcDraw(cdsLines); //draw the lines of the tree
CalcDraw(cdsBoxes); //draw the boxes of the tree
finally
FFormatHandler.FinalizeImageObjects; //finish the image
end;
end;
{Draws the classes, the arrows between them or calculates the position of the
boxes depending on the specified state (actually in reverse order).
~param Draw whether only the positions should be calculated or whether the
arrows or the boxes for the classes should be drawn
~result the X position of the next next class after the last in the list }
function TVectorClassDrawer.CalcDraw(Draw: TClassDrawState): Integer;
var OneList :TIdentifierList; //to pass an identifier as a list
i :Integer; //counter through top level list
Obj :TObject; //the object of the list
begin
Result := 0; //start at the left
OneList := TIdentifierList.Create; //create list to pass a single class
try
for i := 0 to FTopLevelClasses.Count - 1 do //for each class in the list
begin
Obj := FTopLevelClasses.Objects[i]; //get it
//is an unknown class with a list of inheriting classes?
if Obj is TIdentifierList then
//draw all descendants
DrawFigureTree(Draw, TIdentifierList(Obj), Result, 0, 1, nil)
else
begin
Assert(Obj is TIdentifier);
OneList.RemoveAll(False); //clear the list and
OneList.AddIdent(TIdentifier(Obj)); //add just this identifier
//draw the class and all descendants
DrawFigureTree(Draw, OneList, Result, 0, 1, nil);
end;
end;
finally
OneList.RemoveAll(False);
OneList.Free; //free list (but not the identifier)
end;
end;
{Draws a list of classes on the same level, inheriting from the same parent
class (or having no (known) parent class). All their descendants are also
drawn as a (sub-)tree.
~param Draw whether only the positions should be calculated or
whether the arrows or the boxes for the classes
should be drawn
~param List the list of classes (and their descendants) to write
~param XPos horizontal position to start to draw the list at;
the position for the next class after the list is
returned, used to center the parent classes above
their descendants
~param YPos vertical position to start to draw the list at
~param Depth the depth in the figure (y-position as level)
~param CoordsBackToParent if not nil an array of points to receive the
positions of all classes in the list }
procedure TVectorClassDrawer.DrawFigureTree(Draw: TClassDrawState;
List: TIdentifierList;
var XPos: Integer; YPos: Integer;
Depth: Integer;
CoordsBackToParent: PPoint);
var Count :Integer; //number of classes in the list
New :Integer; //new X or Y position value
Runner :PPoint; //positions of classes in the list
i :Integer; //counter through the classes
Ident :TRecordType; //the classes to draw
ChildCount :Cardinal; //number of inheriting classes
ChildCoords :PPoint; //buffer of their positions
begin
if Depth > FMaxDepth then //new maximum depth?
FMaxDepth := Depth; //save it
Count := List.Count; //get number of classes in the list
//first handle all classes without descendants
New := YPos; //save y-position
Runner := CoordsBackToParent; //to save positions of the classes
for i := 0 to Count - 1 do //for each class in the list
begin
Ident := TRecordType(List[i]); //get it
if Ident.Children.IsEmpty then //class has no descendants?
begin
if Draw = cdsBoxes then //if boxes should be drawn
begin
if Assigned(FURLCallBack) then //if links should be included
//get the link target and set it
FFormatHandler.SetNextTextBoxesLinkTarget(FURLCallBack(Ident));
//draw the class
FFormatHandler.DrawBoxedText(Ident.Name, XPos, New, FBoxSize);
end;
if Assigned(Runner) then //positions should be saved?
begin
Runner^.x := XPos; //save it
Runner^.y := New;
end;
Inc(New, FBoxSize.cy * 4); //next position (below old)
end;
if Assigned(Runner) then //next position to save
Inc(Runner);
end;
if New <> YPos then //some classes written?
begin
New := (New - YPos) div (FBoxSize.cy * 4) - 1;
if Depth + New > FMaxDepth then //adjust maximum depth if needed
FMaxDepth := Depth + New;
Inc(XPos, FBoxSize.cx + FBoxSize.cx div 3); //move to next column
end;
//now handle classes with descendants
for i := 0 to Count - 1 do //for each class
begin
Ident := TRecordType(List[i]); //get it
ChildCount := Ident.Children.Count; //get number of inheriting classes
if ChildCount <> 0 then //class has some descendants?
begin
//create buffer for their positions
GetMem(ChildCoords, SizeOf(ChildCoords^) * ChildCount);
try
//draw tree of the descendants at current position but one row below
New := XPos; //the current level
DrawFigureTree(Draw, Ident.Children, New, YPos + FBoxSize.cy * 4,
Depth + 1, ChildCoords);
//draw the class centered to its descendants
XPos := (XPos + New - (FBoxSize.cx + FBoxSize.cx div 3)) div 2;
if Draw = cdsLines then //if lines should be drawn?
begin
Runner := ChildCoords;
//for each position of the inheriting classes
for ChildCount := 0 to ChildCount - 1 do
begin //draw a line to it
FFormatHandler.DrawLine(XPos + FBoxSize.cx div 2,
YPos + FBoxSize.cy,
Runner.x + FBoxSize.cx div 2, Runner.y);
Inc(Runner);
end;
end;
finally
FreeMem(ChildCoords); //free buffer of positions
end;
if Assigned(CoordsBackToParent) then //if positions should be saved
begin
CoordsBackToParent^.x := XPos; //save it
CoordsBackToParent^.y := YPos;
end;
if Draw = cdsBoxes then //if boxes should be drawn
begin
if Assigned(FURLCallBack) then //if links should be included
//get the link target and set it
FFormatHandler.SetNextTextBoxesLinkTarget(FURLCallBack(Ident));
//draw the class
FFormatHandler.DrawBoxedText(Ident.Name, XPos, YPos, FBoxSize);
end;
XPos := New; //set position for next class
end; //if ChildCount <> 0
if Assigned(CoordsBackToParent) then //if positions should be saved
Inc(CoordsBackToParent); //move to next buffer entry
end; //for i := 0 to Count - 1
end;
{Calculates the size of the boxes of the classes in the diagram. This is done
by ascertaining the biggest size of the class names and adding a margin.
~result the needed size for the boxes }
function TVectorClassDrawer.CalculateBoxSize: TSize;
{Calculates the size of the boxes of the classes.
~param List the list to check for the maximum needed size }
procedure CalcBoxSizeList(List: TIdentifierList);
var i :Integer; //counter through the list
Ident :TRecordType; //the identifiers in the list
TextSize :TSize; //size of the name of the class
begin
for i := 0 to List.Count - 1 do //for each class
begin
Ident := TRecordType(List[i]); //get it
//calculate size of its name
TextSize := FFormatHandler.GetTextExtent(Ident.Name);
if TextSize.cx > Result.cx then //and increase maximum if needed
Result.cx := TextSize.cx;
if TextSize.cy > Result.cy then
Result.cy := TextSize.cy;
CalcBoxSizeList(Ident.Children); //also check all descendants
end;
end;
var i :Integer; //counter through top level list
Obj :TObject; //the object of the list
OneList :TIdentifierList; //to pass a single identifier as a list
begin
Result.cx := 0; //box is empty so far
Result.cy := 0;
//let the format handler prepare for the measuring of the class names
FFormatHandler.PrepareTextMeasuring;
try
OneList := TIdentifierList.Create; //create list to pass a single class
try
for i := 0 to FTopLevelClasses.Count - 1 do //for each class in the list
begin
Obj := FTopLevelClasses.Objects[i]; //get it
//is an unknown class with a list of inheriting classes?
if Obj is TIdentifierList then
CalcBoxSizeList(TIdentifierList(Obj)) //calculate for descendants
else
begin
Assert(Obj is TIdentifier);
OneList.RemoveAll(False); //clear the list and
OneList.AddIdent(TIdentifier(Obj)); //add just this identifier
CalcBoxSizeList(OneList); //calculate for it
end;
end;
finally
OneList.RemoveAll(False);
OneList.Free; //free list (but not the identifier)
end;
finally
FFormatHandler.EndTextMeasuring; //end measuring class names
end;
Inc(Result.cx, 10); //add a margin of 5 pixels on each side
Inc(Result.cy, 10);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -