⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 udiagram.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 5 页
字号:


  { * * *  ***  * * *  ***   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 + -