sourcecodememo.pas

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

   CaretPos := Point(i, FCaretPos.y); //got to the beginning of the word

   FSelecting := True;                //start selecting it
   CaretPos := Point(PreviousColumn, FCaretPos.y);  //select the word
   FSelecting := False;               //end selecting
  end //if i >= 1
 else
  begin                               //no word to the left
   i := PreviousColumn;               //get position of the click
   if i <> 0 then                     //valid position?
    begin                               //search beginning of the next word
     while (i <= length(S)) and not (S[i] in WordCharacters) do
      inc(i);
     if i <= length(S) then             //found a word?
      begin
       CaretPos := Point(i - 1, FCaretPos.y);   //go to its beginning
       while (i <= length(S)) and (S[i] in WordCharacters) do //search its end
        inc(i);
       FSelecting := True;                      //start selecting it
       CaretPos := Point(i - 1, FCaretPos.y);   //select it
       FSelecting := False;                     //end selecting
      end //if i <= length(S)
     else
      CaretPos := Point(0, FCaretPos.y);        //go to beginning of the line
    end //if i <> 0
   else
    CaretPos := Point(0, FCaretPos.y);  //go to the beginning of the line
  end; //else i >= 1

 inherited DblClick;                //handle the click
end;



{Handles the scrolling with the mouse wheel.
~param Shift    the state of special keys
~param MousePos position of the mouse pointer
~result whether the message was handled }
function TSourceCodeMemo.DoMouseWheelDown(Shift: TShiftState;
                                          MousePos: TPoint): Boolean;
begin
 if not inherited DoMouseWheelDown(Shift, MousePos) then //event not handled?
  if ssCtrl in Shift then                                  //"Control" holded?
   begin
    if TopLeft.y < FLines.Count - VisibleFullLines - 1 then  //scroll one page
     SetTopLeft(Point(TopLeft.x, TopLeft.y + VisibleFullLines))
    else
     SetTopLeft(Point(TopLeft.x, FLines.Count - 1));
   end
  else
   if ssShift in Shift then                                //shift holded
    begin
     if FCaretPos.y < FLines.Count - 1 then          //move caret down one line
      SetCaretPos(Point(FCaretPos.x, FCaretPos.y + 1));
    end
   else
    if TopLeft.y < FLines.Count - 2 then             //scroll two lines down
     SetTopLeft(Point(TopLeft.x, TopLeft.y + 2))
    else
     SetTopLeft(Point(TopLeft.x, FLines.Count - 1));
 Result := True;                                         //event handled
end;

{Handles the scrolling with the mouse wheel.
~param Shift    the state of special keys
~param MousePos position of the mouse pointer 
~result whether the message was handled }
function TSourceCodeMemo.DoMouseWheelUp(Shift: TShiftState;
                                        MousePos: TPoint): Boolean;
begin
 if not inherited DoMouseWheelUp(Shift, MousePos) then   //event not handled?
  if ssCtrl in Shift then                                  //"Control" holded?
   begin
    if TopLeft.y > VisibleFullLines then                     //scroll one page
     SetTopLeft(Point(TopLeft.x, TopLeft.y - VisibleFullLines))
    else
     SetTopLeft(Point(TopLeft.x, 0));
   end
  else
   if ssShift in Shift then                                //shift holded
    begin
     if FCaretPos.y > 0 then                           //move caret up one line
      SetCaretPos(Point(FCaretPos.x, FCaretPos.y - 1));
    end
   else
    if TopLeft.y > 2 then                              //scroll two lines up
     SetTopLeft(Point(TopLeft.x, TopLeft.y - 2))
    else
     SetTopLeft(Point(TopLeft.x, 0));
 Result := True;                                         //event handled
end;














{Paints the component with its text. }
procedure TSourceCodeMemo.Paint;
var       SelStart       :TPoint;     //beginning of the selection
          SelEnd         :TPoint;     //end of the selection
          W              :Integer;    //maximal visible characters per line
          Y              :Integer;    //current vertical position to paint
          LineIndex      :Integer;    //counter through the lines
          CRect          :TRect;      //rectangle to fill the background
          Right          :Integer;    //right maximal value (pixel) to paint
          Line           :String;     //text of each line
