sourcecodememo.pas

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

{Cancels any modes of the component (selecting). }
procedure TSourceCodeMemo.CancelMode;
begin
// try
   FSelecting := False;              //stop selecting
//   FSelStart := FCaretPos;
   Invalidate;                       //update to show the selection
//   KillTimer(Handle, 1);
// finally
// end;
end;

{Calculates the size of each/all character(s). }
procedure TSourceCodeMemo.CalcCharExtent;
begin
 FCharExtent := Canvas.TextExtent(' ');  //get the size
 inc(FCharExtent.cy);                    //add one pixel space between lines
 UpdateScrollBar(False);                 //update the scroll bar
end;

{Sets the visible caret to its position. }
procedure TSourceCodeMemo.SetCaretPosition;
begin
 Windows.SetCaretPos((FCaretPos.x - FTopLeft.x) * FCharExtent.cx,
                     (FCaretPos.y - FTopLeft.y) * FCharExtent.cy);
end;

{Returns the position of the character in pixels.
~param x the number of the character in the line
~param y the line of the position
~result the position in pixels }
function TSourceCodeMemo.CharacterPositionToScreen(x, y: LongInt): TPoint;
begin
 Result.x := (x - FTopLeft.x) * FCharExtent.cx;
 Result.y := (y - FTopLeft.y) * FCharExtent.cy;
end;

{Returns the position of the character at the specified coordinates.
~param x, y coordinates of the character
~result position of the character }
function TSourceCodeMemo.ScreenToCharacterPosition(x, y: Integer): TPoint;
begin                                     //calculate position of character
 Result.x := (X + (FCharExtent.cx div 2)) div FCharExtent.cx + FTopLeft.x;
 Result.y := Y div FCharExtent.cy + FTopLeft.y;
 if Result.y >= FLines.Count then         //make sure, it is valid
  Result.y := FLines.Count - 1;
end;


{Marks the rectangle to be repainted.
~param Left, Top, Right, Bottom the rectangle in characters to be repainted }
procedure TSourceCodeMemo.InvalidateRect(Left, Top, Right, Bottom: LongInt);
var       InvalRect      :TRect;                     //the rectangle in pixels
begin
// Invalidate; {
 //calculate positions of the characters in pixels
 InvalRect.TopLeft := CharacterPositionToScreen(Left, Top);
 InvalRect.BottomRight := CharacterPositionToScreen(Right, Bottom);
 Windows.InvalidateRect(Handle, @InvalRect, False);  //invalidate it
// }
end;


{Deletes the selected text and returns the extends of the changed region.
~result TopLeft contains the caret position; Bottom contains the number of
        changed lines - 1; Right contains either the number of deleted
        characters (if Bottom = 0), or the number of characters in the first
        line that need to be updated }
function TSourceCodeMemo.DeleteSelectionText: TRect;
var      P1             :TPoint;    //start point of the selection
         P2             :TPoint;    //end point of the selection
         S              :String;    //the text of the first line after deletion
begin
 Result.TopLeft := FCaretPos;       //get current position
 Result.Right := 0;                 //nothign deleted so far
 Result.Bottom := 0;
 if not FReadOnly and               //editable and some text selected
    ((FCaretPos.x <> FSelStart.x) or (FCaretPos.y <> FSelStart.y)) then
  begin
   //get start and end of selection and deselect it
   if (FCaretPos.y < FSelStart.y) or
      ((FCaretPos.y = FSelStart.y) and (FCaretPos.x < FSelStart.x)) then
    begin
     P1 := FCaretPos;
     P2 := FSelStart;
     FSelStart := P1;
    end
   else
    begin
     P1 := FSelStart;
     P2 := FCaretPos;
     FCaretPos := P1;
    end;
   Result.TopLeft := FCaretPos;       //save start of selection
   Result.Bottom := P2.y - P1.y;      //and number of affected lines - 1

   if Result.Bottom <> 0 then         //selection spanned multiple lines?
    begin
     while P2.y > P1.y + 1 do           //for all all complete selected lines
      begin
       FLines.Delete(P1.y + 1);           //delete them
       dec(P2.y);
      end;

     S := FLines[P1.y + 1];             //get remaining text of the last line
     FLines.Delete(P1.y + 1);           //delete the whole last line
     Delete(S, 1, P2.x);                //delete selected text of the last line
     Result.Right := length(FLines[P1.y]); //update to the end of old the line
     if P1.x > Result.Right then        //selection start _after_ the line?
      begin
       if S <> '' then                    //last line has text left?
        FLines[P1.y] := FLines[P1.y] +      //add spaces and the last line
                        StringOfChar(' ', P1.x - Result.Right) + S;
      end
     else                                 //add remaining text of the last line
      FLines[P1.y] := TrimRight(copy(FLines[P1.y], 1, P1.x) + S);
     //first line is now longer that before?
     if length(FLines[P1.y]) > Result.Right then
      //update all replaces and added characters
      Result.Right := length(FLines[P1.y]) - P1.x
     else
      dec(Result.Right, P1.x);             //update all deleted characters

     UpdateScrollBar(False);            //update the scroll bar
    end //if Result.Bottom <> 0
   else
    begin
     S := FLines[P1.y];                 //get the line
     if P1.x < length(S) then           //some real text was selected?
      begin
       if P2.x > length(S) then           //selection past the end of the line
        P2.x := length(S);                  //only delete existing characters
       Result.Right := P2.x - P1.x;       //calculate # of deleted characters
       Delete(S, P1.x + 1, Result.Right); //delete them
       S := TrimRight(S);
       FLines[P1.y] := S;
      end;
    end; //else Result.Bottom <> 0
  end; //if not ReadOnly and FCaretPos <> FSelStart
