sourcecodememo.pas

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

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2003-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit SourceCodeMemo;

{Contains a simple component to show (and maybe in the future to edit) a text.
 It works only on Win32, but can (theoretically) be used with
 syntax-highlighting. Being used in a Pascal program, it was aimed at being a
 clone of the ~[code TEditControl] component used by Delphi's IDE. I never
 finished a program to edit code, where the syntax-highlighting was important,
 so it does not really support the editing. One of the parser-classes was
 thought to be the source of the text to be shown, but on the one hand
 on-the-fly parsing does not work well with Delphi-Pascal, on the other hand I
 never really came to need an editor. Showing the source code is enough
 (although even there the parsed information is not used for
 syntax-highlighting). }

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, Consts, SysUtils,
  StdCtrls;



      //the characters words consist of (used to go one word right or left)
const WordCharacters = ['0'..'9', 'A'..#255];


type

  //how the caret is visible
  TCaretVisible = (
                   cvNo,     //the caret is not visible
                   cvFull,   //the caret is fully visible
                   cvPart);  //only a part of the caret is visible



  {A simple component to show (and maybe in the future to edit) a text.
   It works only on Win32, but can support syntax-highlighting. Being used in a
   Pascal program, it was aimed at being a clone of the ~[code TEditControl]
   component used by Delphi's IDE. I never finished a program to edit code,
   where the syntax-highlighting was important, so it does not really support
   the editing. One of the parser-classes was thought to be the source of the
   text to be shown, but on the one hand on-the-fly parsing does not work well
   with Delphi-Pascal, on the other hand I never really came to need an editor.
   Showing the source code is enough (although even there the parsed
   information is not used for syntax-highlighting). }
  TSourceCodeMemo = class(TCustomControl)
  private
    //the text to be shown by the component
    FLines: TStrings;
    //offset of the first line and character in the line to show
    FTopLeft: TPoint;
    //current position of the caret (to insert text)
    FCaretPos: TPoint;
    //size of each character in the component
    FCharExtent: TSize;
    //position of the start of the selection
    FSelStart: TPoint;
    //if currently the user is changing the selection
    FSelecting: Boolean;
    //if the selection is in block-mode instead of line-by-line
    //~todo not implemented yet
    FBlockSelection: Boolean;

    //if the text can not be edited/changed in this component
    FReadOnly: Boolean;
    //if the selection should not be shown if the component is not selected
    FHideSelection: Boolean;
    //(maximum) length of all lines (only showing/scrolling?)
    FLineLength: Integer;
    //maximum width of the tabulator character (#9); by default it is filled by
    //up to seven spaces
    FTabWidth: Integer;



    //Returns the whole text inside the component.
    function GetText: String;

    //Sets the position of the caret (where text is inserted).
    procedure SetCaretPos(Value: TPoint);
    //Sets the starting point of the selection.
    procedure SetSelectionStart(Value: TPoint);
    //Sets the offset of the first shown line and character.
    procedure SetTopLeft(Value: TPoint);
    //Sets the (maximal shown) length of the lines.
    procedure SetLineLength(Value: Integer);
    //Sets the text to show.
    procedure SetLines(Value: TStrings);
    //Sets the text to show.
    procedure SetText(Value: String);



    //Handles the request to cancel the current action (selecting).
    procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
    //Handles the notification that the font has been changed.
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    //Handles the query if special keys are handles by the component.
//    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
//                                                   message CM_WANTSPECIALKEY;
    //Handles the notification that the component is (no longer) shown.
    procedure CMShowingChanged(var Msg: TMessage); message CM_SHOWINGCHANGED;


    //Handles the query what keys are supported by the component.
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;

    //Handles the vertical scrolling of the text.
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;

    //Handles the request to cancel the current action (selecting).
    procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE;
    //Handles the focusing of the component.
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    //Handles the unfocusing of the component.
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;

    //Returns the shape of the cursor (mouse pointer) at its current position.
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    //Handles the resizing of the component.
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;




  protected
    //Cancels any modes of the component (selecting).
    procedure CancelMode;
    //Calculates the size of each/all character(s).
    procedure CalcCharExtent;
    //Sets the visible caret to its position.
    procedure SetCaretPosition;
    //Returns the position of the character in pixels.
    function CharacterPositionToScreen(x, y: LongInt): TPoint;
    //Returns the position of the character at the specified coordinates.
    function ScreenToCharacterPosition(x, y: Integer): TPoint;
    //Marks the rectangle to be repainted.
    procedure InvalidateRect(Left, Top, Right, Bottom: LongInt);
    //Deletes the selected text and returns the extends of the changed region.
    function DeleteSelectionText: TRect;
    //Deletes the selected text and updates the shown text.
    procedure DeleteSelection;
    //Inserts a text at the current position.
    procedure InsertText(Text: String);
    //Returns the text of the range of lines.
    function GetLinesStr(FromIndex, ToIndex: Integer): String;

    //Updates the scroll bar.
    procedure UpdateScrollBar(PosOnly: Boolean);










    //Handles special keys to navigate through the text.
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    //Handles keys to insert text.
    procedure KeyPress(var Key: Char); override;
    //Handles clicking and selecting.
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    //Selects a range of text if the mouse button is pressed.
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    //Finishes the selecting.
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
                                                                      override;
    //Handles a double-click by selecting the next word on the current line.
    procedure DblClick; override;

    //Handles the scrolling with the mouse wheel.
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
                                                                      override;
    //Handles the scrolling with the mouse wheel.
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
                                                                      override;



    //Paints the component with its text.
    procedure Paint; override;




    //Sets properties of the component to be created.
    procedure CreateParams(var Params: TCreateParams); override;
    //Creates the visible window.
    procedure CreateWnd; override;

    //Creates the list to represent the content of the component.
    function CreateContentList: TStrings; virtual;




    property CharExtent: TSize read FCharExtent;
  public
    //Creates the component.
    constructor Create(AOwner: TComponent); override;
    //Destroys the component.
    destructor Destroy; override;





    //Returns the number of visible lines.
    function VisibleLines: Integer;
    //Returns the number of fully visible lines.
    function VisibleFullLines: Integer;
    //Returns the number of visible characters per line.
    function VisibleChars: Integer;
    //Returns the number of fully visible characters per line.
    function VisibleFullChars: Integer;

    //Returns how the caret is visible.
    function CaretVisible: TCaretVisible;
    //Scrolls the text so the position of the caret is visible.
    procedure ScrollToCaret;


    //Gets the text of the selection.
    function GetSelectionText: String;
    //Copies the selected text to the clipboard.
    procedure CopyToClipboard;
    //Pastes text from the clipboard.
    procedure PasteFromClipboard;
    //Cuts the selected text to the clipboard.
    procedure CutToClipboard;

    //Moves the caret one word left.
    procedure WordLeft; virtual;
    //Moves the caret one word right.
    procedure WordRight; virtual;




    property CaretPos: TPoint read FCaretPos write SetCaretPos;
    property SelectionStart: TPoint read FSelStart write SetSelectionStart;
    property TopLeft: TPoint read FTopLeft write SetTopLeft;

  published
    property LineLength: Integer read FLineLength
                                 write SetLineLength default 1024;
    property TabWidth: Integer read FTabWidth write FTabWidth default 8;
    property Lines: TStrings read FLines write SetLines;
    property ReadOnly: Boolean read FReadOnly write FReadOnly;


    property Text: String read GetText write SetText stored False;

    property HideSelection: Boolean read FHideSelection
                                    write FHideSelection default True;

    property Color default clWindow;
    property ParentColor;
  end;


implementation

uses Clipbrd;




{ **************************************************************************
                              TSourceCodeMemo
  ************************************************************************** }


{Creates the component.
~param AOwner the component owning this one }
constructor TSourceCodeMemo.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);         //create the component

 DoubleBuffered := False;          //in Delphi 4 enabled by default
 //fills the whole canvas (i.e. no default drawing to fill the background
 ControlStyle := ControlStyle + [csOpaque];                           //needed)

 FLineLength := 1024;              //maximal (scrollable) width of lines
 FTabWidth := 8;                   //size/alignment of tabulators in characters
 FHideSelection := True;           //hide selection when not focused
 FCaretPos := Point(0, 0);         //caret at top-left
 FSelStart := FCaretPos;           //nothing selected
 FBlockSelection := False;         //selecting not in block-mode

 Color := clWindow;                //use "white" as backgound color
 ParentColor := False;             //meaning not the parent color
 Canvas.Font.Name := 'Courier New'; //use the same font as Delphi's editor
 Canvas.Font.Size := 10;
 Canvas.Brush.Color := Color;

 TabStop := True;                  //component can be focussed

 FLines := CreateContentList;      //create list for the content/text
end;

{Destroys the component. }
destructor TSourceCodeMemo.Destroy;
begin
 FLines.Free;                //free the content

 inherited Destroy;          //free the component
end;



{Sets properties of the component to be created.
~param Params the parameters/options to use to create the component }
procedure TSourceCodeMemo.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);       //initialize parameters
 with Params do
  begin
   Style := Style or WS_TABSTOP or       //can be focused by pressing tabulator
                     WS_VSCROLL{ or      //wants to have a vertical scroll bar
                     WS_HSCROLL};

   WindowClass.style := CS_DBLCLKS;      //wants double clicks
  end;
end;