sourceformat.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

                             Delete(S, 1, i);         //and remove it
                             //it was only two "'"s to quote a "'"?
                             if (S <> '') and (S[1] = '''') then
                              begin
                               Result := Result + ''''; //add the other "'"
                               Delete(S, 1, 1);         //and delete it
                               i := pos('''', S);       //search the next one
                              end
                             else                     //end of string found
                              i := 0;                   //abort the loop
                            end;
                          until i = 0; //end of string reached?
                        end;
    tsCommentToLineEnd: begin         //comment to the end of the line //
                         Result := S;   //return the whole comment
                         S := '';       //no text left
                        end;
    tsCommentCurly:     begin         //comment {}
                         i := pos('}', S);        //search end of the comment
                         if i = 0 then            //end not in this line?
                          begin
                           Result := S;             //return the whole comment
                           S := ''                  //no text left
                          end
                         else
                          begin
                           Result := copy(S, 1, i); //return the comment
                           Delete(S, 1, i);         //remove the comment
                          end;
                        end;
    tsCommentBraceStar: begin         //comment (**)
                         i := pos('*)', S);           //search end of comment
                         if i = 0 then                //end not in this line
                          begin
                           Result := S;                 //return whole comment
                           S := ''                      //no text left
                          end
                         else
                          begin
                           Result := copy(S, 1, i + 1); //return the comment
                           Delete(S, 1, i + 1);         //remove the comment
                          end;
                        end;
  else
   assert(False);
  end;
  Text := S;                       //return the changed text
 end;

 {Extracts the first text of a state from the text. }
 procedure GetText;
 var       pc     :PChar;          //counter through the text
           Tmp    :String;         //characters introducing a new state
 begin
  if Text <> '' then               //text not empty?
   begin
    pc := Pointer(Text);             //start search in string
    if (pc^ in ['''', '{']) or       //a new state starts immediately?
       ((pc^ = '/') and (PChar(Cardinal(pc) + 1)^ = '/')) or
       ((pc^ = '(') and (PChar(Cardinal(pc) + 1)^ = '*')) then
     begin
      //extract introducing characters
      Tmp := copy(Text, 1, 1 + ord(pc^ in ['/', '(']));
      Delete(Text, 1, length(Tmp));

      if Tmp[1] in ['''', '/'] then    //get the new state
       State := tsString
      else
       State := tsCommentCurly;
      if Tmp[1] in ['/', '('] then
       inc(State);

      GetStateText;                    //extract the text of the state
      Result := Tmp + Result;          //and return it
     end
    else
     begin
      //check all the normal text
      while (pc^ <> #0) and not (pc^ in ['''', '{']) and
            not ((pc^ = '/') and (PChar(Cardinal(pc) + 1)^ = '/')) and
            not ((pc^ = '(') and (PChar(Cardinal(pc) + 1)^ = '*')) do
       inc(pc);

      Result := copy(Text, 1, pc - Pointer(Text)); //extract the normal text
      Delete(Text, 1, pc - Pointer(Text));
     end; //else "a new state starts"
   end; //if Text <> ''
 end;

begin
 Result := '';              //no text so far
 if State <> tsNormal then  //already in a state?
  GetStateText                //get remant text in that state
 else
  GetText;                    //get a text of one state of the text
end;












{Draws a text of one state.
~param Canvas   the canvas to write the text on
~param X, Y     the position to write the text at
~param Text     the text to write
~param State    state of the text
~param Selected if the text is selected }
procedure DrawTextInState(Canvas: TCanvas; X, Y: Integer;
                          Text: String; State: TTextState; Selected: Boolean);

 {Draws normal text, highlighting keywords and directives. }
 procedure DrawText;
 var       i       :Integer;          //counter index through the text
           len     :Integer;          //length of the text
           WordEnd :Integer;          //index of the end of the word
           Part    :String;           //a word of the text to write
           IsBold  :Boolean;          //if the word should be drawn bold
 begin
  i := 1;                             //start at the beginning of the text
  len := length(Text);
  while i <= len do                   //up to its end
   begin
    if Text[i] in WordChars then        //is a word?
     begin

      WordEnd := i + 1;                   //go to the end of the words
      while (WordEnd <= len) and (Text[WordEnd] in WordChars) do
       inc(WordEnd);
      Part := copy(Text, i, WordEnd - i);

      //check if it is a keyword or directive and has to be drawn in bold
      IsBold := IsKeyWord(Part);
      if IsBold then                      //if so, set the font style
       Canvas.Font.Style := Canvas.Font.Style + [fsBold];
      Canvas.TextOut(X, Y, Part);         //draw the text
      if IsBold then                      //and restore font style
       Canvas.Font.Style := Canvas.Font.Style - [fsBold];

      inc(X, Canvas.TextWidth(Part));     //move position after the text
      i := WordEnd;                       //resume after the word
     end //if Text[i] in WordChars
    else                                //not a word
     begin

      WordEnd := i + 1;                   //skip all non-word characters
      while (WordEnd <= len) and not (Text[WordEnd] in WordChars) do
       inc(WordEnd);

      Part := copy(Text, i, WordEnd - i); //get non-word characters
      Canvas.TextOut(X, Y, Part);         //draw all non-word characters

      inc(X, Canvas.TextWidth(Part));     //move position after the characters
      i := WordEnd;                       //resume after the characters
     end; //else Text[i] in WordChars
   end; //while i <= len
 end; //procedure DrawText

begin
 if not Selected then                      //if not selected
  case State of                              //set colors depending on state
    tsNormal:           Canvas.Font.Color := clWindowText;
    tsString:           Canvas.Font.Color := clRed;
    tsCommentToLineEnd: Canvas.Font.Color := clNavy;
    tsCommentCurly:     if (length(Text) > 1) and (Text[2] = '$') then
                         Canvas.Font.Color := clGreen
                        else
                         Canvas.Font.Color := clNavy;
    tsCommentBraceStar: if (length(Text) > 2) and (Text[3] = '$') then
                         Canvas.Font.Color := clGreen
                        else
                         Canvas.Font.Color := clNavy;
  end; //case State

 if State = tsNormal then                  //is normal text?
  DrawText                                   //draw text, highlight keywords
 else
  begin
   if State in tsAllComments then            //is a comment?
    Canvas.Font.Style := [fsItalic];           //write text italic

   Canvas.TextOut(X, Y, Text);               //write the whole text

   if State in tsAllComments then
    Canvas.Font.Style := [];                   //reset style if neccessary
  end; //else State = tsNormal
end; //procedure DrawTextInState










{$IFOPT C+}

{Simple Debug-Test to check if the array ~[link KeyWords] is sorted.
~result whether the array ~[link KeyWords] is sorted }
function TestKeyWordArray: Boolean;
var      i        :Integer;        //counter through the array
begin
 Result := True;                   //assume the array is correctly sorted
 for i := low(KeyWords) to high(KeyWords) - 1 do
  if KeyWords[i] >= KeyWords[i + 1] then   //check if it is sorted
   Result := False;
end;

{$ENDIF}


initialization
{$IFOPT C+}
 Assert(TestKeyWordArray);
{$ENDIF}
end.