jveditor.pas

数据表对拷程序。 做这个程序的本意是

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvEditor.PAS, released on 2002-07-04.
The Initial Developers of the Original Code are: Andrei Prygounkov <[e-mail]>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.
Contributor(s):
Last Modified: 2002-07-04
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
component   : TJvEditor
description : 'Delphi IDE'-like Editor
Known Issues:
  Some russian comments were translated to english; these comments are marked
  with [translated]
-----------------------------------------------------------------------------}
{$I JVCL.INC}
{ history
 (JVCL Library versions) :
  1.00:
    - first release;
  1.01:
    - reduce caret blinking - method KeyUp;
    - fix bug with setting SelLength to 0;
    - changing SelStart now reset SelLength to 0;
    - very simple tab - two blanks;
  1.02:
    - SmartTab;
    - KeepTrailingBlanks;
    - CursorBeyondEOF;
    - AutoIndent;
    - BackSpaceUnindents;
    - two-key commands;
    - automatically expands tabs when setting Lines property;
  1.04:
    - some bugs fixed in Completion;
    - fix bug with reading SelLength property;
    - new method TJvEditorStrings .SetLockText;
    - new dynamic method TextAllChanged;
  1.11:
    - method StatusChanged;
    - fixed bug with setting Lines.Text property;
    - new method GetText with TIEditReader syntax;
  1.14:
    - selected color intialized with system colors;
  1.17:
    some improvements and bug fixes by Rafal Smotrzyk - [e-mail] :
    - AutoIndent now worked when SmartTab Off;
    - method GetTextLen for TMemo compatibility;
    - Indent, Unindent commands;
    - WM_COPY, WM_CUT, WM_PASTE message handling;
  1.17.1:
    - painting and scrolling changed:
      bug with scrolling JvEditor if other StayOnTop
      window overlapes JvEditor window  FIXED;
    - right click now not unselect text;
    - changing RightMargin, RightMarginVisible and RightMarginColor
      Invalidates window;
  1.17.2:
   another good stuf by Rafal Smotrzyk - [e-mail] :
    - fixed bug with backspace pressed when text selected;
    - fixed bug with disabling Backspace Unindents when SmartTab off;
    - fixed bug in GetTabStop method when SmartTab off;
    - new commands: DeleteWord, DeleteLine, ToUpperCase, ToLowerCase;
  1.17.3:
    - TabStops;
  1.17.4:
    - undo for selection modifiers;
    - UndoBuffer.BeginCompound, UndoBuffer.EndCompound for
      compound commands, that must interpreted by UndoBuffer as one operation;
      now not implemented, but must be used for feature compatibility;
    - fixed bug with undoable Delete on end of line;
    - new command ChangeCase;
  1.17.5:
    - UndoBuffer.BeginCompound, UndoBuffer.EndCompound fully implemented;
    - UndoBuffer property in TJvCustomEditor;
  1.17.6:
    - fixed bug with compound undo;
    - fixed bug with scrolling (from v 1.171);
  1.17.7:
    - UndoBuffer.BeginCompound and UndoBuffer.EndCompound moved to TJvCustomEditor;
    - Macro support: BeginRecord, EndRecord, PlayMacro; not complete;
    - additional support for compound operations: prevent updating and other;
  1.17.8:
    - bug fixed with compound commands in macro;
  1.21.2:
    - fixed bug with pressing End-key if CursorBeoyondEOF enabled
      (greetings to Martijn Laan)
  1.21.4:
    - fixed bug in commands ecNextWord and ecPrevWord
      (greetings to Ildar Noureeslamov)
  1.21.6:
    - in OnGetLineAttr now it is possible to change attributes of right
    trailing blanks.
  1.23:
    - fixed bug in completion (range check error)
    (greetings to Willo vd Merwe)
  1.51.1 (JVCL Library 1.51 with Update 1):
    - methods Lines.Add and Lines.Insert now properly updates editor window.
  1.51.2 (JVCL Library 1.51 with Update 2):
    - "Courier New" is default font now.
  1.51.3 (JVCL Library 1.51 with Update 2)::
    - fixed bug: double click on empty editor raise exception;
    - fixed bug: backspace at EOF raise exception;
    - fixed bug: gutter not repainted on vertical scrolling;
  1.53:
    - fixed bug: GetWordOnCaret returns invalid Word if caret stays on start of Word;
  1.54.1:
    - new: undo now works in overwrite mode;
  1.54.2:
    - fixed bug: double click not selects Word on first line;
    - selection work better after consecutive moving to begin_of_line and
      end_of_line, and in other cases;
    - 4 block format supported now: NonInclusive (default), Inclusive,
      Line (initial support), Column;
    - painting was improved;
  1.60:
    - DblClick work better (thanks to Constantin M. Lushnikov);
    - fixed bug: caret moved when mouse moves over JvEditor after
      click on any other windows placed over JvEditor, which loses focus
      after this click; (anyone understand me ? :)
    - bug fixed: accelerator key do not work on window,
      where JvEditor is placed (thanks to Luis David Cardenas Bucio);
  1.61:
    - support for mouse with wheel (thanks to Michael Serpik);
    - ANY font can be used (thanks to Rients Politiek);
    - bug fixed: completion ranges error on first line
      (thanks to Walter Campelo);
    - new functions: CanCopy, CanPaste, CanCut in TJvCustomEditor
      and function CanUndo in TUndoBuffer (TJvCustomEditor.UndoBuffer);
  2.00:
    - removed dependencies from JvUtils.pas unit;
    - bugfixed: TJvDeleteUndo  and TJvBackspaceUndo  do not work always properly
      (thanks to Pavel Chromy);
    - bugfixed: workaround bug with some fonts in Win9x
      (thanks to Dmitry Rubinstain);
  2.10.2: (changes by Andreas Hausladen)
    - speed optimation (font cache, many Lines.Text references were removed)
    - fixed bug: TJvBackspaceUndo, TJvInsertUndo, TJvDeleteUndo still do not work
      always properly
    - fixed bug: caret movement and selections set Modified to TRUE
    - Undo restores Modified-field
    - added [Ctrl][Backspace] (ecBackspaceWord) and [Shift][Backspace] command
    - added [Shift]+MouseDown selections
    - added [Alt]+MouseDown selections (column)
    - new event TKeyboard.OnCommand2
    - fixed bug: CodeCompletition catches VK_HOME, VK_END
    - fixed bug: on empty editor pressing [Ctrl][End] raises "Index out of
      bounds (-1)"
    - fixed bug: caret moves into gutter on horz. scrolling
    - added OnGutterClick and OnGutterDblClick events
    - renamed all "Identifer" to "Identifier"
  2.10.3 (changes by Andreas Hausladen)
    - added new mouse wheel functionality: [Ctrl]+Wheel and [Shift]+Wheel
    - faster TJvReplaceUndo and ReplaceWord/ReplaceWord2
    - bug fixed: first complete selected line stops drawing selection on cell 80
    - added SelectAll, ClearSelection
    - full support for SelBlockFormat = bfColumn and bfLine
    - improved TJvCompletion.ReplaceWord
    - undo system overworked
    - fixed bug: [Shift][Tab] is the same as [Tab]
    - reduced TextAllChanged() calls
    - added: Un-/IndentColumns, Un-/IndentLines, Un-/IndentSelLines
    - new Undo: TJvUnindentColumnUndo, TJvIndentColumnUndo
    - moved: FSelBegX, FSelBegY, ... FSelected into TJvSelectionRec
    - added GetAutoIndentStop and removed AutoIndent code from GetTabStop
    - fixed bug: CanPaste raises Exception SCannotOpenClipboard (new: catches exception)
    - fixed bug: in readonly mode [Return] does nothing
    - added BlockOverwrite property
    - added PeristentBlocks
}
{$IFDEF COMPLIB_VCL}
{$DEFINE VCL}
{$ENDIF}
{$IFDEF LINUX}
{$UNDEF VCL}
{$DEFINE VisualCLX}
{$ENDIF}
{$IFDEF VisualCLX}
VisualCLX is not implemented yet.
{$ENDIF}
unit JvEditor;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls, Clipbrd, JvStrUtils;
const
  Max_X = 1024; {max symbols per row}
  Max_X_Scroll = Max_X;
  {max symbols per row for scrollbar}
  GutterRightMargin = 2;
{$IFDEF VCL}
  WM_EDITCOMMAND = WM_USER + $101;
{$IFNDEF COMPILER3_UP}
  WM_MOUSEWHEEL = $020A;
{$ENDIF COMPILER3_UP}
{$ELSE}
  WM_EDITCOMMAND = CM_BASE + $101;
{$ENDIF}
const
{$IFNDEF DELPHI6_UP}
  sLineBreak = #13#10;
{$ENDIF DELPHI6_UP}
  sLineBreakLen = Length(sLineBreak);