begin
 //has a visible selection?
 if ((FCaretPos.x <> FSelStart.x) or (FCaretPos.y <> FSelStart.y))
    and (not FHideSelection or Focused) then
  begin                                 //get the ranges of the selection
   if (FCaretPos.y < FSelStart.y) or
      ((FCaretPos.y = FSelStart.y) and (FCaretPos.x < FSelStart.x)) then
    begin
     SelStart := FCaretPos;
     SelEnd := FSelStart;
    end
   else
    begin
     SelStart := FSelStart;
     SelEnd := FCaretPos;
    end;
  end
 else
  begin
   SelStart.x := -1;                    //no selection
   SelStart.y := -1;
   SelEnd := SelStart;
  end;

 W := VisibleChars;                   //number of maximal visible characters
 //vertical position to start painting
 Y := Canvas.ClipRect.Top div FCharExtent.cy * FCharExtent.cy;

 //line to start painting with
 LineIndex := FTopLeft.y + Canvas.ClipRect.Top div FCharExtent.cy;
 //the painting starts within the selection?
 if (LineIndex > SelStart.y) and (LineIndex <= SelEnd.y) then
  begin
   Canvas.Brush.Color := clHighlight;   //set selection colors
   Canvas.Font.Color := clHighlightText;
  end;

 //get right border
 Right := Canvas.ClipRect.Right;

 //while not all lines painted and not the whole region painted that needed
 while (LineIndex < FLines.Count) and (Y <= Canvas.ClipRect.Bottom) do //to be
  begin
   Line := FLines[LineIndex];           //get the line

   if LineIndex = SelStart.y then       //selection starts in this line?
    begin
     if TopLeft.x < SelStart.x then       //selection not yet started?
      begin
//*********************************
       CRect.Left := 0;
       CRect.Right := (SelStart.x - TopLeft.x) * FCharExtent.cx;
       CRect.Top := Y + FCharExtent.cy - 1;
       CRect.Bottom := Y + FCharExtent.cy;
       Canvas.FillRect(CRect);              //fill space between lines
//*********************************
       //write the unselected text
       Canvas.TextOut(0, Y, copy(Line, TopLeft.x + 1, SelStart.x - TopLeft.x));

       //the selection starts after the end of the line?
       if length(Line) < SelStart.x then
        begin
         CRect.Left := Canvas.PenPos.x;
         CRect.Right := (SelStart.x - TopLeft.x) * FCharExtent.cx;
         CRect.Top := Y;
         CRect.Bottom := Y + FCharExtent.cy;
         Canvas.FillRect(CRect);              //clear up to the selection
        end;
      end; //if TopLeft.x < SelStart.x

     Canvas.Brush.Color := clHighlight;   //start selection
     Canvas.Font.Color := clHighlightText;

     if SelStart.x < TopLeft.x + W then   //selection visible on the line?
      begin
//*********************************
       CRect.Left := (SelStart.x - TopLeft.x) * FCharExtent.cx;
       CRect.Right := Width;
       CRect.Top := Y + FCharExtent.cy - 1;
       CRect.Bottom := Y + FCharExtent.cy;
       Canvas.FillRect(CRect);              //fill space between lines
//*********************************
       //write selected text (remnant of line)
       Canvas.TextOut((SelStart.x - TopLeft.x) * FCharExtent.cx, Y,
                      copy(Line, SelStart.x + 1, high(length(Line))));
       if LineIndex = SelEnd.y then         //selection also ends on this line?
        begin
         Canvas.Brush.Color := Color;         //reset colors to default
         Canvas.Font.Color := clWindowText;
         if SelEnd.x < TopLeft.x + W then     //unselected text also visible?
          begin
//*********************************
           CRect.Left := (SelEnd.x - TopLeft.x) * FCharExtent.cx;
           Canvas.FillRect(CRect);              //fill space between lines
//*********************************
           //(re-)write unselected text
           Canvas.TextOut((SelEnd.x - TopLeft.x) * FCharExtent.cx, Y,
                          copy(Line, SelEnd.x + 1, high(length(Line))));
          end; //if SelEnd.x < TopLeft.x + W
        end; //if LineIndex = SelEnd.y
      end; //if SelStart.x < TopLeft.x + W
    end //if LineIndex = SelStart.y
   else
    if LineIndex = SelEnd.y then          //selection end in this line?
     begin
      if TopLeft.x < SelEnd.x then          //some selected text is shown?
       begin
