pascalmemo.pas

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

//   Invalidate;                                   //show the content
  end;
end;




{Draws some text of the source code with syntax highlighting.
~param X, Y        coordinates where to draw the text
~param Line        the index of line to draw
~param First, Last the range of characters in the line to draw
~param Selected    if the text should be drawn selected }
procedure TPascalMemo.DrawText(X, Y: Integer; Line: Integer;
                               First, Last: Integer; Selected: Boolean);
var       S                   :String;      //the text of the line
          len                 :Integer;     //lenght of the line
          LineRect            :TRect;       //to fill regions
          i                   :Integer;     //position inside the text to write
          TextPart            :String;      //a part of the text to write
          State               :TTextState;  //state of the text
begin
 if Selected then                           //set color of the text
  begin
   Canvas.Brush.Color := clHighlight;
   Canvas.Font.Color := clHighlightText;
  end
 else
  begin
   Canvas.Brush.Color := Color;
   Canvas.Font.Color := clWindowText;
  end;

 S := FTheFile.Lines[Line];                 //get the text of the line
 len := length(S);

 if Last > len then                         //text does not fill whole line?
  begin
   LineRect.Right := X + (Last - First) * CharExtent.cx;
   LineRect.Left := LineRect.Right - (Last - len) * CharExtent.cx;
   LineRect.Top := Y;
   LineRect.Bottom := Y + CharExtent.cy;
   Canvas.FillRect(LineRect);                 //clear the remnant of the line
   Last := len;                               //only fill where text is
  end;
 LineRect.Left := X;
 LineRect.Right := X + (Last - First) * CharExtent.cx;
 LineRect.Top := Y + CharExtent.cy - 1;
 LineRect.Bottom := Y + CharExtent.cy;
 Canvas.FillRect(LineRect);                 //fill space between lines

 if Last > First then                       //some text to write?
  begin
   i := First + 1;                            //start from the beginning

{  //something about using whole words, so syntax highlighting (bold) does work
   WordStart := i;
   if (i <= Last) and (WordStart > 0) and (S[WordStart] in WordChars) then
    begin
     while (WordStart > 0) and (S[WordStart] in WordChars) do
      dec(WordStart);
     inc(WordStart);
     Canvas.PenPos := Point(X - (WordStart - i) * CharExtent.cx, Y);
     i := WordStart;
    end;
   while (Last <= length(S)) and (S[Last] in WordChars) do
    inc(Last);
}

   //get state of the text, at the part where the writing starts
   State := SkipString(copy(S, 1, i - 1), FTheFile.LineStartComment[Line]);

   S := copy(S, i, Last - i + 1);           //extract text to write
   while S <> '' do                         //write the whole text
    begin
     TextPart := GetTextOfOneState(S, State); //extract a part

     //write the part of the text in its state
     DrawTextInState(Canvas, X, Y, TextPart, State, Selected);
     inc(X, CharExtent.cx * length(TextPart));

     State := tsNormal;                       //resume with normal state
    end; //while S <> ''
  end; //if Last > First
end;



{Draws the source code with syntax highlighting. }
procedure TPascalMemo.Paint;
var       SelStart   :TPoint;    //start of the selection
          SelEnd     :TPoint;    //end of the selection
          ClipRect   :TRect;     //Canvas.ClipRect
          DrawRect   :TRect;     //Canvas.ClipRect round up to whole characters
          TextClip   :TRect;     //part of the text to write
          Y          :Integer;   //vertical position to write to
          Line       :Integer;   //current line to write
          Selected   :Boolean;   //if the text is currently selected
          X          :Integer;   //horizontal position to write to
          CharIndex  :Integer;   //index of character to resume writing