type
{$IFNDEF COMPILER4_UP}
  TWMMouseWheel = packed record
    Msg: Cardinal;
    Keys: Smallint;
    WheelDelta: Smallint;
    case Integer of
      0:
      (XPos: Smallint;
        YPos: Smallint);
      1:
      (Pos: TSmallPoint;
        Result: Longint);
  end;
{$ENDIF COMPILER4_UP}
  TCellRect = record
    Width: Integer;
    Height: Integer;
  end;
  TLineAttr = record
    FC: TColor;
    BC: TColor;
    Style: TFontStyles;
  end;
  TJvCustomEditor = class;
  TLineAttrs = array[0..Max_X] of TLineAttr;
  TOnGetLineAttr = procedure(Sender: TObject; var Line: string; Index: Integer;
    var Attrs: TLineAttrs) of object;
  TOnChangeStatus = TNotifyEvent;
  TJvEditorStrings = class(TStringList)
  private
    FJvEditor: TJvCustomEditor;
    procedure StringsChanged(Sender: TObject);
    procedure SetInternal(Index: Integer; Value: string);
    procedure ReLine;
    procedure SetLockText(const Text: string);
  protected
    procedure SetTextStr(const Value: string); override;
    procedure Put(Index: Integer; const S: string); override;
    procedure InternalPut(Index: Integer; const Value: string);
  public
    constructor Create;
    function Add(const S: string): Integer; override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure DeleteText(BegX, BegY, EndX, EndY: Integer);
    procedure InsertText(X, Y: Integer; const Text: string);
    procedure DeleteColumnText(BegX, BegY, EndX, EndY: Integer);
    procedure InsertColumnText(X, Y: Integer; const Text: string);
    property Internal[Index: Integer]: string write SetInternal;
  end;
  TModifiedAction = (maAll, maInsert, maDelete, maInsertColumn, maDeleteColumn,
    maReplace);
  TBookMark = record
    X: Integer;
    Y: Integer;
    Valid: Boolean;
  end;
  TBookMarkNum = 0..9;
  TBookMarks = array[TBookMarkNum] of TBookMark;
  TJvCompletion = class;
  TOnCompletion = procedure(Sender: TObject; var Cancel: Boolean) of object;
  TOnCompletionApply = procedure(Sender: TObject; const OldString: string; var NewString: string) of object;
  { Borland Block Type:
    00 - inclusive;
    01 - line;
    02 - column;
    03 - noninclusive; }
  TSelBlockFormat = (bfInclusive, bfLine, bfColumn, bfNonInclusive);

  TJvEditorClient = class(TObject)
  private
    FJvEditor: TJvCustomEditor;
    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: TCanvas;
    property Canvas: TCanvas read GetCanvas;
  end;
  TJvGutter = class(TObject)
  private
    FJvEditor: TJvCustomEditor;
  public
    procedure Paint;
    procedure Invalidate;
  end;
  TOnPaintGutter = procedure(Sender: TObject; Canvas: TCanvas) of object;
  TOnGutterClick = procedure(Sender: TObject; Line: Integer) of object;
  TEditCommand = Word;
  TMacro = string; { used as buffer }
  TJvEditKey = class(TObject)
  public
    Key1: Word;
    Key2: Word;
    Shift1: TShiftState;
    Shift2: TShiftState;
    Command: TEditCommand;
    constructor Create(const ACommand: TEditCommand; const AKey1: Word;
      const AShift1: TShiftState);
    constructor Create2(const ACommand: TEditCommand; const AKey1: Word;
      const AShift1: TShiftState; const AKey2: Word;
      const AShift2: TShiftState);
  end;
  TCommand2Event = procedure(Sender: TObject; const Key1: Word; const Shift1: TShiftState;
    const Key2: Word; const Shift2: TShiftState; var Command: TEditCommand) of object;
  TJvKeyboard = class(TObject)
  private
    List: TList;
    FOnCommand2: TCommand2Event;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(const ACommand: TEditCommand; const AKey1: Word;
      const AShift1: TShiftState);
    procedure Add2(const ACommand: TEditCommand; const AKey1: Word;
      const AShift1: TShiftState; const AKey2: Word;
      const AShift2: TShiftState);
    procedure Add2Ctrl(const ACommand: TEditCommand; const AKey1: Word;
      const AShift1: TShiftState; const AKey2: Word);
    procedure Clear;
    function Command(const AKey: Word; const AShift: TShiftState): TEditCommand;
    function Command2(const AKey1: Word; const AShift1: TShiftState;
      const AKey2: Word; const AShift2: TShiftState): TEditCommand;
    procedure SetDefLayout;
    property OnCommand2: TCommand2Event read FOnCommand2 write FOnCommand2;
  end;
  EJvEditorError = class(Exception);
  TUndoBuffer = class;
  PJvSelectionRec = ^TJvSelectionRec;
  TJvSelectionRec = record
    Selected: Boolean;
    SelBlockFormat: TSelBlockFormat;
    SelBegX: Integer;
    SelBegY: Integer;
    SelEndX: Integer;
    SelEndY: Integer;
    SelStartX: Integer;
    SelStartY: Integer;
    SelLineOrgBegX, SelLineOrgEndX: Integer;
  end;
  TUndo = class(TObject)
  private
    FJvEditor: TJvCustomEditor;
    FModified: Boolean; // Editor.FModified
    FSelection: PJvSelectionRec;
    function UndoBuffer: TUndoBuffer;
  protected
    property JvEditor: TJvCustomEditor read FJvEditor;
  public
    constructor Create(AJvEditor: TJvCustomEditor);
    destructor Destroy; override;
    procedure Undo; dynamic; abstract;
    procedure Redo; dynamic; {abstract;}
    procedure SaveSelection;
    procedure RestoreSelection;
  end;
  TUndoBuffer = class(TList)
  private
    FJvEditor: TJvCustomEditor;
    FPtr: Integer;
    InUndo: Boolean;
    function LastUndo: TUndo;
    function IsNewGroup(AUndo: TUndo): Boolean;
    function CanRedo: Boolean;
    procedure ClearRedo;
    function IsCaretGroup: Boolean;
  public
    procedure Add(AUndo: TUndo);
    procedure Undo;
    procedure Redo;
    procedure Clear; {$IFDEF COMPILER35_Up} override; {$ENDIF}
    procedure Delete;
    function CanUndo: Boolean;
  end;
  TJvControlScrollBar95 = class(TObject)
  private
    FKind: TScrollBarKind;
    FPosition: Integer;
    FMin: Integer;