//*********************************
        CRect.Left := 0;
        CRect.Right := (SelStart.x - TopLeft.x) * FCharExtent.cx;
        CRect.Top := Y + FCharExtent.cy - 1;
        CRect.Bottom := Y + FCharExtent.cy;
        Canvas.FillRect(CRect);               //fill space between lines
//*********************************
        //write selected text
        Canvas.TextOut(0, Y, copy(Line, TopLeft.x + 1, SelEnd.x - TopLeft.x));

        //the selection goes beyond the end of the line?
        if length(Line) < SelEnd.x then
         begin
          CRect.Left := Canvas.PenPos.x;
          CRect.Right := (SelEnd.x - TopLeft.x) * FCharExtent.cx;
          CRect.Top := Y;
          CRect.Bottom := Y + FCharExtent.cy;
          Canvas.FillRect(CRect);               //clear up till selection ends
         end; //if length(Line) < SelEnd.x
       end; //if TopLeft.x < SelEnd.x

      Canvas.Brush.Color := Color;          //reset to default colors
      Canvas.Font.Color := clWindowText;

      if SelEnd.x < TopLeft.x + W then      //unselected text is also visible?
       begin
//*********************************
        CRect.Left := (SelEnd.x - TopLeft.x) * FCharExtent.cx;
        CRect.Right := width;
        CRect.Top := Y + FCharExtent.cy - 1;
        CRect.Bottom := Y + FCharExtent.cy;
        Canvas.FillRect(CRect);               //fill space between lines
//*********************************
        //show unselected text
        Canvas.TextOut((SelEnd.x - TopLeft.x) * FCharExtent.cx, Y,
                       copy(Line, SelEnd.x + 1, high(length(Line))));
       end; //if SelEnd.x < TopLeft.x + W
     end //if LineIndex = SelEnd.y
    else
     begin

//*********************************
      CRect.Left := 0;
      CRect.Right := (TopLeft.x + 1) * FCharExtent.cx;
      CRect.Top := Y + FCharExtent.cy - 1;
      CRect.Bottom := Y + FCharExtent.cy;
      Canvas.FillRect(CRect);               //fill space between lines
//*********************************
      //write the text (selected or not)
      Canvas.TextOut(0, Y, copy(Line, TopLeft.x + 1, W));
     end; //else LineIndex = SelEnd.y


   CRect.Left := Canvas.PenPos.x;
   CRect.Right := Right;
   CRect.Top := Y;
   CRect.Bottom := Y + FCharExtent.cy;
   Canvas.FillRect(CRect);              //fill the line up to the end

   inc(Y, FCharExtent.cy);              //go to position to paint the next line
   inc(LineIndex);                      //go to the next line to be painted

  end; //while LineIndex < FLines.Count and Y <= Canvas.ClipRect.Bottom


 CRect := Canvas.ClipRect;
 if Y <= CRect.Bottom then            //not whole region painted?
  begin
   CRect.Top := Y;
   Canvas.FillRect(CRect);              //clear the remnant part
  end;

 Canvas.Brush.Color := Color;         //reset colors
 Canvas.Font.Color := clWindowText;
end;
























{Returns the number of visible lines.
~result the number of visible lines }
function TSourceCodeMemo.VisibleLines: Integer;
begin
 Result := ClientHeight div FCharExtent.cy +
           ord(Height mod FCharExtent.cy <> 0);
end;

{Returns the number of fully visible lines.
~result the number of fully visible lines }
function TSourceCodeMemo.VisibleFullLines: Integer;
begin
 Result := ClientHeight div FCharExtent.cy;
end;

{Returns the number of visible characters per line.
~result the number of visible characters per line }
function TSourceCodeMemo.VisibleChars: Integer;
begin
 Result := ClientWidth div FCharExtent.cx + ord(Width mod FCharExtent.cx <> 0);
end;

{Returns the number of fully visible characters per line.
~result the number of fully visible characters per line }
function TSourceCodeMemo.VisibleFullChars: Integer;
begin
 Result := ClientWidth div F