📄 udiagram.pas
字号:
{ * * * *** * * * *** TAssociation *** * * * *** * * * }
{Creates the association with all its properties.
~param Diagram the diagram containing the association and options
~param Source the box from where the association emerges
~param Destination the box where the associations points to
~param Kind the kind of the association }
constructor TAssociation.Create(Diagram: TDiagram; Source, Destination: TBox;
Kind: TAssociationKind);
begin
inherited Create; //create the object
FDiagram := Diagram; //save the properties
FSource := Source;
FDestination := Destination;
FKind := Kind;
end;
{Tests whether the association is filtered and shouldn't be drawn.
~result if the association is filtered and shouldn't be drawn }
function TAssociation.IsFiltered: Boolean;
begin
Result := //using of units in implementation of other units filtered?
(not FDiagram.ShowUsingImplementation and
(FKind = akUsingFile) and
(TFileReference(Source).TheFile.FileType = sftUnit)) or
//usage of a class in another class filtered?
(not FDiagram.ShowAssociations and (FKind = akUsingClass));
end;
{Draws the association.
~param Drawer the object doing the actual drawing
~param Size size of the region of the diagram to be painted
~param Pos offset of the region of the diagram to be painted
~param Monochrome if it should be drawn monochrome (don't set color) }
procedure TAssociation.Draw(Drawer: TDiagramDrawer; const Size, Pos: TPoint;
Monochrome: Boolean);
{Draws the arrow from the source point to the destination.
~param Src the source point to draw the arrow from
~param Dest the destination point to draw the arrow to }
procedure DrawArrow(Src, Dest: TPoint);
var Part :Extended; //part of the line to use for the arrowhead
Arr1, Arr2 :TPoint; //points of the arrowhead
Tmp :Integer; //helper for calculating Arr1 and Arr2
LineStyle :TPenStyle; //the style of the line of the arrow
begin
if (Src.x <> Dest.x) or (Src.y <> Dest.y) then //arrow does point somewhere?
begin
Part := (Diagram.Margin * 1.5) / //calculate portion of arrowhead
Sqrt(Sqr(Src.x - Dest.x) + Sqr(Src.y - Dest.y));
//calculate position on arrow
Arr1.x := Round(Part * Src.x + (1 - Part) * Dest.x);
Arr1.y := Round(Part * Src.y + (1 - Part) * Dest.y);
Arr2 := Arr1;
Tmp := Arr1.x; //now move both arrowhead points
Dec(Arr1.x, Arr1.y - Dest.y); //orthographic/upright
Inc(Arr1.y, Tmp - Dest.x);
Inc(Arr2.x, Arr2.y - Dest.y);
Dec(Arr2.y, Tmp - Dest.x);
//for implementation of interfaces use dashes
if FKind = akImplementing then
LineStyle := psDash
else
//for usage-associations use dashes and dots
if FKind = akUsingClass then
LineStyle := psDashDot
else
LineStyle := psSolid; //use a normal, solid line
//draw the arrow
Drawer.DrawArrow(Src, Dest, Arr1, Arr2,
(FKind in [akInheriting, akImplementing,
akUsingInterface]) or
((FKind = akUsingFile) and
(TFileReference(FSource).TheFile.FileType <> sftUnit)),
FKind = akInheriting, LineStyle);
end; //if Src <> Dest
end;
{Calculates the point on the surface of a rectangle with a given angle.
~param R the rectangle of a box to calculate the starting or ending point
of an arrow from
~param Angle the angle the point has to have on the rectangle }
function GetPoint(const R: TRect; Angle: Extended): TPoint;
const HalfPi = Pi / 2; //90 degree
var RectAngle :Extended; //angle between width and height of the box
begin
Result := R.TopLeft; //use position of box as a start
if (R.Right <= 0) or (R.Bottom <= 0) then //empty rectangle?
begin
Inc(Result.x, R.Right div 2); //use its center
Inc(Result.y, R.Bottom div 2);
end
else
begin
if Angle > Pi then //make sure it is between -Pi and Pi
Angle := Angle - 2 * Pi;
RectAngle := ArcTan(R.Bottom / R.Right); //angle of width and height of box
//position is on the side of the rectangle?
if (abs(Angle) < RectAngle) or (abs(Angle) >= Pi - RectAngle) then
begin
if abs(Angle) > HalfPi then //right side?
Inc(Result.x, R.Right) //go to right side
else
Angle := Pi - Angle; //adjust angle
//calculate height of the position
Inc(Result.y, Round((R.Bottom + R.Right * Tan(Angle)) / 2));
end
else //position is at top or bottom
begin
if Angle < 0 then //bottom side?
inc(Result.y, R.Bottom) //go to bottom
else
Angle := Pi - Angle; //adjust angle
//calculate width of the position
Inc(Result.x, Round((R.Right + R.Bottom * CoTan(Angle)) / 2));
end;
end;
Dec(Result.x, Pos.x); //adjust position of the point by
Dec(Result.y, Pos.y); //the position of the drawn region
end;
var Angle :Extended; //angle of the arrow
FromRect, ToRect :TRect; //rectangles of the two boxes
begin
FromRect.TopLeft := FSource.Position; //get rectangles of both boxes
FromRect.BottomRight := FSource.Size;
ToRect.TopLeft := FDestination.Position;
ToRect.BottomRight := FDestination.Size;
//calculate angel of the arrow
Angle := ArcTan2(FromRect.Top - ToRect.Top +
(FromRect.Bottom - ToRect.Bottom) div 2,
FromRect.Left - ToRect.Left +
(FromRect.Right - ToRect.Right) div 2);
//draw the arrow
DrawArrow(GetPoint(FromRect, Angle), //calculate first point and
GetPoint(ToRect, Pi + Angle)); //the second with opposite angle
end;
{ * * * *** * * * *** TBox *** * * * *** * * * }
{Creates the box and saves the reference to the diagram.
~param Diagram the diagram containing the box }
constructor TBox.Create(Diagram: TDiagram);
begin
inherited Create; //create the object
assert(assigned(Diagram));
FDiagram := Diagram; //save the reference to the diagram
FAssociations := TList.Create; //create list for associations
end;
{Frees the object and all associations. }
destructor TBox.Destroy;
var i :Integer; //counter through associations
begin
if assigned(FAssociations) then
for i := FAssociations.Count - 1 downto 0 do //free all association
if TAssociation(FAssociations[i]).Source = Self then //emerging from
TAssociation(FAssociations[i]).Free; //this box
FAssociations.Free; //free the list
inherited Destroy; //free the object
end;
{Returns the number of associations of this box.
~result the number of associations }
function TBox.GetAssociationCount: Integer;
begin
Result := FAssociations.Count;
end;
{Returns an association of this box.
~param Index the index of the association to return
~result the requested association }
function TBox.GetAssociation(Index: Integer): TAssociation;
begin
Result := TAssociation(FAssociations[Index]);
end;
{Calculates the module the file is in and sets its property.
~param ForFile the file to calculate the module of }
procedure TBox.CalcModulePath(ForFile: TPascalFile);
var Path :String; //path of the file
Base :String; //the common base path
i :Integer; //counter through the module
begin
Assert(Assigned(ForFile));
Assert(Assigned(ForFile.FileList));
//get path of file and the common base path
Path := ForFile.FileList.GetLongPathName(ForFile.FilePath);
Base := ForFile.FileList.GetLongPathName(ForFile.FileList.GetCommonBasePath);
Delete(Path, 1, Length(Base)); //remove the common part
Path := ExtractFileDir(Path); //we want only the path
if PathDelimiter <> ModuleDelimiter then //delimiter is wrong?
for i := 1 to Length(Path) do //change path delimiter to
if Path[i] = PathDelimiter then //module delimiter
Path[i] := ModuleDelimiter;
FModulePath := Path; //assign the module
end;
{Removes the reference to the association.
~param Ass the association to remove the references of }
procedure TBox.RemoveAssociation(Ass: TAssociation);
begin
assert(FAssociations.IndexOf(Ass) <> -1);
FAssociations.Remove(Ass); //remove the association from the list
end;
{Draws the basic frame of the box and computes the rectangle of the box on the
canvas. If it is selected it is also marked accordingly. This is only done if
the box is in the rectangle to be drawn.
~param Drawer the object doing the actual drawing
~param DrawRect in: BottomRight: the size of the rectangle to be drawn;
out: rectangle of the box on the canvas
~param Pos position of the rectangle to be drawn
~param HideSelection if marks of selected boxes shouldn't be drawn
~result if the box is in the rectangle to be drawn }
function TBox.DrawBase(Drawer: TDiagramDrawer; var DrawRect: TRect;
const Pos: TPoint; HideSelection: Boolean): Boolean;
begin
//check, whether the box has to be drawn in the visible rectangle
Result := (FPosition.x < Pos.x + DrawRect.Right) and
(FPosition.x + FSize.x > Pos.x) and
(FPosition.y < Pos.y + DrawRect.Bottom) and
(FPosition.y + FSize.y > Pos.y);
if Result then //the box is in the rectangle and should be drawn?
begin
DrawRect.Left := FPosition.x - Pos.x; //calculate the rectangle of the box
DrawRect.Top := FPosition.y - Pos.y;
DrawRect.Right := DrawRect.Left + FSize.x;
DrawRect.Bottom := DrawRect.Top + FSize.y;
//draw the rectangle around the box
Drawer.DrawBox(DrawRect.Left, DrawRect.Top, DrawRect.Right, DrawRect.Bottom,
FDiagram.Margin);
if FSelected and not HideSelection then //box selected and should be drawn?
//draw black small boxes at the four corners of the box
Drawer.DrawBoxSelection(DrawRect.Left, DrawRect.Top,
DrawRect.Right, DrawRect.Bottom,
FDiagram.Margin div 2);
end;
end;
{Ends the header of the box by drawing a separator and adjusting (shrinks) the
top position of the rectangle.
~param Drawer the object doing the actual drawing
~param DrawRect the rectangle to end the header at the top }
procedure TBox.EndHeader(Drawer: TDiagramDrawer; var DrawRect: TRect);
begin
//draw a horizontal line
Drawer.DrawLine(DrawRect.Left - Diagram.Margin div 2,
DrawRect.Top + Diagram.Margin div 2,
DrawRect.Right + Diagram.Margin div 2,
DrawRect.Top + Diagram.Margin div 2);
Inc(DrawRect.Top, FDiagram.Margin); //go to the next line
end;
{Moves the box.
~param dX, dY the distance to move the box }
procedure TBox.MoveBy(dX, dY: Integer);
begin
Inc(FPosition.x, dX); //move the box
Inc(FPosition.y, dY);
Assert((FPosition.x >= 0) and (FPosition.y >= 0));
end;
{Called to check for associations when another box is added.
~param Box the newly added box (or each box in the diagram)
~param CallOpposite if the same method of the new box should be called }
procedure TBox.OtherBoxAdded(Box: TBox; CallOpposite: Boolean);
begin
if CallOpposite then //this is an old box?
Box.OtherBoxAdded(Self, False); //call also with the new box
//checks are in the actual classes TClassReference and TFileReference
end;
{Called to remove associations when a box is removed from the diagram.
~param Box the box, that has just been removed from the diagram }
procedure TBox.OtherBoxRemoved(Box: TBox);
var i :Integer; //counter through all associations
Ass :TAssociation; //each association
begin
for i := FAssociations.Count - 1 downto 0 do //for each each association
begin
Ass := TAssociation(FAssociations[i]); //get it
//is an association between this and the deleted box?
if (Ass.Source = Box) or (Ass.Destination = Box) then
try
FAssociations.D
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -