mwcustomedit.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 1,920 行 · 第 1/5 页

{+-----------------------------------------------------------------------------+
 | Class:       TmwCustomEdit
 | Created:     1998-11
 | Last change: 1999-11-18
 | Author:      Martin Waldenburg
 | Description: study on how to create a custom edit control without using
 |              a Windows edit control.
 | Version:     0.90 public beta (see VERSION.RTF for version history)
 | Copyright (c) 1998 Martin Waldenburg
 | All rights reserved.
 |
 | Thanks to : Woo Young Bum, Angus Johnson, Michael Trier, James Jacobson,
 |             Thomas Kurz, Primoz Gabrijelcic, Michael Beck, Andy Jeffries,
 |             Edward Kreis, Brad Stowers, Willo van der Merwe, Bernt Levinsson,
 |             Ted Berg, Michael Hieke, Dragan Grbic, Lucifer, Kees van Spelde,
 |             Hideo Koiso, Albert Research, Theodoros Bebekis, Heedong Lim,
 |             xyeyu, ArentJan Banck, Alexander Reiter, Tohru Hanai,
 |             Winfried Schoettler, Daniel Rodr韌uez Herrera, Hiep Ma,
 |             Nur Ismail, Milan Nikolic, Wynand Breytenbach
 |
 | LICENCE CONDITIONS
 |
 | USE OF THE ENCLOSED SOFTWARE
 | INDICATES YOUR ASSENT TO THE
 | FOLLOWING LICENCE CONDITIONS.
 |
 |
 |
 | These Licence Conditions are exlusively
 | governed by the Law and Rules of the
 | Federal Republic of Germany.
 |
 | Redistribution and use in source and binary form, with or without
 | modification, are permitted provided that the following conditions
 | are met:
 |
 | 1. Redistributions of source code must retain the above copyright
 |    notice, this list of conditions and the following disclaimer.
 |    If the source is modified, the complete original and unmodified
 |    source code has to distributed with the modified version.
 |
 | 2. Redistributions in binary form must reproduce the above
 |    copyright notice, these licence conditions and the disclaimer
 |    found at the end of this licence agreement in the documentation
 |    and/or other materials provided with the distribution.
 |
 | 3. Software using this code must contain a visible line of credit.
 |
 | 4. If my code is used in a "for profit" product, you have to donate
 |    to a registered charity in an amount that you feel is fair.
 |    You may use it in as many of your products as you like.
 |    Proof of this donation must be provided to the author of
 |    this software.
 |
 | 5. If you for some reasons don't want to give public credit to the
 |    author, you have to donate three times the price of your software
 |    product, or any other product including this component in any way,
 |    but no more than $500 US and not less than $200 US, or the
 |    equivalent thereof in other currency, to a registered charity.
 |    You have to do this for every of your products, which uses this
 |    code separately.
 |    Proof of this donations must be provided to the author of
 |    this software.
 |
 |
 | DISCLAIMER:
 |
 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS'.
 |
 | ALL EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
 | PARTICULAR PURPOSE ARE DISCLAIMED.
 |
 | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 |
 |  [e-mail]
 |
 | Known problems:
 |   - dragging cannot be canceled with the chord clicking - don't know how to
 |     fix!
 |
 +----------------------------------------------------------------------------+}

{$I MWEDIT.INC}

unit mwCustomEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics,
  mwKeyCmds,
  mwEditSearch,
  mwLocalStr, mwSupportProcs, mwSupportClasses,
  Printers,
  {$IFDEF MWE_MBCSSUPPORT}
  Imm,
  {$ENDIF}
  ExtCtrls, Forms, StdCtrls, Clipbrd, mwHighlighter,
  ShellAPI,
  uTextDrawer;

const
  DIGIT = ['0'..'9'];
// ALPHA            = ['A'..'Z', 'a'..'z'];
// break these up because we exceed the 4 byte limit when combined.
  ALPHA_UC = ['A'..'Z'];
  ALPHA_LC = ['a'..'z'];

   // not defined in all Delphi versions
  WM_MOUSEWHEEL = $020A;

   // maximum scroll range
  MAX_SCROLL = 32767;

// Max number of book/gutter marks returned from GetMarksForLine - that really
// should be enough.
  maxMarks = 16;

  MWEDIT_CLIPBOARD_FORMAT = 'mwEdit Control Block Type';

var
  mwEditClipboardFormat: UINT;

  {$IFDEF MWE_MBCSSUPPORT}
  {$IFNDEF MWE_COMPILER_4_UP}
{Windows.pas in D4}
const
  C3_NONSPACING = 1; { nonspacing character }
  C3_DIACRITIC = 2; { diacritic mark }
  C3_VOWELMARK = 4; { vowel mark }
  C3_SYMBOL = 8; { symbols }
  C3_KATAKANA = $0010; { katakana character }
  C3_HIRAGANA = $0020; { hiragana character }
  C3_HALFWIDTH = $0040; { half width character }
  C3_FULLWIDTH = $0080; { full width character }
  C3_IDEOGRAPH = $0100; { ideographic character }
  C3_KASHIDA = $0200; { Arabic kashida character }
  C3_LEXICAL = $0400; { lexical character }
  C3_ALPHA = $8000; { any linguistic char (C1_ALPHA) }
  C3_NOTAPPLICABLE = 0; { ctype 3 is not applicable }
  {$ENDIF}
  {$ENDIF}

type
  TmwEditExporter = (cfRTF, cfHTML);
  TmwEditExporters = set of TmwEditExporter;

  TmwSearchOption = (mwsoMatchCase, mwsoWholeWord, mwsoBackwards,
    mwsoEntireScope, mwsoSelectedOnly,
    mwsoReplace, mwsoReplaceAll, mwsoPrompt);
  TmwSearchOptions = set of TmwSearchOption;

  TmwReplaceAction = (mwraCancel, mwraSkip, mwraReplace, mwraReplaceAll);

  EmwEditError = class(Exception);

  PSelectionMode = ^TSelectionMode;
  TSelectionMode = (smNormal, smColumn, smLine);

  TIndexEvent = procedure(Index: Integer) of object;
  TPaintEvent = procedure(Sender: TObject; ACanvas: TCanvas) of object;
  TSpecialLineColorsEvent = procedure(Sender: TObject; Line: integer;
    var Special: boolean; var FG, BG: TColor) of object;
  TReplaceTextEvent = procedure(Sender: TObject; const ASearch, AReplace:
    string; Line, Column: integer; var Action: TmwReplaceAction) of object;

  TDropFilesEvent = procedure(Sender: TObject; X, Y: integer; Files: TStrings)
    of object;

  TProcessCommandEvent = procedure(Sender: TObject;
    var Command: TmwEditorCommand;
    var AChar: char; Data: pointer) of object;

  TCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock);

  // added mw as a prefix otherwise crNone conflicts with the
  // crNone cursor constant.
  TChangeReason = (mwcrInsert, mwcrPaste, mwcrDragDropInsert,
    mwcrDeleteAfterCursor, mwcrDelete, mwcrSelDelete,
    mwcrDragDropDelete, mwcrLineBreak, mwcrNone);

  TChangePtr = ^TChange;
  TChange = record
    ChangeStr: PChar;
    ChangeReason: TChangeReason;
    ChangeStartPos,
      ChangeEndPos: TPoint;
    ChangeSelMode: TSelectionMode;
  end;

  TmwPrintStatus = (psBegin, psNewPage, psEnd);
  TPrintStatusEvent = procedure(Sender: TObject; Status: TmwPrintStatus;
    PageNumber: integer; var Abort: boolean) of object;

  TmwMarginUnits = (muPixels, muThousandthsOfInches, muMillimeters);
  TmwPrintOptions = record
    SelectedOnly: boolean;
    Highlighted: boolean;
    WrapLongLines: boolean;
    IgnoreColors: boolean;
    Copies: integer;
    MarginUnits: TmwMarginUnits;
    Margins: TRect;
    PrintRange: TRect;
    Title: string;
    Header: TStringList;
    Footer: TStringList;
  end;

  TmwHeaderFooterAlign = (hfaLeft, hfaRight, hfaCenter);

  TmwStateFlag = (mwsfCaretChanged, mwsfScrollbarChanged,
    mwsfLinesChanging, mwsfInScrollLoop,
    mwsfCaretVisible, mwsfDblClicked, mwsfWaitForDragging);
  TmwStateFlags = set of TmwStateFlag;

  TmwEditorOption = (mweoAutoIndent, mweoDragDropEditing, mweoDropFiles,
    mweoHalfPageScroll, mweoScrollPastEol, mweoShowScrollHint,
    mweoTabsToSpaces, mweoSmartTabs);
  TmwEditorOptions = set of TmwEditorOption;

const
  MWEDIT_DEFAULT_OPTIONS = [mweoAutoIndent, mweoDragDropEditing,
    mweoScrollPastEol, mweoShowScrollHint,
    mweoSmartTabs, mweoTabsToSpaces];

