sourcecodememo.pas

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

{Updates the scroll bar.
~param PosOnly whether only the position of the scroll bar should be updated
               and not its range }
procedure TSourceCodeMemo.UpdateScrollBar(PosOnly: Boolean);
var       ScrollInfo     :TScrollInfo;  //options of the scroll bar
          Count          :Integer;      //number of lines of the text
          VisLines       :Integer;      //number of fully visible lines
begin
 if HandleAllocated then                //scroll bar already set up?
  if PosOnly then                         //only the position should be updated
   SetScrollPos(Handle, SB_VERT, FTopLeft.y, True)  //set the position
  else
   begin
    Count := FLines.Count;                   //get number of lines
    VisLines := VisibleFullLines;            //get number of visible lines

    ScrollInfo.cbSize := SizeOf(ScrollInfo); //set options of the scroll bar
    ScrollInfo.nMin := 0;
    if Count > VisLines then
      ScrollInfo.nMax := Count - 1
    else
     ScrollInfo.nMax := -1;
    ScrollInfo.nPage := VisLines;
    ScrollInfo.nPos := FTopLeft.y;
    ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;

    SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
   end; //else PosOnly
end;
























{Handles special keys to navigate through the text.
~param Key   the pressed key
~param Shift state of the special keys }
procedure TSourceCodeMemo.KeyDown(var Key: Word; Shift: TShiftState);
          //if the selecting has to be stopped again after the navigation
var       MustResetSelecting  :Boolean;
          Handled             :Boolean;   //if the key has been handled
begin
 inherited KeyDown(Key, Shift);           //handle the key

 //remember, if the selecting is enabled during this navigating
 MustResetSelecting := (ssShift in Shift) and not FSelecting;
 if MustResetSelecting then
  FSelecting := True;
 Handled := True;                         //assume key is being handled

 if ssCtrl in Shift then                  //"Control" key holded?
  begin
   case Key of                              //handle the key
     VK_UP:     begin                         //scroll one line upwards
                 if MustResetSelecting then
                  FSelecting := False;            //don't select
                 if CaretVisible <> cvFull then //caret currently not visible?
                  ScrollToCaret                   //just make it visible
                 else
                  if TopLeft.y > 0 then           //not at topmost position?
                   begin                            //scroll one line upwards
                    SetTopLeft(Point(TopLeft.x, TopLeft.y - 1));
                    //if caret not visible anymore, move it
                    if CaretVisible <> cvFull then
                     SetCaretPos(Point(CaretPos.x, CaretPos.y - 1));
                   end;
                end;
     VK_DOWN:   begin                         //scroll one line upwards
                 if MustResetSelecting then
                  FSelecting := False;            //don't select
                 if CaretVisible <> cvFull then //caret currently not visible?
                  ScrollToCaret                   //just make it visible
                 else
                  if TopLeft.y < FLines.Count - 1 then //not at the bottom?
                   begin                            //scroll one line downwards
                    SetTopLeft(Point(TopLeft.x, TopLeft.y + 1));
                    //if caret not visible anymore, move it
                    if CaretVisible <> cvFull then
                     SetCaretPos(Point(CaretPos.x, CaretPos.y + 1));
                   end;
                end;
     VK_LEFT:   WordLeft;                     //move one word to the left
     VK_RIGHT:  WordRight;                    //move one word to the right
     VK_PRIOR:  //move caret to the first visible line
                SetCaretPos(Point(FCaretPos.x, FTopLeft.y));
     VK_NEXT:   //move caret to the last visible and valid line
                if FTopLeft.y + VisibleFullLines >= FLines.Count then
                 SetCaretPos(Point(FCaretPos.x, FLines.Count - 1))
                else
                 SetCaretPos(Point(FCaretPos.x,
                                   FTopLeft.y + VisibleFullLines - 1));
     VK_HOME:   begin                         //move to beginning of the text
                 SetTopLeft(Point(0, 0));
                 SetCaretPos(Point(0, 0));
                end;
     VK_END:    //move to the end of the text
                SetCaretPos(Point(length(FLines[FLines.Count - 1]),
                                  FLines.Count - 1));
     ord('C'),
     VK_INSERT: if Shift = [ssCtrl] then      //no other special key holded?
                 CopyToClipboard                //copy text to the clipboard
                else
                 Handled := False;
     ord('V'):  if Shift = [ssCtrl] then      //no other special key holded?
                 PasteFromClipboard             //paste text from the clipboard
                else
                 Handled := False;
     ord('X'):  if Shift = [ssCtrl] then      //no other special key holded?
                 CutToClipboard                 //cut text to the clipboard
                else
                 Handled := False;
   else
    Handled := False;                         //key not handled
   end; //case Key
  end //if ssCtrl in Shift
 else