end;

{Deletes the selected text and updates the shown text. }
procedure TSourceCodeMemo.DeleteSelection;
var       OldCaretPos    :TPoint;    //position of start of selection
          Changed        :TRect;     //changed lines and characters
begin
 if not FReadOnly then               //text may be changed?
  begin
   OldCaretPos := FCaretPos;           //get position of start of selection
   if (FSelStart.y < OldCaretPos.y) or
      ((FSelStart.y = OldCaretPos.y) and (FSelStart.x < OldCaretPos.x)) then
    OldCaretPos := FSelStart;
   Changed := DeleteSelectionText;     //delete the text
   if Changed.Right <> 0 then          //first line changed?
    //repaint the first line starting with the beginning of the selection
    InvalidateRect(FCaretPos.x, FCaretPos.y, FLineLength, FCaretPos.y + 1);
   if Changed.Bottom <> 0 then         //more than one line deleted?
    //repaint everything below it
    InvalidateRect(0, FCaretPos.y + 1,
                   FLineLength, Changed.Bottom + FLines.Count);
   //position of the caret changed due to the deletion?
   if (OldCaretPos.x <> FCaretPos.x) or (OldCaretPos.y <> FCaretPos.y) then
    SetCaretPosition;                    //adjust its position
  end;
end;

{Inserts a text at the current position.
~param Text the text to insert }
procedure TSourceCodeMemo.InsertText(Text: String);
var       Selection      :TRect;     //deleted lines and characters
          NewText        :TRect;     //addes lines and characters

 {Inserts a tabulators (as spaces) into the text. }
 procedure DoTab;
 var       S          :String;        //the text of the line
 begin
  S := FLines[NewText.Top];           //get the line
  if NewText.Left < length(S) then    //not after the text?
   begin
    Insert(StringOfChar(' ', FTabWidth - NewText.Left mod FTabWidth),
           S, NewText.Left + 1);        //insert spaces
    FLines[NewText.Top] := S;           //and set the new text
    if NewText.Bottom = 0 then          //add number of changed characters
     inc(NewText.Right, FTabWidth - NewText.Left mod FTabWidth);
   end;
  //adjust the position of the caret
  inc(NewText.Left, FTabWidth - NewText.Left mod FTabWidth);
 end;

 {Adds a line break at the current position of the caret. }
 procedure DoNewLine;
 var       S          :String;       //text of the new line
 begin
  //get text of the new line
  S := copy(FLines[NewText.Top], NewText.Left + 1, high(length(S)));
  FLines.Insert(NewText.Top + 1, S); //break the line
  if S <> '' then                    //new line has some text
   begin                               //delete it from the old one
    FLines[NewText.Top] := TrimRight(copy(FLines[NewText.Top], 1,
                                          NewText.Left));
    inc(Selection.Right, length(S));
   end;
  NewText.Left := 0;                 //go to the next line
  inc(NewText.Bottom);
  inc(NewText.Top);
 end;

 {Inserts some simple characters in the text.
 ~param Text the characters to insert }
 procedure DoInsertText(Text: String);
 var       Len        :Integer;      //number of the characters to insert
           S          :String;       //the current line to insert in
           P          :PChar;        //counter through the string
 begin
  Len := length(Text);               //get number of characters to insert
  S := FLines[NewText.Top];          //get the current line
  if NewText.Left >= length(S) then  //caret after the end of the line?
   begin
    if NewText.Bottom = 0 then         //adjust border
     inc(NewText.Right, NewText.Left - length(S));

    P := Pointer(Text);                //check for trailing spaces
    inc(P, len - 1);
    while (P >= Pointer(Text)) and (P^ = ' ') do
     dec(P);
    if P >= Pointer(Text) then         //not all spaces?
     //append the text after some spaces without the trailing spaces
     S := S + StringOfChar(' ', NewText.Left - length(S)) +
          copy(Text, 1, P - Pointer(Text) + 1);
   end
  else
   Insert(Text, S, NewText.Left + 1);  //insert the text
  FLines[NewText.Top] := S;          //set the changed line
  if NewText.Bottom = 0 then         //adjust the border
   inc(NewText.Right, length(Text));
  inc(NewText.Left, len);            //adjust the position to insert text
 end;

