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

📄 udiagramcreator.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 5 页
字号:
       //search class in the file
       Ident := FindIdentifier(ClassName, FStartFile, UndefPosition);
      //class not found so far or invalid?
      if not assigned(Ident) or DoNotDocumentIdentifier(Ident) then
       begin
        Ident := nil;                     //class not found so far
        i := FFiles.Count - 1;
        while (i >= 0) and not assigned(Ident) do //search each file
         begin
          TheFile := FFiles[i];                              //get each file
          Ident := TheFile.Idents.GetIdentByName(ClassName); //is in the file?
          //is not valid?
          if not (Ident is TRecordType) or DoNotDocumentIdentifier(Ident) then
           Ident := nil;                                       //not found
          dec(i);                                            //next file
         end; //while i >= 0 and not assigned(Ident)
       end; //not assigned(Ident) or
      if not assigned(Ident) then       //identifier not found?
       AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkClassNotFound),
                        Format('Class "%s" not found!', [ClassName]))
      else
       begin
        List.Add(Ident);                  //add it to the list
        Result := True;                   //class was valid
       end; //if not assigned(Ident)
     end; //if Parameter <> ''
   end; //else LowerCase(ClassName) = 'type'
end;




{Handles modifiers of a list of classes to add or remove from the diagram.
~param List      the list so apply the modifiers to
~param Modifiers the list of modifiers to apply to the list
~result whether the modifiers were valid }
function TDiagramCreator.AddSubClassModifiers(List: TList;
                                              Modifiers: String): Boolean;

 {Adds for each interface the classes that implement them. }
 procedure AddImplementingClasses;
 var       i            :Integer;      //counter through the list
           TheInterface :TRecordType;  //interfaces in the list
           j            :Integer;      //counter through implementing classes
           AClass       :TIdentifier;  //classes that implement the interfaces
 begin
  for i := 0 to List.Count - 1 do      //for each type in list
   begin
    TheInterface := List[i];             //get it
    if TheInterface.Kind = rkInterface then //is an interface?
     //for all classes implementing the interface
     for j := 0 to TheInterface.Implementing.Count - 1 do
      begin
       AClass := TheInterface.Implementing[j]; //get it
       assert(AClass is TRecordType);
       assert(TRecordType(AClass).Kind = rkClass);
       //is included in the documentation?
       if not DoNotDocumentIdentifier(AClass) then
        Add(List, AClass);                       //add it to the list
      end;
   end;
 end;


 {Filters the record-like types by their kinds.
 ~param KindsToFilter a string representing the kinds to keep in the list
 ~result whether the parameter is valid }
 function FilterTypes(const KindsToFilter: String): Boolean;
 var      FilterSet  :TRecordKinds; //set of kinds of record-like types
          i          :Integer;      //counter through the list
 begin
  //extract kinds of record-like types to filter
  Result := GetRecordLikeTypeSet(KindsToFilter, FilterSet);
  if Result then                    //valid parameter?
   for i := List.Count - 1 downto 0 do //for each record-like type
    //if it is of a kind not in the filter
    if not (TRecordType(List[i]).Kind in FilterSet) then
     List.Delete(i);                     //remove it from the list
 end;


 {Adds each interface that is implemented by one of the classes in the list. }
 procedure AddImplementedInterfaces;
 var       i            :Integer;      //counter through the list
           TheClass     :TRecordType;  //classes in the list
           j            :Integer;      //counter through implemented interfaces
           AnInterface  :TIdentifier;  //interfaces implemented by the classes
 begin
  for i := 0 to List.Count - 1 do      //for each type
   begin
    TheClass := List[i];                 //get it
    if TheClass.Kind = rkClass then      //if it is a class
     //for all implemented interfaces
     for j := 0 to TheClass.Implementing.Count - 1 do
      begin
       assert(TheClass.Implementing[j] is TIdentType);
       //get the interface
       AnInterface := TIdentType(TheClass.Implementing[j]).GetFinalType;
       //valid interface found and it is documented
       if (AnInterface is TRecordType) and
          (TRecordType(AnInterface).Kind = rkInterface) and
          not DoNotDocumentIdentifier(AnInterface) then
        Add(List, AnInterface);            //add it to the list
      end;
   end;
 end;

 {Adds all ancestors of the classes in the list to it. }
 procedure AddAllAncestors;
 var       i              :Integer;         //counter through the list
           AType          :TRecordType;     //types in the list
 begin
  i := 0;
  while i < List.Count do                   //for each type in the list
   begin
    AType := TRecordType(List[i]).GetParent;  //get the parent
    //if it is valid and documented
    if assigned(AType) and (AType is TRecordType) and
       not DoNotDocumentIdentifier(AType) then
     Add(List, AType);                          //add it to the list
    inc(i);                                   //next type
   end;
 end;

 {Adds all descendants (also indirect). }
 procedure AddAllDescendants;
 var       i              :Integer;      //counter through the list
           AType          :TRecordType;  //types in the list
           j              :Integer;      //counter through children
           AChild         :TIdentifier;  //children of the types
 begin
  i := 0;
  while i < List.Count do                //for each type in the list
   begin
    AType := List[i];                      //get it
    //for each of its direct children/sub-classes
    for j := 0 to AType.Children.Count - 1 do
     begin
      AChild := AType.Children[j];           //get it
      //is part of the documentation?
      if not DoNotDocumentIdentifier(AChild) then
       Add(List, AChild);                      //add it to the list
     end;
    inc(i);                                //next type
   end;
 end;



         //the list of modifiers