//  if [ssShift, ssAlt] * Shift = [] then
   case Key of                              //handle the key
     VK_UP:     if FCaretPos.y <> 0 then      //move caret one line upwards
                 SetCaretPos(Point(FCaretPos.x, FCaretPos.y - 1));
     VK_DOWN:   if FCaretPos.y < FLines.Count - 1 then   //one line downwards
                 SetCaretPos(Point(FCaretPos.x, FCaretPos.y + 1));
     VK_LEFT:   if FCaretPos.x <> 0 then      //move one character to the left
                 SetCaretPos(Point(FCaretPos.x - 1, FCaretPos.y));
     VK_RIGHT:  if FCaretPos.x < FLineLength then  //one character to the right
                 SetCaretPos(Point(FCaretPos.x + 1, FCaretPos.y));
     VK_PRIOR:  begin                         //move one page upwards
                 if TopLeft.y > VisibleFullLines then
                  SetTopLeft(Point(TopLeft.x, TopLeft.y - VisibleFullLines))
                 else
                  SetTopLeft(Point(TopLeft.x, 0));
                 if FCaretPos.y > VisibleFullLines then
                  SetCaretPos(Point(FCaretPos.x, FCaretPos.y - VisibleFullLines))
                 else
                  SetCaretPos(Point(FCaretPos.x, 0));
                end;
     VK_NEXT:   begin                         //move one page downwards
                 if TopLeft.y < FLines.Count - VisibleFullLines - 1 then
                  SetTopLeft(Point(TopLeft.x, TopLeft.y + VisibleFullLines))
                 else
                  SetTopLeft(Point(TopLeft.x, FLines.Count - 1));
                 if FCaretPos.y < FLines.Count - VisibleFullLines - 1 then
                  SetCaretPos(Point(FCaretPos.x, FCaretPos.y + VisibleFullLines))
                 else
                  SetCaretPos(Point(FCaretPos.x, FLines.Count - 1));
                end;
     VK_HOME:   SetCaretPos(Point(0, FCaretPos.y)); //move to beginning of line
     VK_END:    //move caret to the end of the line
                SetCaretPos(Point(length(FLines[FCaretPos.y]), FCaretPos.y));
     VK_INSERT:  if Shift = [ssShift] then    //paste text from the clipboard
                  begin
                   if MustResetSelecting then
                    FSelecting := False;
                   PasteFromClipboard;
                  end
                 else
                  Handled := False;
     VK_DELETE:  if Shift = [ssShift] then    //cut the text to the clipboard
                  begin
                   if MustResetSelecting then
                    FSelecting := False;
                   CutToClipboard;
                  end
                 else
                  Handled := False;
   else
    Handled := False;                         //key not handled
   end; //case Key


 if not Handled then                    //key not handled so far?
  begin
   Handled := True;                       //assume it gets handled
   case Key of
     VK_DELETE:  //delete current selection or one character
                 if (FSelStart.x = FCaretPos.x) and   //nothing selected?
                    (FSelStart.y = FCaretPos.y) then
                  begin                       //at the end of the line?
                   if FCaretPos.x >= length(FLines[FCaretPos.y]) then
                    begin                       //not at the end of the text?
                     if FCaretPos.y < FLines.Count - 1 then
                      begin
                       inc(FSelStart.y);          //select the line break
                       FSelStart.x := 0;
                       DeleteSelection;           //and delete it
                      end
                    end
                   else
                    begin
                     inc(FSelStart.x);          //select following character
                     DeleteSelection;           //and delete it
                    end;
                  end
                 else
                  DeleteSelection;            //delete the selected text
   else
    Handled := False;                     //key not handled
   end;
  end;

 if MustResetSelecting then               //was selecting during the handling?
  FSelecting := False;                      //stop selecting

 if Handled then