var       P              :PChar;       //runner through the string
          TextEnd        :PChar;       //marker of the end of the string
          //beginning of the current part of the text to insert
          Start          :PChar;
          S              :String;      //a part of the text to insert
begin
 if not FReadOnly then                 //content can be edited?
  begin
   Selection := DeleteSelectionText;     //delete the current selection
   NewText.TopLeft := Selection.TopLeft; //nothing inserted so far
   NewText.Right := 0;
   NewText.Bottom := 0;

   if Text <> '' then                    //something to insert?
    //insert all the text, handle tabulators and line breaks specially
    begin
     P := Pointer(Text);                   //run through the string
     TextEnd := P;
     inc(TextEnd, length(Text));           //get marker on its end
     while P < TextEnd do                  //run through the whole string
      begin
       Start := P;                           //current part of text to insert
       while P^ >= ' ' do                    //get all normal characters
        inc(P);
       if P <> Start then                    //some normal characters?
        begin
         SetString(S, Start, P - Start);
         DoInsertText(S);                      //insert the characters
        end;
       if P^ = #9 then                       //tabulator follows?
        DoTab                                  //insert it
       else
        if P^ in [#10, #13] then             //line break?
         begin
          //line-break uses two characters?
          if (PWORD(P)^ = $1013) or (PWORD(P)^ = $1310) then
           inc(P);                               //skip second character
          DoNewLine;                           //insert a line break
         end;
       inc(P);                               //next character
      end; //while P < TextEnd
    end; //if Text <> ''

   if Selection.Bottom = 0 then          //not multiple lines deleted?
    begin

     //same number of characters inserted as deleted?
     if Selection.Right = NewText.Right then
      begin
       if NewText.Right <> 0 then          //paint the inserted characters
        InvalidateRect(Selection.Left, Selection.Top,
                       Selection.Left + NewText.Right, Selection.Top + 1)
      end
     else
      //repaint the whole line starting where text has been inserted
      InvalidateRect(Selection.Left, Selection.Top,
                     FLineLength, Selection.Top + 1);
     if NewText.Bottom <> 0 then           //several lines inserted?
      //repaint all lines and (scroll) all following them
      InvalidateRect(0, Selection.Top + 1,
                     FLineLength, Selection.Top + FLines.Count);

    end //if Selection.Bottom = 0
   else
    begin
     //repaint the whole line starting where text has been inserted
     InvalidateRect(Selection.Left, Selection.Top,
                    FLineLength, Selection.Top + 1);
     //same numer of lines inserted as deleted?
     if Selection.Bottom = NewText.Bottom then
      //repaint all newly inserted lines
      InvalidateRect(0, Selection.Top + 1,
                     FLineLength, Selection.Top + Selection.Bottom)
     else
      //repaint all lines and (scroll) all following them
      InvalidateRect(0, Selection.Top + 1,
                     FLineLength, Selection.Top + FLines.Count);

    end; //else Selection.Bottom = 0
   CaretPos := NewText.TopLeft;         //set the caret after the inserted text

   UpdateScrollBar(False);              //update the scroll bar
  end; //if not FReadOnly
end;

{Returns the text of the range of lines.
~param FromIndex the index of the first line
~param ToIndex   the index of the last line
~result the text of the lines }
function TSourceCodeMemo.GetLinesStr(FromIndex, ToIndex :Integer): String;
begin
 if FromIndex <= ToIndex then                    //valid range specified?
  begin
   Result := FLines[FromIndex];                    //aggregate the text
   for FromIndex := FromIndex + 1 to ToIndex do
    Result := Result + #13#10 + FLines[FromIndex];
  end
 else
  Result := '';                                    //return an empty text
end;