Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
7371 lines (6841 sloc) 213 KB
/// Synopse extended TMemo visual component
// - licensed under a MPL/GPL/LGPL tri-license; version 2.26
unit SynMemoEx;
{
This file is part of Synopse extended TMemo
Synopse SynMemoEx. Copyright (C) 2018 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
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
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse SynMemoEx.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2018
the Initial Developer. All Rights Reserved.
Contributor(s):
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
Based on TMemoEx, by R&A Library 2.03 (c) R&A, 1996-2000.
R&A Library seems now unsupported. Web site is dead, as is their email address.
We decided to put this unit, mostly rewritten, under a MPL/GPL/LGPL tri-license.
* full code rewrite for speed, stability and new features
* regroup in one unit w/out RA Consts
* no expandTabs: too slow
* FAttrs are calculated on the fly: spare RAM on syntax highlight (only text is stored)
* don't use FLines.text on often-call methods (insertText, deleteSelected...)
* fClipProtect: clipBoard Copy/Cut limited to 2K for others programs (copyrights)
* find (text) command
* a lot of bug fixes
Version 1.18
- Unicode compatibility
}
interface
{.$define CLIPBOARDPROTECT} // if defined, ClipProtect truncs clipboard to 2KB
// use only with ONE TMemoEx at once
{$IFNDEF MEMOEX_NOEDITOR}
{$DEFINE MEMOEX_EDITOR} {if not MEMOEX_EDITOR then mode = Viewer}
{$ENDIF}
{$DEFINE MEMOEX_DEFLAYOUT} {set default keyboard layout}
{$IFNDEF MEMOEX_NOUNDO}
{$DEFINE MEMOEX_UNDO} {enable undo}
{$ENDIF}
{$IFNDEF MEMOEX_NOCOMPLETION}
{$DEFINE MEMOEX_COMPLETION} {enable code completion}
{$ENDIF}
{$IFNDEF MEMOEX_EDITOR}
{$UNDEF MEMOEX_DEFLAYOUT}
{$UNDEF MEMOEX_UNDO}
{$UNDEF MEMOEX_COMPLETION}
{$ENDIF MEMOEX_EDITOR}
{ $D-,L-} // avoid jumping in the source for any EComplete exceptions e.g.
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
uses
Windows, Messages, SysUtils, Classes, Types, Graphics, Controls, Forms,
ExtCtrls, StdCtrls, ClipBrd, Menus {$ifdef UNICODE}, UITypes{$endif};
const
RAEditorCompletionChars: set of AnsiChar =
[#8, '_', '0'..'9', 'A'..'Z', 'a'..'z'];
Separators: set of AnsiChar =
[#0, ' ', '-', #13, #10, '.', ',', '/', '\', ':', '+', '%', '*', '(', ')',
';', '=', '{', '}', '[', ']', '{', '}', '|', '!', '@', '"'];
GutterRightMargin = 2;
WM_EDITCOMMAND = WM_USER + $101;
RA_EX_STYLE_DEFAULT = 0;
RA_CASE_CONVERT_UPPER = 0;
RA_CASE_CONVERT_LOWER = 1;
RA_CASE_CONVERT_INVERT = 2;
type
TRAControlScrollBar95 = class
private
FKind: TScrollBarKind;
FPosition: Integer;
FMin: Integer;
FMax: Integer;
FSmallChange: TScrollBarInc;
FLargeChange: TScrollBarInc;
FPage: integer;
FHandle: hWnd;
FOnScroll: TScrollEvent;
// FVisible : boolean;
procedure SetParam(index, Value: Integer);
// procedure SetVisible(Value : boolean);
// procedure SetLargeChange(Value: TScrollBarInc);
protected
procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
public
constructor Create;
procedure SetParams(AMin, AMax, APosition, APage: integer);
procedure DoScroll(var Message: 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: hWnd read FHandle write FHandle;
property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
// property Visible : boolean read FVisible write SetVisible;
end;
TCellRect = record
Width: integer;
Height: integer;
end;
PLineAttr = ^TLineAttr;
TLineAttr = packed record
FC, BC: TColor;
case integer of
0:
(Style: TFontStyles;
ex_style: byte;
underlined: boolean);
1:
(LastInteger: integer);
end;
TCustomMemoEx = class;
TWordUnderCursor = record // for TOnWordClick
Text: string;
Style: integer;
CaretX, CaretY, ParaIndex, ParaOffset: integer;
TextStart: integer;
Shift: TShiftState;
end;
TLineAttrs = array of TLineAttr;
TSelAttrs = array of boolean;
TOnGetLineAttr = procedure(Sender: TObject; const Line: string; index: integer; const SelAttrs: TSelAttrs; var Attrs: TLineAttrs) of object;
TOnChangeStatus = TNotifyEvent;
TOnChangeClipboardState = procedure(Sender: TObject; const CanPaste: boolean) of object;
TOnWordClick = procedure(Sender: TObject; const Clicked: TWordUnderCursor) of object;
TOnMouseOver = procedure(Sender: TObject; WordStyle: word; var _Cursor: TCursor) of object;
TOnBreakLine = procedure(Sender: TObject; const Original: string; var _New: string) of object;
TOnConcatLine = procedure(Sender: TObject; const Original: string; var _New: string) of object;
TOnTextInsert = procedure(Sender: TObject; var Text: string) of object;
TOnCaseConversion = function(Sender: TObject; Conversion: byte; const Text: string): string of object;
TOnInsertBlock = function(Sender: TObject; var Text: string): boolean of object;
TOnSaveBlock = procedure(Sender: TObject; const Text: string) of object;
TOnInsertMacro = function(Sender: TObject; MacroID: integer): string of object;
TOnBlockOperation = function(Sender: TObject; MacroID: integer; const Text: string): string of object;
TOnSetCaretPos = procedure(Sender: TObject; CaretX, CaretY: integer) of object;
TOnClipboardPaste = function(Sender: TObject): boolean of object;
{$IFDEF MEMOEX_COMPLETION}
TOnPreprocessCompletion = function(Sender: TObject; const ID, Text: string): string of object;
{$ENDIF}
PAutoChangeWord = ^TAutoChangeWord;
TAutoChangeWord = record
OldWord, NewWord: string;
end;
PParagraph = ^TParagraph;
TParagraph = record
FPreCount, FCount: integer; // length(FString) = FStrings[0..FCount-1]
FStrings: array of string;
FObject: TObject;
end;
TEditorStrings = class(TStrings)
private
FMemoEx: TCustomMemoEx;
FList: array of TParagraph;
FParaLinesCount, FCount: integer;
FOnChanging: TNotifyEvent;
FOnAfterLoad: TNotifyEvent;
FOnBeforeSave: TNotifyEvent;
procedure Recount(Index: integer);
function _GetString(ParaIndex: integer): string;
procedure _PutString(ParaIndex: integer; const S: string);
procedure ReformatParagraph(ParaIndex: integer);
procedure Reformat;
procedure CheckLength(const st: string);
procedure Grow;
procedure InsertItem(Index: integer; const S: string);
protected
procedure Changed; virtual;
procedure Changing; virtual;
function Get(Index: integer): string; override;
function GetParaString(Index: integer): string;
function GetParagraph(Index: integer): PParagraph;
procedure Put(Index: integer; const S: string); override;
procedure PutParaString(Index: integer; const S: string);
procedure PutObject(Index: Integer; AObject: TObject); override;
function GetObject(Index: Integer): TObject; override;
procedure SetUpdateState(Updating: Boolean); override;
function GetTextStr: string; override;
procedure SetTextStr(const Value: string); override;
procedure SetInternal(Index: integer; const Value: string);
procedure SetInternalParaStr(Index: integer; const Value: string);
function GetCount: Integer; override; // make compiler happy
function AddParaStr(ParaIndex: integer; const S: string): integer;
procedure ReLine; // complete line with spaces until caret X pos
property Internal[Index: integer]: string write SetInternal;
property InternalParaStrings[Index: integer]: string write SetInternalParaStr;
public
constructor Create;
destructor Destroy; override;
procedure Clear; override;
procedure BeginUpdate;
procedure EndUpdate;
function Add(const S: string): integer; override;
procedure Delete(Index: integer); override;
procedure Insert(Index: integer; const S: string); override;
procedure LoadFromFile(const FileName: string); override;
procedure SaveToFile(const FileName: string); override;
procedure SetLockText(const Text: string);
function GetTextLength: integer; // fast get length(Text) value
function HasText: boolean; // true if Text<>''
procedure Index2ParaIndex(Index: integer; out Para, ParaIndex: integer);
function GetParagraphByIndex(Index: integer; out ParaIndex, IndexOffs: integer): string;
procedure Caret2Paragraph(X, Y: integer; out ParaIndex, IndexOffs: integer);
procedure Paragraph2Caret(ParaIndex, IndexOffs: integer; out X, Y: integer);
function GetParaOffs(ParaIndex: integer): integer; // in global Text[] string
property ParaLineCount: integer read FParaLinesCount;
property ParaStrings[Index: integer {=ParaY}]: string read GetParaString write PutParaString;
property Paragraphs[Index: integer]: PParagraph read GetParagraph; // = FList[index]
// property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
end;
TModifiedAction = (maInsert, maDelete);
TBookMark = record
X, Y: integer;
Valid: boolean;
end;
TBookMarkNum = 0..9;
TBookMarks = array[TBookMarkNum] of TBookMark;
TEditorClient = class
private
FMemoEx: TCustomMemoEx;
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;
TGutter = class
private
FMemoEx: TCustomMemoEx;
public
procedure Paint;
procedure Invalidate;
end;
TOnPaintGutter = procedure(Sender: TObject; Canvas: TCanvas; const Rect: TRect) of object;
TEditCommand = word;
TMacro = string; { uses as buffer }
TEditKey = class
public
Key1, Key2: Word;
Shift1, 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;
TKeyboard = class
private
List: TList;
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 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;
{$IFDEF MEMOEX_DEFLAYOUT}
procedure SetDefLayout;
{$ENDIF MEMOEX_DEFLAYOUT}
end;
EMemoExError = class(Exception);
{$IFDEF MEMOEX_UNDO}
TUndoBuffer = class;
TUndo = class
private
FMemoEx: TCustomMemoEx;
function UndoBuffer: TUndoBuffer;
public
constructor Create(const AMemoEx: TCustomMemoEx);
procedure Undo; dynamic; abstract;
procedure Redo; dynamic; abstract;
end;
TUndoBuffer = class(TList)
private
FMemoEx: TCustomMemoEx;
FPtr: integer;
FCancelUndo, InUndo: boolean;
function IsNewGroup(const AUndo: TUndo): boolean;
public
constructor Create;
procedure Add(AUndo: TUndo);
function LastUndo: TUndo;
procedure Undo;
procedure Redo;
procedure Clear; override;
procedure Delete;
end;
{$ENDIF MEMOEX_UNDO}
{$IFDEF MEMOEX_COMPLETION}
TCompletion = class;
TOnCompletion = procedure(Sender: TObject; var Cancel: boolean) of object;
{$ENDIF MEMOEX_COMPLETION}
TTabStop = (tsTabStop, tsAutoIndent);
{*** TCustomMemoEx }
TCustomMemoEx = class(TCustomControl)
private
{ internal objects }
FLines: TEditorStrings;
scbHorz: TRAControlScrollBar95;
scbVert: TRAControlScrollBar95;
EditorClient: TEditorClient;
FGutter: TGutter;
FKeyboard: TKeyboard;
FBookMarks: TBookMarks;
FUpdateLock: integer;
{$IFDEF MemoEx_UNDO}
FUndoBuffer: TUndoBuffer;
FGroupUndo: boolean;
{$ENDIF MEMOEX_UNDO}
{$IFDEF MEMOEX_COMPLETION}
FCompletion: TCompletion;
{$ENDIF MEMOEX_COMPLETION}
{ internal - Columns and rows attributes }
FCols, FRows: integer;
FLeftCol, FTopRow: integer;
// FLeftColMax, FTopRowMax : integer;
FLastVisibleCol, FLastVisibleRow: integer;
FCaretX, FCaretY: integer;
FVisibleColCount: integer;
FVisibleRowCount: integer;
{ internal - other flags and attributes }
FAllRepaint: boolean;
FCellRect: TCellRect;
{$IFDEF MEMOEX_EDITOR}
IgnoreKeyPress: boolean;
{$ENDIF MEMOEX_EDITOR}
WaitSecondKey: Boolean;
Key1: Word;
Shift1: TShiftState;
{ internal - selection attributes }
FSelected: boolean;
FSelBlock: boolean;
FSelBegX, FSelBegY, FSelEndX, FSelEndY: integer;
FUpdateSelBegX, FUpdateSelEndX, FUpdateSelBegY, FUpdateSelEndY: integer;
FSelStartX, FSelStartY: integer;
FclSelectBC, FclSelectFC: TColor;
{ mouse support }
timerScroll: TTimer;
MouseMoveY, MouseMoveXX, MouseMoveYY: integer;
{ internal }
FTabPos: array of boolean;
FTabStops: string;
{ internal - primary for TIReader support }
FEditBuffer: string;
FPEditBuffer: PChar;
FEditBufferSize: integer;
FCompound: integer;
{ FMacro - buffer of TEditCommand, each command represents by two chars }
FMacro: TMacro;
FDefMacro: TMacro;
{ visual attributes - properties }
FBorderStyle: TBorderStyle;
FGutterColor: TColor;
FGutterWidth: integer;
FRightMarginVisible: boolean;
FRightMargin: integer;
FRightMarginColor: TColor;
FScrollBars: TScrollStyle;
FDoubleClickLine: boolean;
FSmartTab: Boolean;
FBackSpaceUnindents: Boolean;
FAutoIndent: Boolean;
FKeepTrailingBlanks: Boolean;
FCursorBeyondEOF: Boolean;
FCursorBeyondEOL: Boolean;
{ FInclusive - Inclusive mode }
FInclusive: Boolean;
{ non-visual attributes - properties }
FInsertMode: boolean;
FReadOnly: boolean;
FModified: boolean;
FRecording: boolean;
{ Events }
FOnGetLineAttr: TOnGetLineAttr;
FOnChange: TNotifyEvent;
FOnSelectionChange: TNotifyEvent;
FOnChangeStatus: TOnChangeStatus;
FOnChangeClipboardState: TOnChangeClipboardState;
FOnScroll: TNotifyEvent;
FOnResize: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnPaintGutter: TOnPaintGutter;
FOnWordClick: TOnWordClick;
FOnMouseOver: TOnMouseOver;
FOnBreakLine: TOnBreakLine;
FOnConcatLine: TOnConcatLine;
FOnTextInsert: TOnTextInsert;
FOnCaseConversion: TOnCaseConversion;
FOnInsertBlock: TOnInsertBlock;
FOnSaveBlock: TOnSaveBlock;
FOnInsertMacro: TOnInsertMacro;
FOnBlockOperation: TOnBlockOperation;
FOnSetCaretPos: TOnSetCaretPos;
{$IFDEF MEMOEX_COMPLETION}
FOnCompletionIdentifer: TOnCompletion;
FOnCompletionTemplate: TOnCompletion;
FOnCompletionDrawItem: TDrawItemEvent;
FOnCompletionMeasureItem: TMeasureItemEvent;
FOnPreprocessCompletion: TOnPreprocessCompletion;
{$ENDIF MEMOEX_COMPLETION}
FDrawBitmap: TBitmap;
FFont: TFont;
FWantTabs: boolean;
FWordWrap: boolean;
FStripInvisible: boolean;
FParaX, FParaY: integer;
NextClipViewer: THandle;
scbVertWidth, scbHorzHeight: integer;
Max_X: integer;
mouse_down, mouse_dragged, double_clicked: boolean;
FWordUnderCursor: TWordUnderCursor;
FClipPasteRtfBackSlashConvert: boolean;
{$ifdef CLIPBOARDPROTECT} // ClipProtect will trunc clipboard to 2KB
FClip: string; // AB
FClipProtect: boolean;
{$endif}
FOnClipboardPaste: TOnClipboardPaste; // AB
procedure SetMax_X(const Value: integer);
procedure UpdateEditorSize(const FullUpdate: boolean = true; const RepaintGutter: boolean = true);
procedure RedrawFrom(YFrom: integer);
function RepaintParagraph(LineIndex: integer): integer;
{$IFDEF MEMOEX_COMPLETION}
procedure DoCompletionIdentifer(var Cancel: boolean);
procedure DoCompletionTemplate(var Cancel: boolean);
function DoPreprocessCompletion(const ID, OldText: string): string;
{$ENDIF MEMOEX_COMPLETION}
procedure ScrollTimer(Sender: TObject);
procedure ReLine;
function GetDefTabStop(const X: integer; const Next: Boolean): integer;
function GetTabStop(const X, Y: integer; const What: TTabStop; const Next: Boolean): integer;
function GetBackStop(const X, Y: integer): integer;
procedure TextAllChangedInternal(const Unselect: Boolean);
{ properties }
procedure SetGutterWidth(AWidth: integer);
procedure SetGutterColor(AColor: TColor);
procedure SetFont(Value: TFont);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetLines(ALines: TEditorStrings);
function GetRealOffs(DefOffs, Index: integer): integer;
function GetSelStart: integer;
procedure SetSelStart(const ASelStart: integer);
procedure SetSelLength(const ASelLength: integer);
function GetSelLength: integer;
procedure SetMode(index: integer; Value: boolean);
procedure SetCaretPosition(const index, Pos: integer);
procedure SetCols(ACols: integer);
procedure SetRows(ARows: integer);
procedure SetScrollBars(Value: TScrollStyle);
procedure SetRightMarginVisible(Value: boolean);
procedure SetRightMargin(Value: integer);
procedure SetRightMarginColor(Value: TColor);
function ExtractStringWithStyle(XX, YY: integer; const From: string; Style: word; const LineAttrs: TLineAttrs; out start: integer): string;
procedure GetWordUnderCursor(X, Y: integer; aShift: TShiftState = []);
function GetAfterLoad: TNotifyEvent;
procedure SetAfterLoad(Value: TNotifyEvent);
function GetBeforeSave: TNotifyEvent;
procedure SetBeforeSave(Value: TNotifyEvent);
procedure SetWordWrap(Value: boolean);
procedure SetStripInvisible(Value: boolean);
procedure SetSelectedText(Value: boolean);
procedure FontChanged(Sender: TObject);
procedure SetTopRow(const Value: integer);
function GetTextStr: string;
procedure SetTextStr(const Value: string);
protected
SelAttrs_Size: integer;
SelAttrs: TSelAttrs;
property FSelectedText: boolean read FSelected write SetSelectedText;
procedure Resize; override;
procedure CreateWnd; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
procedure Paint; override;
procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: integer);
procedure Scroll(const Vert: boolean; const ScrollPos: integer);
procedure PaintLine(const Line: integer; ColBeg, ColEnd: integer);
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{$IFDEF MEMOEX_EDITOR}
procedure KeyPress(var Key: Char); override;
procedure InsertChar(const Key: Char);
{$ENDIF MEMOEX_EDITOR}
procedure SetSel(const ASelX, ASelY: integer);
function GetAttrDelta(StartFrom, EndTo: integer; const LineAttrs: TLineAttrs): integer;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure DblClick; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: integer; MousePos: TPoint): boolean; override;
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
// procedure DrawRightMargin;
procedure PaintSelection;
procedure SetUnSelected;
procedure Mouse2Cell(const X, Y: integer; var CX, CY: integer);
procedure Mouse2Caret(const X, Y: integer; var CX, CY: integer);
procedure CaretCoord(const X, Y: integer; var CX, CY: integer);
function PosFromMouse(const X, Y: integer): integer;
procedure SetLockText(const Text: string);
// function ExpandTabs(const S: string): string;
{$IFDEF MEMOEX_UNDO}
procedure CantUndo;
{$ENDIF MEMOEX_UNDO}
procedure SetCaretInternal(X, Y: integer);
procedure ValidateEditBuffer;
procedure SetXY(X, Y: integer);
{$IFDEF MEMOEX_EDITOR}
procedure ChangeBookMark(const BookMark: TBookMarkNum; const Valid: boolean);
procedure InsertText(const Text: string);
{$ENDIF MEMOEX_EDITOR}
procedure BeginRecord;
procedure EndRecord(var AMacro: TMacro);
procedure PlayMacro(const AMacro: TMacro);
function YinBounds(AY: integer): boolean;
function DoChangeCase(const st: string; Conversion: byte): string;
{ triggers for descendants }
procedure Changed; dynamic;
procedure TextAllChanged; dynamic;
procedure StatusChanged; dynamic;
procedure SelectionChanged; dynamic;
procedure ClipboardChanged; dynamic;
procedure GetLineAttr(Line, LineIdx, LineOffs, LineLen, ColBeg, ColEnd: integer; const ALine: string; var FAttrs: TLineAttrs); virtual;
procedure GutterPaint(Canvas: TCanvas; const Rect: TRect); dynamic;
procedure BookmarkChanged(BookMark: integer); dynamic;
{$IFDEF MEMOEX_COMPLETION}
procedure CompletionIdentifer(var Cancel: boolean); dynamic;
procedure CompletionTemplate(var Cancel: boolean); dynamic;
{$ENDIF MEMOEX_COMPLETION}
property Gutter: TGutter read FGutter;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Invalidate; override;
procedure WndProc(var Message: TMessage); override;
procedure SetLeftTop(ALeftCol, ATopRow: integer);
procedure ClipBoardCopy;
procedure ClipBoardPaste;
procedure ClipBoardCut;
procedure DeleteSelected;
function CalcCellRect(const X, Y: integer): TRect;
procedure SetCaret(const X, Y: integer);
procedure SetCaretAtParaPos(const ParaIndex, IndexOffs: integer);
procedure CaretFromPos(Pos: integer; var X, Y: integer);
function PosFromCaret(X, Y: integer): integer;
procedure PaintCaret(bShow: boolean);
function GetTextLen: integer;
function GetSelText: string;
procedure SetSelText(const AValue: string);
function GetWordOnCaret: string;
procedure BeginUpdate;
procedure EndUpdate;
procedure MakeRowVisible(ARow: integer);
procedure Command(ACommand: TEditCommand); virtual;
procedure PostCommand(ACommand: TEditCommand);
{$IFDEF MEMOEX_EDITOR}
procedure InsertTextAtCurrentPos(const _Text: string);
function FindNext(const text: string; ignCase: boolean): boolean;
procedure ReplaceWord(const NewString: string);
procedure ReplaceWord2(const NewString: string);
{$ENDIF}
procedure BeginCompound;
procedure EndCompound;
function GetText(Position: longint; Buffer: PChar; Count: longint): longint;
function IsUndoEmpty: boolean;
procedure MouseWheelScroll(Delta: integer);
{$ifdef CLIPBOARDPROTECT} // ClipProtect will trunc clipboard to 2KB
property ClipProtect: boolean read FClipProtect write FClipProtect; // AB
{$endif}
property ClipPasteRtfBackSlashConvert: boolean // AB: rtf
read FClipPasteRtfBackSlashConvert write FClipPasteRtfBackSlashConvert;
property LeftCol: integer read FLeftCol;
property TopRow: integer read FTopRow write SetTopRow;
property VisibleColCount: integer read FVisibleColCount;
property VisibleRowCount: integer read FVisibleRowCount;
property LastVisibleCol: integer read FLastVisibleCol;
property LastVisibleRow: integer read FLastVisibleRow;
property Cols: integer read FCols write SetCols;
property Rows: integer read FRows write SetRows;
property CaretX: integer index 0 read FCaretX write SetCaretPosition;
property CaretY: integer index 1 read FCaretY write SetCaretPosition;
property Modified: boolean read FModified write FModified;
property SelStart: integer read GetSelStart write SetSelStart;
property SelLength: integer read GetSelLength write SetSelLength;
property SelText: string read GetSelText write SetSelText;
property SelectedText: boolean read FSelected;
property BookMarks: TBookMarks read FBookMarks;
property Keyboard: TKeyboard read FKeyboard;
property CellRect: TCellRect read FCellRect;
{$IFDEF MEMOEX_UNDO}
property UndoBuffer: TUndoBuffer read FUndoBuffer;
{$ENDIF MEMOEX_UNDO}
property Recording: boolean read FRecording;
property WordUnderCursor: TWordUnderCursor read FWordUnderCursor;
property SelBegY: integer read FSelBegY;
property SelEndY: integer read FSelEndY;
public { published in descendants }
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Lines: TEditorStrings read FLines write SetLines;
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
property Cursor default crIBeam;
property Color default clWindow;
property Font: TFont read FFont write SetFont;
property Text: string read GetTextStr write SetTextStr;
property GutterWidth: integer read FGutterWidth write SetGutterWidth;
property GutterColor: TColor read FGutterColor write SetGutterColor default clBtnFace;
property RightMarginVisible: boolean read FRightMarginVisible write SetRightMarginVisible default true;
property RightMargin: integer read FRightMargin write SetRightMargin default 80;
property RightMarginColor: TColor read FRightMarginColor write SetRightMarginColor default clBtnFace;
property InsertMode: boolean index 0 read FInsertMode write SetMode default true;
property ReadOnly: boolean index 1 read FReadOnly write SetMode default false;
property DoubleClickLine: boolean read FDoubleClickLine write FDoubleClickLine default false;
{$IFDEF MEMOEX_COMPLETION}
property Completion: TCompletion read FCompletion write FCompletion;
{$ENDIF MEMOEX_COMPLETION}
property TabStops: string read FTabStops write FTabStops;
property SmartTab: Boolean read FSmartTab write FSmartTab default true;
property BackSpaceUnindents: Boolean read FBackSpaceUnindents write FBackSpaceUnindents default true;
property AutoIndent: Boolean read FAutoIndent write FAutoIndent default true;
property KeepTrailingBlanks: Boolean read FKeepTrailingBlanks write FKeepTrailingBlanks default false;
property CursorBeyondEOF: Boolean read FCursorBeyondEOF write FCursorBeyondEOF default false;
property CursorBeyondEOL: Boolean read FCursorBeyondEOL write FCursorBeyondEOL default true;
property SelForeColor: TColor read FclSelectFC write FclSelectFC;
property SelBackColor: TColor read FclSelectBC write FclSelectBC;
property StripInvisible: boolean read FStripInvisible write SetStripInvisible default false;
property WantTabs: boolean read FWantTabs write FWantTabs default true;
property WordWrap: boolean read FWordWrap write SetWordWrap default true;
property OnAfterLoad: TNotifyEvent read GetAfterLoad write SetAfterLoad;
property OnBeforeSave: TNotifyEvent read GetBeforeSave write SetBeforeSave;
property OnGetLineAttr: TOnGetLineAttr read FOnGetLineAttr write FOnGetLineAttr;
property OnChangeStatus: TOnChangeStatus read FOnChangeStatus write FOnChangeStatus;
property OnChangeClipboardState: TOnChangeClipboardState read FOnChangeClipboardState write FOnChangeClipboardState;
property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
property OnResize: TNotifyEvent read FOnResize write FOnResize;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnPaintGutter: TOnPaintGutter read FOnPaintGutter write FOnPaintGutter;
property OnMouseOver: TOnMouseOver read FOnMouseOver write FOnMouseOver;
property OnWordClick: TOnWordClick read FOnWordClick write FOnWordClick;
property OnBreakLine: TOnBreakLine read FOnBreakLine write FOnBreakLine;
property OnConcatLine: TOnConcatLine read FOnConcatLine write FOnConcatLine;
property OnTextInsert: TOnTextInsert read FOnTextInsert write FOnTextInsert;
property OnCaseConversion: TOnCaseConversion read FOnCaseConversion write FOnCaseConversion;
property OnInsertBlock: TOnInsertBlock read FOnInsertBlock write FOnInsertBlock;
property OnSaveBlock: TOnSaveBlock read FOnSaveBlock write FOnSaveBlock;
property OnInsertMacro: TOnInsertMacro read FOnInsertMacro write FOnInsertMacro;
property OnBlockOperation: TOnBlockOperation read FOnBlockOperation write FOnBlockOperation;
property OnSetCaretPos: TOnSetCaretPos read FOnSetCaretPos write FOnSetCaretPos;
property OnClipboardPaste: TOnClipboardPaste read FOnClipboardPaste write FOnClipboardPaste;
{$IFDEF MEMOEX_COMPLETION}
property OnCompletionIdentifer: TOnCompletion read FOnCompletionIdentifer write FOnCompletionIdentifer;
property OnCompletionTemplate: TOnCompletion read FOnCompletionTemplate write FOnCompletionTemplate;
property OnCompletionDrawItem: TDrawItemEvent read FOnCompletionDrawItem write FOnCompletionDrawItem;
property OnCompletionMeasureItem: TMeasureItemEvent read FOnCompletionMeasureItem write FOnCompletionMeasureItem;
property OnPreprocessCompletion: TOnPreprocessCompletion read FOnPreprocessCompletion write FOnPreprocessCompletion;
{$ENDIF MEMOEX_COMPLETION}
property DockManager;
end;
TMemoEx = class(TCustomMemoEx)
public
/// a JSON syntax highlighter
class procedure JSONLineAttr(Sender: TObject; const Line: string;
index: Integer; const SelAttrs: TSelAttrs; var Attrs: TLineAttrs);
published
property TabOrder;
property BorderStyle;
property Lines;
property ScrollBars;
property GutterWidth;
property GutterColor;
property RightMarginVisible;
property RightMargin;
property RightMarginColor;
property InsertMode;
property ReadOnly;
property DoubleClickLine;
{$IFDEF MEMOEX_COMPLETION}
property Completion;
{$ENDIF MEMOEX_COMPLETION}
property TabStops;
property SmartTab;
property BackSpaceUnindents;
property AutoIndent;
property KeepTrailingBlanks;
property CursorBeyondEOF;
property CursorBeyondEOL;
property SelForeColor;
property SelBackColor;
property Text;
property StripInvisible;
property OnAfterLoad;
property OnBeforeSave;
property OnEnter;
property OnExit;
property OnGetLineAttr;
property OnChangeStatus;
property OnChangeClipboardState;
property OnScroll;
property OnResize;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnChange;
property OnSelectionChange;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnDblClick;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnPaintGutter;
property OnMouseOver;
property OnWordClick;
property OnBreakLine;
property OnConcatLine;
property OnTextInsert;
property OnCaseConversion;
property OnInsertBlock;
property OnSaveBlock;
property OnInsertMacro;
property OnBlockOperation;
property OnSetCaretPos;
{$IFDEF MEMOEX_COMPLETION}
property OnCompletionIdentifer;
property OnCompletionTemplate;
property OnCompletionDrawItem;
property OnCompletionMeasureItem;
property OnPreprocessCompletion;
{$ENDIF MEMOEX_COMPLETION}
{ TCustomControl }
property align;
property Enabled;
property Color;
property Ctl3D;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabStop;
property Visible;
property Anchors;
property AutoSize;
property BiDiMode;
property Constraints;
property UseDockManager default true;
property DockSite;
property DragKind;
property ParentBiDiMode;
property WantTabs default true;
property WordWrap default true;
property OnCanResize;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnEndDock;
property OnGetSiteInfo;
property OnStartDock;
property OnUnDock;
end;
{$IFDEF MEMOEX_COMPLETION}
TCompletionList = (cmIdentifers, cmTemplates);
TCompletion = class(TPersistent)
private
FMemoEx: TCustomMemoEx;
FPopupList: TListBox;
FAutoChange: TStrings;
FAutoChangeList: TList;
FIdentifers: TStrings;
FTemplates: TStrings;
FItems: TStringList;
FItemIndex: integer;
FMode: TCompletionList;
FDefMode: TCompletionList;
FItemHeight: integer;
FTimer: TTimer;
FEnabled: boolean;
FVisible: boolean;
FDropDownCount: integer;
FDropDownWidth: integer;
FListBoxStyle: TListBoxStyle;
FCaretChar: char;
FCRLF: string;
FSeparator: string;
function DoKeyDown(Key: Word; Shift: TShiftState): boolean;
procedure DoKeyPress(Key: Char);
procedure OnTimer(Sender: TObject);
procedure FindSelItem(var Eq: boolean);
procedure ReplaceWord(const ANewString: string);
function Cmp1(const S1, S2: string): integer;
function Cmp2(const S1, S2: string): boolean;
procedure AutoChangeChanged(Sender: TObject);
procedure ClearAutoChangeList;
procedure UpdateAutoChange;
procedure SetStrings(index: integer; AValue: TStrings);
function GetItemIndex: integer;
procedure SetItemIndex(AValue: integer);
function GetInterval: cardinal;
procedure SetInterval(AValue: cardinal);
procedure MakeItems;
function GetItems: TStrings;
public
constructor Create2(AMemoEx: TCustomMemoEx);
destructor Destroy; override;
procedure DropDown(const AMode: TCompletionList; const ShowAlways: boolean);
procedure DoCompletion(const AMode: TCompletionList);
procedure CloseUp(const Apply: boolean);
procedure SelectItem;
property ItemIndex: integer read GetItemIndex write SetItemIndex;
property Visible: boolean read FVisible write FVisible;
property Mode: TCompletionList read FMode write FMode;
property Items: TStringList read FItems;
published
property DropDownCount: integer read FDropDownCount write FDropDownCount default 6;
property DropDownWidth: integer read FDropDownWidth write FDropDownWidth default 300;
property Enabled: boolean read FEnabled write FEnabled default false;
property Separator: string read FSeparator write FSeparator;
property Identifers: TStrings index 0 read FIdentifers write SetStrings;
property Templates: TStrings index 1 read FTemplates write SetStrings;
property AutoChange: TStrings index 2 read FAutoChange write SetStrings;
property ItemHeight: integer read FItemHeight write FItemHeight;
property Interval: cardinal read GetInterval write SetInterval;
property ListBoxStyle: TListBoxStyle read FListBoxStyle write FListBoxStyle;
property CaretChar: char read FCaretChar write FCaretChar;
property CRLF: string read FCRLF write FCRLF;
end;
{$ENDIF MEMOEX_COMPLETION}
const
{ Editor commands }
ecCharFirst = $00;
ecCharLast = $FF;
ecCommandFirst = $100;
ecUser = $8000; { use this for descendants }
{Cursor}
ecLeft = ecCommandFirst + 1;
ecUp = ecLeft + 1;
ecRight = ecLeft + 2;
ecDown = ecLeft + 3;
{Cursor with select}
ecSelLeft = ecCommandFirst + 9;
ecSelUp = ecSelLeft + 1;
ecSelRight = ecSelLeft + 2;
ecSelDown = ecSelLeft + 3;
{Cursor position change according to word}
ecPrevWord = ecSelDown + 1;
ecNextWord = ecPrevWord + 1;
ecSelPrevWord = ecPrevWord + 2;
ecSelNextWord = ecPrevWord + 3;
ecSelWord = ecPrevWord + 4;
ecWindowTop = ecSelWord + 1;
ecWindowBottom = ecWindowTop + 1;
ecPrevPage = ecWindowTop + 2;
ecNextPage = ecWindowTop + 3;
ecSelPrevPage = ecWindowTop + 4;
ecSelNextPage = ecWindowTop + 5;
ecBeginLine = ecSelNextPage + 1;
ecEndLine = ecBeginLine + 1;
ecBeginDoc = ecBeginLine + 2;
ecEndDoc = ecBeginLine + 3;
ecSelBeginLine = ecBeginLine + 4;
ecSelEndLine = ecBeginLine + 5;
ecSelBeginDoc = ecBeginLine + 6;
ecSelEndDoc = ecBeginLine + 7;
ecSelAll = ecBeginLine + 8;
ecScrollLineUp = ecSelAll + 1;
ecScrollLineDown = ecScrollLineUp + 1;
ecInsertPara = ecCommandFirst + 101;
ecBackspace = ecInsertPara + 1;
ecDelete = ecInsertPara + 2;
ecChangeInsertMode = ecInsertPara + 3;
ecTab = ecInsertPara + 4;
ecBackTab = ecInsertPara + 5;
ecIndent = ecInsertPara + 6;
ecUnindent = ecInsertPara + 7;
ecDeleteSelected = ecInsertPara + 10;
ecClipboardCopy = ecInsertPara + 11;
ecClipboardCut = ecClipboardCopy + 1;
ecClipBoardPaste = ecClipboardCopy + 2;
ecDeleteLine = ecClipBoardPaste + 1;
ecDeleteWord = ecDeleteLine + 1;
ecToUpperCase = ecDeleteLine + 2;
ecToLowerCase = ecToUpperCase + 1;
ecChangeCase = ecToUpperCase + 2;
ecUndo = ecChangeCase + 1;
ecRedo = ecUndo + 1;
ecBeginCompound = ecUndo + 2; { not implemented }
ecEndCompound = ecUndo + 3; { not implemented }
ecBeginUpdate = ecUndo + 4;
ecEndUpdate = ecUndo + 5;
ecSetBookmark0 = ecEndUpdate + 1;
ecSetBookmark1 = ecSetBookmark0 + 1;
ecSetBookmark2 = ecSetBookmark0 + 2;
ecSetBookmark3 = ecSetBookmark0 + 3;
ecSetBookmark4 = ecSetBookmark0 + 4;
ecSetBookmark5 = ecSetBookmark0 + 5;
ecSetBookmark6 = ecSetBookmark0 + 6;
ecSetBookmark7 = ecSetBookmark0 + 7;
ecSetBookmark8 = ecSetBookmark0 + 8;
ecSetBookmark9 = ecSetBookmark0 + 9;
ecGotoBookmark0 = ecSetBookmark9 + 1;
ecGotoBookmark1 = ecGotoBookmark0 + 1;
ecGotoBookmark2 = ecGotoBookmark0 + 2;
ecGotoBookmark3 = ecGotoBookmark0 + 3;
ecGotoBookmark4 = ecGotoBookmark0 + 4;
ecGotoBookmark5 = ecGotoBookmark0 + 5;
ecGotoBookmark6 = ecGotoBookmark0 + 6;
ecGotoBookmark7 = ecGotoBookmark0 + 7;
ecGotoBookmark8 = ecGotoBookmark0 + 8;
ecGotoBookmark9 = ecGotoBookmark0 + 9;
ecCompletionIdentifers = ecGotoBookmark9 + 1;
ecCompletionTemplates = ecCompletionIdentifers + 1;
ecRecordMacro = ecCompletionTemplates + 1;
ecPlayMacro = ecRecordMacro + 1;
ecBeginRecord = ecRecordMacro + 2;
ecEndRecord = ecRecordMacro + 3;
ecSaveBlock = ecEndRecord + 1;
ecInsertBlock = ecSaveBlock + 1;
ecInsertMacro0 = ecInsertBlock + 1;
ecInsertMacro1 = ecInsertMacro0 + 1;
ecInsertMacro2 = ecInsertMacro0 + 2;
ecInsertMacro3 = ecInsertMacro0 + 3;
ecInsertMacro4 = ecInsertMacro0 + 4;
ecInsertMacro5 = ecInsertMacro0 + 5;
ecInsertMacro6 = ecInsertMacro0 + 6;
ecInsertMacro7 = ecInsertMacro0 + 7;
ecInsertMacro8 = ecInsertMacro0 + 8;
ecInsertMacro9 = ecInsertMacro0 + 9;
ecInsertMacroA = ecInsertMacro0 + 10;
ecInsertMacroB = ecInsertMacro0 + 11;
ecInsertMacroC = ecInsertMacro0 + 12;
ecInsertMacroD = ecInsertMacro0 + 13;
ecInsertMacroE = ecInsertMacro0 + 14;
ecInsertMacroF = ecInsertMacro0 + 15;
ecInsertMacroG = ecInsertMacro0 + 16;
ecInsertMacroH = ecInsertMacro0 + 17;
ecInsertMacroI = ecInsertMacro0 + 18;
ecInsertMacroJ = ecInsertMacro0 + 19;
ecInsertMacroK = ecInsertMacro0 + 20;
ecInsertMacroL = ecInsertMacro0 + 21;
ecInsertMacroM = ecInsertMacro0 + 22;
ecInsertMacroN = ecInsertMacro0 + 23;
ecInsertMacroO = ecInsertMacro0 + 24;
ecInsertMacroP = ecInsertMacro0 + 25;
ecInsertMacroQ = ecInsertMacro0 + 26;
ecInsertMacroR = ecInsertMacro0 + 27;
ecInsertMacroS = ecInsertMacro0 + 28;
ecInsertMacroT = ecInsertMacro0 + 29;
ecInsertMacroU = ecInsertMacro0 + 30;
ecInsertMacroV = ecInsertMacro0 + 31;
ecInsertMacroW = ecInsertMacro0 + 32;
ecInsertMacroX = ecInsertMacro0 + 33;
ecInsertMacroY = ecInsertMacro0 + 34;
ecInsertMacroZ = ecInsertMacro0 + 35;
ecBlockOpA = ecInsertMacroZ + 1;
ecBlockOpB = ecBlockOpA + 1;
ecBlockOpC = ecBlockOpA + 2;
ecBlockOpD = ecBlockOpA + 3;
ecBlockOpE = ecBlockOpA + 4;
ecBlockOpF = ecBlockOpA + 5;
ecBlockOpG = ecBlockOpA + 6;
ecBlockOpH = ecBlockOpA + 7;
ecBlockOpI = ecBlockOpA + 8;
ecBlockOpJ = ecBlockOpA + 9;
ecBlockOpK = ecBlockOpA + 10;
ecBlockOpL = ecBlockOpA + 11;
ecBlockOpM = ecBlockOpA + 12;
ecBlockOpN = ecBlockOpA + 13;
ecBlockOpO = ecBlockOpA + 14;
ecBlockOpP = ecBlockOpA + 15;
ecBlockOpQ = ecBlockOpA + 16;
ecBlockOpR = ecBlockOpA + 17;
ecBlockOpS = ecBlockOpA + 18;
ecBlockOpT = ecBlockOpA + 19;
ecBlockOpU = ecBlockOpA + 20;
ecBlockOpV = ecBlockOpA + 21;
ecBlockOpW = ecBlockOpA + 22;
ecBlockOpX = ecBlockOpA + 23;
ecBlockOpY = ecBlockOpA + 24;
ecBlockOpZ = ecBlockOpA + 25;
ecBackword = ecBlockOpZ + 1;
ecScrollPageUp = ecBackword + 1;
ecScrollPageDown = ecScrollPageUp + 1;
twoKeyCommand = High(word);
const
__Brackets =['(', ')', '[', ']', '{', '}'];
__StdWordDelims =[#0..' ', ',', '.', ';', '\', ':', '''', '`']{ + __Brackets};
procedure Register;
function Max(x, y: integer): integer; {$ifdef HASINLINE}inline;{$endif}
function Min(x, y: integer): integer; {$ifdef HASINLINE}inline;{$endif}
implementation
uses
Consts, RTLConsts;
{$ifdef UNICODE}
function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer; inline;
begin
Result := System.Pos(SubStr, S, Offset);
end;
{$else}
function PosEx(const SubStr, S: AnsiString; Offset: Cardinal = 1): Integer;
// Faster Equivalent of Delphi 7 StrUtils.PosEx
asm
push ebx
push esi
push edx // @Str
test eax,eax
jz @@NotFound // Exit if SubStr = ''
test edx,edx
jz @@NotFound // Exit if Str = ''
mov esi,ecx
mov ecx,[edx-4] // Length(Str)
mov ebx,[eax-4] // Length(Search string)
add ecx,edx
sub ecx,ebx // ecx = Max Start Pos for Full Match
lea edx,[edx+esi-1] // edx = Start Position
cmp edx,ecx
jg @@NotFound // StartPos > Max Start Pos
cmp ebx,1 // Length(SubStr)
jle @@SingleChar // Length(SubStr) <= 1
push edi
push ebp
lea edi,[ebx-2] // edi = Length(Search string) - 2
mov esi,eax // esi = Search string
movzx ebx,byte ptr [eax] // bl = Search Character
@@Loop: // Compare 2 Characters per Loop
cmp bl,[edx]
je @@Char1Found
@@NotChar1:
cmp bl,[edx+1]
je @@Char2Found
@@NotChar2:
lea edx,[edx+2]
cmp edx,ecx // Next Start Position <= Max Start Position
jle @@Loop
pop ebp
pop edi
@@NotFound:
xor eax,eax // returns 0 if not found
pop edx
pop esi
pop ebx
ret
@@Char1Found:
mov ebp,edi // ebp = Length(Search string) - 2
@@Char1Loop:
movzx eax,word ptr [esi+ebp]
cmp ax,[edx+ebp] // Compare 2 Chars per Char1Loop (may include #0)
jne @@NotChar1
sub ebp,2
jnc @@Char1Loop
pop ebp
pop edi
jmp @@SetResult
@@Char2Found:
mov ebp,edi // ebp = Length(Search string) - 2
@@Char2Loop:
movzx eax,word ptr [esi+ebp]
cmp ax,[edx+ebp+1] // Compare 2 Chars per Char2Loop (may include #0)
jne @@NotChar2
sub ebp,2
jnc @@Char2Loop
pop ebp
pop edi
jmp @@CheckResult
@@SingleChar:
jl @@NotFound // Needed for Zero-Length Non-NIL Strings
movzx eax,byte ptr [eax] // Search Character
@@CharLoop:
cmp al,[edx]
je @@SetResult
cmp al,[edx+1]
je @@CheckResult
lea edx,[edx+2]
cmp edx,ecx
jle @@CharLoop
jmp @@NotFound
@@CheckResult: // Check within AnsiString
cmp edx,ecx
jge @@NotFound
add edx,1
@@SetResult:
pop ecx // @Str
pop esi
pop ebx
neg ecx
lea eax,[edx+ecx+1]
end;
{$endif UNICODE}
function StringReplaceAll(const S, OldPattern, NewPattern: string): string;
// fast replacement of StringReplace(S, OldPattern, NewPattern,[rfReplaceAll]);
procedure Process(j: integer);
var
i: integer;
begin
Result := '';
i := 1;
repeat
Result := Result + Copy(S, i, j - i) + NewPattern;
i := j + length(OldPattern);
j := PosEx(OldPattern, S, i);
if j = 0 then
begin
Result := Result + Copy(S, i, maxInt);
break;
end;
until false;
end;
var
j: integer;
begin
j := PosEx(OldPattern, S);
if j = 0 then
result := S
else
Process(j);
end;
const
StIdSymbols =
['_', '0'..'9', 'A'..'Z', 'a'..'z', 'À'..'ß', 'à'..'ÿ'];
_StIdSymbols =
['>', '<', '''', '"', '`', '!', '@', '#', '$', '%', '^', '&', '*', '/', '?'] + __Brackets + StIdSymbols + [#127..#255];
_AutoChangePunctuation: set of AnsiChar =
[' ', '`', '~', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '_', '-', '+', '=', ';', ':', '''', '"', '[', ']', '{', '}', ',', '.', '/', '?', '<', '>'];
function Max(x, y: integer): integer;
begin
if x > y then
Result := x
else
Result := y;
end;
function Min(x, y: integer): integer;
begin
if x < y then
Result := x
else
Result := y;
end;
function GetWordOnPosEx(const S: string; const P: integer; out iBeg, iEnd: integer): string;
begin
Result := '';
if (P > Length(S)) or (P < 1) then
exit;
iBeg := P;
if {$ifdef UNICODE} (S[P] < #255) and {$endif} (AnsiChar(S[P]) in Separators) then
if (P < 1) or ({$ifdef UNICODE}(S[P - 1] < #255) and {$endif} (AnsiChar(S[P - 1]) in Separators)) then
inc(iBeg)
else if {$ifdef UNICODE} (S[P - 1] > #255) or {$endif} not (AnsiChar(S[P - 1]) in Separators) then
dec(iBeg);
while iBeg >= 1 do
if {$ifdef UNICODE} (S[iBeg] < #255) and {$endif} (AnsiChar(S[iBeg]) in Separators) then
break
else
dec(iBeg);
inc(iBeg);
iEnd := P;
while iEnd <= Length(S) do
if {$ifdef UNICODE} (S[iEnd] < #255) and {$endif} (AnsiChar(S[iEnd]) in Separators) then
break
else
inc(iEnd);
if iEnd > iBeg then
Result := Copy(S, iBeg, iEnd - iBeg)
else
Result := S[P];
end;
var
CF_MEMOEX: integer = 0; // indicates MemoEx clipboard
function _CopyToClipboard(Handle: THandle; const SelText: string; FontCharset: TFontCharset): boolean;
var
Data: HGLOBAL;
_Text: PChar;
fmt: UINT;
begin
Result := false;
if SelText <> '' then
begin
Data := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, (length(SelText) + 1) * SizeOf(char));
if Data <> 0 then
begin
_Text := GlobalLock(Data);
if Assigned(_Text) then
begin
StrCopy(_Text, PChar(SelText));
GlobalUnlock(Data);
{$ifdef UNICODE}
fmt := CF_UNICODETEXT;
{$else}
if FontCharset = OEM_CHARSET then
fmt := CF_OEMTEXT
else
fmt := CF_TEXT;
{$endif}
if OpenClipboard(Handle) then
begin
EmptyClipboard;
SetClipboardData(fmt, Data);
SetClipboardData(CF_MEMOEX, 0); // indicates from MemoEx
CloseClipboard;
Result := true;
end
else
GlobalFree(Data);
end
else
GlobalFree(Data);
end;
end;
end;
function _PasteFromClipboard(Handle: THandle; FontCharset: TFontCharset;
{$ifdef CLIPBOARDPROTECT}const InternalClip: string; {$endif}
DeleteCRLF: boolean = true): string;
var
fmtText, fmtOEMText: boolean;
Data: HGLOBAL;
fmt: UINT;
_Text: PChar;
Txt: string;
i: integer;
begin
{$ifdef CLIPBOARDPROTECT} // ClipProtect will trunc clipboard to 2KB
if IsClipboardFormatAvailable(CF_MEMOEX) and (InternalClip <> '') then
begin
result := InternalClip;
exit;
end;
{$endif}
Result := '';
{$ifdef UNICODE}
fmtText := IsClipboardFormatAvailable(CF_UNICODETEXT);
fmtOEMText := IsClipboardFormatAvailable(CF_TEXT);
{$else}
fmtText := IsClipboardFormatAvailable(CF_TEXT);
fmtOEMText := IsClipboardFormatAvailable(CF_OEMTEXT);
{$endif}
if fmtText or fmtOEMText then
if OpenClipboard(Handle) then
begin
{$ifdef UNICODE}
if not fmtText then
fmt := CF_TEXT
else
fmt := CF_UNICODETEXT;
{$else}
if not fmtText then
fmt := CF_OEMTEXT
else
fmt := CF_TEXT;
{$endif}
Data := GetClipboardData(fmt);
if Data <> 0 then
begin
_Text := GlobalLock(Data);
if Assigned(_Text) then
begin
{$ifdef UNICODE}
if fmt = CF_TEXT then
Txt := _Text
else
Txt := UnicodeString(AnsiString(PAnsiChar(_Text)));
{$else}
Txt := _Text;
if (FontCharset = OEM_CHARSET) and (fmt = CF_TEXT) then
CharToOEM(PChar(Txt), PChar(Txt))
else if (FontCharset = DEFAULT_CHARSET) and (fmt = CF_OEMTEXT) then
OEMToChar(PChar(Txt), PChar(Txt));
{$endif}
if DeleteCRLF then
begin
i := 1;
while i <= length(Txt) do
if Ord(Txt[i]) in [10, 13] then
System.Delete(Txt, i, 1)
else
begin
if Txt[i] < ' ' then // prevent TAB bug
Txt[i] := ' ';
inc(i);
end;
end
else
for i := 1 to length(Txt) do
if ord(Txt[i]) in [1..9, 11, 12, 14..31] then // prevent TAB bug
Txt[i] := ' ';
Result := Txt;
GlobalUnlock(Data);
end;
end;
CloseClipboard;
end;
end;
function GetWordOnPos(const S: string; const P: integer): string;
var
i, Beg: integer;
begin
Result := '';
if (P > Length(S)) or (P < 1) then
exit;
for i := P downto 1 do
if {$ifdef UNICODE} (S[i] < #255) and {$endif} (AnsiChar(S[i]) in Separators) then
break;
Beg := i + 1;
for i := P to Length(S) do
if {$ifdef UNICODE} (S[i] < #255) and {$endif} (AnsiChar(S[i]) in Separators) then
break;
if i > Beg then
Result := Copy(S, Beg, i - Beg)
else
Result := S[P];
end;
function SubStr(const S: string; const index: integer; const Separator: string): string;
// used on word completion
var
i: integer;
pB, pE: PChar;
begin
Result := '';
if (index < 0) or ((index = 0) and (Length(S) > 0) and (S[1] = Separator)) then
exit;
pB := PChar(S);
for i := 1 to index do
begin
pB := StrPos(pB, PChar(Separator));
if pB = nil then
exit;
pB := pB + Length(Separator);
end;
pE := StrPos(pB + 1, PChar(Separator));
if pE = nil then
pE := PChar(S) + Length(S);
if not (StrLIComp(pB, PChar(Separator), Length(Separator)) = 0) then
SetString(Result, pB, pE - pB);
end;
function KeyPressed(VK: integer): boolean;
begin
Result := GetKeyState(VK) and $8000 = $8000;
end;
{ TRAControlScrollBar95 }
constructor TRAControlScrollBar95.Create;
begin
FPage := 1;
FSmallChange := 1;
FLargeChange := 1;
end;
const
SBKIND: array[TScrollBarKind] of integer = (SB_HORZ, SB_VERT);
procedure TRAControlScrollBar95.SetParams(AMin, AMax, APosition, APage: integer);
var
SCROLLINFO: TSCROLLINFO;
begin
if AMax < AMin then
raise EInvalidOperation.Create(SScrollBarRange);
if APosition < AMin then
APosition := AMin;
if APosition > AMax then
APosition := AMax;
if Handle > 0 then
begin
with SCROLLINFO do
begin
cbSize := sizeof(TSCROLLINFO);
fMask := SIF_DISABLENOSCROLL;
if (AMin >= 0) or (AMax >= 0) then
fMask := fMask or SIF_RANGE;
if APosition >= 0 then
fMask := fMask or SIF_POS;
if APage >= 0 then
fMask := fMask or SIF_PAGE;
nPos := APosition;
nMin := AMin;
nMax := AMax;
nPage := APage;
end;
SetScrollInfo(Handle, // handle of window with scroll bar
SBKIND[Kind], // scroll bar flag
SCROLLINFO, // pointer to structure with scroll parameters
true // redraw flag
);
end;
end;
procedure TRAControlScrollBar95.SetParam(index, Value: Integer);
begin
case index of
0:
FMin := Value;
1:
FMax := Value;
2:
FPosition := Value;
3:
FPage := Value;
end;
if FMax < FMin then
raise EInvalidOperation.Create(SScrollBarRange);
if FPosition < FMin then
FPosition := FMin;
if FPosition > FMax then
FPosition := FMax;
SetParams(FMin, FMax, FPosition, FPage);
end;
procedure TRAControlScrollBar95.DoScroll(var Message: TWMScroll);
var
ScrollPos: Integer;
NewPos: Longint;
ScrollInfo: TScrollInfo;
begin
with Message do
begin
NewPos := FPosition;
case TScrollCode(ScrollCode) of
scLineUp:
Dec(NewPos, FSmallChange);
scLineDown:
Inc(NewPos, FSmallChange);
scPageUp:
Dec(NewPos, FLargeChange);
scPageDown:
Inc(NewPos, FLargeChange);
scPosition, scTrack:
with ScrollInfo do
begin
cbSize := SizeOf(ScrollInfo);
fMask := SIF_ALL;
GetScrollInfo(Handle, SBKIND[Kind], ScrollInfo);
NewPos := nTrackPos;
end;
scTop:
NewPos := FMin;
scBottom:
NewPos := FMax;
end;
if NewPos < FMin then
NewPos := FMin;
if NewPos > FMax then
NewPos := FMax;
ScrollPos := NewPos;
Scroll(TScrollCode(ScrollCode), ScrollPos);
end;
Position := ScrollPos;
end;
procedure TRAControlScrollBar95.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
if Assigned(FOnScroll) then
FOnScroll(Self, ScrollCode, ScrollPos);
end;
{$IFDEF MEMOEX_UNDO}
type
TCaretUndo = class(TUndo)
private
FCaretX, FCaretY: integer;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer);
procedure Undo; override;
procedure Redo; override;
end;
TInsertUndo = class(TCaretUndo)
private
FText: string;
FOffset, FParaOffset: integer;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer; const AText: string);
procedure Undo; override;
end;
TReLineUndo = class(TInsertUndo);
TInsertTabUndo = class(TInsertUndo);
TOverwriteUndo = class(TCaretUndo)
private
FOldText, FNewText: string;
FOffset: integer;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer; const AOldText, ANewText: string);
procedure Undo; override;
end;
TDeleteUndo = class(TInsertUndo)
public
procedure Undo; override;
end;
TDeleteTrailUndo = class(TDeleteUndo);
TBackspaceUndo = class(TDeleteUndo)
public
procedure Undo; override;
end;
TReplaceUndo = class(TCaretUndo)
private
FBeg, FEnd: integer;
FText, FNewText: string;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer; const ABeg, AEnd: integer; const AText, ANewText: string);
procedure Undo; override;
end;
TDeleteSelectedUndo = class(TDeleteUndo)
private
FSelBlock: boolean; { vertical block }
FSelBegX, FSelBegY, FSelEndX, FSelEndY, FSelOffs: integer;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer; const AText: string; const ASelBlock: boolean; const ASelBegX, ASelBegY, ASelEndX, ASelEndY, ASelOffs: integer);
procedure Undo; override;
end;
TSelectUndo = class(TCaretUndo)
private
FSelBlock: boolean; { vertical block }
FSelBegX, FSelBegY, FSelEndX, FSelEndY: integer;
public
constructor Create(const AMemoEx: TCustomMemoEx; const ACaretX, ACaretY: integer; const ASelBlock: boolean; const ASelBegX, ASelBegY, ASelEndX, ASelEndY: integer);
procedure Undo; override;
end;
TUnselectUndo = class(TSelectUndo);
TBeginCompoundUndo = class(TUndo)
public
procedure Undo; override;
end;
TEndCompoundUndo = class(TBeginCompoundUndo);
{$ENDIF MEMOEX_UNDO}
procedure Err;
begin
MessageBeep(0);
end;
function FindNotBlankCharPos(const S: string): integer;
begin
for result := 1 to Length(S) do
if S[result] <> ' ' then
Exit;
Result := 1;
end;
function ANSIChangeCase(const S: string): string;
var
i: integer;
Up: char;
begin
Result := S;
for i := 1 to Length(Result) do
begin
Up := upcase(Result[i]);
if Result[i] = Up then
Result[i] := chr(ord(Result[i]) + 32)
else
Result[i] := Up;
end;
end;
type
{$ifdef CPU64}
PPtrInt = ^Int64;
{$else}
PPtrInt = ^integer;
{$endif}
function StringDynArrayGetSize(V: PPtrInt; n: integer): integer;
// Siz := StringDynArrayGetSize(pointer(FStrings),FCount);
var
i: integer;
begin
result := 0;
for i := 1 to n do begin
if V^ <> 0 then // very fast inc(Result, length(FStrings[i-1])
inc(result, PInteger(V^ - 4)^);
inc(V);
end;
end;
function StringDynArrayToPChar(V: PPtrInt; n: integer; P: PChar): PChar;
// StringDynArrayToPChar(pointer(FStrings),FCount,pointer(Result))
var
i, Size: integer;
begin
for i := 1 to n do begin
if V^ <> 0 then
begin
size := PInteger(V^ - 4)^;
move(pointer(V^)^, P^, size * SizeOf(char));
inc(P, size);
end;
inc(V);
end;
result := P;
end;
{ TEditorStrings }
procedure TEditorStrings.LoadFromFile(const FileName: string);
begin
BeginUpdate;
inherited LoadFromFile(FileName);
if Assigned(FOnAfterLoad) then
FOnAfterLoad(FMemoEx);
EndUpdate;
end;
procedure TEditorStrings.SaveToFile(const FileName: string);
begin
if Assigned(FOnBeforeSave) then
FOnBeforeSave(FMemoEx);
inherited SaveToFile(FileName);
end;
procedure TEditorStrings.Recount(Index: integer);
var
i: integer;
begin
if FCount = 0 then
exit;
if Index = 0 then
begin
FList[0].FPreCount := 0;
inc(Index);
end;
for i := Index to FCount - 1 do
with FList[i - 1] do
FList[i].FPreCount := FPreCount + FCount;
end;
procedure TEditorStrings.Index2ParaIndex(Index: integer; out Para, ParaIndex: integer);
var
L, H, I: integer;
begin
if (not FMemoEx.FWordWrap) or (FParaLinesCount = FCount) then
begin
Para := Index;
if Para > FCount - 1 then
Para := FCount - 1;
ParaIndex := 0;
end
else
begin
{ fast find paragraph index using MinMax (binary search) algo }
Para := -1;
ParaIndex := -1;
L := 0;
H := FCount - 1;
while L <= H do
begin
I := (L + H) shr 1;
with FList[I] do
if Index > FPreCount + FCount - 1 then
L := I + 1
else
begin
H := I - 1;
if (Index <= FPreCount + FCount - 1) and (Index >= FPreCount) then
begin // found
Para := I;
ParaIndex := Index - FPreCount;
break;
end;
end;
end;
end;
end;
procedure ListIndexError(Index: integer);
// outside procedure -> no temp string -> less heap
function ReturnAddr: Pointer;
asm
MOV EAX, [EBP + 4]
end;
begin
raise EStringListError.CreateFmt(SListIndexError, [Index]) at ReturnAddr;
end;
function TEditorStrings.GetParagraphByIndex(Index: integer; out ParaIndex, IndexOffs: integer): string;
var
_P, _PI: integer;
begin
IndexOffs := 0;
ParaIndex := 0;
Result := '';
Index2ParaIndex(Index, _P, _PI);
if (_P = -1) or (_PI = -1) then
ListIndexError(Index);
ParaIndex := _P;
result := _GetString(_P);
IndexOffs := StringDynArrayGetSize(pointer(FList[_P].FStrings), _PI);
end;
procedure TEditorStrings.Caret2Paragraph(X, Y: integer; out ParaIndex, IndexOffs: integer);
var
_P, _PI: integer;
begin
ParaIndex := 0;
IndexOffs := 0;
Index2ParaIndex(Y, _P, _PI);
if (_P = -1) or (_PI = -1) then
ListIndexError(Y);
ParaIndex := _P;
IndexOffs := X + StringDynArrayGetSize(pointer(FList[_P].FStrings), _PI);
end;
procedure TEditorStrings.Paragraph2Caret(ParaIndex, IndexOffs: integer; out X, Y: integer);
var
i, j, k: integer;
found: boolean;
begin
X := 0;
Y := ParaIndex;
found := false;
k := 0;
for i := 0 to FCount - 1 do
with Flist[i] do
begin
if i >= Y then
begin
for j := 0 to FCount - 1 do
begin
inc(X, length(FStrings[j]));
if X >= IndexOffs then
begin
found := true;
Y := k + j;
X := IndexOffs - (X - length(FStrings[j]));
break;
end;
end;
if found then
break;
end;
inc(k, FCount);
end;
if not found then
begin
if X > 0 then
begin
Y := k;
X := length(FList[Y].FStrings[FList[Y].FCount - 1]);
exit;
end;
Y := FCount - 1;
if Y >= 0 then
X := length(FList[Y].FStrings[FList[Y].FCount - 1])
else
begin
X := 0;
Y := 0;
end;
end;
end;
function TEditorStrings.GetParaOffs(ParaIndex: integer): integer;
var
i: integer;
begin
Result := ParaIndex * 2;
for i := 0 to ParaIndex - 1 do
with FList[i] do
inc(Result, StringDynArrayGetSize(pointer(FStrings), FCount));
end;
procedure TEditorStrings.ReformatParagraph(ParaIndex: integer);
var // full rewrite by AB: much faster and use less ram
s: string;
c, d, b: PChar;
L: integer;
begin
with FList[ParaIndex] do
begin
dec(FParaLinesCount, FCount);
FPreCount := 0;
if FMemoEx.FWordWrap then
begin
s := _GetString(ParaIndex); // whole paragraph text in s
L := FMemoEx.FRightMargin;
if length(s) <= L then
begin
if FCount > 1 then
begin
SetLength(FStrings, 1);
FCount := 1;
FStrings[0] := s;
end;
end
else
begin
FCount := 0;
c := @s[1]; // UniqueString() because we change FStrings[0] below
d := c;
b := c;
while (c^ <> #0) do
begin
if c^ = ' ' then
b := c; // b = last ' '
if ((c - d) >= L) then
begin
inc(FCount);
if FCount >= length(FStrings) then
Setlength(FStrings, FCount + 10);
if b = d then
b := d + L; // if no ' '
SetString(FStrings[FCount - 1], d, b - d + 1);
c := b + 1;
b := c;
d := c;
if c^ = #0 then
break;
end;
inc(c);
end;
if d <> c then
begin // append last chars (if any) as last line
inc(FCount);
SetString(FStrings[FCount - 1], d, c - d);
end;
Setlength(FStrings, FCount); // set exact line count
end;
end
else if FCount > 1 then
begin // something to reformat only if FCount>1
s := _GetString(ParaIndex);
SetLength(FStrings, 1);
FCount := 1;
FStrings[0] := s;
end;
inc(FParaLinesCount, FCount);
end;
end;
procedure TEditorStrings.Reformat;
var
i: integer;
begin
for i := 0 to FCount - 1 do
ReformatParagraph(i);
Recount(0);
Changed;
end;
procedure TEditorStrings.CheckLength(const st: string);
begin
if length(st) > FMemoEx.Max_X then
FMemoEx.SetMax_X(length(st) + 1);
end;
constructor TEditorStrings.Create;
begin
inherited Create;
FParaLinesCount := 0;
FOnAfterLoad := nil;
FOnBeforeSave := nil;
end;
destructor TEditorStrings.Destroy;
begin
// FOnChange := nil;
FOnChanging := nil;
inherited Destroy;
end;
function TEditorStrings.Add(const S: string): integer;
begin
Result := FCount;
InsertItem(Result, S);
end;
procedure TEditorStrings.Delete(Index: integer);
begin
if (Index < 0) or (Index >= FCount) then
ListIndexError(Index);
Changing;
dec(FParaLinesCount, FList[Index].FCount);
Dec(FCount);
Finalize(FList[Index]); // avoid memory bug: release deleted FStrings
if Index < FCount then
begin
System.Move(FList[Index + 1], FList[Index], (FCount - Index) * SizeOf(TParagraph));
FillChar(FList[FCount], sizeof(TParagraph), 0); // avoid memory bug
Recount(Index);
end;
Changed;
end;
procedure TEditorStrings.Insert(Index: integer; const S: string);
begin
if (Index < 0) or (Index > FCount) then
ListIndexError(Index);
InsertItem(Index, S);
end;
procedure TEditorStrings.InsertItem(Index: integer; const S: string);
begin
Changing;
if FCount = length(FList) then
Grow;
if Index < FCount then
System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(TParagraph));
fillchar(FList[Index], sizeof(TParagraph), 0); // avoid memory bug
Inc(FCount);
AddParaStr(Index, S);
Changed;
end;
{$WARNINGS OFF}
function TEditorStrings.AddParaStr(ParaIndex: integer; const S: string): integer;
begin
if (ParaIndex < 0) or (ParaIndex >= FCount) then
ListIndexError(ParaIndex);
with FList[ParaIndex] do
begin
inc(FCount);
inc(FParaLinesCount);
SetLength(FStrings, FCount);
FStrings[FCount - 1] := S;
CheckLength(S);
end;
ReformatParagraph(ParaIndex);
Recount(ParaIndex);
Changed;
end;
{$WARNINGS ON}
procedure TEditorStrings.Changed;
begin
if (csLoading in FMemoEx.ComponentState) then
exit;
if FMemoEx.FUpdateLock = 0 then
begin
FMemoEx.TextAllChanged;
if Assigned(FMemoEx.FOnChange) then
FMemoEx.FOnChange(Self);
end;
end;
procedure TEditorStrings.Changing;
begin
if (FMemoEx.FUpdateLock = 0) and Assigned(FOnChanging) then
FOnChanging(Self);
end;
procedure TEditorStrings.Clear;
begin
if FCount <> 0 then
begin
Changing;
FCount := 0;
FParaLinesCount := 0;
Finalize(FList); // free all memory
Changed;
end;
fMemoEx.SetCaret(0, 0);
end;
procedure TEditorStrings.BeginUpdate;
begin
inc(FMemoEx.FUpdateLock);
end;
procedure TEditorStrings.EndUpdate;
begin
dec(FMemoEx.FUpdateLock);
Changed;
end;
function TEditorStrings._GetString(ParaIndex: integer): string;
begin
with FList[ParaIndex] do
if FCount > 1 then
begin
SetString(Result, nil, StringDynArrayGetSize(pointer(FStrings), FCount));
StringDynArrayToPChar(pointer(FStrings), FCount, pointer(Result));
end
else
result := FStrings[0];
end;
function TEditorStrings.Get(Index: integer): string;
begin
if cardinal(Index) >= cardinal(FCount) then
ListIndexError(Index);
Result := _GetString(Index);
end;
function TEditorStrings.GetParagraph(Index: integer): PParagraph;
begin
if cardinal(Index) >= cardinal(FCount) then
ListIndexError(Index);
Result := @FList[Index];
end;
function TEditorStrings.GetParaString(Index: integer): string;
var
_P, _PI: integer;
begin
if not FMemoEx.FWordWrap or (FParaLinesCount = FCount) then
Result := Get(Index)
else
begin
Index2ParaIndex(Index, _P, _PI);
if (_P = -1) or (_PI = -1) then
ListIndexError(Index);
Result := FList[_P].FStrings[_PI];
end;
end;
procedure TEditorStrings.Grow;
var
Delta: integer;
begin
Delta := length(FList);
if Delta > 64 * 4 then
inc(Delta, Delta shr 2)
else
inc(Delta, 64); // AB
SetLength(FList, Delta);
end;
procedure TEditorStrings._PutString(ParaIndex: integer; const S: string);
var
old_count, old_precount: integer;
begin
old_count := FList[ParaIndex].FCount;
old_precount := FList[ParaIndex].FPreCount;
dec(FParaLinesCount, FList[ParaIndex].FCount);
with FList[ParaIndex] do
begin
FCount := 1;
SetLength(FStrings, 1);
FStrings[0] := S;
FObject := nil;
end;
inc(FParaLinesCount);
ReformatParagraph(ParaIndex);
if old_count <> FList[ParaIndex].FCount then
Recount(ParaIndex)
else
FList[ParaIndex].FPreCount := old_precount;
end;
procedure TEditorStrings.Put(Index: integer; const S: string);
begin
if (Index < 0) or (Index >= FCount) then
ListIndexError(Index);
CheckLength(S);
Changing;
_PutString(Index, S);
Changed;
end;
procedure TEditorStrings.PutObject(Index: Integer; AObject: TObject);
begin
if (Index < 0) or (Index >= FCount) then
ListIndexError(Index);
FList[Index].FObject := AObject;
end;
function TEditorStrings.GetObject(Index: Integer): TObject;
begin
if (Index < 0) or (Index >= FCount) then
ListIndexError(Index);
result := FList[Index].FObject;
end;
procedure TEditorStrings.PutParaString(Index: integer; const S: string);
var
_P, _PI: integer;
old_count, old_precount: integer;
begin
if not FMemoEx.FWordWrap then
Put(Index, S)
else
begin
Index2ParaIndex(Index, _P, _PI);
if (_P = -1) or (_PI = -1) then
ListIndexError(Index);
Changing;
old_count := FList[_P].FCount;
old_precount := FList[_P].FPreCount;
CheckLength(S);
FList[_P].FStrings[_PI] := S;
ReformatParagraph(_P);
if old_count <> FList[_P].FCount then
Recount(_P)
else
FList[_P].FPreCount := old_precount;
Changed;
end;
end;
procedure TEditorStrings.SetUpdateState(Updating: Boolean);
begin
if Updating then
Changing
else
Changed;
end;
procedure TEditorStrings.SetTextStr(const Value: string);
begin
inc(FMemoEx.FUpdateLock);
inherited SetTextStr(Value);
dec(FMemoEx.FUpdateLock);
if FMemoEx.FUpdateLock = 0 then
begin
{$IFDEF MEMOEX_EDITOR} FMemoEx.CantUndo; {$ENDIF MEMOEX_EDITOR}
FMemoEx.TextAllChanged;
FMemoEx.SetCaretInternal(0, 0);
end;
end;
procedure TEditorStrings.ReLine;
// complete line with spaces if caret X is after real chars
var
L: integer;
begin
inc(FMemoEx.FUpdateLock);
try
{$IFDEF MEMOEX_UNDO}
if FParaLinesCount = 0 then
L := FMemoEx.FCaretX
else
L := Length(ParaStrings[FParaLinesCount - 1]);
while FMemoEx.FCaretY > FParaLinesCount - 1 do
begin
if FParaLinesCount > 0 then
TReLineUndo.Create(FMemoEx, L, FMemoEx.FCaretY, #13#10);
L := 0;
Add('');
end;
{$ENDIF MEMOEX_UNDO}
if FMemoEx.FCaretX > Length(ParaStrings[FMemoEx.FCaretY]) then
begin
L := FMemoEx.FCaretX - Length(ParaStrings[FMemoEx.FCaretY]);
{$IFDEF MEMOEX_UNDO}
TReLineUndo.Create(FMemoEx, Length(ParaStrings[FMemoEx.FCaretY]), FMemoEx.FCaretY, StringOfChar(' ', L));
{$ENDIF MEMOEX_UNDO}
PutParaString(FMemoEx.FCaretY, ParaStrings[FMemoEx.FCaretY] + StringOfChar(' ', L));
end;
finally
dec(FMemoEx.FUpdateLock);
end;
end; { ReLine }
procedure TEditorStrings.SetLockText(const Text: string);
begin
inc(FMemoEx.FUpdateLock);
try
inherited SetTextStr(Text);
finally
dec(FMemoEx.FUpdateLock);
end;
end;
procedure TEditorStrings.SetInternalParaStr(Index: integer; const Value: string);
begin
inc(FMemoEx.FUpdateLock);
try
PutParaString(Index, Value);
finally
dec(FMemoEx.FUpdateLock);
end;
end;
procedure TEditorStrings.SetInternal(Index: integer; const Value: string);
begin
inc(FMemoEx.FUpdateLock);
try
Put(Index, Value);
finally
dec(FMemoEx.FUpdateLock);
end;
end;
function TEditorStrings.GetTextStr: string;
var
i, sizetot: integer;
P: PChar;
begin
// result := inherited GetTextStr; exit; 8 times slower than code below
SizeTot := GetTextLength;
Setlength(Result, Sizetot);
P := Pointer(Result);
for i := 0 to FCount - 1 do
with FList[i] do
begin
P := StringDynArrayToPChar(pointer(FStrings), FCount, P); // line
{$ifdef UNICODE}
pCardinal(P)^ := $000A000D;
{$else}
pWord(P)^ := $0A0D;
{$endif}
inc(P, 2); // CRLF
end;
assert((p - pointer(result)) = sizeTot);
end;
function TEditorStrings.GetCount: Integer;
begin
result := FCount;
end;
function TEditorStrings.GetTextLength: integer;
var
i: integer;
begin
Result := FCount * 2; // CRLF char size
for i := 0 to FCount - 1 do
with FList[i] do
inc(Result, StringDynArrayGetSize(pointer(FStrings), FCount));
end;
function TEditorStrings.HasText: boolean;
var
i: integer;
begin
result := true;
for i := 0 to FCount - 1 do
with FList[i] do
if StringDynArrayGetSize(pointer(FStrings), FCount) <> 0 then
exit;
result := false;
end;
{ TEditorClient }
function TEditorClient.GetCanvas: TCanvas;
begin
Result := FMemoEx.Canvas;
end;
function TEditorClient.Left: integer;
begin
Result := FMemoEx.GutterWidth + GutterRightMargin;
end;
function TEditorClient.Height: integer;
begin
Result := FMemoEx.ClientHeight;
end;
function TEditorClient.Width: integer;
begin
Result := Max(FMemoEx.ClientWidth - Left, 0);
end;
function TEditorClient.ClientWidth: integer;
begin
Result := Width;
end;
function TEditorClient.ClientHeight: integer;
begin
Result := Height;
end;
function TEditorClient.ClientRect: TRect;
begin
Result := Bounds(Left, Top, Width, Height);
end;
function TEditorClient.BoundsRect: TRect;
begin
Result := Bounds(0, 0, Width, Height);
end;
procedure TGutter.Invalidate;
begin
Paint;
end;
procedure TGutter.Paint;
var
Rect: TRect;
begin
with FMemoEx, Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := FGutterColor;
Rect.Left := 0;
Rect.Top := EditorClient.Top;
Rect.Right := GutterWidth;
Rect.Bottom := Rect.Top + EditorClient.Height;
FillRect(Rect);
Pen.Width := 1;
Pen.Color := Color;
MoveTo(GutterWidth - 2, EditorClient.Top);
LineTo(GutterWidth - 2, EditorClient.Top + EditorClient.Height);
Pen.Width := 2;
MoveTo(GutterWidth + 1, EditorClient.Top);
LineTo(GutterWidth + 1, EditorClient.Top + EditorClient.Height);
Pen.Width := 1;
Pen.Color := clGray;
MoveTo(GutterWidth - 1, EditorClient.Top);
LineTo(GutterWidth - 1, EditorClient.Top + EditorClient.Height);
end;
with FMemoEx do
GutterPaint(Canvas, Rect);
end;
constructor TCustomMemoEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csClickEvents {, csOpaque}, csDoubleClicks, csReplicatable];
FInsertMode := true;
FReadOnly := false;
FWantTabs := true;
FLines := TEditorStrings.Create;
FLines.FMemoEx := Self;
FKeyboard := TKeyboard.Create;
FRows := 1;
FCols := 1;
{$IFDEF MEMOEX_UNDO}
FUndoBuffer := TUndoBuffer.Create;
FUndoBuffer.FMemoEx := Self;
FGroupUndo := true;
{$ENDIF MEMOEX_UNDO}
FDrawBitmap := TBitmap.Create;
FFont := TFont.Create;
with FFont do
begin
if Screen.Fonts.IndexOf('Consolas')>=0 then
begin
Name := 'Consolas';
Size := 9;
end
else
begin
Name := 'Courier New';
Size := 10;
end;
Pitch := fpFixed;
OnChange := FontChanged;
end;
FRightMarginVisible := true;
FRightMargin := 80;
FBorderStyle := bsSingle;
Ctl3d := true;
Height := 40;
Width := 150;
ParentColor := false;
Cursor := crIBeam;
TabStop := true;
FTabStops := '8';
FSmartTab := true;
FBackSpaceUnindents := true;
FAutoIndent := true;
FKeepTrailingBlanks := false;
FCursorBeyondEOF := false;
FCursorBeyondEOL := true;
FWordWrap := true;
FScrollBars := ssBoth;
scbHorz := TRAControlScrollBar95.Create;
scbVert := TRAControlScrollBar95.Create;
scbVert.Kind := sbVertical;
scbHorz.OnScroll := ScrollBarScroll;
scbVert.OnScroll := ScrollBarScroll;
Color := clWindow;
FGutterColor := clBtnFace;
FclSelectBC := clHighLight;
FclSelectFC := clHighLightText;
FRightMarginColor := clSilver;
EditorClient := TEditorClient.Create;
EditorClient.FMemoEx := Self;
FGutter := TGutter.Create;
FGutter.FMemoEx := Self;
FLeftCol := 0;
FTopRow := 0;
FSelected := false;
FCaretX := 0;
FCaretY := 0;
timerScroll := TTimer.Create(Self);
timerScroll.Enabled := false;
timerScroll.Interval := 100;
timerScroll.OnTimer := ScrollTimer;
SelAttrs_Size := 0;
FTabPos := nil;
SetMax_X(512);
mouse_down := false;
double_clicked := false;
mouse_dragged := false;
{$IFDEF MEMOEX_EDITOR}
{$IFDEF MEMOEX_DEFLAYOUT}
FKeyboard.SetDefLayout;
{$ENDIF MEMOEX_DEFLAYOUT}
{$IFDEF MEMOEX_COMPLETION}
FCompletion := TCompletion.Create2(Self);
{$ENDIF MEMOEX_COMPLETION}
{$ENDIF MEMOEX_EDITOR}
end;
destructor TCustomMemoEx.Destroy;
begin
FLines.Free;
scbHorz.Free;
scbVert.Free;
EditorClient.Free;
FKeyboard.Free;
{$IFDEF MEMOEX_EDITOR}
{$IFDEF MEMOEX_COMPLETION}
FCompletion.Free;
{$ENDIF MEMOEX_COMPLETION}
{$ENDIF MEMOEX_EDITOR}
FGutter.Free;
FDrawBitmap.Free;
FFont.Free;
SelAttrs := nil;
FTabPos := nil;
{$IFDEF MEMOEX_UNDO}
FreeAndNil(FUndoBuffer);
{$ENDIF MEMOEX_UNDO}
inherited Destroy;
end;
procedure TCustomMemoEx.Invalidate;
begin
if (csLoading in ComponentState) then
exit;
if FUpdateLock = 0 then
inherited;
end;
procedure TCustomMemoEx.Loaded;
begin
inherited Loaded;
scbVertWidth := GetSystemMetrics(SM_CXVSCROLL);
scbHorzHeight := GetSystemMetrics(SM_CYHSCROLL);
NextClipViewer := SetClipboardViewer(Handle);
UpdateEditorSize;
Changed;
SelectionChanged;
ClipboardChanged;
FModified := false;
{$IFDEF MEMOEX_COMPLETION}
FCompletion.UpdateAutoChange;
{$ENDIF}
end;
procedure TCustomMemoEx.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of cardinal = (0, WS_BORDER);
ScrollStyles: array[TScrollStyle] of cardinal = (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or BorderStyles[FBorderStyle] or ScrollStyles[FScrollBars];
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TCustomMemoEx.Resize;
begin
if not (csLoading in ComponentState) then
begin
UpdateEditorSize(true, false);
Invalidate;
end;
end;
procedure TCustomMemoEx.CreateWnd;
begin
inherited CreateWnd;
if FScrollBars in [ssHorizontal, ssBoth] then
scbHorz.Handle := Handle;
if FScrollBars in [ssVertical, ssBoth] then
scbVert.Handle := Handle;
FAllRepaint := true;
end;
procedure TCustomMemoEx.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
procedure TCustomMemoEx.PaintSelection;
var
iR: integer;
begin
for iR := FUpdateSelBegY to FUpdateSelEndY do
PaintLine(iR, -1, -1);
end;
procedure TCustomMemoEx.SetUnSelected;
begin
if FSelected then
begin
FSelectedText := false;
{$IFDEF MEMOEX_UNDO}
TUnselectUndo.Create(Self, FCaretX, FCaretY, FSelBlock, FSelBegX, FSelBegY, FSelEndX, FSelEndY);
{$ENDIF MEMOEX_UNDO}
PaintSelection;
end;
end;
function IsRectEmpty(R: TRect): boolean;
begin
Result := (R.Top = R.Bottom) and (R.Left = R.Right);
end;
function TCustomMemoEx.CalcCellRect(const X, Y: integer): TRect;
begin
Result := Bounds(EditorClient.Left + X * FCellRect.Width + 1, EditorClient.Top + Y * FCellRect.Height, FCellRect.Width, FCellRect.Height)
end;
procedure TCustomMemoEx.Paint;
var
iR: integer;
ECR: TRect;
BX, EX, BY, EY: integer;
begin
if FUpdateLock > 0 then
exit;
{$IFDEF MEMOEX_NOOPTIMIZE}
FAllRepaint := true;
{$ENDIF}
PaintCaret(false);
ECR := EditorClient.Canvas.ClipRect;
OffsetRect(ECR, -FGutterWidth, 0);
if FAllRepaint then
ECR := EditorClient.BoundsRect;
BX := ECR.Left div FCellRect.Width - 1;
EX := ECR.Right div FCellRect.Width + 1;
BY := ECR.Top div FCellRect.Height;
EY := ECR.Bottom div FCellRect.Height + 1;
for iR := BY to EY do
PaintLine(FTopRow + iR, FLeftCol + BX, FLeftCol + EX);
PaintCaret(true);
FGutter.Paint;
FAllRepaint := false;
end;
procedure TCustomMemoEx.BeginUpdate;
begin
if self = nil then
exit;
inc(FUpdateLock);
end;
procedure TCustomMemoEx.EndUpdate;
begin
if self = nil then
exit;
if FUpdateLock = 0 then
Exit; { Error ? }
dec(FUpdateLock);
if FUpdateLock = 0 then
begin
FAllRepaint := true;
UpdateEditorSize(false);
Changed;
StatusChanged;
Invalidate;
end;
end;
{ FTabPos... }
procedure TCustomMemoEx.SetMax_X(const Value: integer);
begin
Max_X := Value;
SetLength(FTabPos, Max_X);
end;
{
FullUpdate
}
procedure TCustomMemoEx.UpdateEditorSize(const FullUpdate: boolean = true; const RepaintGutter: boolean = true);
const
BiggestSymbol = 'W';
var
Size: TSize;
begin
if (csLoading in ComponentState) then
exit;
if FullUpdate then
begin
EditorClient.Canvas.Font := Font;
EditorClient.Canvas.Font.Style := [fsBold, fsItalic];
Size := EditorClient.Canvas.TextExtent(BiggestSymbol);
FCellRect.Width := Max(1, Size.cx);
FCellRect.Height := Max(1, Size.cy);
EditorClient.Canvas.Font := Font;
FDrawBitmap.Canvas.Font.Assign(Font);
FDrawBitmap.Canvas.Brush.Assign(EditorClient.Canvas.Brush);
FDrawBitmap.Width := Width;
FDrawBitmap.Height := FCellRect.Height;
end;
FVisibleColCount := Trunc(EditorClient.ClientWidth / FCellRect.Width);
FVisibleRowCount := Trunc(EditorClient.ClientHeight / FCellRect.Height);
FLastVisibleCol := FLeftCol + FVisibleColCount - 1;
FLastVisibleRow := FTopRow + FVisibleRowCount - 1;
FCols := -1;
FRows := -1;
Rows := FLines.ParaLineCount;
if FWordWrap then
Cols := FRightMargin
else
Cols := Max_X;
if RepaintGutter then
FGutter.Invalidate;
end;
procedure TCustomMemoEx.PaintLine(const Line: integer; ColBeg, ColEnd: integer);
var
Ch: string;
R: TRect;
F, k, x, i, j, iC, jC, SL, MX, PX, PY: integer;
T, S: string;
FAttrs: TLineAttrs;
LA, LB: TLineAttr;
begin
if (Line < FTopRow) or (Line > FTopRow + FVisibleRowCount) or (FUpdateLock > 0) then
exit;
if ColBeg < FLeftCol then
ColBeg := FLeftCol;
if (ColEnd < 0) or (ColEnd > FLeftCol + FVisibleColCount) then
ColEnd := FLeftCol + FVisibleColCount;
ColEnd := Min(ColEnd, Max_X - 1);
j := 0;
i := ColBeg;
if (Line > -1) and (Line < FLines.ParaLineCount) then
with FDrawBitmap do
begin
T := FLines.GetParagraphByIndex(Line, PY, PX);
S := FLines.ParaStrings[Line];
if not FWordWrap then
begin
iC := ColBeg;
jC := ColEnd;
end
else
begin
iC := 0;
jC := length(T);
end;
GetLineAttr(PY, Line, PX, length(S), iC, jC, T, FAttrs);
Canvas.Brush.Color := Color;
Canvas.FillRect(Bounds(EditorClient.Left, 0, 1, FCellRect.Height));
SL := Length(S);
if SL > ColEnd then
MX := ColEnd
else
MX := SL;
if FStripInvisible and FReadOnly and (ColBeg > 0) then
begin
x := PX + ColBeg;
if x >= SelAttrs_Size then
x := SelAttrs_Size - 1;
for k := PX to x do
if FAttrs[k].FC = FAttrs[k].BC then
inc(j);
end;
while i < MX do
with Canvas do
begin
iC := i + 1;
jC := iC + 1;
if iC <= SL then
Ch := S[iC]
else
Ch := ' ';
if (iC + PX > SelAttrs_Size) or (jC + PX > SelAttrs_Size) then
break;
LA := FAttrs[iC + PX - 1];
if SelAttrs[iC + PX - 1] then
with LA do
begin
FC := FclSelectFC;
BC := FclSelectBC;
end;
while (jC <= MX) and (jC + PX <= SelAttrs_Size) do
begin
// append chars with same attrs into Ch
LB := FAttrs[jC + PX - 1];
if SelAttrs[jC + PX - 1] then
with LB do
begin
FC := FclSelectFC;
BC := FclSelectBC;
end;
if (LA.FC = LB.FC) and (LA.BC = LB.BC) and (LA.LastInteger = LB.LastInteger) then
begin
if jC <= SL then
Ch := Ch + S[jC]
else
Ch := Ch + ' ';
inc(jC);
end
else
break;
end;
if (not ((LA.BC = LA.FC) and FStripInvisible)) or not readonly then
begin
// draw Ch into bitmap
Brush.Color := LA.BC;
Font.Color := LA.FC;
Font.Style := LA.Style;
R.Left := EditorClient.Left + (i - FLeftCol - j) * FCellRect.Width + 1;
R.Top := 0;
R.Right := R.Left + FCellRect.Width * Length(Ch);
R.Bottom := FCellRect.Height;
FillRect(R);
TextOut(R.Left, 0, Ch);
end
else
inc(j, length(Ch));
i := jC - 1;
end;
end
else
begin
FDrawBitmap.Canvas.Brush.Color := Color;
FDrawBitmap.Canvas.FillRect(Bounds(EditorClient.Left, 0, 1, FCellRect.Height));
end;
R := Bounds(CalcCellRect(i - j - FLeftCol, Line - FTopRow).Left, 0, (FLeftCol + FVisibleColCount - i{ - j} + 10) * FCellRect.Width, FCellRect.Height);
FDrawBitmap.Canvas.Brush.Color := Color;
FDrawBitmap.Canvas.FillRect(R);
R := Bounds(EditorClient.Left, (Line - FTopRow) * FCellRect.Height, (FVisibleColCount + 2) * FCellRect.Width, FCellRect.Height);
if FRightMarginVisible and (FRightMargin > FLeftCol) and (FRightMargin < FLastVisibleCol + 3) then
with FDrawBitmap.Canvas do
begin
Pen.Color := FRightMarginColor;
F := CalcCellRect(FRightMargin - FLeftCol, 0).Left;
MoveTo(F, 0);
LineTo(F, FCellRect.Height);
end;
BitBlt(EditorClient.Canvas.Handle, R.Left, R.Top, R.Right - R.Left, FCellRect.Height, FDrawBitmap.Canvas.Handle, R.Left, 0, SRCCOPY);
end;
procedure TCustomMemoEx.GetLineAttr(Line, LineIdx, LineOffs, LineLen, ColBeg, ColEnd: integer; const ALine: string; var FAttrs: TLineAttrs);
procedure SetAttrs(A: pLineAttr; count: integer);
var
i: integer;
begin
for i := 1 to Count do
begin
A^.FC := clWindowText;
A^.BC := clWindow;
A^.LastInteger := 0;
inc(A);
end;
end;
procedure ChangeSelectedAttr;
procedure DoChange(const iBeg, iEnd: integer);
var
i: integer;
begin
if (iBeg + LineOffs < SelAttrs_Size) and (iEnd + LineOffs < SelAttrs_Size) then
for i := iBeg + LineOffs to iEnd + LineOffs do
SelAttrs[i] := true;
end;
begin
if SelAttrs_Size > 0 then
FillChar(SelAttrs[0], SelAttrs_Size, 0);
if not FSelected then
exit;
if (LineIdx = FSelBegY) and (LineIdx = FSelEndY) then
DoChange(FSelBegX, Min(LineLen - 1, FSelEndX - 1 + integer(FInclusive)))
else
begin
if LineIdx = FSelBegY then
DoChange(FSelBegX, LineLen - 1);
if (LineIdx > FSelBegY) and (LineIdx < FSelEndY) then
DoChange(0, LineLen - 1);
if LineIdx = FSelEndY then
DoChange(0, Min(LineLen - 1, FSelEndX - 1 + integer(FInclusive)));
end
end;
begin
if SelAttrs_Size <> length(ALine) + 1 then
begin
SelAttrs_Size := length(ALine) + 1;
SetLength(SelAttrs, SelAttrs_Size);
end;
ChangeSelectedAttr;
SetLength(FAttrs, SelAttrs_Size);
SetAttrs(@FAttrs[0], SelAttrs_Size);
if (ALine <> '') and Assigned(FOnGetLineAttr) then
FOnGetLineAttr(Self, ALine, Line, SelAttrs, FAttrs);
end;
procedure TCustomMemoEx.ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: integer);
begin
case ScrollCode of
scLineUp..scPageDown, scTrack:
if Sender = scbVert then
Scroll(true, ScrollPos)
else if Sender = scbHorz then
Scroll(false, ScrollPos);
end;
end;
procedure TCustomMemoEx.Scroll(const Vert: boolean; const ScrollPos: integer);
var
R, RClip, RUpdate: TRect;
OldFTopRow: integer;
begin
if FUpdateLock = 0 then
begin
PaintCaret(false);
if Vert then
begin {Vertical Scroll}
OldFTopRow := FTopRow;
FTopRow := ScrollPos;
if Abs((OldFTopRow - ScrollPos) * FCellRect.Height) < EditorClient.Height then
begin
R := EditorClient.ClientRect;
R.Bottom := R.Top + CellRect.Height * (FVisibleRowCount + 1); {??}
RClip := R;
ScrollDC(EditorClient.Canvas.Handle, // handle of device context
0, // horizontal scroll units
(OldFTopRow - ScrollPos) * FCellRect.Height, // vertical scroll units
R, // address of structure for scrolling rectangle
RClip, // address of structure for clipping rectangle
0, // handle of scrolling region
@RUpdate // address of structure for update rectangle
);
InvalidateRect(Handle, @RUpdate, false);
if Assigned(OnPaintGutter) then
Gutter.Paint;
end
else
Invalidate;
Update;
end
else {Horizontal Scroll}
begin
FLeftCol := ScrollPos;
Invalidate;
end;
end
else { FUpdateLock > 0 }
begin
if Vert then
FTopRow := ScrollPos
else
FLeftCol := ScrollPos;
end;
FLastVisibleRow := FTopRow + FVisibleRowCount - 1;
FLastVisibleCol := FLeftCol + FVisibleColCount - 1;
if FUpdateLock = 0 then
begin
// DrawRightMargin;
PaintCaret(true);
end;
if Assigned(FOnScroll) then
FOnScroll(Self);
end;
procedure TCustomMemoEx.PaintCaret(bShow: boolean);
begin
if not bShow then
HideCaret(Handle)
else if Focused then
begin
with CalcCellRect(FCaretX - FLeftCol, FCaretY - FTopRow) do
SetCaretPos(Left - 1, Top + 1);
ShowCaret(Handle)
end;
end;
procedure TCustomMemoEx.SetCaretInternal(X, Y: integer);
begin
if (X = FCaretX) and (Y = FCaretY) then
exit;
if not FCursorBeyondEOF then
Y := Min(Y, FLines.ParaLineCount - 1);
Y := Max(Y, 0);
X := Min(X, Max_X);
X := Max(X, 0);
if Y < FTopRow then
SetLeftTop(FLeftCol, Y)
else if Y > Max(FLastVisibleRow, 0) then
SetLeftTop(FLeftCol, Y - FVisibleRowCount + 1);
if X < 0 then
X := 0;
if X < FLeftCol then
SetLeftTop(X, FTopRow)
else if X > FLastVisibleCol then
SetLeftTop(X - FVisibleColCount {+ 1}, FTopRow);
with CalcCellRect(X - FLeftCol, Y - FTopRow) do
SetCaretPos(Left - 1, Top + 1);
if (FCaretX <> X) or (FCaretY <> Y) then
begin
FCaretX := X;
FCaretY := Y;
if Assigned(OnSetCaretPos) then
OnSetCaretPos(Self, X, Y);
StatusChanged;
end;
FCaretX := X;
FCaretY := Y;
end;
procedure TCustomMemoEx.SetCaret(const X, Y: integer);
begin
if (X = FCaretX) and (Y = FCaretY) then
exit;
{$IFDEF MEMOEX_UNDO}
TCaretUndo.Create(Self, FCaretX, FCaretY);
{$ENDIF MEMOEX_UNDO}
SetCaretInternal(X, Y);
if FUpdateLock = 0 then
StatusChanged;
end;
procedure TCustomMemoEx.SetCaretAtParaPos(const ParaIndex, IndexOffs: integer);
var
X, Y: integer;
begin
Lines.Paragraph2Caret(ParaIndex, IndexOffs, X, Y);
SetCaret(X, Y);
end;
procedure TCustomMemoEx.SetCaretPosition(const index, Pos: integer);
begin
if index = 0 then
SetCaret(Pos, FCaretY)
else
SetCaret(FCaretX, Pos)
end;
procedure TCustomMemoEx.KeyDown(var Key: Word; Shift: TShiftState);
var
Form: TCustomForm;
{$IFDEF MEMOEX_EDITOR}
Com: word;
{$ENDIF MEMOEX_EDITOR}
begin
{$IFDEF MEMOEX_COMPLETION}
if FCompletion.FVisible then
if FCompletion.DoKeyDown(Key, Shift) then
exit
else
else
FCompletion.FTimer.Enabled := false;
{$ENDIF MEMOEX_COMPLETION}
if (Key = VK_TAB) and ((Shift = []) or (Shift = [ssShift])) then
if ((FReadOnly) or (not FWantTabs)) then
begin
Form := GetParentForm(Self);
if Assigned(Form) then
begin
Key := 0;
if Shift = [] then
Form.Perform(WM_NEXTDLGCTL, 0, 0)
else
Form.Perform(WM_NEXTDLGCTL, 1, 0);
end;
exit;
end;
{$IFDEF MEMOEX_EDITOR}
if WaitSecondKey then
begin
Com := FKeyboard.Command2(Key1, Shift1, Key, Shift);
WaitSecondKey := false;
IgnoreKeyPress := true;
end
else
begin
inherited KeyDown(Key, Shift);
Key1 := Key;
Shift1 := Shift;
Com := FKeyboard.Command(Key, Shift);
if Com = twoKeyCommand then
begin
IgnoreKeyPress := true;
WaitSecondKey := true;
end
else
IgnoreKeyPress := Com > 0;
end;
if (Com > 0) and (Com <> twoKeyCommand) then
begin
Key := 0;
Shift := [];
Command(Com);
end;
{$IFDEF MEMOEX_COMPLETION}
if (Com = ecBackSpace) then
FCompletion.DoKeyPress(#8);
{$ENDIF MEMOEX_COMPLETION}
{$ENDIF MEMOEX_EDITOR}
end;
{$IFDEF MEMOEX_EDITOR}
procedure TCustomMemoEx.ReLine;
begin
FLines.ReLine;
end; { ReLine }
procedure TCustomMemoEx.KeyPress(var Key: Char);
begin
if IgnoreKeyPress then
begin
IgnoreKeyPress := false;
exit
end;
if FReadOnly then
exit;
PaintCaret(false);
inherited KeyPress(Key);
Command(ord(Key));
PaintCaret(true);
end;
function AutoChangeCompare(Item1, Item2: pointer): integer;
var
i, j: integer;
begin
i := length(PAutoChangeWord(Item1)^.OldWord);
j := length(PAutoChangeWord(Item2)^.OldWord);
if i = j then
Result := 0
else if i > j then
Result := 1
else
Result := -1;
end;
procedure TCustomMemoEx.InsertChar(const Key: Char);
{$IFDEF MEMOEX_COMPLETION}
function GetAutoChangeWord(const CurrentWord: string; var NewWord: string): boolean;
var
i, j, k: integer;
s, t: string;
begin
Result := false;
t := DoChangeCase(CurrentWord, RA_CASE_CONVERT_LOWER);
j := length(t);
for i := 0 to FCompletion.FAutoChangeList.Count - 1 do
begin
s := PAutoChangeWord(FCompletion.FAutoChangeList[i])^.OldWord;
k := length(s);
if j < k then
break
else if j = k then
if t = s then
begin
Result := true;
NewWord := PAutoChangeWord(FCompletion.FAutoChangeList[i])^.NewWord;
break;
end;
end;
end;
{$ENDIF}
var
S: string;
{$IFDEF MEMOEX_COMPLETION}
T, old_str, new_str: string;
k1, k2, str_pos: integer;
AutoChanged, AddKeyToNewStr: boolean;
{$ENDIF}
oldChar: string;
i, _X, _Y, Y: integer;
b: boolean;
KeyAnsiChar: AnsiChar;
begin
ReLine;
if Key < #32 then
exit;
{$ifdef UNICODE}
if Key > #255 then
KeyAnsiChar := #255
else
{$endif}
KeyAnsiChar := AnsiChar(Key);
{$IFDEF MEMOEX_COMPLETION}
if not (KeyAnsiChar in RAEditorCompletionChars) then
FCompletion.DoKeyPress(Key);
{$ENDIF MEMOEX_COMPLETION}
DeleteSelected;
FLines.Caret2Paragraph(FCaretX, FCaretY, FParaY, FParaX);
{$IFDEF MEMOEX_COMPLETION}
str_pos := 0;
if (KeyAnsiChar in _AutoChangePunctuation) and (FCompletion.FAutoChangeList.Count > 0) then
begin
S := FLines[FParaY];
AutoChanged := false;
AddKeyToNewStr := false;
str_pos := FParaX - 1;
k1 := length(PAutoChangeWord(FCompletion.FAutoChangeList[0])^.OldWord);
k2 := length(PAutoChangeWord(FCompletion.FAutoChangeList[FCompletion.FAutoChangeList.Count - 1])^.OldWord);
while (str_pos > -1) and (FParaX - str_pos <= k2) do
begin
if FParaX - str_pos >= k1 then
begin
old_str := System.Copy(S, str_pos + 1, FParaX - str_pos);
AutoChanged := GetAutoChangeWord(old_str, new_str); // çàìåíÿåì ïîäñòðîêó áåç çíàêà?
if not AutoChanged then
AutoChanged := GetAutoChangeWord(old_str + Key, new_str) // çàìåíÿåì ïîäñòðîêó ñî çíàêîì?
else
AddKeyToNewStr := true;
if AutoChanged then
if ((str_pos > 0) and ({$ifdef UNICODE}(S[str_pos] < #255) and {$endif}
(AnsiChar(S[str_pos]) in _AutoChangePunctuation))) or (str_pos = 0) then
break
else
AutoChanged := false;
end;
dec(str_pos);
end;
if AutoChanged then
if AddKeyToNewStr then
if GetAutoChangeWord(Key, T) then
new_str := new_str + T
else
new_str := new_str + Key
else
else
begin
AutoChanged := GetAutoChangeWord(Key, new_str);
if AutoChanged then
begin
str_pos := FParaX; // çàìåíÿåì 1, òîëüêî ÷òî ââåäåííûé, çíàê
old_str := '';
end;
end;
end
else
AutoChanged := false;
if AutoChanged then
begin
{
str_pos
S
old_str
new_str
}
{$IFDEF MEMOEX_UNDO}
// undo
BeginCompound;
TCaretUndo.Create(Self, FCaretX, FCaretY);
FLines.Paragraph2Caret(FParaY, str_pos, _X, _Y);
if (length(old_str) + integer(not FInsertMode) > 0) and (length(S) > 0) then
begin
if FInsertMode then
T := old_str
else
T := old_str + S[FParaX + 1];
TDeleteUndo.Create(Self, _X, _Y, T);
end;
if length(new_str) > 0 then
TInsertUndo.Create(Self, _X, _Y, new_str);
EndCompound;
{$ENDIF}
k1 := FLines.Paragraphs[FParaY].FCount;
System.Delete(S, str_pos + 1, length(old_str) + integer(not FInsertMode));
System.Insert(new_str, S, str_pos + 1);
FLines.Internal[FParaY] := S;
B := k1 <> FLines.Paragraphs[FParaY].FCount;
FParaX := str_pos + length(new_str);
end
else
{$ENDIF MEMOEX_COMPLETION}
begin
S := FLines.ParaStrings[FCaretY];
if FInsertMode then
begin
{$IFDEF MEMOEX_UNDO}
TInsertUndo.Create(Self, FCaretX, FCaretY, Key);
{$ENDIF MEMOEX_UNDO}
Insert(Key, S, FCaretX + 1);
end
else
begin
if FCaretX + 1 <= Length(S) then
begin
oldChar := S[FCaretX + 1];
S[FCaretX + 1] := Key;
end
else
begin
oldChar := '';
S := S + Key;
end;
{$IFDEF MEMOEX_UNDO}
TOverwriteUndo.Create(Self, FCaretX, FCaretY, oldChar, Key);
{$ENDIF MEMOEX_UNDO}
end;
Y := FCaretY;
i := FLines.Paragraphs[FParaY].FCount;
FLines.InternalParaStrings[Y] := S;
inc(FParaX);
B := i <> FLines.Paragraphs[FParaY].FCount;
end;
i := RepaintParagraph(FCaretY);
if B then
begin
UpdateEditorSize(false);
RedrawFrom(i + 1);
end;
FLines.Paragraph2Caret(FParaY, FParaX, _X, _Y);
SetCaretInternal(_X, _Y);
Changed;
{$IFDEF MEMOEX_COMPLETION}
if KeyAnsiChar in RAEditorCompletionChars then
FCompletion.DoKeyPress(Key);
{$ENDIF MEMOEX_COMPLETION}
end;
{$ENDIF MEMOEX_EDITOR}
procedure TCustomMemoEx.RedrawFrom(YFrom: integer);
var
i: integer;
begin
for i := YFrom - 1 to FLastVisibleRow + 1 do
PaintLine(i, -1, -1);
end;
function TCustomMemoEx.RepaintParagraph(LineIndex: integer): integer;
var
P, PI, i, j, k: integer;
begin
FLines.Index2ParaIndex(LineIndex, P, PI);
j := LineIndex - PI;
k := j + FLines.FList[P].FCount - 1;
if j < FTopRow - 1 then
j := FTopRow - 1;
j := Max(0, j);
if k > FLastVisibleRow + 1 then
k := FLastVisibleRow + 1;
Result := k;
for i := j to k do
PaintLine(i, -1, -1);
end;
function TCustomMemoEx.IsUndoEmpty: boolean;
begin
{$IFDEF MEMOEX_EDITOR} Result := FUndoBuffer.FPtr < 0; {$endif}
end;
function TCustomMemoEx.YinBounds(AY: integer): boolean;
begin
Result := (AY > -1) and (AY < FLines.ParaLineCount);
end;
function TCustomMemoEx.DoChangeCase(const st: string; Conversion: byte): string;
begin
if Assigned(FOnCaseConversion) then
Result := FOnCaseConversion(Self, Conversion, st)
else
case Conversion of
RA_CASE_CONVERT_UPPER:
Result := ANSIUpperCase(st);
RA_CASE_CONVERT_LOWER:
Result := ANSILowerCase(st);
else
Result := ANSIChangeCase(st);
end;
end;
{$IFDEF MEMOEX_EDITOR}
type
EComplete = class(EAbort);
procedure TCustomMemoEx.Command(ACommand: TEditCommand);
var
X, Y: integer;
{$IFDEF MEMOEX_UNDO}
CaretUndo: boolean;
{$ENDIF MEMOEX_UNDO}
type
TPr = procedure of object;
procedure DoAndCorrectXY(Pr: TPr);
begin
Pr;
X := FCaretX;
Y := FCaretY;
{$IFDEF MEMOEX_COMPLETION}
CaretUndo := false;
{$ENDIF MEMOEX_COMPLETION}
end;
function Com(const Args: array of TEditCommand): boolean;
var
i: integer;
begin
Result := true;
for i := 0 to High(Args) do
if Args[i] = ACommand then
exit;
Result := false;
end;
procedure SetSel1(X, Y: integer);
begin
SetSel(X, Y);
{$IFDEF MEMOEX_UNDO}
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
end;
procedure SetSelText1(S: string);
begin
SelText := S;
CaretUndo := false;
end;
procedure Complete;
begin
raise EComplete.Create('');
end;
var
F, _Y: integer;
S, S2, T: string;
B: boolean;
iBeg, iEnd: integer;
begin
X := FCaretX;
Y := FCaretY;
{$IFDEF MEMOEX_UNDO}
CaretUndo := true;
{$ENDIF MEMOEX_UNDO}
PaintCaret(false);
{ macro recording }
if FRecording and not Com([ecRecordMacro, ecBeginCompound]) and (FCompound = 0) then
FMacro := FMacro + Char(Lo(ACommand)) + Char(Hi(ACommand));
try
try
case ACommand of
{ caret movements }
ecLeft, ecRight, ecSelLeft, ecSelRight:
begin
if Com([ecSelLeft, ecSelRight]) and not FSelected then
SetSel1(X, Y);
B := Com([ecLeft, ecSelLeft]);
if B then
dec(X)
else
inc(X);
if (not FCursorBeyondEOL) and (YinBounds(Y)) then
begin
_Y := 0;
if (B) and (X < 0) then
_Y := -1
else if (not B) and (X > length(FLines.ParaStrings[Y])) then
_Y := 1;
if (_Y <> 0) and (YinBounds(Y + _Y)) then
begin
Y := Y + _Y;
if B then
X := length(FLines.ParaStrings[Y])
else
X := 0;
end
else if X > length(FLines.ParaStrings[Y]) then
X := length(FLines.ParaStrings[Y]);
end
else if not CursorBeyondEOL then
X := 0;
if Com([ecSelLeft, ecSelRight]) then
SetSel1(X, Y)
else
SetUnSelected;
end;
ecUp, ecDown, ecSelUp, ecSelDown:
if (Com([ecUp, ecSelUp]) and (Y > 0)) or (Com([ecDown, ecSelDown]) and ((Y < FRows - 1) or (FCursorBeyondEOF))) then
begin
if Com([ecSelUp, ecSelDown]) and not FSelected then
SetSel1(X, Y);
if Com([ecUp, ecSelUp]) then
dec(Y)
else
inc(Y);
if (not FCursorBeyondEOL) and (YinBounds(Y)) then
if X > length(FLines.ParaStrings[Y]) then
X := length(FLines.ParaStrings[Y]);
if Com([ecSelUp, ecSelDown]) then
SetSel1(X, Y)
else
SetUnSelected;
end;
ecPrevWord, ecSelPrevWord:
if FLines.ParaLineCount > 0 then
begin
S := FLines.ParaStrings[Y];
if X > length(S) then
X := length(S);
if X = 0 then
if Y > 0 then
begin
dec(Y);
X := length(FLines.ParaStrings[Y]);
end
else
else
begin
if (ACommand = ecSelPrevWord) and not FSelected then
SetSel1(FCaretX, FCaretY);
B := false;
for F := X - 1 downto 0 do
if B then
if {$ifdef UNICODE} (S[F + 1] < #255) and {$endif} (AnsiChar(S[F + 1]) in Separators) then
begin
X := F + 1;
break;
end
else
else if {$ifdef UNICODE} (S[F + 1] > #255) or {$endif} not (AnsiChar(S[F + 1]) in Separators) then
B := true;
if X = FCaretX then
X := 0;
if ACommand = ecSelPrevWord then
SetSel1(X, Y)
else
SetUnselected;
if (not B) and (X = 0) and (Y > 0) then
begin
FCaretX := X;
Command(ACommand);
Complete;
end;
end;
end;
ecNextWord, ecSelNextWord:
if FLines.ParaLineCount > 0 then
begin
if X >= length(FLines.ParaStrings[Y]) then
begin
if Y < FLines.ParaLineCount - 1 then
begin
inc(Y);
X := 0;
if length(FLines.ParaStrings[Y]) > 0 then
if FLines.ParaStrings[Y][X + 1] = #32 then
begin
FCaretX := X;
FCaretY := Y;
Command(ACommand);
Complete;
end;
end;
end
else
begin
if (ACommand = ecSelNextWord) and not FSelected then
SetSel1(FCaretX, FCaretY);
S := FLines.ParaStrings[Y];
B := false;
for F := X to Length(S) - 1 do
if B then
if {$ifdef UNICODE} (S[F + 1] > #255) or {$endif} not (AnsiChar(S[F + 1]) in Separators) then
begin
X := F;
break;
end
else
else if {$ifdef UNICODE} (S[F + 1] < #255) and {$endif} (AnsiChar(S[F + 1]) in Separators) then
B := true;
if X = FCaretX then
begin
B := X <> length(S);
X := length(S);
end;
if ACommand = ecSelNextWord then
SetSel1(X, Y)
else
SetUnselected;
if (not B) and (X = length(S)) and (Y < FLines.ParaLineCount - 1) then
begin
FCaretX := X;
Command(ACommand);
Complete;
end;
end;
end;
ecScrollLineUp, ecScrollLineDown, ecScrollPageUp, ecScrollPageDown:
begin
if not ((ACommand = ecScrollLineDown) and (Y >= FLines.ParaLineCount - 1) and (Y = FTopRow)) then
begin
case ACommand of
ecScrollLineUp:
F := -1;
ecScrollLineDown:
F := 1;
ecScrollPageUp:
F := -scbVert.LargeChange;
else
F := scbVert.LargeChange;
end;
scbVert.Position := scbVert.Position + F;
Scroll(true, scbVert.Position);
end;
if Y < FTopRow then
Y := FTopRow
else if Y > FLastVisibleRow then
Y := FLastVisibleRow;
end;
ecBeginLine, ecSelBeginLine, ecBeginDoc, ecSelBeginDoc, ecEndLine, ecSelEndLine, ecEndDoc, ecSelEndDoc:
begin
if Com([ecSelBeginLine, ecSelBeginDoc, ecSelEndLine, ecSelEndDoc]) and not FSelected then
SetSel1(FCaretX, Y);
if Com([ecBeginLine, ecSelBeginLine]) then
X := 0
else if Com([ecBeginDoc, ecSelBeginDoc]) then
begin
X := 0;
Y := 0;
SetLeftTop(0, 0);
end
else if Com([ecEndLine, ecSelEndLine]) then
begin
if FLines.ParaLineCount > 0 then
X := Length(FLines.ParaStrings[Y])
else
X := 0;
end
else if Com([ecEndDoc, ecSelEndDoc]) then
if FLines.ParaLineCount > 0 then
begin
Y := FLines.ParaLineCount - 1;
X := Length(FLines.ParaStrings[Y]);
SetLeftTop(X - FVisibleColCount, Y - FVisibleRowCount + 1{ div 2});
end;
if Com([ecSelBeginLine, ecSelBeginDoc, ecSelEndLine, ecSelEndDoc]) then
SetSel1(X, Y)
else
SetUnSelected;
end;
ecPrevPage:
begin
scbVert.Position := scbVert.Position - scbVert.LargeChange;
Scroll(true, scbVert.Position);
Y := Y - FVisibleRowCount;
SetUnSelected;
end;
ecNextPage:
begin
scbVert.Position := scbVert.Position + scbVert.LargeChange;
Scroll(true, scbVert.Position);
Y := Y + FVisibleRowCount;
SetUnSelected;
end;
ecSelPrevPage:
begin
BeginUpdate;
SetSel1(X, Y);
scbVert.Position := scbVert.Position - scbVert.LargeChange;
Scroll(true, scbVert.Position);
Y := Y - FVisibleRowCount;
SetSel1(X, Y);
EndUpdate;
end;
ecSelNextPage:
begin
BeginUpdate;
SetSel1(X, Y);
scbVert.Position := scbVert.Position + scbVert.LargeChange;
Scroll(true, scbVert.Position);
Y := Y + FVisibleRowCount;
if Y <= FLines.ParaLineCount - 1 then
SetSel1(X, Y)
else
SetSel1(X, FLines.ParaLineCount - 1);
EndUpdate;
end;
ecSelWord:
if not FSelected and (GetWordOnPosEx(FLines.ParaStrings[Y] + ' ', X + 1, iBeg, iEnd) <> '') then
begin
SetSel1(iBeg - 1, Y);
SetSel1(iEnd - 1, Y);
X := iEnd - 1;
end;
ecWindowTop:
begin
Y := FTopRow;
if (not FCursorBeyondEOL) and (YinBounds(Y)) then
if X > length(FLines.ParaStrings[Y]) then
X := length(FLines.ParaStrings[Y]);
SetUnSelected;
end;
ecWindowBottom:
begin
Y := FTopRow + FVisibleRowCount - 1;
if (not FCursorBeyondEOL) and (YinBounds(Y)) then
if X > length(FLines.ParaStrings[Y]) then
X := length(FLines.ParaStrings[Y]);
SetUnSelected;
end;
{ editing }
{$IFDEF MEMOEX_EDITOR}
ecCharFirst..ecCharLast:
if not FReadOnly then
begin
InsertChar(Char(ACommand - ecCharFirst));
// Changed; // AB
Complete;
end;
ecInsertPara:
if not FReadOnly then
begin
DeleteSelected;
ReLine;
FLines.Caret2Paragraph(X, Y, FParaY, FParaX);
S := FLines[FParaY];
S2 := Copy(S, FParaX + 1, length(S));
T := S2;
if Assigned(FOnBreakLine) then
FOnBreakLine(Self, S, S2);
if S2 = T then
begin
{$IFDEF MEMOEX_UNDO}
BeginCompound;
TInsertUndo.Create(Self, FCaretX, FCaretY, #13#10);
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
if FAutoIndent then
F := length(S2) - length(TrimLeft(S2));
FLines.Insert(FParaY + 1, S2);
FLines.Internal[FParaY] := Copy(S, 1, FParaX);
inc(Y);
{ smart tab }
if (FAutoIndent) and (Trim(FLines.ParaStrings[FCaretY]) <> '')
{ (FLines.ParaStrings[FCaretY][1] = ' ')) or
((Trim(FLines.ParaStrings[FCaretY]) = '') and (X > 0)))} then
begin
X := GetTabStop(0, Y, tsAutoIndent, true);
if X > F then
begin
{$IFDEF MEMOEX_UNDO}
TInsertUndo.Create(Self, 0, Y, StringOfChar(' ', X - F));
{$ENDIF MEMOEX_UNDO}
FLines.Internal[FParaY + 1] := StringOfChar(' ', X - F) + S2;
end;
end
else if (FAutoIndent) and (S2 = '') then
X := length(FLines.ParaStrings[FCaretY])
else
X := 0;
{$IFDEF MEMOEX_UNDO}
EndCompound;
{$ENDIF MEMOEX_UNDO}
end
else
begin
T := Copy(S, 1, FParaX) + #13#10 + S2 + #13#10;
F := FLines.GetParaOffs(FParaY);
S2 := FLines.Text;
System.Delete(S2, F + 1, length(S) + 2);
System.Insert(T, S2, F + 1);
FLines.Paragraph2Caret(FParaY, 0, F, _Y);
{$IFDEF MEMOEX_UNDO}
CaretUndo := false;
BeginCompound;
TCaretUndo.Create(Self, FCaretX, FCaretY);
TDeleteUndo.Create(Self, 0, _Y, S + #13#10);
TInsertUndo.Create(Self, 0, _Y, T);
EndCompound;
{$ENDIF MEMOEX_UNDO}
FLines.SetLockText(S2);
inc(Y);
X := 0;
end;
UpdateEditorSize(false);
{ Invalidate }
F := RepaintParagraph(FCaretY);
RedrawFrom(F + 1);
Changed;
end;
ecBackword:
if not FReadOnly then
begin
if length(FLines.ParaStrings[Y]) > 0 then
begin
Command(ecBeginCompound);
Command(ecBeginUpdate);
Command(ecSelPrevWord);
Command(ecDeleteSelected);
Command(ecEndUpdate);
Command(ecEndCompound);
end
else
Command(ecBackspace);
Complete;
end;
ecBackspace:
if not FReadOnly then
begin
if FSelected then
begin
DoAndCorrectXY(DeleteSelected);
Changed;
end
else
begin
ReLine;
FLines.Caret2Paragraph(X, Y, FParaY, FParaX);
if X > 0 then
begin
if FBackSpaceUnindents then
X := GetBackStop(FCaretX, FCaretY)
else
X := FCaretX - 1;
S := Copy(FLines.ParaStrings[FCaretY], X + 1, FCaretX - X);
dec(FParaX, length(S));
F := FLines.Paragraphs[FParaY].FCount;
FLines.InternalParaStrings[Y] := Copy(FLines.ParaStrings[Y], 1, X) + Copy(FLines.ParaStrings[Y], FCaretX + 1, Length(FLines.ParaStrings[Y]));
FLines.Paragraph2Caret(FParaY, FParaX, X, Y);
{$IFDEF MEMOEX_UNDO}
TBackspaceUndo.Create(Self, X, Y, S);
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
B := F <> FLines.Paragraphs[FParaY].FCount;
F := RepaintParagraph(Y);
if B then
begin
UpdateEditorSize(false);
RedrawFrom(F + 1);
end;
Changed;
end
else if Y > 0 then
begin
if FParaX > 0 then
begin
T := FLines[FParaY];
S := Copy(T, FParaX, 1);
System.Delete(T, FParaX, 1);
FLines.Internal[FParaY] := T;
dec(FParaX);
FLines.Paragraph2Caret(FParaY, FParaX, X, Y);
{$IFDEF MEMOEX_UNDO}
TBackspaceUndo.Create(Self, X, Y, S);
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
end
else if FParaY > 0 then
begin
inc(FUpdateLock);
S := FLines[FParaY - 1];
S2 := FLines[FParaY];
if Assigned(FOnConcatLine) then
FOnConcatLine(Self, S, S2);
{$IFDEF MEMOEX_UNDO}
CaretUndo := false;
FLines.Paragraph2Caret(FParaY - 1, 0, F, _Y);
BeginCompound;
TCaretUndo.Create(Self, X, Y);
TDeleteUndo.Create(Self, 0, _Y, FLines[FParaY - 1] + #13#10 + FLines[FParaY] + #13#10);
TInsertUndo.Create(Self, 0, _Y, S + S2 + #13#10);
EndCompound;
{$ENDIF MEMOEX_UNDO}
FLines.Internal[FParaY - 1] := S + S2;
FLines.Delete(FParaY);
dec(FUpdateLock);
FLines.Paragraph2Caret(FParaY - 1, length(S), X, Y);
end
else
Complete;
UpdateEditorSize(false);
F := RepaintParagraph(Y);
RedrawFrom(F + 1);
Changed;
end;
end;
end;
ecDelete:
if not FReadOnly then
begin
if FLines.ParaLineCount = 0 then
FLines.Add('');
if FSelected then
begin
DoAndCorrectXY(DeleteSelected);
Changed;
end
else
begin
ReLine;
FLines.Caret2Paragraph(X, Y, FParaY, FParaX);
if X < Length(FLines.ParaStrings[Y]) then
begin
{$IFDEF MEMOEX_UNDO}
TDeleteUndo.Create(Self, FCaretX, FCaretY, FLines.ParaStrings[Y][X + 1]);
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
F := FLines.Paragraphs[FParaY].FCount;
FLines.InternalParaStrings[Y] := Copy(FLines.ParaStrings[Y], 1, X) + Copy(FLines.ParaStrings[Y], X + 2, Length(FLines.ParaStrings[Y]));
FLines.Paragraph2Caret(FParaY, FParaX, X, Y);
B := F <> FLines.Paragraphs[FParaY].FCount;
F := RepaintParagraph(Y);
if B then
begin
UpdateEditorSize(false);
RedrawFrom(F + 1);
end;
Changed;
end
else if (Y >= 0) and (Y <= FLines.ParaLineCount - 2) then
begin
S := FLines[FParaY];
if FParaX < length(S) then
begin
{$IFDEF MEMOEX_UNDO}
TDeleteUndo.Create(Self, FCaretX, FCaretY, System.Copy(S, FParaX + 1, 1));
CaretUndo := false;
{$ENDIF MEMOEX_UNDO}
System.Delete(S, FParaX + 1, 1);
FLines.Internal[FParaY] := S;
FLines.Paragraph2Caret(FParaY, FParaX, X, Y);
end
else
begin
inc(FUpdateLock);
S := FLines[FParaY];
S2 := FLines[FParaY + 1];
if Assigned(FOnConcatLine) then
FOnConcatLine(Self, S, S2);
{$IFDEF MEMOEX_UNDO}
CaretUndo := false;
FLines.Paragraph2Caret(FParaY, 0, F, _Y);
BeginCompound;
TCaretUndo.Create(Self, X, Y);
TDeleteUndo.Create(Self, 0, _Y, FLines[FParaY] + #13#10 + FLines[FParaY + 1] + #13#10);
TInsertUndo.Create(Self, 0, _Y, S + S2 + #13#10);
EndCompound;
{$ENDIF MEMOEX_UNDO}
FLines.Internal[FParaY] := S + S2;
FLines.Delete(FParaY + 1);
dec(FUpdateLock);
FLines.Paragraph2Caret(FParaY, length(S), X, Y);
end;
UpdateEditorSize(false);
F := RepaintParagraph(FCaretY);
RedrawFrom(F + 1);
Changed;
end;
end;
end;
ecTab, ecBackTab:
if not FReadOnly then