//  Key := #0
  ;
end;

{Handles keys to insert text.
~param Key the pressed key }
procedure TSourceCodeMemo.KeyPress(var Key: Char);
begin
 inherited;                              //handle keys

 //normal character, tabulator or line break?
 if Key in [#9, #13, #32..#255] then
  InsertText(Key)                          //insert it
 else
  if Key = #8 then                       //backspace?
   if (FSelStart.x = FCaretPos.x) and      //nothing selected?
      (FSelStart.y = FCaretPos.y) then
    begin
     if FCaretPos.x = 0 then                 //at the beginning of the line?
      begin
       if FCaretPos.y > 0 then                 //not in the first line?
        begin
         dec(FSelStart.y);                       //select the line break
         FSelStart.x := length(FLines[FSelStart.y]);
         DeleteSelection;                        //and delete it
        end
      end
     else
      begin
       dec(FSelStart.x);                       //select character before caret
       DeleteSelection;                        //and delete it
      end;
    end
   else
    DeleteSelection;                         //delete the selection
end;

{Handles clicking and selecting.
~param Button the button with which the user clicked
~param Shift  the state of special keys and if it was a double click
~param X, Y   position where the user clicked }
procedure TSourceCodeMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
                                    X, Y: Integer);
begin
 //if possible, focus the component
 if not (csDesigning in ComponentState) and
    (CanFocus or not assigned(GetParentForm(Self))) then
  begin
   SetFocus;
{  if not IsActiveControl then
    begin
     MouseCapture := False;
     Exit;
    end;}
  end;
 //in case of a normal left click, move the caret to the position
 if (Button = mbLeft) and not (ssDouble in Shift) then
  begin
   FSelecting := ssShift in Shift;          //selecting while clicking?
   //set the caret to the clicked position
   SetCaretPos(ScreenToCharacterPosition(X, Y));
   //keep selecting until the mouse button is released
   FSelecting := True;
  end;

 inherited MouseDown(Button, Shift, X, Y); //handle the click
end;

{Selects a range of text if the mouse button is pressed.
~param Shift the state of special keys
~param X, Y  position where the mouse pointer was moved to }
procedure TSourceCodeMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
 if FSelecting then                       //currently selecting text?
  //set the caret to the clicked position
  SetCaretPos(ScreenToCharacterPosition(X, Y));
 inherited MouseMove(Shift, X, Y);        //handle the movement
end;


{Finishes the selecting.
~param Button the button which the user released after clicking/dragging
~param Shift  the state of special keys
~param X, Y   position where the user clicked }
procedure TSourceCodeMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if FSelecting then                        //currently selecting text?
  begin
   //set the caret to the clicked position
   SetCaretPos(ScreenToCharacterPosition(X, Y));
   FSelecting := False;                      //stop selecting
  end;
 inherited MouseUp(Button, Shift, X, Y);   //handle the release of the button
end;

{Handles a double-click by selecting the next word on the current line. }
procedure TSourceCodeMemo.DblClick;
var       S              :String;   //text of the clicked line
          i              :Integer;  //index within the line
          PreviousColumn :Integer;  //position of the double click in the line
begin
 FSelecting := False;               //stop selecting

 S := FLines[FCaretPos.y];          //get the text of the line
 i := FCaretPos.x + 1;              //get position of the click
 if i > length(S) then
  i := length(S);
 PreviousColumn := i;               //and remember it
 //search the next word to the left
 while (i >= 1) and not (S[i] in WordCharacters) do
  dec(i);
 if i >= 1 then                     //a word found at or before the position?
  begin
   if i = FCaretPos.x + 1 then        //in a word?
    begin                               //search the end of the word
     while (i <= length(S)) and (S[i] in WordCharacters) do
      inc(i);
     dec(i);
    end;
   PreviousColumn := i;               //remember end of the word

   //search beginning of the word
   while (i >= 1) and (S[i] in WordCharacters) do
    dec(i);