rm_jveditorcommon.pas

这是一个功能强大

  TJvUndoBuffer = class(TList)
  protected
    FJvEditor: TJvCustomEditorBase;
    FPtr: Integer;
    InUndo: Boolean;
    function LastUndo: TJvUndo;
    function IsNewGroup(AUndo: TJvUndo): Boolean;
    function CanRedo: Boolean;
    procedure ClearRedo;
    function IsCaretGroup: Boolean;
  public
    procedure Add(AUndo: TJvUndo);
    procedure Undo;
    procedure Redo;
    procedure Clear; override;
    procedure Delete;
    function CanUndo: Boolean;
  end;

  TJvUndo = class(TInterfacedObject)
  protected
    FJvEditor: TJvCustomEditorBase;
    FModified: Boolean; // Editor.FModified
    FSelection: PJvSelectionRec;
    function UndoBuffer: TJvUndoBuffer;
  protected
    property JvEditor: TJvCustomEditorBase read FJvEditor;
  public
    constructor Create(AJvEditor: TJvCustomEditorBase);
    destructor Destroy; override;
    procedure Undo; dynamic; abstract;
    procedure Redo; dynamic; {abstract;}
    procedure SaveSelection;
    procedure RestoreSelection;
  end;

  TJvCaretUndo = class(TJvUndo)
  protected
    FCaretX: Integer;
    FCaretY: Integer;
    property CaretX: Integer read FCaretX write FCaretX;
    property CaretY: Integer read FCaretY write FCaretY;
  public
    constructor Create(AJvEditor: TJvCustomEditorBase; ACaretX, ACaretY: Integer);
    procedure Undo; override;
  end;

  TJvSelectUndo = class(TJvCaretUndo)
  public
    constructor Create(AJvEditor: TJvCustomEditorBase; ACaretX, ACaretY: Integer);
    procedure Undo; override;
  end;

  TJvUnselectUndo = class(TJvSelectUndo);

  TJvBeginCompoundUndo = class(TJvUndo)
  public
    procedure Undo; override;
  end;

  TJvEndCompoundUndo = class(TJvBeginCompoundUndo);

  TJvControlScrollBar95 = class(TObject)
  private
    FKind: TScrollBarKind;
    FPosition: Integer;
    FMin: Integer;
    FMax: Integer;
    FSmallChange: TScrollBarInc;
    FLargeChange: TScrollBarInc;
    FPage: Integer;
    FHandle: THandle;
    FOnScroll: TScrollEvent;
    procedure SetParam(Index, Value: Integer);
  protected
    procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
  public
    constructor Create;
    procedure SetParams(AMin, AMax, APosition, APage: Integer);
    procedure DoScroll(var Msg: TWMScroll);
    property Kind: TScrollBarKind read FKind write FKind default sbHorizontal;
    property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
    property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
    property Min: Integer index 0 read FMin write SetParam default 0;
    property Max: Integer index 1 read FMax write SetParam default 100;
    property Position: Integer index 2 read FPosition write SetParam default 0;
    property Page: Integer index 3 read FPage write SetParam;
    property Handle: THandle read FHandle write FHandle;
    property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
  end;

  TJvEditorClient = class(TObject)
  public
    FJvEditor: TJvCustomEditorBase;
    Top: Integer;
    function Left: Integer;
    function Height: Integer;
    function Width: Integer;
    function ClientWidth: Integer;
    function ClientHeight: Integer;
    function ClientRect: TRect;
    function BoundsRect: TRect;
    function GetCanvas: TJvUnicodeCanvas;
    property Canvas: TJvUnicodeCanvas read GetCanvas;
  end;

  TJvGutter = class(TObject)
  private
    FJvEditor: TJvCustomEditorBase;
  public
    procedure Paint;
    procedure Invalidate;
  end;

  TJvLineInformation = class(TObject)
  private
    FLine: Integer;
    FSelectStyle: TJvLineSelectStyle;
    FData: Pointer;
    FEditor: TJvCustomEditorBase;
    procedure SetLine(Value: Integer);
    procedure SetSelectStyle(const Value: TJvLineSelectStyle);
  protected
    procedure RepaintLine(LineNum: Integer); virtual;
    procedure CheckEmpty; virtual; // releases the object if Data=nil and SelectStyle=lssUnselected
  public
    constructor Create(AEditor: TJvCustomEditorBase; ALine: Integer);
    destructor Destroy; override;

    property Line: Integer read FLine write SetLine;
    property SelectStyle: TJvLineSelectStyle read FSelectStyle write SetSelectStyle;
    property Data: Pointer read FData write FData;
    property Editor: TJvCustomEditorBase read FEditor;
  end;

  TJvLineInformationList = class(TObject)
  private
    FEditor: TJvCustomEditorBase;
    FList: TObjectList;
    FDebugColor: TColor;
    FDebugTextColor: TColor;
    FBreakpointColor: TColor;
    FBreakpointTextColor: TColor;
    FErrorPointTextColor: TColor;
    FErrorPointColor: TColor;
    function GetCount: Integer;
    function GetData(Index: Integer): Pointer;
    function GetItems(Index: Integer): TJvLineInformation;
    function GetLineCount: Integer;
    function GetLines(Index: Integer): TJvLineInformation;
    function GetSelectStyle(Index: Integer): TJvLineSelectStyle;
    procedure SetData(Index: Integer; Value: Pointer);
    procedure SetSelectStyle(Index: Integer; const Value: TJvLineSelectStyle);
    procedure SetBreakpointColor(const Value: TColor);
    procedure SetBreakpointTextColor(const Value: TColor);
    procedure SetDebugColor(const Value: TColor);
    procedure SetDebugTextColor(const Value: TColor);
    procedure SetErrorPointColor(const Value: TColor);
    procedure SetErrorPointTextColor(const Value: TColor);
  protected
    function CreateLineInfo(Index: Integer): TJvLineInformation;
      // Returns the line information assoziated with the line or creates a new.
      // If Index not in [0..Count-1] the function raises EListError
  public
    constructor Create(AEditor: TJvCustomEditorBase);
    destructor Destroy; override;

    procedure Clear;
      // Clear() removes all extra line information objects
    procedure DeleteLine(Line: Integer);
      // DeleteLine() deletes all information for "Line" and updates all
      // following lines by decrementing their line number
    procedure InsertLine(Line: Integer);
      // InsertLine() updates all line information line number which are below
      // "Line"

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TJvLineInformation read GetItems;

    property LineCount: Integer read GetLineCount;
      // LineCount returns Editor.Lines.Count
    property Lines[Index: Integer]: TJvLineInformation read GetLines; default;
      // Lines[] returns nil if the line has no extra information
    property SelectStyle[Index: Integer]: TJvLineSelectStyle read GetSelectStyle write SetSelectStyle;
      // SelectStyle[] returns/sets the select style for the line
    property Data[Index: Integer]: Pointer read GetData write SetData;
      // Data[] returns/sets the user defined data for the line

    property DebugPointColor: TColor read FDebugColor write SetDebugColor;
    property DebugPointTextColor: TColor read FDebugTextColor write SetDebugTextColor;
    property BreakpointColor: TColor read FBreakpointColor write SetBreakpointColor;
    property BreakpointTextColor: TColor read FBreakpointTextColor write SetBreakpointTextColor;
    property ErrorPointColor: TColor read FErrorPointColor write SetErrorPointColor;
    property ErrorPointTextColor: TColor read FErrorPointTextColor write SetErrorPointTextColor;

    property Editor: TJvCustomEditorBase read FEditor;
  end;

  TJvBracketHighlighting = class(TPersistent)
  private
    FStart: TRect;
    FStop: TRect;

    FActive: Boolean;
    FFontColor: TColor;
    FBorderColor: TColor;
    FColor: TColor;
    FWordPairs: TStrings;
    FCaseSensitiveWordPairs: Boolean;
    FStringChar: string;
    FCommentPairs: TStrings;
    FStringChars: string;
    FStringEscape: string;
    FShowBetweenHighlighting: Boolean;
    procedure SetWordPairs(Value: TStrings);
    procedure SetCommentPairs(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    function CreateStringMap(const Text: string): TDynBoolArray;
  published
    property Active: Boolean read FActive write FActive default False;
    property BorderColor: TColor read FBorderColor write FBorderColor default clSilver;
    property Color: TColor read FColor write FColor default clNone;
    property FontColor: TColor read FFontColor write FFontColor default clNone;
    property ShowBetweenHighlighting: Boolean read FShowBetweenHighlighting write FShowBetweenHighlighting default False;

    property CaseSensitiveWordPairs: Boolean read FCaseSensitiveWordPairs write FCaseSensitiveWordPairs default True;
    property WordPairs: TStrings read FWordPairs write SetWordPairs;
      { example: "begin=end", "repeat=until", "for=do", "asm=end" }
    property StringChars: string read FStringChars write FStringChars;
      { example: '"''' }
    property StringEscape: string read FStringEscape write FStringEscape;
      { example: '\"' }
    property CommentPairs: TStrings read FCommentPairs write SetCommentPairs; // not implemented yet
      { example: "/*=*/", "(*=*)" }
  end;

  TJvErrorHighlighting = class;

  TJvErrorHighlightingItem = class(TObject)
  private
    FCol: Integer;
    FLine: Integer;
    FLen: Integer;
    FErrorText: string;
    FData: TObject;
    FTag: Integer;
    FOwner: TJvErrorHighlighting;
    procedure SetCol(const Value: Integer);
    procedure SetLine(const Value: Integer);
  public
    constructor Create(AOwner: TJvErrorHighlighting;
       ACol, ALine, ALen: Integer; const AErrorText: string);
    destructor Destroy; override;

    property Col: Integer read FCol write SetCol;
    property Line: Integer read FLine write SetLine;
    property Len: Integer read FLen;
    property ErrorText: string read FErrorText;
    property Data: TObject read FData write FData;
    property Tag: Integer read FTag write FTag;
  end;

  TJvErrorHighlighting = class(TObject)
  private
    FItems: TObjectList;
    FEditor: TJvCustomEditorBase;
    FNeedsRepaint: Boolean;
    FPaintLock: Integer;
    function GetCount: Integer;
    function GetItem(Index: Integer): TJvErrorHighlightingItem;
  protected
    procedure RepaintLine(Line: Integer);
  public
    constructor Create(AEditor: TJvCustomEditorBase);
    destructor Destroy; override;

    function Add(ACol, ALine, ALen: Integer; const AErrorText: string): Integer;
    procedure Remove(Item: TJvErrorHighlightingItem);
    procedure Delete(Index: Integer);
    procedure Clear;
    procedure BeginUpdate;
    procedure EndUpdate;

    procedure DeleteLine(Line: Integer);
      // DeleteLine() deletes all error information for "Line" and updates all
      // following lines by decrementing their line number
    procedure InsertLine(Line: Integer);
      // InsertLine() updates all error information line number which are below
      // "Line"

    function GetLineErrorMap(Y: Integer): TDynBoolArray;
    function ErrorAt(X, Y: Integer): TJvErrorHighlightingItem;
    procedure PaintError(Canvas: TCanvas; Col, Line: Integer; const R: TRect;
      Len: Integer; const MyDi: TDynIntArray);

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TJvErrorHighlightingItem read GetItem; default;

    property Editor: TJvCustomEditorBase read FEditor;
  end;

  TJvCustomEditorBase = class(TJvExCustomControl, IFixedPopupIntf)
  private
    { internal objects }
    FScrollBarHorz: TJvControlScrollBar95;
    FScrollBarVert: TJvControlScrollBar95;
    FEditorClient: TJvEditorClient;
    FCompletion: TJvCompletionBase; // must be initialized by a decendent

    FGutter: TJvGutter;
    FKeyboard: TJvKeyboard;
    FUpdateLock: Integer;
    FUndoBuffer: TJvUndoBuffer;
    FGroupUndo: Boolean;
    FUndoAfterSave: Boolean;
    FBracketHighlighting: TJvBracketHighlighting;
    FErrorHighlighting: TJvErrorHighlighting;
    FCurrentLineHighlight: TColor;

    { internal - Columns and rows attributes }
    FCols: Integer;
    FRows: Integer;
    FLeftCol: Integer;
    FTopRow: Integer;
    // FLeftColMax, FTopRowMax : Integer;
    FLastVisibleCol: Integer;
    FLastVisibleRow: Integer;
    FVisibleColCount: Integer;
    FVisibleRowCount: Integer;

    { internal - other flags and attributes }
    FFontCache: TList;  // collects all used fonts for faster font creation
    FAllRepaint: Boolean;
    FCellRect: TCellRect;
    IgnoreKeyPress: Boolean;
    WaitSecondKey: Boolean;
    Key1: Word;
    Shift1: TShiftState;

    { internal - selection attributes }
    FUpdateSelBegY: Integer;
    FUpdateSelEndY: Integer;
    FPersistentBlocksCaretChanged: Boolean;
    FSelBackColor: TColor;
    FSelForeColor: TColor;
    FLineInformations: TJvLineInformationList;

    { mouse support }
    TimerScroll: TTimer;
    MouseMoveY: Integer;
    MouseMoveXX: Integer;
    MouseMoveYY: Integer;