type

  TmwStatusChange = (mwscCaretX, mwscCaretY, mwscLeftChar, mwscTopLine,
    mwscInsertMode);
  TmwStatusChanges = set of TmwStatusChange;

  TStatusChangeEvent = procedure(Sender: TObject; Changes: TmwStatusChanges)
    of object;

  TmwCustomEdit = class;

  TMark = class
  protected
    fLine, fColumn, fImage: Integer;
    fEdit: TmwCustomEdit;
    fVisible: boolean;
    fInternalImage: boolean;
    fBookmarkNum: integer;
    function GetEdit: TmwCustomEdit; virtual;
    procedure SetColumn(const Value: Integer); virtual;
    procedure SetImage(const Value: Integer); virtual;
    procedure SetLine(const Value: Integer); virtual;
    procedure SetVisible(const Value: boolean);
    procedure SetInternalImage(const Value: boolean);
    function GetIsBookmark: boolean;
    procedure SetIsBookmark(const Value: boolean);
  public
    constructor Create(owner: TmwCustomEdit);
    property Line: integer read fLine write SetLine;
    property Column: integer read fColumn write SetColumn;
    property ImageIndex: integer read fImage write SetImage;
    property BookmarkNumber: integer read fBookmarkNum write fBookmarkNum;
    property Visible: boolean read fVisible write SetVisible;
    property InternalImage: boolean read fInternalImage write SetInternalImage;
    property IsBookmark: boolean read GetIsBookmark write SetIsBookmark;
  end;

  TPlaceMarkEvent = procedure(Sender: TObject; var mark: TMark) of object;

  TMarks = array[1..maxMarks] of TMark;

  { A list of mark objects. Each object cause a litle picture to be drawn in the
    gutter. }
  TMarkList = class(TList)
  protected
    fEdit: TmwCustomEdit;
    fOnChange: TNotifyEvent;
    function Get(Index: Integer): TMark;
    procedure Put(Index: Integer; Item: TMark);
    procedure DoChange;
  public
    constructor Create(owner: TmwCustomEdit);
    function Add(Item: TMark): Integer;
    function First: TMark;
    function Last: TMark;
    procedure Insert(Index: Integer; Item: TMark);
    function Remove(Item: TMark): Integer;
    procedure Delete(Index: Integer);
    procedure ClearLine(line: integer);
    procedure Place(mark: TMark);
    procedure GetMarksForLine(line: integer; var marks: TMarks);
    property Items[Index: Integer]: TMark read Get write Put; default;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TUndoList = class
  private
    fList: TList;
    fCanUndo: Integer;
    fMaxUndo: Integer;
    fOwner: TmwCustomEdit;
    fUndoLocked: Boolean;
    function GetCanUndo: Integer;
    procedure SetMaxUndo(const Value: Integer);
  protected
    procedure RemoveChange(index: Integer);
  public
    constructor Create(AOwner: TmwCustomEdit);
    destructor Destroy; override;
    procedure AddChange(ChangeReason: TChangeReason; ChangeStartPos,
      ChangeEndPos: TPoint; ChangeStr: PChar; ChangeSelMode: TSelectionMode);
    function GetChange(var ChangeStartPos, ChangeEndPos: TPoint;
      var ChangeStr: PChar; var ChangeSelMode: TSelectionMode): TChangeReason;
    {$IFDEF UNDO_DEBUG}
    function GetChange2(var ChangeStartPos, ChangeEndPos: TPoint;
      var ChangeStr: PChar; var ChangeSelMode: TSelectionMode; i: Integer):
        TChangeReason;
    {$ENDIF}
    function GetChangeReason: TChangeReason;
    procedure ClearList;
    procedure LockUndo;
    procedure UnLockUndo;
    property CanUndo: Integer read GetCanUndo;
    property MaxUndo: Integer read FMaxUndo write SetMaxUndo;
  end;

  TmwEditList = class(TStringList)
  private
    FOnAdded: TNotifyEvent;
    fOnCleared: TNotifyEvent;
    FOnDeleted: TIndexEvent;
    FOnInserted: TIndexEvent;
    FOnLoaded: TNotifyEvent;
    fOnPutted: TIndexEvent;
    fOnScanRanges: TNotifyEvent;
    nLoading: integer;
  protected
    procedure BeginLoading;
    procedure EndLoading;
    procedure Put(Index: Integer; const S: string); override;
  public
    function Add(const S: string): Integer; override;

    procedure AddStrings(Strings: TStrings); override;
    procedure Assign(Source: TPersistent); override;

    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure SetTextStr(const Value: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    property OnAdded: TNotifyEvent read FOnAdded write FOnAdded;
    property OnCleared: TNotifyEvent read fOnCleared write fOnCleared;
    property OnDeleted: TIndexEvent read FOnDeleted write FOnDeleted;
    property OnInserted: TIndexEvent read FOnInserted write FOnInserted;
    property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
    property OnPutted: TIndexEvent read FOnPutted write FOnPutted;
    property OnScanRanges: TNotifyEvent read fOnScanRanges write fOnScanRanges;
  end;

  TmwCustomEdit = class(TCustomControl)
  private
    fBlockBegin: TPoint;
    fBlockEnd: TPoint;
    fCaretX: Integer;
    fCaretY: Integer;
    fCharsInWindow: Integer;
    fCharWidth: Integer;
    fFontDummy: TFont;
    fGutterWidth: Integer;
    {$IFDEF MWE_MBCSSUPPORT}
    fImeCount: Integer;
    fMBCSStepAside: Boolean;
    {$ENDIF}
    fInserting: Boolean;
    fLines: TStrings;
    fLinesInWindow: Integer;
    fLeftChar: Integer;
    fMaxLeftChar: Integer;
    fPaintLock: Integer;