begin
 if not assigned(FTheFile) then             //no text to write?
  Canvas.FillRect(Canvas.ClipRect)            //just clear the component
 else
  begin
   if ((CaretPos.x <> SelectionStart.x) or (CaretPos.y <> SelectionStart.y))
      and (not HideSelection or Focused) then //has a visible selection?
    begin
     if (CaretPos.y < SelectionStart.y) or      //get position of selection
        ((CaretPos.y = SelectionStart.y) and
         (CaretPos.x < SelectionStart.x)) then
      begin
       SelStart := CaretPos;
       SelEnd := SelectionStart;
      end
     else
      begin
       SelStart := SelectionStart;
       SelEnd := CaretPos;
      end;
    end
   else
    begin
     SelStart.x := -1;
     SelStart.y := -1;
     SelEnd := SelStart;                        //no selection
    end;

   ClipRect := Canvas.ClipRect;               //get region to fill

   DrawRect.TopLeft := ClipRect.TopLeft;      //round it up to whole
   dec(DrawRect.Left, DrawRect.Left mod CharExtent.cx);        //characters
   dec(DrawRect.Top, DrawRect.Top mod CharExtent.cy);
   DrawRect.Right := (ClipRect.Right + CharExtent.cx - 1) div CharExtent.cx *
                     CharExtent.cx;
   DrawRect.Bottom := (ClipRect.Bottom + CharExtent.cy - 1) div CharExtent.cy *
                      CharExtent.cy;

   TextClip.TopLeft := TopLeft;               //get the part of the text to
   TextClip.BottomRight := TextClip.TopLeft;                           //write
   inc(TextClip.Left, ClipRect.Left div CharExtent.cx);
   inc(TextClip.Top, ClipRect.Top div CharExtent.cy);
   inc(TextClip.Right, ClipRect.Right div CharExtent.cx +
                       ord(ClipRect.Right mod CharExtent.cx <> 0));
   inc(TextClip.Bottom, ClipRect.Bottom div CharExtent.cy +
                        ord(ClipRect.Bottom mod CharExtent.cy <> 0));
   if TextClip.Bottom >= Lines.Count then
    TextClip.Bottom := Lines.Count;             //write only text that exists

   Y := DrawRect.Top;                         //get vertical position to write
   Line := TextClip.Top;                      //get line to write
   //beginning of the first line to write is selected?
   Selected := (TextClip.Top > SelStart.y) and (TextClip.Top <= SelEnd.y);

   while Line < TextClip.Bottom do            //write all lines
    begin
     if Line = SelStart.y then                 //selection starts in this line?
      begin
       X := DrawRect.Left;
       CharIndex := TextClip.Left;
       if SelStart.x > TextClip.Left then       //some unselected text visible?
        begin
         //write the unselected text at the beginning of the line
         DrawText(DrawRect.Left, Y, Line, CharIndex, SelStart.x, False);
         //write the selected text after it
         inc(X, (SelStart.x - TextClip.Left) * CharExtent.cx);
         CharIndex := SelStart.x;
        end;

       if Line = SelEnd.y then                  //selection also end in line?
        if SelEnd.x >= TextClip.Right then        //remaining text selected?
         DrawText(X, Y, Line, CharIndex, TextClip.Right, True) //write it
        else
         begin
          //write the selected text
          DrawText(X, Y, Line, CharIndex, SelEnd.x, True);
          //write the unselected text
          DrawText(DrawRect.Left + (SelEnd.x - TextClip.Left) * CharExtent.cx,
                   Y, Line, SelEnd.x, TextClip.Right, False);
         end //else SelEnd.x >= TextClip.Right
       else //if Line = SelEnd.y
        begin
         if SelStart.x < TextClip.Right then      //selected text visible?
          DrawText(X, Y, Line, CharIndex, TextClip.Right, True);  //write it
         Selected := True;                        //text is now selected
        end; //else Line = SelEnd.y
      end //if Line = SelStart.y
     else
      if Line = SelEnd.y then                  //selection ends in this line?
       begin
        if SelEnd.x >= TextClip.Right then       //only selected text visible?
         //write the selected text
         DrawText(DrawRect.Left, Y, Line, TextClip.Left, TextClip.Right, True)
        else
         begin
          //write selected text and the not selected text after it
          DrawText(DrawRect.Left, Y, Line, TextClip.Left, SelEnd.x, True);
          DrawText(DrawRect.Left + (SelEnd.x - TextClip.Left) * CharExtent.cx,
                   Y, Line, SelEnd.x, TextClip.Right, False)
         end;
        Selected := False;                       //text is no longer selected
       end //if Line = SelEnd.y
      else
       DrawText(DrawRect.Left, Y, Line, TextClip.Left, TextClip.Right,
                Selected);                       //just write the text


     inc(Y, CharExtent.cy);                    //write next line below this
     inc(Line);                                //next line
    end; //while Line < TextClip.Bottom


   if Y < ClipRect.Bottom then                //not enough lines to fill?
    begin
     ClipRect.Top := Y;
     Canvas.Brush.Color := Color;
     Canvas.FillRect(ClipRect);                 //fill the remaining part
    end; //if Y < ClipRect.Bottom

  end; //else not assigned(FTheFile)
end;


end.