skyedit.pas

SkyEdit是一个可用彩色语法来显示及编辑各种开发语言源代码的编辑器控件。

    FAlphabet:      TSkySymbols;    //组成单词的字母表（默认为ALPHA）

    FSelTimer:      TTimer;         //选择文本并滚动时用

    FParser:        TSkyParser;     //语法控件

    FUndoList:      TSkyUndoList;

    procedure AdjustCaretX(var CaretX: Integer; var ToLeft: Boolean);
    procedure AdjustCurColOfCursorUpDown;   //光标上下移动时调整其位置
    procedure AdjustLeftColByCurCol;        //水平滚动至可见
    function AdjustTopRowByCurRow: Boolean; //垂直滚动至可见
    function CalcColByXPix(iX: Integer): Integer;    //由X坐标计算所属列
    function CalcRowByYPix(iY: Integer): Integer;    //由Y坐标计算所属行
    function GetActualColByCaretX(iX, iRow: Integer; bCheck: Boolean): Integer;
    procedure CalcCaretXY(X, Y: Integer);
    function GetLeftSpaces(const CurLine: String): Integer; overload;
    function GetLeftSpaces(CurRow: Integer): Integer; overload;
    function GetLeftSpaces(CurRow, CurSpaces: Integer): Integer; overload;
    procedure UpdateCaret;
    function SearchAWord(var CX, CY: Integer; ToLeft: Boolean = False;
        bIgnorePunctuation: Boolean = True): Boolean;
    procedure ReCalcCharsLinesInWindow;     //重新计算窗口内的行列数
    procedure DragSelText(bCtrlInShift: Boolean);    //拖动选中文本
    function GetCharsShowLen(iBegin, iEnd, iRow: Integer): Integer;
    function NowNotAfterEscapeChars(iRow, iBegin, iEnd: Integer): Boolean;
    procedure PaintObjText(ACanvas: TCanvas; var iLeft, iTop: Integer;
        iRow, iColBegin, iColEnd: Integer);
    function SearchComments(var sSource: String; slComments: TStrings;
             var idx: Integer; var iComIdx: Integer): Boolean;
    function SearchCommentsAfterMacroSymbols(sSource: String;
             var idx: Integer): Boolean;
    procedure PretreatBeforeCurPos(var sstNowIs: TSkySyntaxType;
        var iOnsIdx: Integer; iFrom, iTo: Integer; bAll: Boolean = false);
    procedure ScanSyntaxType(idx: Integer; bAll: Boolean = false);
    function GetSyntaxType(idx: Integer; var iOnsIdx: Integer): TSkySyntaxType;
    function GetScrollPos(iBarFlag: Integer): Integer;
    function GetUndoBlankStr: String;
    function GetFindColBeginOfRow(iRow, iStartX, iStartY: Integer): Integer;
		function GetFindColEndOfRow(iRow, iEndX, iEndY: Integer): Integer;
    procedure SetBlockBeginEndOfSearch(ptBegin, ptEnd: TPoint;
        var ptFindPos: TPoint; bGo: Boolean);
		function FindOfForward(bMatchCase, bWholeWord: Boolean; cFirst: Char;
        const sFindStr: String; iFindLen: Integer;
        iStartX, iStartY, iEndX, iEndY: Integer; var ptFindPos: TPoint;
        bGo: Boolean; bFind: Boolean = True): Integer;
    function GetCursorWord: String; //取得当前光标处的词语（连续中文也认为是）
    function GetCursorXY: TPoint;       //取光标处屏幕相对坐标(相对于控件自身)
    function GetCursorXYOrigin: TPoint; //取光标处屏幕绝对坐标(相对于屏幕原点)

    procedure SetHideSelection(Value: Boolean);
    function GetModified: Boolean;
    procedure SetModified(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetLines(Value: TStrings);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetMaxLength(Value: Integer);
    function GetLeftCol: Integer;
    procedure SetLeftCol(Value: Integer);
    function GetTopRow: Integer;
    procedure SetTopRow(Value: Integer);

    function GetCurCol: Integer;
    procedure SetCurCol(Value: Integer);
    function GetCurRow: Integer;
    procedure SetCurRow(Value: Integer);
    function GetCaretPos: TPoint;
    procedure SetCaretPos(const Value: TPoint);  //本函数会将光标处滚动至可见!
    function GetLineText: String;
    procedure SetLineText(const Value: String);
    procedure SetTabSpaces(Value: Integer);
    procedure SetBindLine(Value: Integer);
    procedure SetGutterWidth(Value: Integer);
    procedure SetParser(Value: TSkyParser);
    procedure SetSelBkgColor(Value: TColor);
    procedure SetSelFrgColor(Value: TColor);
    function GetBlockBegin: TPoint;
    procedure SetBlockBegin(Value: TPoint);
    function GetBlockEnd: TPoint;
    procedure SetBlockEnd(Value: TPoint);
    procedure SetShowLineNum(Value: Boolean);
    procedure SetLineNumFont(Value: TFont);
    function GetHasSelect: Boolean;
    function GetCanUndo: Boolean;
    function GetCanRedo: Boolean;

    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMHScroll(var Message: TWMScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMScroll); message WM_VSCROLL;
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
    procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
    //procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    { Protected declarations }
    procedure FontChanged(Sender: TObject);
    procedure LinesChanged(Sender: TObject);
    procedure ListAdded(Sender: TObject);
    procedure ListDeleted(Index: Integer);
    procedure ListInserted(Index: Integer);
    procedure ListLoaded(Sender: TObject);
    procedure ListPutted(Index: Integer);

    procedure UpdateScrollBars;
    procedure DecPaintLock;
    procedure IncPaintLock;
    procedure DecCaretLock;
    procedure IncCaretLock;
    procedure HideCaret;           //隐藏光标,含光标是否显示的判断
    procedure ShowCaret;           //显示光标,含光标是否显示的判断
    procedure GotoOriginLeftTop;                 //跳至最左上处（原始位置）
    function CheckInEditRect(ptCur: TPoint): Boolean; //检测是否在编辑区内部?
    function CheckInSelArea(X, Y: Integer): Boolean;  //检测光标是否处于选择区?
    procedure MouseSelOnTimer(Sender: TObject);  //选中文本时用鼠标滚动时用
    procedure PaintBindLine(ACanvas: TCanvas);   //画右侧装订线
    procedure PaintGutter(ACanvas: TCanvas);     //画左侧装订区
    procedure PaintLineNumbers(ACanvas: TCanvas);//画行号
    procedure PaintText(ACanvas: TCanvas);       //画普通文本
    procedure PaintParserText(ACanvas: TCanvas); //画彩色语法文本
    procedure DoSetSelText(const Value: String); virtual; //不含Undo/Redo
    procedure DoSetText(const Value: String); virtual;    //不含Undo/Redo
    procedure GetSearchPos(Options: TSkySearchTypes;
        var iStartX, iStartY, iEndX, iEndY: Integer);

    procedure Paint; override;
    procedure Change; dynamic;
    procedure SelectionChanged; virtual;         //选中文本发生变化时执行
    procedure CreateParams(var Params: TCreateParams); override;
    function GetSelLength: Integer; virtual;
    procedure SetSelLength(Value: Integer); virtual;
    function GetSelStart: Integer; virtual;
    procedure SetSelStart(Value: Integer); virtual;
    function GetSelText: String; virtual;
    procedure SetSelText(const Value: String); virtual;  //含Undo/Redo
    function GetText: String; virtual;                   
    procedure SetText(const Value: String); virtual;     //含Undo/Redo

    procedure Loaded; override;    //此处用于初始化滚动条
    procedure ProcessVK_BACK(Shift: TShiftState); virtual;
    procedure ProcessVK_DELETE(Shift: TShiftState); virtual;
    procedure ProcessVK_DOWN(Shift: TShiftState); virtual;
    procedure ProcessVK_END(Shift: TShiftState); virtual;
    procedure ProcessVK_HOME(Shift: TShiftState); virtual;
    procedure ProcessVK_INSERT(Shift: TShiftState); virtual;
    procedure ProcessVK_LEFT(Shift: TShiftState); virtual;
    procedure ProcessVK_NEXT(Shift: TShiftState); virtual;
    procedure ProcessVK_PRIOR(Shift: TShiftState); virtual;
    procedure ProcessVK_RETURN(Shift: TShiftState); virtual;
    procedure ProcessVK_RIGHT(Shift: TShiftState); virtual;
    procedure ProcessVK_UP(Shift: TShiftState); virtual;
    procedure ProcessVK_TAB(Shift: TShiftState); virtual;
    procedure SetName(const Value: TComponentName); override;

    procedure SetWordBlock(Value: TPoint); virtual;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure DblClick; override;

    property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property WantReturns: Boolean read FWantReturns write FWantReturns default True;
    property WantTabs: Boolean read FWantTabs write FWantTabs default True;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Lines: TStrings read FLines write SetLines;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnSelectionChanged: TNotifyEvent read FOnSelChanged write FOnSelChanged;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
    property ParentColor default False;
    property LeftCol: Integer read GetLeftCol write SetLeftCol;
    property TopRow:  Integer read GetTopRow  write SetTopRow;
    property InsertMode: Boolean read FInsertMode write FInsertMode;
    property ProgramMode: Boolean read FProgramMode write FProgramMode;
    property Draging: Boolean read FDraging write FDraging;

    property MaxCharInLine: Integer read FMaxCharInLine write FMaxCharInLine default 1024;
    property LineText: String read GetLineText write SetLineText;
    property UseTabKey: Boolean read FUseTabKey write FUseTabKey default True;
    property TabSpaces: Integer read FTabSpaces write SetTabSpaces default 8;
    property PaintLock: Integer read FPaintLock;
    property CaretLock: Integer read FCaretLock;
    property BindLine:  Integer read FBindLine  write SetBindLine default 80;
    property SelBkgColor: TColor read FSelBkgColor write SetSelBkgColor default clHighlight;
    property SelFrgColor: TColor read FSelFrgColor write SetSelFrgColor default clHighlightText;
    property BlockBegin:  TPoint read GetBlockBegin write SetBlockBegin;
    property BlockEnd:    TPoint read GetBlockEnd write SetBlockEnd;
    property ShowLineNum: Boolean read FShowLineNum write SetShowLineNum default True;
    property LineNumFont: TFont read FLineNumFont write SetLineNumFont;
    property HasSelect: Boolean read GetHasSelect;
    property CanUndo: Boolean read GetCanUndo;
    property CanRedo: Boolean read GetCanRedo;

    property Alphabet: TSkySymbols read FAlphabet write FAlphabet;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetTextLen: Integer;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure BeginParser;
    procedure EndParser;
    procedure ScrollToCaretPos;    //滚动到光标处，即使光标处可见

    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure SelectAll;

    procedure Undo;
    procedure Redo;
    procedure ClearUndo;           //清空Undo栈（Redo栈当然也清空）

    function Find(const sFindStr: String; ptBegin, ptEnd: TPoint;
        Options: TSkySearchTypes; var ptFindPos: TPoint;
        bGo: Boolean=True):Boolean;
    function ReplaceAll(const sFindStr, sRepStr: String; ptBegin, ptEnd: TPoint;
        Options: TSkySearchTypes): Integer;
    function Count(const sFindStr: String; ptBegin, ptEnd: TPoint;
        Options: TSkySearchTypes): Integer;

    property CaretPos: TPoint read GetCaretPos write SetCaretPos;
    property CurCol: Integer read GetCurCol write SetCurCol;
    property CurRow: Integer read GetCurRow write SetCurRow;
    property CursorWord: String read GetCursorWord;
    property CursorXY: TPoint read GetCursorXY;
    property CursorXYOrigin: TPoint read GetCursorXYOrigin;
    property Modified: Boolean read GetModified write SetModified;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelText: String read GetSelText write SetSelText;
    property Text: String read GetText write SetText;
  published
    { Published declarations }
    property GutterColor: TColor read FGutterColor write FGutterColor;
    property GutterWidth: Integer read FGutterWidth write SetGutterWidth;
    property Parser:      TSkyParser read FParser write SetParser;
    property TabStop default True;
  end;

  TSkyEdit = class(TCustomSkyEdit)
  private
  protected
  public
    property BlockBegin;
    property BlockEnd;
    property Canvas;
    property LeftCol;
    property TopRow;
    property InsertMode;
    property UseTabKey;
    property TabSpaces;
    property CanUndo;
    property CanRedo;
  published
    property Action;
    property Align;
    property Alignment;
    property Anchors; 
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property Cursor default crDefault;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property LineNumFont;
    property Lines;
    property MaxLength;
    property ParentColor;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property SelBkgColor;
    property SelFrgColor;
    property ShowHint;
    property ShowLineNum;
    property Visible;
    property WantReturns;
    property WantTabs;
    //property WordWrap;

    property OnCanResize;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;