sourcecodememo.pas

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

{Creates the visible window. }
procedure TSourceCodeMemo.CreateWnd;
begin
 inherited CreateWnd;                  //create the window
// UpdateScrollBar(False);               //update the scroll bar
end;


{Creates the list to represent the content of the component.
~result the list to represent the content }
function TSourceCodeMemo.CreateContentList: TStrings;
begin
// Result := TSCMemoStrings.Create(Self);
 Result := TStringList.Create;            //create a simple list
 try
   Result.Append('');                     //make sure it isn't empty
//   TStringList(Result).OnChange := TextChanged;
 except
   Result.Free;
   raise;
 end;
end;















{Returns the whole text inside the component.
~result the text inside the component
~see Text }
function TSourceCodeMemo.GetText: String;
begin
 Result := FLines.Text;
end;


{Sets the position of the caret (where text is inserted).
~param Value the new position of the caret
~see CaretPos }
procedure TSourceCodeMemo.SetCaretPos(Value: TPoint);

 {Invalidated the section of the text beweent the two points, so it is shown
  with/without the selection.
 ~param P1, P2 the text between these points is invalidated }
 procedure InvalidateSelection(const P1, P2: TPoint);
 var       min, max           :LongInt;    //extreme values of the points
 begin
  if P1.y = P2.y then                      //on the same line?
   begin
    if P1.x < P2.x then                      //get minimum and maximum
     begin
      min := P1.x;
      max := P2.x;
     end
    else
     begin
      min := P2.x;
      max := P1.x;
     end;                                    //invalidate the text on the line
    InvalidateRect(min - 1, P1.y, max + 1, P1.y + 1);
   end
  else
   begin
    if P1.y < P2.y then                      //get minimum and maximum line
     begin
      min := P1.y;
      max := P2.y;
     end
    else
     begin
      min := P2.y;
      max := P1.y;
     end;
    InvalidateRect(0, min, FLineLength, max + 1);  //invalidate the lines
   end; //if P1.y = P2.y
 end; //procedure InvalidateSelection

begin
 if Value.x < 0 then             //make sure the horizontal value is valid
  Value.x := 0
 else
  if Value.x > FLineLength then
   Value.x := FLineLength;
 if Value.y < 0 then             //make sure the vertical value is valid
  Value.y := 0
 else
  if Value.y >= FLines.Count then
   Value.y := FLines.Count - 1;

 //caret should be moved to a new, different position?
 if (Value.x <> FCaretPos.x) or (Value.y <> FCaretPos.y) then
  begin
   if FSelecting then                         //currently selecting?
    begin
//     if Focused then
      InvalidateSelection(FCaretPos, Value);    //show the text de-/selected
    end
   else
    begin
     //some text is currently selected?
     if //Focused and
        ((FSelStart.x <> FCaretPos.x) or (FSelStart.y <> FCaretPos.y)) then
      InvalidateSelection(FSelStart, FCaretPos);  //show the text deselected
     FSelStart := Value;
    end;
   FCaretPos := Value;                        //set the new position
   ScrollToCaret;                             //make sure it is visible
   if Focused then                            //component is focused?
    SetCaretPosition;                           //show the blinking dash
  end; //if Value <> FCaretPos
end;

{Sets the starting point of the selection.
~param Value the new starting point of the selection.
~see SelectionStart }
procedure TSourceCodeMemo.SetSelectionStart(Value: TPoint);
begin
 //is different point?
 if (Value.x <> FSelStart.x) or (Value.y <> FSelStart.y) then
  begin
   FSelStart := Value;          //set the new point
   Invalidate;                  //and make sure the new selection is shown
  end;
end;

{Sets the offset of the first shown line and character.
~param Value the new first shown line and character
~see TopLeft}
procedure TSourceCodeMemo.SetTopLeft(Value: TPoint);
begin
 if Value.y < 0 then        //make sure it's a valid position
  Value.y := 0;
 if Value.x < 0 then
  Value.x := 0;
 //text has to be be scrolled?
 if (Value.x <> FTopLeft.x) or (Value.y <> FTopLeft.y) then
  begin
   FTopLeft := Value;            //set new position
   Invalidate;                   //show the text at that position
   if Focused then               //component is focused?
    SetCaretPosition;              //move the visible caret
   UpdateScrollBar(True);        //update the positions of the scroll bars
  end;
end;

{Sets the (maximal shown) length of the lines.
~param Value the new maximal length of the lines
~see LineLength }
procedure TSourceCodeMemo.SetLineLength(Value: Integer);
begin
 if FLineLength <> Value then            //new maximal length?
  begin
   FLineLength := Value                    //set it
   //update the vertical scroll bar?
   //chop all lines that are too long?
  end;
end;

{Sets the text to show.
~param Value the new text to show
~see Lines }
procedure TSourceCodeMemo.SetLines(Value: TStrings);
begin
 FLines.Assign(Value);        //set the text
 UpdateScrollBar(False);      //update the scrollbar
 //if positon of caret or selection is invalid, correct it
 if (FCaretPos.y >= FLines.Count) or (FSelStart.y >= FLines.Count) then
  CaretPos := CaretPos;
end;