type     TModifier = (
                    mClasses,    //for interfaces: add all implementing classes
                    mFilter,     //remove all record-like types of other kinds
                    mInterfaces, //for classes: add all implemented interfaces
                    mSuper,      //add all ancestors
                    mTree);      //add all descendants
         //the names/commands of the modifiers
const    ModifierWords: array[TModifier] of String =
                        ('classes', 'filter', 'interfaces', 'super', 'tree');

var      Part           :String;       //each modifier and its parameters
         Name           :String;       //name of each modifier
         Modifier       :Integer;      //index of the modifier
begin
 Result := True;                       //no error so far
 //for all modifiers, unless there is an error or no classes left
 while Result and (List.Count <> 0) and (Modifiers <> '') do
  begin
   Result := False;                      //assume this modifier is invalid

   Part := ExtractFirstPart(Modifiers);  //extract modifier
   Name := ExtractName(Part);            //extract name of modifier

   //get the modifier by its name
   if not IsWordIn(Name, ModifierWords, Modifier) then
    AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkModifierUnknown),
                     Format('Modifier "%s" is unknown!', [Name]))
   else
    //check if the parameters are valid
    if (TModifier(Modifier) <> mFilter) and (Part <> '') then
     AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkModifierParameter),
                      Format('Only modifier "filter" does have parameters, not "%s"!',
                             [Name]))
    else
     begin
      Result := True;                        //modifier is correct
      case TModifier(Modifier) of
        mClasses:    //add for each interface the classes that implement them
                     AddImplementingClasses;
        mFilter:     if (Part = '') or (Part[1] <> '(') or
                        (Part[Length(Part)] <> ')') then
                      begin
                       AddSimpleMessage(FDiagramCreatorMessagesID,
                                        Ord(dcmkModifierParameter),
                                        Format('Modifier "%s" must have a parameter!',
                                               [Name]));
                       Result := False;
                      end
                     else
                      //filter the record-like types by their kinds
                      Result := FilterTypes(copy(Part, 2, Length(Part) - 2));
        mInterfaces: //add each interface that is implemented by one of
                     AddImplementedInterfaces;        //the classes in the list
        mSuper:      AddAllAncestors;                 //adds all ancestors
        mTree:       AddAllDescendants;  //adds all descendants (also indirect)
      else
       assert(False);
      end; //case Modifier of
     end; //else modifier or parameter incorrect

  end; //while Result and List.Count <> 0 and Modifiers <> ''

 //only correct, if all modifiers have been handled
 Result := Result and (Modifiers = '');
end;








