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

📄 uvectorgraphics.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 5 页
字号:
         //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 + -