{Sets the text to show.
~param Value the new text to show
~see Text }
procedure TSourceCodeMemo.SetText(Value: String);
begin
 FLines.Text := Value;        //set the text
 UpdateScrollBar(False);      //update the scrollbar
 //if positon of caret or selection is invalid, correct it
 if (FCaretPos.y >= FLines.Count) or (FSelStart.y >= FLines.Count) then
  CaretPos := CaretPos;
end;








{Handles the request to cancel the current action (selecting).
~param Msg the message of the request }
procedure TSourceCodeMemo.CMCancelMode(var Msg: TMessage);
begin
 inherited;                    //cancel any other mode
 CancelMode;                   //cancel selecting
end;

{Handles the notification that the font has been changed.
~param Msg the message of the notification }
procedure TSourceCodeMemo.CMFontChanged(var Msg: TMessage);
begin
 inherited;                    //handle the change of the font
 CalcCharExtent;               //calculate the new size of a character
end;

(*

{Handles the query if special keys are handles by the component.
~param Msg the message of the query }
procedure TSourceCodeMemo.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
 inherited;
// if not FReadOnly and (Char(Msg.CharCode) = #13) then
//  Msg.Result := 1;
end;

*)

{Handles the notification that the component is (no longer) shown.
~param Msg the message of the notification }
procedure TSourceCodeMemo.CMShowingChanged(var Msg: TMessage);
begin
 inherited;                   //handle the notification
 if Showing then              //if component is newly shown
  CalcCharExtent;               //calculate the size of a character
end;




{Handles the query what keys are supported by the component.
~param Msg the message of the query }
procedure TSourceCodeMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
 //component wants normal characters, tabulator and arrow keys
 Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS;
 if not FReadOnly then
  Msg.Result := Msg.Result or DLGC_WANTTAB;
end;


{Handles the vertical scrolling of the text.
~param Msg the message of the notification that the text is being scrolled }
procedure TSourceCodeMemo.WMVScroll(var Msg: TWMVScroll);
var       NewPos         :TPoint;          //the new scrolled position
begin
 NewPos := FTopLeft;                       //get current position
 case Msg.ScrollCode of                    //scroll the position
   SB_BOTTOM:        NewPos.y := FLines.Count - 1;
// SB_ENDSCROLL:     Ends scroll.
   SB_LINEDOWN:      inc(NewPos.y);
   SB_LINEUP:        dec(NewPos.y);
   SB_PAGEDOWN:      inc(NewPos.y, VisibleFullLines);
   SB_PAGEUP:        dec(NewPos.y, VisibleFullLines);
   SB_TOP:           NewPos.y := 0;
   SB_THUMBPOSITION,
   SB_THUMBTRACK:    NewPos.y := Msg.Pos;
 end;
// if (Message.ScrollCode = SB_THUMBPOSITION) or
//    (Message.ScrollCode = SB_THUMBTRACK) then

// else
//  NewPos.y := Message.ScrollCode;
 if NewPos.y < 0 then                      //keep position valid
  NewPos.y := 0
 else
  if NewPos.y >= FLines.Count then
   NewPos.y := FLines.Count - 1;
 SetTopLeft(NewPos);                       //set the new position
end;



{Handles the request to cancel the current action (selecting).
~param Msg the message of the request }
procedure TSourceCodeMemo.WMCancelMode(var Msg: TWMCancelMode);
begin
 inherited;                    //cancel any other mode
 CancelMode;                   //cancel selecting
end;

{Handles the focusing of the component.
~param Msg the message of the notification that it has been focused }
procedure TSourceCodeMemo.WMSetFocus(var Msg: TWMSetFocus);
begin
 inherited;                                 //handle focusing
 CreateCaret(Handle, 0, 2, FCharExtent.cy); //create its caret
 ShowCaret(Handle);                         //and show it
 SetCaretPosition;                          //at the correct position
 //some text is selected and the selection had been hidden?
 if ((FCaretPos.x <> FSelStart.x) or (FCaretPos.y <> FSelStart.y)) and
    FHideSelection then
  Invalidate;                                 //let it be shown now
//  InvalidateRect(Selection);
end;

{Handles the unfocusing of the component.
~param Msg the message of the notification that it is no longer focused }
procedure TSourceCodeMemo.WMKillFocus(var Msg: TWMKillFocus);
begin
 inherited;                                 //handle the unfocusing
 HideCaret(Handle);                         //hide the caret
 DestroyCaret();                            //and destroy it
 //if some text is selected and the selection has to be hidden?
 if ((FCaretPos.x <> FSelStart.x) or (FCaretPos.y <> FSelStart.y)) and
    FHideSelection then
  Invalidate;                                 //hide the selection
//  InvalidateRect(Selection);
end;



{Returns the shape of the cursor (mouse pointer) at its current position.
~param Msg the message of the request }
procedure TSourceCodeMemo.WMSetCursor(var Msg: TWMSetCursor);
begin
 //inherited;
 if Msg.HitTest = HTCLIENT then            //inside the text?
  SetCursor(Screen.Cursors[crIBeam])         //use a text-cursor
 else
  SetCursor(Screen.Cursors[crDefault]);      //use the normal pointer
end;

{Handles the resizing of the component.
~param Msg the message of the notification }
procedure TSourceCodeMemo.WMSize(var Msg: TWMSize);
begin
 inherited;                         //handle the resize
 if UseRightToLeftAlignment then    //text is drawn from the right?
  Invalidate;                         //position changed, so redraw all text
end;