{Handles the first part of files to add or remove from the diagram.
~param FileName  the name fo the file or a kind of files
~param Parameter parameter to the file or command
~param List      the list to add the file(s) to
~result whether the file(s) has/ve been successfully added }
function TDiagramCreator.AddSubFileStart(const FileName, Parameter: String;
                                         List: TList): Boolean;
var      TheFile        :TPascalFile;     //the file(s) to add
         KindIndex      :Integer;         //index of kind of files
         Kind           :TSourceFileType; //kind of files to add
         i              :Integer;         //counter through all files
begin
 Result := Parameter = '';                //check that there is no parameter
 if Result then
  if IsWordIn(FileName, FileStartWords, KindIndex) then //is a kind of files?
   begin
    Kind := FileStartWordTypes[TSourceFileType(KindIndex)]; //get the kind
    for i := 0 to FFiles.Count - 1 do         //for each file
     begin
      TheFile := FFiles[i];                     //get it
      if (TheFile.FileType = Kind) and          //is of kind and documented?
         not DoNotDocumentIdentifier(nil, TheFile) then
       List.Add(TheFile);                         //add it to the list
     end; //for i := 0 to FFiles.Count - 1
   end //if IsWordIn(FileName, FileStartWords, KindIndex)
  else
   begin
    TheFile := FFiles.GetFileByName(FileName);  //search the file by its name
    //file found and it is documented?
    if assigned(TheFile) and not DoNotDocumentIdentifier(nil, TheFile) then
     List.Add(TheFile)                            //add it to the list
    else
     begin
      AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkFileNotFound),
                       Format('File not found: %s', [FileName]));
      Result := False;                             //erroneous file
     end
   end //else IsWordIn(FileName, FileStartWords, KindIndex)
 else
  AddSimpleMessage(FDiagramCreatorMessagesID, Ord(dcmkParameters),
                   Format('Files don''t need parameters! (%s)', [FileName]));
end;



{Handles modifiers of a list of files to add or remove from the diagram.
~param List      the list so apply the modifiers to
~param Modifiers the list of modifiers to apply to the list
~result whether the modifiers were valid }
function TDiagramCreator.AddSubFileModifiers(List: TList;
                                             Modifiers: String): Boolean;

         //the valid modifiers
type     TModifier = (
                      mUsed,            //add all used files
                      mInterface,       //add all files used in interface
                      mImplementation); //add all files used in implementation

 {Adds the specified used files.
 ~param WhatFiles   in what part the files should be used to be added
 ~param Recursively if the used files of the used files should also be added }
 procedure AddUsedFiles(WhatFiles: TModifier; Recursively: Boolean);

  {Adds all files in the list to the list.
  ~param Files the list of file to add to the list }
  procedure AddList(Files: TStrings);
  var       i      :Integer;                 //counter through the list
            AFile  :TPascalFile;             //each file
  begin
   for i := 0 to Files.Count - 1 do          //for each file
    begin
     AFile := TPascalFile(Files.Objects[i]);   //get it
     //it is documented?
     if assigned(AFile) and not DoNotDocumentIdentifier(nil, AFile) then
      Add(List, AFile);                          //add it to the list
    end;
  end;

 var       OldCount    :Integer;         //previous number of files in the list
           i           :Integer;         //counter through the list
           AFile     :TPascalFile;       //each file in the list
 begin
  repeat                                 //until no change
    OldCount := List.Count;                //save number of files

    for i := 0 to List.Count - 1 do        //for each file
     begin
      AFile := List[i];                      //get it
      //is a unit or all used files should be added
      if (AFile.FileType = sftUnit) or (WhatFiles = mUsed) then
       begin
        //add all files used in the specified way
        if WhatFiles <> mImplementation then
         AddList(AFile.UsedUnitList[fpInterface]);
        if WhatFiles <> mInterface then
         AddList(AFile.UsedUnitList[fpMain]);
       end; //if is Unit or all used files should be added
     end; //for i := 0 to List.Count - 1

  //either only diectly used files should be added, or repeat until all
  until (Recursively) or (List.Count = OldCount);    //files added
 end;

         //the names of the modifiers
const    ModifierWords: array[TModifier] of String =
         

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -