unit TextEditor;
interface
uses
Windows, SysUtils, Classes, Types, Controls, Graphics, Messages, Menus,
ExtCtrls, RichEdit, CommCtrl, Forms, BitmapEffects, TextEncodings,
UnicodeData, ActiveX, System.Win.ComObj, ShlObj, Generics.Defaults,
Generics.Collections, UITypes, Math, Rux;
resourcestring
SNumOnlyErrorTitle = 'Character not allowed';
SNumOnlyErrorText = 'You can only type a number here.';
SControlLineInputTitle = 'Text input not allowed';
SControlLineInputText = 'You cannot enter text on a control line.';
SPicture = 'Picture';
SImageFilter = 'All images|*.bmp; *.jpg; *.jpeg; *.jpe; *.png; *.gif; *.ico|Bitmap images|*.bmp|JPEG images|*.jpg; *.jpeg; *.jpe|PNG images|*.png|GIF images|*.gif|Icons|*.ico';
SOpenImageDialogCaption = 'Select image';
SControl = 'Control';
SRemovedControl = 'Removed control';
SCliHistoryDialogCaption = 'Command History';
SMultiSelectCaption = 'Character Selection';
SMultiCharDlgLvColumnTitleDescription = 'Description';
SMultiCharDlgLvColumnTitleCodepoint = 'Codepoint';
SMultiCharDlgLvColumnTitleBlock = 'Block';
SNewFileName = 'New file %d';
SMenuOpenURL = 'Open URL';
SMenuOpenURLHint = 'Opens %s.';
SMenuBack = 'Back';
SMenuBackHint = 'Goes back one page in history.';
SMenuForward = 'Forward';
SMenuForwardHint = 'Goes forward one page in history.';
SMenuUndo = 'Undo';
SMenuUndoHint = 'Undoes the previous operation in the undo list.';
SMenuRedo = 'Redo';
SMenuRedoHint = 'Redoes the next operation in the undo list.';
SMenuCut = 'Cut';
SMenuCutHint = 'Moves the selected text to clipboard.';
SMenuCopy = 'Copy';
SMenuCopyHint = 'Copies the selected text or the current word to clipboard.';
SMenuPaste = 'Paste';
SMenuPasteHint = 'Pastes the contents of the clipboard at the caret, replacing any selection.';
SMenuClear = 'Clear';
SMenuClearHint = 'Removes the selected text.';
SMenuSelectAll = 'Select all';
SMenuSelectAllHint = 'Selects all text.';
SMenuSetBookmark = 'Set bookmark';
SMenuSetBookmarkItemHint = 'Sets this bookmark to the current caret position.';
SMenuGotoBookmark = 'Goto bookmark';
SMenuGotoBookmarkItemHint = 'Moves the caret to this bookmark.';
SMenuClearBookmark = 'Clear bookmark';
SMenuClearBookmarkItemHint = 'Clears (removes) this bookmark.';
SMenuClasses = 'Classes';
SMenuClassesItemHint = 'Assigns this class to the current line.';
SMenuActivateControl = 'Activate control';
SMenuActivateControlHint = 'Activates this control.';
SMenuTransform = 'Transform';
SMenuTransformUpperCase = 'To upper case';
SMenuTransformUpperCaseHint = 'Converts the selected text to upper case.';
SMenuTransformLowerCase = 'To lower case';
SMenuTransformLowerCaseHint = 'Converts the selected text to lower case.';
SMenuTransformInvertCase = 'Invert case';
SMenuTransformInvertCaseHint = 'Inverts the case of the characters in the selection.';
SMenuTransformCamelCase = 'To camel case';
SMenuTransformCamelCaseHint = 'Enforces camel case (Camel Case) in the selection.';
SMenuTransformSentenceCase = 'To sentence case';
SMenuTransformSentenceCaseHint = 'Enforces sentence case in the selection.';
SMenuTransformReverse = 'Reverse text';
SMenuTransformReverseHint = 'Reverses the selected text.';
SMenuTransformROT13 = 'Perform ROT-13';
SMenuTransformROT13Hint = 'Performs ROT-13 on the selected text.';
SMenuTransformCaesar = 'Apply Caesar cipher...';
SMenuTransformCaesarHint = 'Performs the Caesar cipher on the selected text.';
SMenuTransformVigenere = 'Apply Vigenère cipher...';
SMenuTransformVigenereHint = 'Performs the Vigenère cipher on the selected text.';
SMenuTransformVigenereInverse = 'Apply inverse Vigenère cipher...';
SMenuTransformVigenereInverseHint = 'Performs the inverse Vigenère cipher on the selected text.';
SCaesarNTitle = 'Caesar Cipher';
SCaesarNText = 'Please enter the parameter of the Caesar cipher:';
SVigenereTitle = 'Vigenère Cipher';
SVigenereText = 'Please enter the parameter of the Vigenère cipher:';
SMenuNoBookmarksSetParen = '(No bookmarks set.)';
SMenuClearAllBookmarks = 'Clear all';
SMenuClearAllBookmarksHint = 'Clears all bookmarks.';
SMenuUseNoClass = 'No class';
SMenuUseNoClassHint = 'Assigns no class to the current line.';
SPrint = 'Print...';
SPrintHint = 'Sends the entire page or the selected text to a printer.';
SMenuToggleCaretBeyondEOL = 'Allow caret beyond EOL';
SMenuToggleCaretBeyondEOLHint = 'If checked, the caret may be positioned beyond the end of each line.';
SBookmarkDescriptionInvalid = 'Invalid bookmark';
SBookmarkDescription = 'Bookmark %d (%d, %d)';
SBookmarkDescriptionEmpty = 'Bookmark %d (empty)';
SMenuCopyImage = 'Copy image';
SMenuCopyImageHint = 'Copies the image to the clipboard.';
SMenuDeleteImage = 'Remove image';
SMenuDeleteImageHint = 'Removes the image.';
SMenuChangeImage = 'Change image...';
SMenuChangeImageHint = 'Replaces the image with a different one.';
SMenuRulerProperties = 'Properties';
SMenuRulerPropertiesHint = 'Displays or modifies the ruler properties.';
SMenuCopyLine = 'Copy this line';
SMenuCopyLineHint = 'Copies the line with the caret to clipboard.';
SMenuCopyAll = 'Copy list';
SMenuCopyAllHint = 'Copies the entire list to clipboard.';
SMoveHere = 'Move here';
SCopyHere = 'Copy here';
SCancel = 'Cancel';
SFPSlowTitle = 'Text Editor Control';
SFPSlowText = 'The formatting processor used for interactive formatting (syntax highlighting) appears to be slow. Do you want to disable interactive formatting?';
SRestoreWrapAtText = 'Do you want to restore the default wrap at characters?';
SRestoreWrapAtCaption = 'TTextEditor control';
SNotifyDragMove = 'Drag to move the selection to the new position. (Press Esc to abort.)';
SNotifyDragCopy = 'Drag to copy the selection to the new position. (Press Esc to abort.)';
SNotifyReadOnlyError = 'You cannot edit a read-only line.';
SNotifyInputError = 'Invalid operation.';
SNotifyPrinting = 'Printing...';
SNotifyScrollMode = 'Scroll mode';
SNotifyScript = 'Script running... (Press Esc to abort.)';
SNotifyMultiCharSelect = 'Press F9 to show a list of related characters.';
SNotifyReadOnlyMode = 'Read-only mode';
SNotifyMultiCaretMode = 'Multi-caret mode. (Press Esc to abort.)';
SReadOnlyErrorText = 'You cannot edit a read-only line.';
SReadOnlyErrorTitle = 'Read only';
SUndoSelectionTransformed = 'Selection transformed (%s)';
SUndoTextTransformed = 'Text transformed (%s)';
SUndoLineCleared = 'Line cleared';
SUndoSelectionCleared = 'Selection cleared';
SUndoFirstPost = 'First version since undo history was removed';
SUndoTyped = 'Typed';
SUndoInitialText = 'Initial text';
SUndoCutToClipboard = 'Cut to clipboard';
SUndoTrimRight = 'Lines trimmed to the right';
SUndoTextCleared = 'Document cleared';
SUndoBookmarksCleared = 'Bookmarks cleared';
SUndoWordWrap = 'Word wrap performed';
SUndoTextInserted = 'Text inserted';
SUndoTextSurrounded = 'Selection surrounded by "%s" and "%s"';
SUndoReplacedAll = 'Replaced %d instance(s) of "%s" by "%s"';
SUndoUnicodeReplacedCodepoint = 'Unicode codepoint replaced by character';
SUndoLinesSwapped = 'Lines swapped';
SUndoMouseMove = 'Selection moved using mouse';
SUndoMouseCopy = 'Selection copied using mouse';
SUndoMouseMoveExtSrc = 'External text moved here using mouse';
SUndoMouseCopyExtSrc = 'External text copied here using mouse';
SUndoMouseMoveExtDst = 'Selection moved to external document';
SUndoNewFile = 'Document created';
SUndoBookmarkCleared = 'Bookmark cleared';
SUndoBookmarkAdded = 'Bookmark added';
SUndoIndentIncreased = 'Indent increased';
SUndoDocumentLoaded = 'Document loaded';
SUndoPastedFromClipboard = 'Pasted from clipboard';
SUndoIndentRemoved = 'Indent removed';
SUndoIndentDecreased = 'Indent decreased';
SUndoReverted = 'Reverted to version #%d from %s';
SUndoSorted = 'Sorted lines';
SUndoMadeLinesUnique = 'Removed duplicates, made lines unique';
SUndoScript = 'Script executed';
SUndoScriptAbort = 'Script partially executed before being aborted';
SUndoCliHistory = 'Command-line history item recalled';
SUndoFillWithChar = 'Filled selection with character %s';
SUndoLinesTruncated = 'Lines truncated';
SUndoLinesFiltered = 'Lines filtered';
SUndoAutoReplaced = 'Auto-replaced code';
SUndoFileTruncated = 'File truncated';
SUndoTextSet = 'Text set programmatically';
SDefaultPrintJobTitle = 'Text file';
SDefaultFileName = 'Untitled file';
STransformNameUpperCase = 'upper case';
STransformNameLowerCase = 'lower case';
STransformNameInvertCase = 'invert case';
STransformNameCamelCase = 'camel case';
STransformNameSentenceCase = 'sentence case';
STransformNameReverse = 'reverse text';
STransformNameRot13 = 'ROT-13';
STransformNameCaesarN = 'Caesar %d';
STransformNameVigenere = 'Vigenère';
SNoInteractiveFormattingParen = '(No interactive formatting)';
SHTMLExportFileName = 'File name';
SHTMLExportDate = 'Date exported';
SHTMLExportTime = 'Time exported';
SHTMLExportFP = 'Formatting processor';
SInvalidOpMsgSingleLineModeInsertLine = 'Cannot insert line in single-line mode.';
SInvalidOpMsgInvalidChrIndex = 'TTextFile: Invalid character index %d.';
SNoLineComparer = 'Cannot sort because no line comparison function has been assigned.';
SIllegalLineComparer = 'Illegal line-comparing function assigned.';
const
FORMATETC_UNICODETEXT: TFormatEtc =
(
cfFormat: CF_UNICODETEXT;
ptd: nil;
dwAspect: DVASPECT_CONTENT;
lindex: -1;
tymed: TYMED_HGLOBAL
);
type
TChangeType = (ctNone, ctFile, ctLineRange, ctBlock, ctLine, ctLineFrom,
ctChar, ctTwoChars, ctPostFile);
TChangeRecord = record
ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer;
end;
TChangeRecords = array of TChangeRecord;
function MakeChangeRecord(ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
const
NO_CHANGE_RECORD: TChangeRecord = (ChangeType: ctNone; Data1: 0; Data2: 0; Data3: 0; Data4: 0);
FILE_CHANGE_RECORD: TChangeRecord = (ChangeType: ctFile; Data1: 0; Data2: 0; Data3: 0; Data4: 0);
type
TChangeEvent = procedure(Sender: TObject; ChangeType: TChangeType; Data1,
Data2, Data3, Data4: Integer) of object;
function ChangeUnion(const ChangeRecord1, ChangeRecord2: TChangeRecord): TChangeRecord;
type
TSelectionType = (stLineBased, stBlock);
TCaretPos = class
private
FCaretPos: TPoint;
FSelStartPos: TPoint;
FSelectionType: TSelectionType;
FOnChange: TNotifyEvent;
FOnSelChange: TChangeEvent;
FSavedSelExtent: TChangeRecord;
procedure SetCaretPos(const Value: TPoint);
procedure Changed;
procedure SelChanged(ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer);
procedure SelRemoved;
procedure SetSelEndPos(const Value: TPoint);
procedure SetSelectionType(const Value: TSelectionType);
function GetSelExtent(ACaretPos, ASelEndPos: TPoint; ASelectionType: TSelectionType): TChangeRecord;
procedure SaveSelExtent; inline;
function GetFirstPoint: TPoint;
function GetLastPoint: TPoint;
public
constructor Create;
procedure Reset;
property Data: TPoint read FCaretPos;
property SelEnd: TPoint read FSelStartPos;
property FirstPoint: TPoint read GetFirstPoint;
property LastPoint: TPoint read GetLastPoint;
property X: Integer read FCaretPos.X;
property Y: Integer read FCaretPos.Y;
procedure SetPoint(X, Y: Integer; SelEnd: Boolean = False); overload;
procedure SetPoint(Point: TPoint; SelEnd: Boolean = False); overload; inline;
procedure SetX(X: Integer; SelEnd: Boolean = False);
procedure SetY(Y: Integer; SelEnd: Boolean = False);
procedure CreateSelection(const ASelStart, ASelEnd: TPoint;
const ASelectionType: TSelectionType = stLineBased);
procedure RemoveSelection;
property SelectionType: TSelectionType read FSelectionType write SetSelectionType default stLineBased;
procedure GetSelBdry(const PointA, PointB: TPoint; out FirstPoint, SecondPoint: TPoint); overload;
procedure GetSelBdry(out FirstPoint, SecondPoint: TPoint); overload;
procedure InternalPush(Size: Integer; LastLine: Boolean = True);
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnSelChange: TChangeEvent read FOnSelChange write FOnSelChange;
end;
TEditMode = (emText, emConsole, emReadOnly);
EReadOnlyViolation = class(Exception);
TAutoReplaceItem = record
Token,
ReplacedValue: string;
end;
TAutoReplaceItems = array of TAutoReplaceItem;
const
NUM_BOOKMARKS = 17;
INTERNAL_BOOKMARK = -1;
type
TBookmarkList = array[-1..NUM_BOOKMARKS - 1] of TPoint;
const
EMPTY_BOOKMARK: TPoint = (X: -1; Y: -1);
type
TUndoDataItem = record
Text: string;
Classes: string;
CaretPos: TPoint;
SelStartPos: TPoint;
SelType: TSelectionType;
Time: TDateTime;
Comment: string;
UID: Integer;
Bookmarks: TBookmarkList;
end;
TUndoData = array of TUndoDataItem;
THistoryManager = class
public const
UNDO_SIGNATURE = $4F444E55;
UNDO_SIGNATURE_ITEM = $4D455449;
strict private const
DEFAULT_MAX_UNDO_SIZE = 536870912;
HISTORY_ALLOC_BY = 1024;
strict private
FUndoData: TUndoData;
FMaxSize: Integer;
FActualLength: Integer;
FSize: Integer;
FFirstItem: Integer;
FHistoryIndex: Integer;
function GetLength: Integer;
function SizeOfItem(ItemIndex: Integer): Integer;
procedure SetMaxSize(Value: Integer);
procedure ClearItem(ItemIndex: Integer);
function RemoveFirstItem: Boolean;
procedure TrimLeft;
function GetUndoData(Index: Integer): TUndoDataItem;
function GetLastItem: Integer;
procedure Revert;
public
constructor Create;
destructor Destroy; override;
procedure Add(AUndoDataItem: TUndoDataItem); overload;
procedure Add(const AText: string; const AClasses: string;
const ACaretPos, ASelStartPos: TPoint; ASelType: TSelectionType;
const ATime: TDateTime; const AComment: string;
const ABookmarks: TBookmarkList; AUID: Integer = 0); overload;
procedure Clear;
function Undo(out UndoData: TUndoDataItem): Boolean;
function CanUndo: Boolean;
function Redo(out UndoData: TUndoDataItem): Boolean;
function CanRedo: Boolean;
function GotoVersion(Index: Integer; out UndoData: TUndoDataItem): Boolean;
procedure CreateDataStream(out Data: pointer; out Len: UInt64);
procedure SaveToStream(AStream: TStream);
procedure LoadFromStream(AStream: TStream);
procedure LoadFromBuffer(const Data: pointer; const Len: UInt64);
property UndoData[Index: Integer]: TUndoDataItem read GetUndoData;
property Sizes[Index: Integer]: Integer read SizeOfItem;
property Count: Integer read GetLength;
property Size: Integer read FSize;
property FirstItem: Integer read FFirstItem;
property LastItem: Integer read GetLastItem;
property HistoryIndex: Integer read FHistoryIndex;
property MaxSize: Integer read FMaxSize write SetMaxSize default DEFAULT_MAX_UNDO_SIZE;
end;
TFindQuery = record
SearchString: string;
MatchCase: Boolean;
MatchWord: Boolean;
Linebreak: Boolean;
UCBlock: Integer;
end;
const
FQ_NULL = 0;
FQ_NONASCII = -1;
FQ_CONTROL = -2;
FQ_NONCHAR = -3;
FQ_MIN = -3;
function MakeFindQuery(const ASearchString: string; AMatchCase, AMatchWord, ALinebreak: Boolean): TFindQuery; overload;
function MakeFindQuery(UCBlock: Integer): TFindQuery; overload;
type
TTextSpan = record
A, B: TPoint;
end;
TFindData = array of TTextSpan;
TFileStatisticsFlags = set of (fsfCharTypes, fsfLines, fsfWords, fsSourceCode,
fsCaseSensitive);
const
FILE_STAT_ALL = [fsfCharTypes, fsfLines, fsfWords];
FILE_STAT_CHARS = [fsfCharTypes];
FILE_STAT_LINES = [fsfLines];
FILE_STAT_WORDS = [fsfWords];
const
LINE_CONTROL_CLASS = #$FFFF ;
LINE_CONTROL_PREFIX = #$FFFC#$FFFF ;
LINE_CLASS_INDICATOR = #$FFFE ;
type
TFileStatistics = record
Flags: TFileStatisticsFlags;
NumLines: Integer;
NumChars: Integer;
NumLetters: Integer;
NumDigits: Integer;
NumWhitespace: Integer;
NumPunctuation: Integer;
MaxLineLength: Integer;
AvgLineLength: real;
LineLengthDistr: array of Integer;
NumWords: Integer;
MaxWordLength: Integer;
AvgWordLength: real;
WordLengthDistr: array of Integer;
procedure Clear;
end;
TCharTestFunction = function(C: Char): Boolean;
TLineChangeType = (lctAll, lctAppend, lctChangeFrom);
TLineChangeEvent = procedure(Sender: TObject; ChangeType: TLineChangeType; From: Integer) of object;
TControlEvent = procedure(Sender: TObject; ControlID: Integer) of object;
TLineEvent = procedure(Sender: TObject; LineIndex: Integer) of object;
TGetControlTextEvent = procedure(Sender: TObject; LineIndex: Integer; var ControlText: string) of object;
TChrTransformFunc = reference to function(C: Char): Char;
TTextTransformFunc = reference to function(const AText: string): string;
function ChrUpperCase(C: Char): Char;
function ChrLowerCase(C: Char): Char;
function ChrInvertCase(C: Char): Char;
function ChrROT13(C: Char): Char;
function ChrCaesar(N: Integer): TChrTransformFunc;
function TxtVigenère(const Key: string; decode: Boolean = False): TTextTransformFunc;
function TxtCamelCase(const AText: string): string;
function TxtSentenceCase(const AText: string): string;
function ReverseText(const AText: string): string;
const
UNICODE_RETURN_SYMBOL = #$23CE;
UNICODE_RETURN_SYMBOL_ALTERNATIVE = #$21B5;
const
DEFAULT_WRAP_AT = #$9#$20#$1680#$2000#$2001#$2002#$2003#$2004#$2005#$2006 +
#$2008#$2009#$200A#$205F#$3000#$180E#$200B#$200C#$200D#$002D#$00AD#$2010 +
#$2013#$2014';:@?=>)]}';
type
TLinkRec = record
Location: TPoint;
EndPos: Integer;
Caption: string;
URL: string;
end;
THyperlink = class
Location: TPoint;
EndPos: Integer;
Caption: string;
ExplicitURL: string;
constructor Create(const ALocation: TPoint; AEndPos: Integer;
const ACaption, AURL: string);
function URL: string;
function ToRecord: TLinkRec;
end;
THyperlinks = TObjectList<THyperlink>;
TEditorState = class
private var
FValid: Boolean;
FFormattingProcessorClassName: string;
FScrollPos: TPoint;
FMultiSize: Boolean;
FOverwrite: Boolean;
FHiddenChrs: Boolean;
FRulerVisible: Boolean;
FZoomLevel: Integer;
FFPCache: PByte;
FFPCacheLen: Integer;
public
constructor Create;
destructor Destroy; override;
property Valid: Boolean read FValid write FValid;
property FormattingProcessor: string read FFormattingProcessorClassName
write FFormattingProcessorClassName;
property ScrollPos: TPoint read FScrollPos write FScrollPos;
property MultiSize: Boolean read FMultiSize write FMultiSize;
property Overwrite: Boolean read FOverwrite write FOverwrite;
property HiddenChrs: Boolean read FHiddenChrs write FHiddenChrs;
property RulerVisible: Boolean read FRulerVisible write FRulerVisible;
property ZoomLevel: Integer read FZoomLevel write FZoomLevel;
property FPCache: PByte read FFPCache write FFPCache;
property FPCacheLen: Integer read FFPCacheLen write FFPCacheLen;
end;
TLineComparer = function(const LineA, LineB: string): Integer;
PFilterOptions = ^TFilterOptions;
TFilterOptions = record
RemoveMatchingLines: Boolean;
Contains,
StartsWith,
EndsWith: string;
MatchCase: Boolean;
end;
TPointArray = array of TPoint;
TWordFreqItem = class
Count: Int64;
InNaturalCase: string;
IsLower: Boolean;
constructor Create(AInNaturalCase: string; AIsLower: Boolean = False;
ACount: Int64 = 1);
end;
TWordFreqDict = TObjectDictionary<string, TWordFreqItem>;
TTextFile = class
private var
FFindData: TFindData;
strict private const
TEXTFILE_SIGNATURE: Cardinal = $53455452;
TEXTFILE_SIGNATURE_FPCACHE: Cardinal = $41435046;
TEXTFILE_SIGNATURE_UNDO: Cardinal = $4F444E55;
strict private type
TFixedString = record
strict private const
MAXLEN = 1024;
public
Data: array[0..MAXLEN] of Char;
class operator Implicit(const S: string): TFixedString;
class operator Implicit(const S: TFixedString): string;
end;
TStreamHeader = record
Signature: Cardinal;
CaretPos,
SelEndPos: TPoint;
SelectionType: TSelectionType;
EditMode: TEditMode;
Modified: Boolean;
FileName: TFixedString;
LineCount: Integer;
Bookmarks: TBookmarkList;
ScrollPos: TPoint;
MultiSize,
Overwrite,
HiddenChars,
RulerVisible: Boolean;
ZoomLevel: Integer;
Encoding: TTextFileFormatInfo;
RecentlyOpened: Boolean;
StrictReadOnly: Boolean;
UseLineClasses: Boolean;
FPClassName: TFixedString;
end;
strict private class var
FAutoReplaceLoaded: Boolean;
FAutoReplaceItems: TAutoReplaceItems;
strict private var
FLines: array of string;
FClasses: array of string;
FCaretPos: TCaretPos;
FOnCaretPosChange: TNotifyEvent;
FOnCaretPosSelChange: TChangeEvent;
FOnChange: TChangeEvent;
FCaretAfterEOL: Boolean;
FOnInputError: TNotifyEvent;
FOnReadOnlyError: TNotifyEvent;
FAutoIndent: Boolean;
FIndentSize: Integer;
FEditMode: TEditMode;
FModified: Boolean;
FFileName: TFileName;
FOnModified: TNotifyEvent;
FHistoryManager: THistoryManager;
FFindDataActualLength: Integer;
FOnFindDataClear: TNotifyEvent;
FFindResultValid: Boolean;
FFindQuery: TFindQuery;
FSingleLine: Boolean;
FOnLineChange: TLineChangeEvent;
FOnControlRemoved: TControlEvent;
FOnLineClassChange: TLineEvent;
FControlAware: Boolean;
FOnGetControlText: TGetControlTextEvent;
FBookmarks: TBookmarkList;
FOnBookmarksMoved: TNotifyEvent;
FWrapAt: string;
FEditorState: TEditorState;
FLineComparer: TLineComparer;
FSortReverseOrder: Boolean;
FDesiredCol: Integer;
FPreserveDesiredCol: Boolean;
FMultiAddLineMode: Integer;
FEncoding: TTextFileFormatInfo;
FRecentlyOpened: Boolean;
FOnLockVisualUpdates,
FOnUnlockVisualUpdates: TNotifyEvent;
FStrictReadOnly: Boolean;
FUseLineClasses: Boolean;
function GetLine(Index: Integer): string;
procedure SetLine(Index: Integer; const Value: string);
function GetClass(Index: Integer): string;
procedure SetClass(Index: Integer; const Value: string);
function GetLineCount: Integer; inline;
function GetLogicalLineCount: Integer;
function GetPhysicalLineWidth(Index: Integer): Integer; inline;
function GetVirtualLineWidth(Index: Integer): Integer; inline;
function GetMaxLineWidth: Integer;
function GetChar(Y, X: Integer): Char; overload;
function GetChar(APoint: TPoint): Char; overload; inline;
procedure CaretPosChange(Sender: TObject);
procedure CaretPosSelChange(Sender: TObject; ChangeType: TChangeType; Data1,
Data2, Data3, Data4: Integer);
procedure Changed(ChangeType: TChangeType; Data1: Integer = 0; Data2: Integer = 0;
Data3: Integer = 0; Data4: Integer = 0);
procedure PostFileChanged(const NumLines: Integer);
procedure InternalAddLine(const ALine: string; const AClassName: string);
procedure InternalAddLines(const NumLines: Integer);
procedure InternalInsertLine(const LineIndex: Integer; const ALine: string; const AClassName: string);
procedure InternalInsertLines(const LineIndex: Integer; const NumLines: Integer);
procedure InternalDeleteLine(const LineIndex: Integer); inline;
procedure InternalDeleteLines(const LineIndex: Integer; const NumLines: Integer);
procedure IssueInputError;
function GetIndentOnReturn(out Len: Integer): string; overload;
function TextIsMultiline(const AText: string): Boolean;
function GetFirstLine(const AText: string): string;
function GetVirtualSpace: string; overload;
function GetVirtualSpace(LineIndex, Col: Integer): string; overload;
function GetText: string;
function GetClassesAsText: string;
procedure SetText(const Value: string); overload;
procedure SetText(const Value, Classes: string); overload;
function GetNumCharacters: Integer;
function GetVirtualTextLength: Integer;
function GetPhysicalTextLength: Integer;
function GetClassLength: Integer;
function GetSelText: string;
procedure InternalZero;
function GetSelLength: Integer;
procedure SetSelLength(const Value: Integer);
procedure IssueReadOnlyError;
procedure Modified;
function PrevChar(const APoint: TPoint): TPoint;
function NextChar(const APoint: TPoint): TPoint;
procedure LoadAutoReplaceItems;
function GetSelStart: Integer;
procedure SetSelStart(const Value: Integer);
procedure InternalClearFindData;
procedure AddFindData(const A, B: TPoint); overload; inline;
procedure AddFindData(const A: TPoint); overload; inline;
procedure EndAddFindData;
function GetFindData(Index: Integer): TTextSpan;
function GetFindCount: Integer;
procedure ReplaceInLineDiffWidth(const ReplaceText: string);
procedure ReplaceInLineSameWidth(const ReplaceText: string);
procedure ReplaceMultilineDiffWidth(const ReplaceText: string);
procedure ReplaceMultilineSameWidth(const ReplaceText: string);
function CompareFindQuery(const AFindQuery: TFindQuery): Boolean;
function HasQueryResult(const AFindQuery: TFindQuery): Boolean;
function GetSingleLineText: string;
procedure SetSingleLine(const Value: Boolean);
procedure SetCaretAfterEOL(const Value: Boolean);
procedure LineArrayChanged;
function IsControlLine: Boolean; overload; inline;
function IsControlLine(LineIndex: Integer): Boolean; overload; inline;
procedure LineClassChanged(LineIndex: Integer);
function GetCurrentClass: string;
function GetControlText(LineIndex: Integer): string;
function GetDecoratedControlText(LineIndex: Integer): string; inline;
function GetEmptyBookmarkIndex: Integer;
function GetBookmark(Index: Integer): TPoint;
function GetBookmarkCount: Integer;
function GetUsedBookmarkCount: Integer;
function GetHasBookmarks: Boolean;
function PushBookmarks(LineIndex, ColIndex: Integer; NumChars: Integer = 1): Boolean;
function PushMultiCarets(var ACarets: TPointArray; LineIndex, ColIndex: Integer; NumChars: Integer = 1): Boolean;
function PushBookmarksInternal(LineIndex: Integer; NumChars: Integer = 1): Boolean;
function PushBookmarksEx(FirstLine, LastLine: Integer; NumChars: Integer = 1): Boolean;
function QushBookmarks(LineIndex, ColIndex: Integer): Boolean;
function QushBookmarksEx(SelectionType: TSelectionType;
const FirstPoint, SecondPoint: TPoint): Boolean;
function RushBookmarks(const FirstPoint: TPoint): Boolean;
function RushBookmarksInternal(const FirstPoint: TPoint): Boolean;
function RushBookmarksEx(const FirstPoint, SecondPoint: TPoint): Boolean;
function SushBookmarks(FirstLine, SecondLine: Integer; Silent: Boolean = False): Boolean;
function TushBookmarks(Line: Integer; NumLines: Integer = 1): Boolean;
function TushBookmarksInternal(Line: Integer; NumLines: Integer = 1): Boolean;
function DeleteBookmarksOnLine(Line: Integer): Boolean;
procedure BookmarksMoved;
procedure InternalSwapLines(FirstLine, SecondLine: Integer;
BookmarkAware: Boolean = True);
procedure SortRecursive(AFirstLine, ALastLine: Integer; BookmarkAware: Boolean = True);
procedure SetChar(Y, X: Integer; const Value: Char);
procedure IntersectFindDataWithSelection;
procedure ApplyUndoRecord(const UndoData: TUndoDataItem);
procedure LockVisualUpdates;
procedure UnlockVisualUpdates;
function LineMatches(LineIndex: Integer;
const ACriteria: TFilterOptions): Boolean;
function GetAutoReplaceItem(Index: Integer): TAutoReplaceItem;
function GetAutoReplaceItemCount: Integer;
procedure SanitizeSelection;
function GetLastLine: string;
procedure SetLastLine(const AText: string);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure ClearFindData;
function GetIndexOfPoint(const APoint: TPoint): Integer;
function GetPhysicalIndexOfPoint(const APoint: TPoint): Integer;
function GetPhysicalPhysicalIndexOfPoint(const APoint: TPoint): Integer;
function GetPointOfIndex(const Index: Integer): TPoint;
function CharacterExists(Y, X: Integer): Boolean; overload; inline;
function CharacterExists(APoint: TPoint): Boolean; overload; inline;
function CharacterExistsEx(Y, X: Integer): Boolean; overload; inline;
function CharacterExistsEx(APoint: TPoint): Boolean; overload; inline;
function ValidCaretPos(APoint: TPoint): Boolean; inline;
function AtEOL: Boolean; inline;
function AtOrBeyondEOL: Boolean; inline;
function BeyondEOL: Boolean; inline;
function AtEOF: Boolean; inline;
function AtOrBeyondEOF: Boolean; inline;
function AtLastLine: Boolean; inline;
function AtSOF: Boolean; inline;
function CurrentLine: string;
function LineToRight: string;
function LineToLeft: string;
procedure GotoSOF(Selection: Boolean = False);
procedure GotoEOF(Selection: Boolean = False);
procedure GotoBottomRight(Selection: Boolean = False);
procedure AddLine(const ALine: string; const AClassName: string); overload;
procedure AddLine(const ALine: string); overload;
procedure BeginAddLine;
procedure EndAddLine;
procedure InsertLine(const ALine: string; const AClassName: string; LineIndex: Integer); overload;
procedure InsertLine(const ALine: string; LineIndex: Integer); overload;
procedure InsertChar(const AChar: Char; const Overwrite: Boolean = False);
function IndexOf(const ALine: string): Integer;
function IndexOfText(const ALine: string): Integer;
function IndexOfText2(const ALine: string): Integer;
procedure MultiInsertChar(var ACarets: TPointArray; const AChar: Char; const Overwrite: Boolean = False);
procedure Backspace(Word: Boolean = False);
procedure MultiBackspace(var ACarets: TPointArray);
procedure Delete(Word: Boolean = False);
procedure Left(Word: Boolean = False; Selection: Boolean = False; Block: Boolean = False);
procedure Right(Word: Boolean = False; Selection: Boolean = False; Block: Boolean = False);
procedure Up(Selection: Boolean = False; Block: Boolean = False);
procedure Down(Selection: Boolean = False; Block: Boolean = False);
procedure Return;
procedure Home(AFile: Boolean = False; Selection: Boolean = False);
procedure KEnd(AFile: Boolean = False; Selection: Boolean = False);
function HasSelection: Boolean; inline;
function SelectionIsMultiline: Boolean; inline;
procedure ClearSelection;
function PrevWordBoundary(Point: TPoint): Integer; overload; inline;
function NextWordBoundary(Point: TPoint): Integer; overload; inline;
function PrevWordBoundary(Y, X: Integer): Integer; overload;
function NextWordBoundary(Y, X: Integer): Integer; overload;
function PrevWordBoundary: Integer; overload;
function NextWordBoundary: Integer; overload;
function GetIndent(LineIndex: Integer): Integer; overload;
function GetIndent: Integer; overload;
function LineIsEmpty(const LineIndex: Integer): Boolean;
property LastLine: string read GetLastLine write SetLastLine;
procedure InsertText(const AText: string);
procedure MultiInsertText(var ACarets: TPointArray; const AText: string);
procedure InsertTextAsBlock(const AText: string);
procedure SurroundText(const APrefix, APostfix: string);
procedure CutToClipboard;
procedure CopyToClipboard;
function PasteFromClipboard: Boolean;
function PasteFromClipboardAsBlock: Boolean;
procedure ClearLine(LineIndex: Integer); overload;
procedure ClearLine; overload;
function SwapLines(FirstLine, SecondLine: Integer): Boolean;
function SwapLinesAbove: Boolean;
function SwapLinesBelow: Boolean;
function ReplaceCodepoint: Boolean;
function IsCharInRgn(X, Y: Integer; SelectionType: TSelectionType; const FirstPoint, SecondPoint: TPoint): Boolean; overload;
function IsCharInRgn(const Point: TPoint; SelectionType: TSelectionType; const FirstPoint, SecondPoint: TPoint): Boolean; overload; inline;
function IsCharSel(const X, Y: Integer): Boolean; overload;
function IsCharSel(const Point: TPoint): Boolean; overload; inline;
function IsCharFound(const X, Y: Integer): Boolean;
procedure SelectAll;
procedure SelectNone;
procedure SelectAllNone;
function AllSelected: Boolean;
function GetWordBoundary(const Point: TPoint; out StartPos, EndPos: Integer; PascalIdent: Boolean = False): Boolean; overload;
function GetWordBoundary(out StartPos, EndPos: Integer; PascalIdent: Boolean = False): Boolean; overload;
function GetWord(const Point: TPoint; PascalIdent: Boolean = False): string; overload;
function GetWord(PascalIdent: Boolean = False): string; overload;
function GetURLAtCaret(out AURL: string): Boolean;
function SelectWord: Boolean;
procedure SelectLines(const ALineA, ALineB: Integer);
procedure SelectLine(const ALineIndex: Integer); overload;
procedure SelectLine; overload;
procedure NewFile;
procedure NewFileAndInitUndo;
procedure SaveToFile(const FileName: TFileName; TrimRight: Boolean = False;
AExport: Boolean = False);
procedure LoadFromFile(const FileName: TFileName; Encoding: TEncoding;
ClassAware: Boolean = False);
procedure LoadFromFileAndInitUndo(const FileName: TFileName; Encoding: TEncoding);
procedure AddIndent;
procedure RemoveIndent;
procedure RemoveAllIndent;
function CanAutoReplace(out StartPos, Index: Integer): Boolean;
procedure DoAutoReplace(const StartPos, Index: Integer);
function AutoReplace: Boolean;
function MatchBracket(const BracketPoint: TPoint): TPoint;
procedure AddUndoRecord(const AComment: string; UID: UNDONAMEID); overload;
procedure AddUndoRecord; overload;
procedure ClearUndoHistory;
function CanUndo: Boolean;
function Undo: Boolean;
function CanRedo: Boolean;
function Redo: Boolean;
function GotoHistoryVersion(Index: Integer): Boolean;
function Find(AFindData: TFindQuery; AInternal: Boolean = False): Integer;
function ReplaceAll(const ReplaceText: string; SelOnly: Boolean = False): Integer;
function NumCharsOfType(CharTestFunction: TCharTestFunction): Integer;
function GetFileStatistics(AFileStatisticsFlags: TFileStatisticsFlags = FILE_STAT_ALL;
AWordFreqs: TWordFreqDict = nil): TFileStatistics;
function GetUnicodeBlockStatistics: TIntegerArray;
function GetControlCharCount: Integer;
function GetNoncharacterCount: Integer;
function LineExists(LineIndex: Integer): Boolean; inline;
function DeleteControlAtLine(const LineIndex: Integer): Boolean;
procedure TrimRight;
procedure ClearBookmarks;
procedure AddBookmark(AIndex: Integer; const APoint: TPoint); overload;
procedure AddBookmark(AIndex: Integer); overload;
function AddBookmark(const APoint: TPoint): Integer; overload;
function AddBookmark: Integer; overload;
function GotoBookmark(AIndex: Integer): Boolean;
function RemoveGhostBookmarks: Boolean;
function ChrTransform(Transformation: TChrTransformFunc): Boolean;
procedure ChrTransformText(Transformation: TChrTransformFunc);
function FillWithChar(const AChar: Char): Boolean;
property CaretPos: TCaretPos read FCaretPos;
property Lines[Index: Integer]: string read GetLine write SetLine;
function LineArray: TArray<string>;
property Classes[Index: Integer]: string read GetClass write SetClass;
property PhysicalLineWidths[Index: Integer]: Integer read GetPhysicalLineWidth;
property VirtualLineWidths[Index: Integer]: Integer read GetVirtualLineWidth;
property Character[Y, X: Integer]: Char read GetChar write SetChar;
function UnsafeGetChar(Y, X: Integer): Char; inline;
function IsWrappable(const AChar: Char): Boolean; inline;
procedure FindWhereToWrap(ALineIndex: Integer; MaxLength: Integer;
var AWrapList: TIntegerDynArray);
procedure WordWrap(ALineLength: Integer = 80; ANice: Boolean = True;
AChr: Char = #0);
function Sort(AFirstLine, ALastLine: Integer; BookmarkAware: Boolean): Boolean; overload;
function Sort(BookmarkAware: Boolean): Boolean; overload;
function SortSelection(BookmarkAware: Boolean): Boolean;
property LineComparer: TLineComparer read FLineComparer write FLineComparer;
property SortReverseOrder: Boolean read FSortReverseOrder write FSortReverseOrder default False;
function MakeLinesUnique: Boolean;
procedure TruncateAt(AFirstLine, ALastLine, AIndex: Integer;
AChar: Char = #0; PreserveChar: Boolean = False; AReverse: Boolean = False);
procedure Filter(const AFilterOptions: TFilterOptions);
procedure TruncateFileAt(Line, Col: Integer);
procedure SaveToStream(AStream: TStream);
procedure CreateDataStream(out Data: pointer; out Len: UInt64);
procedure LoadFromStream(AStream: TStream);
procedure LoadFromBuffer(const Data: pointer; const Len: UInt64);
property MaxLineWidth: Integer read GetMaxLineWidth;
property LineCount: Integer read GetLineCount;
property LogicalLineCount: Integer read GetLogicalLineCount;
property CaretAfterEOL: Boolean read FCaretAfterEOL write SetCaretAfterEOL default True;
property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
property NumCharacters: Integer read GetNumCharacters;
property VirtualTextLength: Integer read GetVirtualTextLength;
property PhysicalTextLength: Integer read GetPhysicalTextLength;
property PlainText: string read GetText write SetText;
property SelText: string read GetSelText write InsertText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
property IndentSize: Integer read FIndentSize write FIndentSize;
property EditMode: TEditMode read FEditMode write FEditMode default emText;
property FileModified: Boolean read FModified write FModified default False;
property FileName: TFileName read FFileName write FFileName;
property HistoryManager: THistoryManager read FHistoryManager;
property FindData[Index: Integer]: TTextSpan read GetFindData;
property FindCount: Integer read GetFindCount;
property SingleLine: Boolean read FSingleLine write SetSingleLine default False;
property ControlAware: Boolean read FControlAware write FControlAware default False;
function Empty: Boolean;
property Bookmarks[Index: Integer]: TPoint read GetBookmark write AddBookmark;
property BookmarkCount: Integer read GetBookmarkCount;
property UsedBookmarkCount: Integer read GetUsedBookmarkCount;
property HasBookmarks: Boolean read GetHasBookmarks;
property WrapAt: string read FWrapAt write FWrapAt;
property EditorState: TEditorState read FEditorState write FEditorState;
property Encoding: TTextFileFormatInfo read FEncoding write FEncoding;
property RecentlyOpened: Boolean read FRecentlyOpened;
property StrictReadOnly: Boolean read FStrictReadOnly write FStrictReadOnly default False;
property UseLineClasses: Boolean read FUseLineClasses write FUseLineClasses default False;
property AutoReplaceItems[Index: Integer]: TAutoReplaceItem read GetAutoReplaceItem;
property AutoReplaceItemCount: Integer read GetAutoReplaceItemCount;
property OnChange: TChangeEvent read FOnChange write FOnChange;
property OnCaretPosChange: TNotifyEvent read FOnCaretPosChange write FOnCaretPosChange;
property OnCaretPosSelChange: TChangeEvent read FOnCaretPosSelChange write FOnCaretPosSelChange;
property OnFileModified: TNotifyEvent read FOnModified write FOnModified;
property OnInputError: TNotifyEvent read FOnInputError write FOnInputError;
property OnReadOnlyError: TNotifyEvent read FOnReadOnlyError write FOnReadOnlyError;
property OnFindDataClear: TNotifyEvent read FOnFindDataClear write FOnFindDataClear;
property OnLineChange: TLineChangeEvent read FOnLineChange write FOnLineChange;
property OnControlRemoved: TControlEvent read FOnControlRemoved write FOnControlRemoved;
property OnLineClassChange: TLineEvent read FOnLineClassChange write FOnLineClassChange;
property OnGetControlText: TGetControlTextEvent read FOnGetControlText write FOnGetControlText;
property OnBookmarksMoved: TNotifyEvent read FOnBookmarksMoved write FOnBookmarksMoved;
property OnLockVisualUpdates: TNotifyEvent read FOnLockVisualUpdates write FOnLockVisualUpdates;
property OnUnlockVisualUpdates: TNotifyEvent read FOnUnlockVisualUpdates write FOnUnlockVisualUpdates;
end;
const
EDITOR_COMMAND_RIGHT = 1;
EDITOR_COMMAND_LEFT = 2;
EDITOR_COMMAND_DOWN = 3;
EDITOR_COMMAND_UP = 4;
EDITOR_COMMAND_HOME = 5;
EDITOR_COMMAND_END = 6;
EDITOR_COMMAND_PAGE_UP = 7;
EDITOR_COMMAND_PAGE_DOWN = 8;
EDITOR_COMMAND_BACKSPACE = 9;
EDITOR_COMMAND_DELETE = 10;
EDITOR_COMMAND_CLEAR_SELECTION = 11;
EDITOR_COMMAND_SELECT_ALL = 12;
EDITOR_COMMAND_SELECT_NONE = 13;
EDITOR_COMMAND_SELECT_ALL_NONE = 14;
EDITOR_COMMAND_SELECT_WORD = 15;
EDITOR_COMMAND_SELECT_LINE = 16;
EDITOR_COMMAND_CLEAR_LINE = 17;
EDITOR_COMMAND_CUT = 18;
EDITOR_COMMAND_COPY = 19;
EDITOR_COMMAND_PASTE = 20;
EDITOR_COMMAND_UNDO = 21;
EDITOR_COMMAND_REDO = 22;
EDITOR_COMMAND_CLEAR_UNDO_BUFFER = 23;
EDITOR_COMMAND_GOTO_SOF = 24;
EDITOR_COMMAND_GOTO_EOF = 25;
EDITOR_COMMAND_RETURN = 26;
EDITOR_COMMAND_CHAR = 27;
EDITOR_COMMAND_GET_AT_SOF = 28;
EDITOR_COMMAND_GET_AT_EOL = 29;
EDITOR_COMMAND_GET_BEYOND_EOL = 30;
EDITOR_COMMAND_GET_AT_EOF = 31;
EDITOR_COMMAND_GET_AT_LAST_LINE = 32;
EDITOR_COMMAND_GET_HAS_SELECTION = 33;
EDITOR_COMMAND_GET_LINE_NUMBER_0 = 34;
EDITOR_COMMAND_GET_COL_NUMBER_0 = 35;
EDITOR_COMMAND_GET_CHR_INDEX = 36;
EDITOR_COMMAND_GOTO_POINT = 37;
EDITOR_COMMAND_GOTO_INDEX = 38;
EDITOR_COMMAND_GET_SEL_LENGTH = 39;
EDITOR_COMMAND_SET_SEL_LENGTH = 40;
EDITOR_COMMAND_GET_EDIT_MODE = 41;
EDITOR_COMMAND_SET_EDIT_MODE = 42;
EDITOR_COMMAND_GET_SELECTION_MODE = 43;
EDITOR_COMMAND_SET_SELECTION_MODE = 44;
EDITOR_COMMAND_GET_OVERWRITE = 45;
EDITOR_COMMAND_SET_OVERWRITE = 46;
EDITOR_COMMAND_GET_AUTO_REPLACE = 47;
EDITOR_COMMAND_SET_AUTO_REPLACE = 48;
EDITOR_COMMAND_GET_CHAR = 49;
EDITOR_COMMAND_ADD_INDENT = 50;
EDITOR_COMMAND_REMOVE_INDENT = 51;
EDITOR_COMMAND_TRIM_INDENT = 52;
EDITOR_COMMAND_SWAP_UP = 53;
EDITOR_COMMAND_SWAP_DOWN = 54;
EDITOR_COMMAND_GET_AUTO_INDENT = 55;
EDITOR_COMMAND_SET_AUTO_INDENT = 56;
EDITOR_COMMAND_GET_CARET_BEYOND_EOL = 57;
EDITOR_COMMAND_SET_CARET_BEYOND_EOL = 58;
EDITOR_COMMAND_GET_NUM_CHARACTERS = 59;
EDITOR_COMMAND_GET_TEXT_SIZE = 60;
EDITOR_COMMAND_GET_NUM_LINES = 61;
EDITOR_COMMAND_GET_MAX_WIDTH = 62;
EDITOR_COMMAND_SCROLL_TO_CARET = 63;
EDITOR_COMMAND_REPLACE_TOKEN = 64;
EDITOR_COMMAND_REPLACE_CODEPOINT = 65;
EDITOR_COMMAND_UPDATE_SCROLLBARS = 66;
EDITOR_COMMAND_UPDATE_CARET = 67;
EDITOR_COMMAND_UPDATE_CURSOR = 68;
EDITOR_COMMAND_REDRAW = 69;
EDITOR_COMMAND_REDRAW_LINE = 70;
EDITOR_COMMAND_REDRAW_LINE_RANGE = 71;
EDITOR_COMMAND_REDRAW_BLOCK = 72;
EDITOR_COMMAND_GET_MODIFIED = 73;
EDITOR_COMMAND_SET_MODIFIED = 74;
EDITOR_COMMAND_NEW = 75;
EDITOR_COMMAND_CLEAR = 76;
EDITOR_COMMAND_OPEN = 77;
EDITOR_COMMAND_SAVE = 78;
EDITOR_COMMAND_GET_HIDDEN = 79;
EDITOR_COMMAND_SET_HIDDEN = 80;
EDITOR_COMMAND_SET_SELECTION = 81;
EDITOR_COMMAND_GET_MATCH_BRACKETS = 82;
EDITOR_COMMAND_SET_MATCH_BRACKETS = 83;
EDITOR_COMMAND_GET_BRACKET_HIGHLIGHT = 84;
EDITOR_COMMAND_GET_SCROLL_POS_X = 85;
EDITOR_COMMAND_GET_SCROLL_POS_Y = 86;
EDITOR_COMMAND_SET_SCROLL_POS = 87;
EDITOR_COMMAND_REDRAW_CHAR = 88;
EDITOR_COMMAND_REDRAW_CHARS = 89;
EDITOR_COMMAND_GET_INDENT = 90;
EDITOR_COMMAND_SET_INDENT = 91;
EDITOR_COMMAND_GET_TAB_LENGTH = 92;
EDITOR_COMMAND_SET_TAB_LENGTH = 93;
EDITOR_COMMAND_GET_SINGLE_LINE = 94;
EDITOR_COMMAND_SET_SINGLE_LINE = 95;
EDITOR_COMMAND_GET_LABEL_MODE = 96;
EDITOR_COMMAND_SET_LABEL_MODE = 97;
EDITOR_COMMAND_GET_ELLIPSIS_MODE = 98;
EDITOR_COMMAND_SET_ELLIPSIS_MODE = 99;
EDITOR_COMMAND_GET_INPUT_TRANSFORM = 100;
EDITOR_COMMAND_SET_INPUT_TRANSFORM = 101;
EDITOR_COMMAND_GET_NUMBERS_ONLY = 102;
EDITOR_COMMAND_SET_NUMBERS_ONLY = 103;
EDITOR_COMMAND_GET_PASSWORD_CHAR = 104;
EDITOR_COMMAND_SET_PASSWORD_CHAR = 105;
EDITOR_COMMAND_GET_UNICODE_FALLBACK = 106;
EDITOR_COMMAND_SET_UNICODE_FALLBACK = 107;
EDITOR_COMMAND_ESCAPE = 108;
EDITOR_COMMAND_USE_DEFAULT_FALLBACK_FONTS = 109;
EDITOR_COMMAND_SHOW_BALLOON = 110;
EDITOR_COMMAND_HIDE_BALLOON = 111;
EDITOR_COMMAND_SHOW_BALLOON_POS = 112;
EDITOR_COMMAND_IS_BALLOON_VISIBLE = 113;
EDITOR_COMMAND_ADJUST_HEIGHT = 114;
EDITOR_COMMAND_GET_UNDO_LENGTH = 115;
EDITOR_COMMAND_GET_UNDO_SIZE = 116;
EDITOR_COMMAND_GET_UNDO_MAX_SIZE = 117;
EDITOR_COMMAND_SET_UNDO_MAX_SIZE = 118;
EDITOR_COMMAND_GET_UNDO_FIRST_INDEX = 119;
EDITOR_COMMAND_GET_UNDO_LAST_INDEX = 120;
EDITOR_COMMAND_GET_UNDO_POSITION = 121;
EDITOR_COMMAND_WINDOWS_MESSAGE = 122;
EDITOR_COMMAND_COPY_ALL = 123;
EDITOR_COMMAND_FIND = 124;
EDITOR_COMMAND_GET_FIND_COUNT = 125;
EDITOR_COMMAND_FIND_NEXT = 126;
EDITOR_COMMAND_FIND_PREV = 127;
EDITOR_COMMAND_FIND_FROM_TOP = 128;
EDITOR_COMMAND_GET_START_OVER = 129;
EDITOR_COMMAND_SET_START_OVER = 130;
EDITOR_COMMAND_REPLACE_ALL = 131;
EDITOR_COMMAND_ADD_UNDO_RECORD = 132;
EDITOR_COMMAND_POSTTYPE = 133;
EDITOR_COMMAND_TYPE_TIMER_EMD = 134;
EDITOR_COMMAND_TYPE_TIMER_DISABLE = 135;
EDITOR_COMMAND_TYPE_TIMER_DISCONNECT = 136;
EDITOR_COMMAND_TYPE_TIMER_CONNECT = 137;
EDITOR_COMMAND_GET_ENABLED = 138;
EDITOR_COMMAND_SET_ENABLED = 139;
EDITOR_COMMAND_IS_FOCUSED = 140;
EDITOR_COMMAND_TRY_FOCUS = 141;
EDITOR_COMMAND_GET_FIRST_VISIBLE_LINE = 142;
EDITOR_COMMAND_GET_LAST_VISIBLE_LINE = 143;
EDITOR_COMMAND_RECOMPUTE_HOR_EXTENT = 144;
EDITOR_COMMAND_ACTIVATE_CONTROL = 145;
EDITOR_COMMAND_REMOVE_LINE_CONTROL = 146;
EDITOR_COMMAND_ADD_LINE_CONTROL = 147;
EDITOR_COMMAND_ADD_GRAPHICS = 148;
EDITOR_COMMAND_INSERT_LINE_CONTROL = 149;
EDITOR_COMMAND_INSERT_GRAPHICS = 150;
EDITOR_COMMAND_TRIM_RIGHT = 151;
EDITOR_COMMAND_BOOKMARK_SET_MENU = 152;
EDITOR_COMMAND_BOOKMARK_GO_MENU = 153;
EDITOR_COMMAND_BOOKMARK_CLEAR_MENU = 154;
EDITOR_COMMAND_BOOKMARK_SET = 155;
EDITOR_COMMAND_BOOKMARK_GO = 156;
EDITOR_COMMAND_BOOKMARK_CLEAR = 157;
EDITOR_COMMAND_BOOKMARK_CLEAR_ALL = 158;
EDITOR_COMMAND_CLASS_MENU = 159;
EDITOR_COMMAND_CLASS_USE = 160;
EDITOR_COMMAND_CLASS_REMOVE = 161;
EDITOR_COMMAND_SET_FP = 162;
EDITOR_COMMAND_EXPORT_HTML = 163;
EDITOR_COMMAND_OPEN_URL_AT_CARET = 164;
EDITOR_COMMAND_SELECT_LINE_INDEX = 165;
EDITOR_COMMAND_SELECT_LINE_RANGE = 166;
EDITOR_COMMAND_DISABLE_SCROLL_TO_CARET = 167;
EDITOR_COMMAND_ENABLE_SCROLL_TO_CARET = 168;
EDITOR_COMMAND_CREATE_SELECTION = 169;
EDITOR_COMMAND_CREATE_BLOCK_SELECTION = 170;
EDITOR_COMMAND_GET_LINE_HIGHLIGHT = 171;
EDITOR_COMMAND_SET_LINE_HIGHLIGHT = 172;
EDITOR_COMMAND_REDRAW_RULER = 173;
EDITOR_COMMAND_REDRAW_RULER_LINE = 174;
EDITOR_COMMAND_PRINT = 175;
EDITOR_COMMAND_PRINT_SELECTION = 176;
EDITOR_COMMAND_SET_PRINT_MARGINS = 177;
EDITOR_COMMAND_SET_PRINT_WW_OPTIONS = 178;
EDITOR_COMMAND_PRINT_DIALOG = 179;
EDITOR_COMMAND_GET_PRINT_VMARGIN = 180;
EDITOR_COMMAND_GET_PRINT_HMARGIN = 181;
EDITOR_COMMAND_GET_PRINT_WW_OPTIONS = 182;
EDITOR_COMMAND_GET_PRINT_WW_CHAR = 183;
EDITOR_COMMAND_GET_PRINT_WW_COLOR = 184;
EDITOR_COMMAND_WORDWRAP = 185;
EDITOR_COMMAND_UPPER_CASE = 186;
EDITOR_COMMAND_LOWER_CASE = 187;
EDITOR_COMMAND_INVERT_CASE = 188;
EDITOR_COMMAND_SEL_UPPER_CASE = 189;
EDITOR_COMMAND_SEL_LOWER_CASE = 190;
EDITOR_COMMAND_SEL_INVERT_CASE = 191;
EDITOR_COMMAND_CAMEL_CASE = 192;
EDITOR_COMMAND_SENTENCE_CASE = 193;
EDITOR_COMMAND_SEL_CAMEL_CASE = 194;
EDITOR_COMMAND_SEL_SENTENCE_CASE = 195;
EDITOR_COMMAND_SEL_TRANSFORM_MENU = 196;
EDITOR_COMMAND_ROT13 = 197;
EDITOR_COMMAND_CAESAR = 198;
EDITOR_COMMAND_VIGENERE = 199;
EDITOR_COMMAND_SEL_ROT13 = 200;
EDITOR_COMMAND_SEL_CAESAR = 201;
EDITOR_COMMAND_SEL_VIGENERE = 202;
EDITOR_COMMAND_UPDATE_SCROLL_MODE = 203;
EDITOR_COMMAND_GET_SCROLL_MODE = 204;
EDITOR_COMMAND_SORT = 205;
EDITOR_COMMAND_SORT_ALL = 206;
EDITOR_COMMAND_SORT_SEL = 207;
EDITOR_COMMAND_SET_LINE_COMPARER = 208;
EDITOR_COMMAND_GET_LINE_COMPARER = 209;
EDITOR_COMMAND_SET_SORT_REVERSE = 210;
EDITOR_COMMAND_GET_SORT_REVERSE = 211;
EDITOR_COMMAND_MAKE_LINES_UNIQUE = 212;
EDITOR_COMMAND_CLI_NEW_PROMPT = 213;
EDITOR_COMMAND_CLI_WRITELN = 214;
EDITOR_COMMAND_ABORT_SCRIPT = 215;
EDITOR_COMMAND_WRITE_INT = 216;
EDITOR_COMMAND_ABORT_SCRIPT_IF_EOL = 217;
EDITOR_COMMAND_ABORT_SCRIPT_IF_LL = 218;
EDITOR_COMMAND_ABORT_SCRIPT_IF_EOF = 219;
EDITOR_COMMAND_ABORT_SCRIPT_IF_SOF = 220;
EDITOR_COMMAND_SET_SCRIPT_COUNTER = 221;
EDITOR_COMMAND_GET_SCRIPT_COUNTER = 222;
EDITOR_COMMAND_GET_LINE_NUMBER_1 = 223;
EDITOR_COMMAND_GET_COL_NUMBER_1 = 224;
EDITOR_COMMAND_WRITE_DATE = 225;
EDITOR_COMMAND_WRITE_TIME = 226;
EDITOR_COMMAND_WRITE_DATETIME = 227;
EDITOR_COMMAND_GET_TICKCOUNT = 228;
EDITOR_COMMAND_GET_RANDOM_INTEGER = 229;
EDITOR_COMMAND_FIX_REMOVED_LINE_CONTROLS = 230;
EDITOR_COMMAND_CLI_HISTORY_UP = 231;
EDITOR_COMMAND_CLI_HISTORY_DOWN = 232;
EDITOR_COMMAND_CLI_HISTORY_CLEAR = 233;
EDITOR_COMMAND_CLI_HISTORY_ADD = 234;
EDITOR_COMMAND_CLI_GET_HISTORY_LENGTH = 235;
EDITOR_COMMAND_CLI_GET_HISTORY_INDEX = 236;
EDITOR_COMMAND_CLI_HISTORY_RECALL = 237;
EDITOR_COMMAND_BEGIN_ADD_LINES = 238;
EDITOR_COMMAND_END_ADD_LINES = 239;
EDITOR_COMMAND_GET_LISTBOX_MODE = 240;
EDITOR_COMMAND_SET_LISTBOX_MODE = 241;
EDITOR_COMMAND_WRITE_STRING = 242;
EDITOR_COMMAND_WRITE_INPUT_DIALOG = 243;
EDITOR_COMMAND_SET_AS_HYPHEN_ASTERISK_TOGGLE = 244;
EDITOR_COMMAND_SET_MULTI_CHAR_SELECT = 245;
EDITOR_COMMAND_GET_MULTI_CHAR_SELECT = 246;
EDITOR_COMMAND_SET_MULTI_CHAR_REPORT_VIEW = 247;
EDITOR_COMMAND_GET_MULTI_CHAR_REPORT_VIEW = 248;
EDITOR_COMMAND_SET_NO_VERIFY_FONT = 249;
EDITOR_COMMAND_SET_DOUBLE_BUFFERING = 250;
EDITOR_COMMAND_REPLACE_ALL_IN_SELECTION = 251;
EDITOR_COMMAND_SET_BITMAP_EFFECT = 252;
EDITOR_COMMAND_GET_BITMAP_EFFECT = 253;
EDITOR_COMMAND_SET_DISABLED_EFFECT = 254;
EDITOR_COMMAND_GET_DISABLED_EFFECT = 255;
EDITOR_COMMAND_REPEAT = 256;
EDITOR_COMMAND_REPEAT_EX_SET_NUM = 257;
EDITOR_COMMAND_REPEAT_EX_SET_COMMAND = 258;
EDITOR_COMMAND_REPEAT_EX = 259;
EDITOR_COMMAND_RESTORE_MARGINS = 260;
EDITOR_COMMAND_FILL_WITH_CHAR = 261;
EDITOR_COMMAND_PASTE_AS_BLOCK = 262;
EDITOR_COMMAND_TRUNCATE_AT = 263;
EDITOR_COMMAND_TRUNCATE_AT_IN_FILE = 264;
EDITOR_COMMAND_TRUNCATE_AT_IN_SELECTION = 265;
EDITOR_COMMAND_GET_JUST_OPENED = 266;
EDITOR_COMMAND_LOAD_DEFAULT_CLASSES = 267;
EDITOR_COMMAND_BEGIN_VISUAL_UPDATE = 268;
EDITOR_COMMAND_END_VISUAL_UPDATE = 269;
EDITOR_COMMAND_SURROUND_SEL = 270;
EDITOR_COMMAND_FILTER_LINES = 271;
EDITOR_COMMAND_UPDATE_SPI = 272;
EDITOR_COMMAND_SET_STRICT_READONLY = 273;
EDITOR_COMMAND_REMOVE_GHOST_BOOKMARKS = 274;
EDITOR_COMMAND_CHARACTER_FIND = 275;
EDITOR_COMMAND_SEL_REVERSE = 276;
EDITOR_COMMAND_CENTER_ON_SELECTION = 277;
EDITOR_COMMAND_COPY_LINE = 278;
EDITOR_COMMAND_BACK = 279;
EDITOR_COMMAND_FORWARD = 280;
EDITOR_COMMAND_REFRESH = 281;
EDITOR_COMMAND_TOGGLE_CARET_BEYOND_EOL = 282;
IMAGE_COMMAND_COPY = 1;
IMAGE_COMMAND_REMOVE = 2;
IMAGE_COMMAND_CHANGE = 3;
RULER_COMMAND_PROPERTIES = 1;
type
TFontRecord = record
Size: Integer;
Style: TFontStyles;
Color: TColor;
BoxSize: TSize;
end;
TClassRecord = record
Name: string;
Format: TFontRecord;
end;
TClassArray = array of TClassRecord;
function FontRecord(ASize: Integer; AStyle: TFontStyles; AColor: TColor): TFontRecord;
function MakeClass(const AName: string; ASize: Integer; AStyle: TFontStyles; AColor: TColor): TClassRecord;
type
TInputTransform = (itNone, itUpperCase, itLowerCase, itSuperscript,
itSubscript, itCircled, itParenthesized, itFullStop, itDoublyCircled);
TBalloonPersistence = (bpTime, bpScroll, bpCaretPos, bpModify, bpRemain);
TBalloonIconKind = (bikNone = TTI_NONE, bikInfo = TTI_INFO,
bikWarning = TTI_WARNING, bikError = TTI_ERROR, bikInfoLarge = TTI_INFO_LARGE,
bikWarningLarge = TTI_WARNING_LARGE, bikErrorLarge = TTI_ERROR_LARGE);
TLineControlRecord = record
ID: Integer;
Control: TControl;
OriginalSize: TSize;
end;
TCSSDeclaration = record
CSSProperty: string;
Value: string;
end;
TCSSDeclarationBlock = array of TCSSDeclaration;
TCSSRule = record
Selector: string;
Declarations: TCSSDeclarationBlock;
end;
TCSSRules = array of TCSSRule;
function MakeCSSDeclaration(const AProperty, AValue: string): TCSSDeclaration;
function MakeCSSOptionalDeclaration(const AUse: Boolean; const AProperty, AValue: string): TCSSDeclaration;
function MakeCSSRule(const ASelector: string; const ADeclarations: array of TCSSDeclaration): TCSSRule;
function CSSColor(const AColor: TColor): string;
const
SC_BLACK = $00000000;
SC_BLUE = $00FF0000;
SC_RED = $00000099;
SC_GREEN = $00008000;
SC_GRAY = $00999999;
SC_INTENSE_RED = $000000FF;
type
TColorScheme = record
Default,
Accent1,
Accent2,
Accent3,
Soft,
Intense: TColor;
end;
const
DEFAULT_COLORS: TColorScheme = (Default: SC_BLACK; Accent1: SC_BLUE; Accent2:
SC_GREEN; Accent3: SC_RED; Soft: SC_GRAY; Intense: SC_INTENSE_RED);
type
TGetLineWidthEvent = function(ALineIndex: Integer): Integer of object;
TGetCharEvent = function(ALineIndex, ACol: Integer): Char of object;
TGetLineCountEvent = function: Integer of object;
TGetWordEvent = function(const APoint: TPoint; APascalIdent: Boolean = False): string of object;
TGetWordBoundaryEvent = function(const APoint: TPoint; out SP, EP: Integer): Boolean of object;
TFormattingProcessor = class(TComponent)
strict private
FUpdateLevel: Integer;
FOnChange: TNotifyEvent;
FOnGetLineWidth: TGetLineWidthEvent;
FOnGetChar: TGetCharEvent;
FOnGetLineCount: TGetLineCountEvent;
FOnGetWord: TGetWordEvent;
FOnGetWordBoundary: TGetWordBoundaryEvent;
strict protected
procedure Changed;
function TextLineWidth(ALineIndex: Integer): Integer; inline;
function TextChar(ALineIndex, ACol: Integer): Char; inline;
function TextLineCount: Integer; inline;
function TextGetWord(const APoint: TPoint; APascalIdent: Boolean = False): string; inline;
function TextGetWordBoundary(const APoint: TPoint; out SP, EP: Integer): Boolean; inline;
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); virtual; abstract;
function FileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord; virtual;
function GetCSSRules: TCSSRules; virtual; abstract;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; virtual; abstract;
procedure BeginUpdate;
procedure EndUpdate;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); virtual; abstract;
function GetCache(out ACache: PByte): Integer; virtual;
function RestoreCache(ACache: PByte; ASize: Integer): Boolean; virtual;
procedure ClearCache; virtual;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnGetLineWidth: TGetLineWidthEvent read FOnGetLineWidth write FOnGetLineWidth;
property OnGetChar: TGetCharEvent read FOnGetChar write FOnGetChar;
property OnGetLineCount: TGetLineCountEvent read FOnGetLineCount write FOnGetLineCount;
property OnGetWord: TGetWordEvent read FOnGetWord write FOnGetWord;
property OnGetWordBoundary: TGetWordBoundaryEvent read FOnGetWordBoundary write FOnGetWordBoundary;
end;
TVowelsAndConsonantsFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_VOWEL_COLOR = SC_RED;
DEFAULT_CONSONANT_COLOR = SC_GREEN;
DEFAULT_VOWELS_BOLD = True;
DEFAULT_CONSONANTS_BOLD = False;
private const
CSS_CLASS_VOWEL = 0;
CSS_CLASS_CONSONANT = 1;
CSS_CLASS_HIGH = CSS_CLASS_CONSONANT;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FVowelColor,
FConsonantColor: TColor;
FVowelsBold: Boolean;
FConsonantsBold: Boolean;
procedure SetConsonantColor(const Value: TColor);
procedure SetVowelColor(const Value: TColor);
procedure SetConsonantsBold(const Value: Boolean);
procedure SetVowelsBold(const Value: Boolean);
function IsVowel(const AChar: Char): Boolean;
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer; AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property VowelColor: TColor read FVowelColor write SetVowelColor default DEFAULT_VOWEL_COLOR;
property ConsonantColor: TColor read FConsonantColor write SetConsonantColor default DEFAULT_CONSONANT_COLOR;
property VowelsBold: Boolean read FVowelsBold write SetVowelsBold default DEFAULT_VOWELS_BOLD;
property ConsonantBold: Boolean read FConsonantsBold write SetConsonantsBold default DEFAULT_CONSONANTS_BOLD;
end;
TBracketListFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_BRACKET_COLOR = SC_GRAY;
private const
CSS_CLASS_TEXT = 0;
CSS_CLASS_BRACKET = 1;
CSS_CLASS_HIGH = CSS_CLASS_BRACKET;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FBracketColor: TColor;
procedure SetBracketColor(const Value: TColor);
function InBracket(ALineIndex, ACol: Integer): Boolean;
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer; AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property BracketColor: TColor read FBracketColor write SetBracketColor default DEFAULT_BRACKET_COLOR;
end;
TASRefFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_HEADING_COLOR = SC_GREEN;
DEFAULT_LINK_COLOR = SC_BLUE;
DEFAULT_CODE_COLOR = SC_GRAY;
private const
CSS_CLASS_TEXT = 0;
CSS_CLASS_LINK = 1;
CSS_CLASS_CODE = 2;
CSS_CLASS_INPUT = 3;
CSS_CLASS_OUTPUT = 4;
CSS_CLASS_FAILURE = 5;
CSS_CLASS_HEADING1 = 6;
CSS_CLASS_HEADINGn = 7;
CSS_CLASS_DELIMITER = 8;
CSS_CLASS_HIGH = CSS_CLASS_DELIMITER;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FHeadingColor: TColor;
FLinkColor: TColor;
FCodeColor: TColor;
procedure SetHeadingColor(const Value: TColor);
procedure SetLinkColor(const Value: TColor);
procedure SetCodeColor(const Value: TColor);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer; AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property HeadingColor: TColor read FHeadingColor write SetHeadingColor default DEFAULT_HEADING_COLOR;
property LinkColor: TColor read FLinkColor write SetLinkColor default DEFAULT_LINK_COLOR;
property CodeColor: TColor read FCodeColor write SetCodeColor default DEFAULT_CODE_COLOR;
end;
TXMLFormattingProcessor = class(TFormattingProcessor)
private type
TXMLChrKind = (ckXmlUndefined = -1, ckXmlText, ckXmlTag, ckXmlTagName,
ckXmlParam, ckXmlValue, ckXmlComment, ckCDATAMarker, ckCDATA,
ckXmlSignatureOnly);
TFmtBreak = record
x: Integer;
kind: TXMLChrKind;
signature: Cardinal;
end;
private const
DEFAULT_TAG_COLOR = SC_BLUE;
DEFAULT_TAG_NAME_COLOR = SC_RED;
DEFAULT_TAG_NAME_BOLD = False;
DEFAULT_PARAM_COLOR = SC_BLUE;
DEFAULT_VALUE_COLOR = SC_GREEN;
DEFAULT_COMMENT_COLOR = SC_GRAY;
DEFAULT_CDATAM_COLOR = SC_GRAY;
DEFAULT_CDATAM_BOLD = True;
DEFAULT_CDATA_COLOR = SC_BLACK;
private const
CSS_CLASS_TEXT = 0;
CSS_CLASS_TAG = 1;
CSS_CLASS_TAG_NAME = 2;
CSS_CLASS_PARAM = 3;
CSS_CLASS_VALUE = 4;
CSS_CLASS_COMMENT = 5;
CSS_CLASS_CDATAMARKER = 6;
CSS_CLASS_CDATA = 7;
CSS_CLASS_HIGH = CSS_CLASS_CDATA;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FValueColor: TColor;
FParamColor: TColor;
FTagColor: TColor;
FCommentColor: TColor;
FTokens: array of array of TFmtBreak;
FTagNameColor: TColor;
FTagNameBold: Boolean;
FCDATAMColor: TColor;
FCDATAMBold: Boolean;
FCDATAColor: TColor;
procedure SetParamColor(const Value: TColor);
procedure SetTagColor(const Value: TColor);
procedure SetValueColor(const Value: TColor);
function ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
function GetChrKind(ALineIndex, ACol: Integer): TXMLChrKind;
procedure SetCommentColor(const Value: TColor);
procedure PushTokensDownFrom(ALineIndex: Integer);
procedure PushTokensUpFrom(ALineIndex: Integer);
procedure SetTagNameBold(const Value: Boolean);
procedure SetTagNameColor(const Value: TColor);
procedure SetCDATAMBold(const Value: Boolean);
procedure SetCDATAMColor(const Value: TColor);
procedure SetCDATAColor(const Value: TColor);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property TagColor: TColor read FTagColor write SetTagColor default DEFAULT_TAG_COLOR;
property TagNameColor: TColor read FTagNameColor write SetTagNameColor default DEFAULT_TAG_NAME_COLOR;
property TagNameBold: Boolean read FTagNameBold write SetTagNameBold default DEFAULT_TAG_NAME_BOLD;
property ParamColor: TColor read FParamColor write SetParamColor default DEFAULT_PARAM_COLOR;
property ValueColor: TColor read FValueColor write SetValueColor default DEFAULT_VALUE_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor default DEFAULT_COMMENT_COLOR;
property CDATAMarkerColor: TColor read FCDATAMColor write SetCDATAMColor default DEFAULT_CDATAM_COLOR;
property CDATAMarkerBold: Boolean read FCDATAMBold write SetCDATAMBold default DEFAULT_CDATAM_BOLD;
property CDATAColor: TColor read FCDATAColor write SetCDATAColor default DEFAULT_CDATA_COLOR;
end;
TCSSFormattingProcessor = class(TFormattingProcessor)
private type
TCSSChrKind = (ckCssUndefined = -1, ckCssSelector, ckCssBlockDelim,
ckCssProperty, ckCssValue, ckCssImportant, ckCssComment);
TFmtBreak = record
x: Integer;
kind: TCSSChrKind;
signature: Cardinal;
end;
private const
DEFAULT_SELECTOR_COLOR = SC_RED;
DEFAULT_SELECTOR_BOLD = False;
DEFAULT_PROPERTY_COLOR = SC_BLUE;
DEFAULT_VALUE_COLOR = SC_BLACK;
DEFAULT_COMMENT_COLOR = SC_GRAY;
DEFAULT_BLOCK_DELIM_COLOR = SC_RED;
DEFAULT_BLOCK_DELIM_BOLD = False;
DEFAULT_IMPORTANT_COLOR = SC_INTENSE_RED;
DEFAULT_IMPORTANT_BOLD = True;
private const
CSS_CLASS_SELECTOR = 0;
CSS_CLASS_PROPERTY = 1;
CSS_CLASS_VALUE = 2;
CSS_CLASS_COMMENT = 3;
CSS_CLASS_BLOCK_DELIM = 4;
CSS_CLASS_IMPORTANT = 5;
CSS_CLASS_HIGH = CSS_CLASS_IMPORTANT;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FSelectorColor: TColor;
FSelectorBold: Boolean;
FPropertyColor: TColor;
FValueColor: TColor;
FCommentColor: TColor;
FTokens: array of array of TFmtBreak;
FBlockDelimColor: TColor;
FBlockDelimBold: Boolean;
FImportantBold: Boolean;
FImportantColor: TColor;
procedure SetSelectorColor(const Value: TColor);
procedure SetSelectorBold(const Value: Boolean);
procedure SetPropertyColor(const Value: TColor);
procedure SetValueColor(const Value: TColor);
procedure SetCommentColor(const Value: TColor);
function GetChrKind(ALineIndex, ACol: Integer): TCSSChrKind;
function ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
procedure SetBlockDelimColor(const Value: TColor);
procedure SetBlockDelimBold(const Value: Boolean);
procedure SetImportantBold(const Value: Boolean);
procedure SetImportantColor(const Value: TColor);
procedure PushTokensDownFrom(ALineIndex: Integer);
procedure PushTokensUpFrom(ALineIndex: Integer);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property SelectorColor: TColor read FSelectorColor write SetSelectorColor default DEFAULT_SELECTOR_COLOR;
property SelectorBold: Boolean read FSelectorBold write SetSelectorBold default DEFAULT_SELECTOR_BOLD;
property PropertyColor: TColor read FPropertyColor write SetPropertyColor default DEFAULT_PROPERTY_COLOR;
property ValueColor: TColor read FValueColor write SetValueColor default DEFAULT_VALUE_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor default DEFAULT_COMMENT_COLOR;
property BlockDelimColor: TColor read FBlockDelimColor write SetBlockDelimColor default DEFAULT_BLOCK_DELIM_COLOR;
property BlockDelimBold: Boolean read FBlockDelimBold write SetBlockDelimBold default DEFAULT_BLOCK_DELIM_BOLD;
property ImportantColor: TColor read FImportantColor write SetImportantColor default DEFAULT_IMPORTANT_COLOR;
property ImportantBold: Boolean read FImportantBold write SetImportantBold default DEFAULT_IMPORTANT_BOLD;
end;
TINIFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_SECTION_COLOR = SC_RED;
DEFAULT_SECTION_BOLD = True;
DEFAULT_NAME_COLOR = SC_BLUE;
DEFAULT_VALUE_COLOR = SC_BLACK;
DEFAULT_COMMENT_COLOR = SC_GRAY;
private const
CSS_CLASS_SECTION = 0;
CSS_CLASS_NAME = 1;
CSS_CLASS_VALUE = 2;
CSS_CLASS_COMMENT = 3;
CSS_CLASS_EQUALS = 4;
CSS_CLASS_HIGH = CSS_CLASS_EQUALS;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FSectionColor: TColor;
FSectionBold: Boolean;
FValueColor: TColor;
FNameColor: TColor;
FCommentColor: TColor;
procedure SetSectionColor(const Value: TColor);
procedure SetSectionBold(const Value: Boolean);
procedure SetCommentColor(const Value: TColor);
procedure SetNameColor(const Value: TColor);
procedure SetValueColor(const Value: TColor);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property SectionColor: TColor read FSectionColor write SetSectionColor default DEFAULT_SECTION_COLOR;
property SectionBold: Boolean read FSectionBold write SetSectionBold default DEFAULT_SECTION_BOLD;
property NameColor: TColor read FNameColor write SetNameColor default DEFAULT_NAME_COLOR;
property ValueColor: TColor read FValueColor write SetValueColor default DEFAULT_VALUE_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor DEFAULT DEFAULT_COMMENT_COLOR;
end;
TPascalFormattingProcessor = class(TFormattingProcessor)
private type
TPascalChrKind = (ckPasUndefined = -1, ckPasKeyword, ckPasString,
ckPasNumber, ckPasComment, ckPasCompilerDirective);
TFmtBreak = record
x: Integer;
kind: TPascalChrKind;
signature: Cardinal;
end;
private const
PASCAL_IDENTS: array[0..118] of string = ('absolute', 'abstract', 'and',
'array', 'as', 'asm', 'assembler', 'automated', 'begin', 'case', 'cdecl',
'class', 'const', 'constructor', 'contains', 'default', 'delayed',
'deprecated', 'destructor', 'dispid', 'dispinterface', 'div', 'do',
'downto', 'dynamic', 'else', 'end', 'except', 'experimental', 'export',
'exports', 'external', 'far', 'file', 'final', 'finalization', 'finally',
'for', 'forward', 'function', 'goto', 'helper', 'if', 'implementation',
'implements', 'in', 'index', 'inherited', 'initialization', 'inline',
'interface', 'is', 'label', 'library', 'local', 'message', 'mod', 'name',
'near', 'nil', 'nodefault', 'not', 'object', 'of', 'operator', 'or', 'out',
'overload', 'override', 'package', 'packed', 'pascal', 'platform',
'private', 'procedure', 'program', 'property', 'protected', 'public',
'published', 'raise', 'read', 'readonly', 'record', 'reference',
'register', 'reintroduce', 'repeat', 'requires', 'resident',
'resourcestring', 'safecall', 'sealed', 'set', 'shl', 'shr', 'static',
'stdcall', 'stored', 'strict', 'string', 'then', 'threadvar', 'to', 'try',
'type', 'unit', 'unsafe', 'until', 'uses', 'var', 'varargs', 'while',
'winapi', 'virtual', 'with', 'write', 'writeonly', 'xor');
private const
DEFAULT_KEYWORD_COLOR = SC_RED;
DEFAULT_KEYWORD_BOLD = True;
DEFAULT_STRING_COLOR = SC_BLUE;
DEFAULT_NUMBER_COLOR = SC_BLUE;
DEFAULT_COMMENT_COLOR = SC_GREEN;
DEFAULT_COMPILER_DIRECTIVE_COLOR = SC_RED;
private const
CSS_CLASS_DEFAULT = 0;
CSS_CLASS_KEYWORD = 1;
CSS_CLASS_STRING = 2;
CSS_CLASS_NUMBER = 3;
CSS_CLASS_COMMENT = 4;
CSS_CLASS_COMPILER_DIRECTIVE = 5;
CSS_CLASS_HIGH = CSS_CLASS_COMPILER_DIRECTIVE;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FKeywordColor: TColor;
FKeywordBold: Boolean;
FStringColor: TColor;
FNumberColor: TColor;
FCommentColor: TColor;
FTokens: array of array of TFmtBreak;
FCompilerDirectiveColor: TColor;
procedure SetKeywordColor(const Value: TColor);
procedure SetKeywordBold(const Value: Boolean);
procedure SetStringColor(const Value: TColor);
procedure SetNumberColor(const Value: TColor);
procedure SetCommentColor(const Value: TColor);
procedure SetCompilerDirectiveColor(const Value: TColor);
function ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
function GetChrKind(ALineIndex, ACol: Integer): TPascalChrKind;
procedure PushTokensDownFrom(ALineIndex: Integer);
procedure PushTokensUpFrom(ALineIndex: Integer);
public
constructor Create(AOwner: TComponent); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
function GetCSSRules: TCSSRules; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
function GetCache(out ACache: PByte): Integer; override;
function RestoreCache(ACache: PByte; ASize: Integer): Boolean; override;
procedure ClearCache; override;
published
property KeywordColor: TColor read FKeywordColor write SetKeywordColor default DEFAULT_KEYWORD_COLOR;
property KeywordBold: Boolean read FKeywordBold write SetKeywordBold default DEFAULT_KEYWORD_BOLD;
property StringColor: TColor read FStringColor write SetStringColor default DEFAULT_STRING_COLOR;
property NumberColor: TColor read FNumberColor write SetNumberColor default DEFAULT_NUMBER_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor default DEFAULT_COMMENT_COLOR;
property CompilerDirectiveColor: TColor read FCompilerDirectiveColor write SetCompilerDirectiveColor default DEFAULT_COMPILER_DIRECTIVE_COLOR;
end;
TAlgoSimFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_KEYWORD_COLOR = SC_RED;
DEFAULT_KEYWORD_BOLD = True;
DEFAULT_STRING_COLOR = SC_BLUE;
DEFAULT_NUMBER_COLOR = SC_BLUE;
DEFAULT_COMMENT_COLOR = SC_GREEN;
private const
CSS_CLASS_DEFAULT = 0;
CSS_CLASS_KEYWORD = 1;
CSS_CLASS_STRING = 2;
CSS_CLASS_NUMBER = 3;
CSS_CLASS_COMMENT = 4;
CSS_CLASS_HIGH = CSS_CLASS_COMMENT;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FKeywordColor: TColor;
FKeywordBold: Boolean;
FStringColor: TColor;
FNumberColor: TColor;
FCommentColor: TColor;
procedure SetKeywordColor(const Value: TColor);
procedure SetKeywordBold(const Value: Boolean);
procedure SetStringColor(const Value: TColor);
procedure SetNumberColor(const Value: TColor);
procedure SetCommentColor(const Value: TColor);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property KeywordColor: TColor read FKeywordColor write SetKeywordColor default DEFAULT_KEYWORD_COLOR;
property KeywordBold: Boolean read FKeywordBold write SetKeywordBold default DEFAULT_KEYWORD_BOLD;
property StringColor: TColor read FStringColor write SetStringColor default DEFAULT_STRING_COLOR;
property NumberColor: TColor read FNumberColor write SetNumberColor default DEFAULT_NUMBER_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor default DEFAULT_COMMENT_COLOR;
end;
TAlgosim3FormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_STRING_COLOR = SC_BLUE;
DEFAULT_NUMBER_COLOR = SC_RED;
private const
CSS_CLASS_DEFAULT = 0;
CSS_CLASS_NUMBER = 1;
CSS_CLASS_STRING = 2;
CSS_CLASS_HIGH = CSS_CLASS_STRING;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
strict private type
TChrEvent = (ceDefault, ceNumberBegin, ceNumberEnd, ceStringBegin, ceStringEnd);
strict private var
FChrEvents: TObjectList<TList<TPair<Integer, TChrEvent>>>;
private var
FNumberColor: TColor;
FStringColor: TColor;
procedure SetNumberColor(const Value: TColor);
procedure SetStringColor(const Value: TColor);
procedure Reparse(AFromLine: Integer = 0);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property NumberColor: TColor read FNumberColor write SetNumberColor default DEFAULT_NUMBER_COLOR;
property StringColor: TColor read FStringColor write SetStringColor default DEFAULT_STRING_COLOR;
end;
THTMLFormattingProcessor = class(TFormattingProcessor)
private type
THTMLChrKind = (ckHtmlUndefined = -1, ckHtmlText, ckHtmlTag, ckHtmlTagName, ckHtmlParam,
ckHtmlValue, ckHtmlComment, ckHtmlDoctype, ckHtmlCssSelector, ckHtmlCssBlockDelim,
ckHtmlCssProperty, ckHtmlCssValue, ckHtmlCssImportant, ckHtmlCssComment,
ckHtmlScript);
TFmtBreak = record
x: Integer;
kind: THtmlChrKind;
signature: Cardinal;
end;
private const
DEFAULT_TAG_COLOR = SC_BLUE;
DEFAULT_TAG_NAME_COLOR = SC_RED;
DEFAULT_TAG_NAME_BOLD = False;
DEFAULT_PARAM_COLOR = SC_BLUE;
DEFAULT_VALUE_COLOR = SC_GREEN;
DEFAULT_COMMENT_COLOR = SC_GRAY;
DEFAULT_CSS_SELECTOR_COLOR = SC_RED;
DEFAULT_CSS_SELECTOR_BOLD = False;
DEFAULT_CSS_PROPERTY_COLOR = SC_BLUE;
DEFAULT_CSS_VALUE_COLOR = SC_GREEN;
DEFAULT_CSS_COMMENT_COLOR = SC_GRAY;
DEFAULT_CSS_BLOCK_DELIM_COLOR = SC_RED;
DEFAULT_CSS_BLOCK_DELIM_BOLD = False;
DEFAULT_CSS_IMPORTANT_COLOR = SC_INTENSE_RED;
DEFAULT_CSS_IMPORTANT_BOLD = True;
DEFAULT_DOCTYPE_COLOR = SC_GRAY;
DEFAULT_DOCTYPE_BOLD = False;
DEFAULT_DOCTYPE_ITALICS = True;
private const
CSS_CLASS_TEXT = 0;
CSS_CLASS_TAG = 1;
CSS_CLASS_TAG_NAME = 2;
CSS_CLASS_PARAM = 3;
CSS_CLASS_VALUE = 4;
CSS_CLASS_COMMENT = 5;
CSS_CLASS_CSS_SELECTOR = 6;
CSS_CLASS_CSS_PROPERTY = 7;
CSS_CLASS_CSS_VALUE = 8;
CSS_CLASS_CSS_COMMENT = 9;
CSS_CLASS_CSS_BLOCK_DELIM = 10;
CSS_CLASS_CSS_IMPORTANT = 11;
CSS_CLASS_DOCTYPE = 12;
CSS_CLASS_SCRIPT = 13;
CSS_CLASS_HIGH = CSS_CLASS_SCRIPT;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FValueColor: TColor;
FParamColor: TColor;
FTagColor: TColor;
FTagNameColor: TColor;
FTagNameBold: Boolean;
FCommentColor: TColor;
FCssSelectorColor: TColor;
FCssSelectorBold: Boolean;
FCssPropertyColor: TColor;
FCssValueColor: TColor;
FCssCommentColor: TColor;
FCssBlockDelimColor: TColor;
FCssBlockDelimBold: Boolean;
FCssImportantBold: Boolean;
FCssImportantColor: TColor;
FDoctypeColor: TColor;
FDoctypeBold: Boolean;
FDoctypeItalics: Boolean;
FTokens: array of array of TFmtBreak;
procedure SetParamColor(const Value: TColor);
procedure SetTagColor(const Value: TColor);
procedure SetValueColor(const Value: TColor);
function ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
function GetChrKind(ALineIndex, ACol: Integer): THtmlChrKind;
procedure SetCommentColor(const Value: TColor);
procedure SetCssBlockDelimBold(const Value: Boolean);
procedure SetCssBlockDelimColor(const Value: TColor);
procedure SetCssCommentColor(const Value: TColor);
procedure SetCssImportantBold(const Value: Boolean);
procedure SetCssImportantColor(const Value: TColor);
procedure SetCssPropertyColor(const Value: TColor);
procedure SetCssSelectorBold(const Value: Boolean);
procedure SetCssSelectorColor(const Value: TColor);
procedure SetCssValueColor(const Value: TColor);
procedure SetDoctypeBold(const Value: Boolean);
procedure SetDoctypeColor(const Value: TColor);
procedure SetDoctypeItalics(const Value: Boolean);
procedure SetTagNameBold(const Value: Boolean);
procedure SetTagNameColor(const Value: TColor);
procedure PushTokensDownFrom(ALineIndex: Integer);
procedure PushTokensUpFrom(ALineIndex: Integer);
public
constructor Create(AOwner: TComponent); override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property TagColor: TColor read FTagColor write SetTagColor default DEFAULT_TAG_COLOR;
property TagNameColor: TColor read FTagNameColor write SetTagNameColor default DEFAULT_TAG_NAME_COLOR;
property TagNameBold: Boolean read FTagNameBold write SetTagNameBold default DEFAULT_TAG_NAME_BOLD;
property ParamColor: TColor read FParamColor write SetParamColor default DEFAULT_PARAM_COLOR;
property ValueColor: TColor read FValueColor write SetValueColor default DEFAULT_VALUE_COLOR;
property CommentColor: TColor read FCommentColor write SetCommentColor default DEFAULT_COMMENT_COLOR;
property CssSelectorColor: TColor read FCssSelectorColor write SetCssSelectorColor default DEFAULT_CSS_SELECTOR_COLOR;
property CssSelectorBold: Boolean read FCssSelectorBold write SetCssSelectorBold default DEFAULT_CSS_SELECTOR_BOLD;
property CssPropertyColor: TColor read FCssPropertyColor write SetCssPropertyColor default DEFAULT_CSS_PROPERTY_COLOR;
property CssValueColor: TColor read FCssValueColor write SetCssValueColor default DEFAULT_CSS_VALUE_COLOR;
property CssCommentColor: TColor read FCssCommentColor write SetCssCommentColor default DEFAULT_CSS_COMMENT_COLOR;
property CssBlockDelimColor: TColor read FCssBlockDelimColor write SetCssBlockDelimColor default DEFAULT_CSS_BLOCK_DELIM_COLOR;
property CssBlockDelimBold: Boolean read FCssBlockDelimBold write SetCssBlockDelimBold default DEFAULT_CSS_BLOCK_DELIM_BOLD;
property CssImportantColor: TColor read FCssImportantColor write SetCssImportantColor default DEFAULT_CSS_IMPORTANT_COLOR;
property CssImportantBold: Boolean read FCssImportantBold write SetCssImportantBold default DEFAULT_CSS_IMPORTANT_BOLD;
property DoctypeColor: TColor read FDoctypeColor write SetDoctypeColor default DEFAULT_DOCTYPE_COLOR;
property DoctypeBold: Boolean read FDoctypeBold write SetDoctypeBold default DEFAULT_DOCTYPE_Bold;
property DoctypeItalics: Boolean read FDoctypeItalics write SetDoctypeItalics default DEFAULT_DOCTYPE_Italics;
end;
TMediaWikiFormattingProcessor = class(TFormattingProcessor)
private const
DEFAULT_HEADING1_COLOR = SC_BLUE;
DEFAULT_HEADING1_BOLD = True;
DEFAULT_HEADING1_ITALICS = True;
DEFAULT_HEADING2_COLOR = SC_BLUE;
DEFAULT_HEADING2_BOLD = True;
DEFAULT_HEADING2_ITALICS = False;
DEFAULT_HEADING3_COLOR = SC_BLUE;
DEFAULT_HEADING3_BOLD = False;
DEFAULT_HEADING3_ITALICS = True;
DEFAULT_HEADING4_COLOR = SC_BLUE;
DEFAULT_HEADING4_BOLD = False;
DEFAULT_HEADING4_ITALICS = False;
DEFAULT_HEADING5_COLOR = SC_GRAY;
DEFAULT_HEADING5_BOLD = False;
DEFAULT_HEADING5_ITALICS = True;
DEFAULT_HEADING6_COLOR = SC_GRAY;
DEFAULT_HEADING6_BOLD = False;
DEFAULT_HEADING6_ITALICS = False;
DEFAULT_WIKILINK_COLOR = SC_RED;
DEFAULT_EXTLINK_COLOR = SC_RED;
DEFAULT_TEMPLATE_COLOR = SC_GREEN;
DEFAULT_TEMPLATE_NAME_BOLD = True;
DEFAULT_BOLD_BOLD = True;
DEFAULT_ITALICS_ITALICS = True;
DEFAULT_INDENT_COLOR = SC_GRAY;
private const
CSS_CLASS_TEXT = 0;
CSS_CLASS_HEADING1 = 1;
CSS_CLASS_HEADING2 = 2;
CSS_CLASS_HEADING3 = 3;
CSS_CLASS_HEADING4 = 4;
CSS_CLASS_HEADING5 = 5;
CSS_CLASS_HEADING6 = 6;
CSS_CLASS_WIKILINK = 7;
CSS_CLASS_EXTLINK = 8;
CSS_CLASS_TEMPLATE_NAME = 9;
CSS_CLASS_TEMPLATE = 10;
CSS_CLASS_BOLD = 11;
CSS_CLASS_ITALICS = 12;
CSS_CLASS_BOLDITALICS = 13;
CSS_CLASS_INDENT = 14;
CSS_CLASS_HIGH = CSS_CLASS_INDENT;
CSS_CLASS_LENGTH = CSS_CLASS_HIGH + 1;
private var
FHeading4Color: TColor;
FHeading1Italics: Boolean;
FHeading4Italics: Boolean;
FHeading2Bold: Boolean;
FHeading3Bold: Boolean;
FHeading1Bold: Boolean;
FHeading4Bold: Boolean;
FHeading2Color: TColor;
FHeading3Color: TColor;
FHeading1Color: TColor;
FHeading2Italics: Boolean;
FHeading3Italics: Boolean;
FWikilinkColor: TColor;
FTemplateColor: TColor;
FBoldBold: Boolean;
FItalicsItalics: Boolean;
FExtlinkColor: TColor;
FIndentColor: TColor;
FTemplateNameBold: Boolean;
FHeading5Color: TColor;
FHeading5Italics: Boolean;
FHeading5Bold: Boolean;
FHeading6Italics: Boolean;
FHeading6Bold: Boolean;
FHeading6Color: TColor;
procedure SetHeading1Bold(const Value: Boolean);
procedure SetHeading1Color(const Value: TColor);
procedure SetHeading1Italics(const Value: Boolean);
procedure SetHeading2Bold(const Value: Boolean);
procedure SetHeading2Color(const Value: TColor);
procedure SetHeading2Italics(const Value: Boolean);
procedure SetHeading3Bold(const Value: Boolean);
procedure SetHeading3Color(const Value: TColor);
procedure SetHeading3Italics(const Value: Boolean);
procedure SetHeading4Bold(const Value: Boolean);
procedure SetHeading4Color(const Value: TColor);
procedure SetHeading4Italics(const Value: Boolean);
procedure SetWikilinkColor(const Value: TColor);
procedure SetTemplateColor(const Value: TColor);
procedure SetBoldBold(const Value: Boolean);
procedure SetItalicsItalics(const Value: Boolean);
procedure SetExtlinkColor(const Value: TColor);
procedure SetIndentColor(const Value: TColor);
procedure SetTemplateNameBold(const Value: Boolean);
procedure SetHeading5Bold(const Value: Boolean);
procedure SetHeading5Color(const Value: TColor);
procedure SetHeading5Italics(const Value: Boolean);
procedure SetHeading6Bold(const Value: Boolean);
procedure SetHeading6Color(const Value: TColor);
procedure SetHeading6Italics(const Value: Boolean);
public
constructor Create(AOwner: TComponent); override;
function GetCSSRules: TCSSRules; override;
function GetCharCSSClass(ALineIndex: Integer; ACol: Integer;
AChar: Char): Integer; override;
procedure GetCharFormat(ALineIndex: Integer; ACol: Integer; AChar: Char;
var AFontRecord: TFontRecord); override;
function FileChangeNotification(ChangeType: TChangeType; Data1: Integer;
Data2: Integer; Data3: Integer; Data4: Integer): TChangeRecord; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyColorScheme(const AColorScheme: TColorScheme); override;
published
property Heading1Color: TColor read FHeading1Color write SetHeading1Color default DEFAULT_HEADING1_COLOR;
property Heading1Bold: Boolean read FHeading1Bold write SetHeading1Bold default DEFAULT_HEADING1_BOLD;
property Heading1Italics: Boolean read FHeading1Italics write SetHeading1Italics default DEFAULT_HEADING1_BOLD;
property Heading2Color: TColor read FHeading2Color write SetHeading2Color default DEFAULT_HEADING2_COLOR;
property Heading2Bold: Boolean read FHeading2Bold write SetHeading2Bold default DEFAULT_HEADING2_BOLD;
property Heading2Italics: Boolean read FHeading2Italics write SetHeading2Italics default DEFAULT_HEADING2_BOLD;
property Heading3Color: TColor read FHeading3Color write SetHeading3Color default DEFAULT_HEADING3_COLOR;
property Heading3Bold: Boolean read FHeading3Bold write SetHeading3Bold default DEFAULT_HEADING3_BOLD;
property Heading3Italics: Boolean read FHeading3Italics write SetHeading3Italics default DEFAULT_HEADING3_BOLD;
property Heading4Color: TColor read FHeading4Color write SetHeading4Color default DEFAULT_HEADING4_COLOR;
property Heading4Bold: Boolean read FHeading4Bold write SetHeading4Bold default DEFAULT_HEADING4_BOLD;
property Heading4Italics: Boolean read FHeading4Italics write SetHeading4Italics default DEFAULT_HEADING4_BOLD;
property Heading5Color: TColor read FHeading5Color write SetHeading5Color default DEFAULT_HEADING5_COLOR;
property Heading5Bold: Boolean read FHeading5Bold write SetHeading5Bold default DEFAULT_HEADING5_BOLD;
property Heading5Italics: Boolean read FHeading5Italics write SetHeading5Italics default DEFAULT_HEADING5_BOLD;
property Heading6Color: TColor read FHeading6Color write SetHeading6Color default DEFAULT_HEADING6_COLOR;
property Heading6Bold: Boolean read FHeading6Bold write SetHeading6Bold default DEFAULT_HEADING6_BOLD;
property Heading6Italics: Boolean read FHeading6Italics write SetHeading6Italics default DEFAULT_HEADING6_BOLD;
property WikilinkColor: TColor read FWikilinkColor write SetWikilinkColor default DEFAULT_WIKILINK_COLOR;
property ExtlinkColor: TColor read FExtlinkColor write SetExtlinkColor default DEFAULT_EXTLINK_COLOR;
property TemplateColor: TColor read FTemplateColor write SetTemplateColor default DEFAULT_TEMPLATE_COLOR;
property TemplateNameBold: Boolean read FTemplateNameBold write SetTemplateNameBold default DEFAULT_TEMPLATE_NAME_BOLD;
property BoldBold: Boolean read FBoldBold write SetBoldBold default DEFAULT_BOLD_BOLD;
property ItalicsItalics: Boolean read FItalicsItalics write SetItalicsItalics default DEFAULT_ITALICS_ITALICS;
property IndentColor: TColor read FIndentColor write SetIndentColor default DEFAULT_INDENT_COLOR;
end;
TPrintSettings = class(TPersistent)
strict private var
FVerticalMargin: Integer;
FHorizontalMargin: Integer;
FWordWrap: Boolean;
FNiceWordWrap: Boolean;
FWordWrapChar: Char;
FShowWordWrapIcon: Boolean;
FWordWrapIconColor: TColor;
public const
DEFAULT_VERTICAL_MARGIN = 200;
DEFAULT_HORIZONTAL_MARGIN = 220;
DEFAULT_WORD_WRAP = True;
DEFAULT_NICE_WORD_WRAP = True;
DEFAULT_WORD_WRAP_CHAR = '↳';
DEFAULT_SHOW_WORD_WRAP_ICON = False;
DEFAULT_WORD_WRAP_ICON_COLOR = clBlack;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
published
property VerticalMargin: Integer read FVerticalMargin write FVerticalMargin default DEFAULT_VERTICAL_MARGIN;
property HorizontalMargin: Integer read FHorizontalMargin write FHorizontalMargin default DEFAULT_HORIZONTAL_MARGIN;
property WordWrap: Boolean read FWordWrap write FWordWrap default DEFAULT_WORD_WRAP;
property NiceWordWrap: Boolean read FNiceWordWrap write FNiceWordWrap default DEFAULT_NICE_WORD_WRAP;
property WordWrapIcon: Char read FWordWrapChar write FWordWrapChar default DEFAULT_WORD_WRAP_CHAR;
property ShowWordWrapIcon: Boolean read FShowWordWrapIcon write FShowWordWrapIcon default DEFAULT_SHOW_WORD_WRAP_ICON;
property WordWrapIconColor: TColor read FWordWrapIconColor write FWordWrapIconColor default DEFAULT_WORD_WRAP_ICON_COLOR;
end;
TProgressStartEvent = procedure(Sender: TObject; NumSteps: Integer) of object;
TProgressEvent = function(Sender: TObject; CurStep: Integer; NumSteps: Integer): Boolean of object;
TProgressCompleteEvent = TNotifyEvent;
TNotificationMessage = procedure(Sender: TObject; MsgID: Cardinal; AClear: Boolean = False) of object;
TSimpleNotificationMessage = procedure(Sender: TObject; MsgID: Cardinal; const AStr: string) of object;
TGraphicControlCracker = type TGraphicControl;
TBorderType = (btNone, btWin32ThinLine, btWin32SunkenEdge, btThemeBorder,
btSimpleColor);
TTextFileOwner = (tfoEditor, tfoApplication);
TSelectionBarBehaviour = (sbbAlwaysSelect, sbbNeverSelect, sbbAuto, sbbAutoMixed);
TCliGetPromptClassEvent = procedure(Sender: TObject; var AClassName: string) of object;
TCliInputEvent = procedure(Sender: TObject; var AInput: string; var NewPrompt: Boolean) of object;
TParamType = (ptConstant, ptCommand);
TScriptParam = record
ParamType: TParamType;
ParamValue: Integer;
end;
TEditorCommand = record
Verb: Integer;
Param1,
Param2,
Param3,
Param4: TScriptParam;
end;
TEditorScript = array of TEditorCommand;
function MakeEditorCommand(Verb: Integer; Param1: Integer = 0;
ParamType1: TParamType = ptConstant; Param2: Integer = 0;
ParamType2: TParamType = ptConstant; Param3: Integer = 0;
ParamType3: TParamType = ptConstant; Param4: Integer = 0;
ParamType4: TParamType = ptConstant): TEditorCommand;
const
MultiCharHyphen: array[0..6] of Char = (#$002D, #$2010, #$2011, #$00AD, #$2013, #$2014, #$2212);
MultiCharAsterisk: array[0..4] of Char = (#$002A, #$2022, #$22C5, #$00D7, #$2219);
MultiCharDoubleQuote: array[0..5] of Char = (#$0022, #$201C, #$201D, #$201E, #$00BB, #$00AB);
MultiCharSingleQuote: array[0..5] of Char = (#$0027, #$2018, #$2019, #$201A, #$203A, #$2039);
type
TScrollBehaviour = (sbDefault, sbLine, sbPixel);
TTextEditor = class;
TTextEditorDataObject = class(TInterfacedObject, IDataObject)
strict private type
TEnumFormatEtc = class(TInterfacedObject, IEnumFORMATETC)
strict private
FIndex: Integer;
public
function Next(celt: Longint; out elt;
pceltFetched: PLongint): HResult; stdcall;
function Skip(celt: Longint): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
end;
public const
FMT_UNICODETEXT = 0;
class var
Formats: TFormatEtcArray;
private
FTextEditor: TTextEditor;
FBuffer: string;
function GetMatchingFormatIdx(const AFormatEtc: TFormatEtc): Integer;
public
class constructor ClassCreate;
class function CreateHGlobal(Data: pointer; Len: UInt64; uFlags: DWORD;
out hGlobal: HGLOBAL): HRESULT; static;
constructor Create(AEditor: TTextEditor);
function DAdvise(const formatetc: tagFORMATETC; advf: Integer;
const advSink: IAdviseSink; out dwConnection: Integer): HRESULT; stdcall;
function DUnadvise(dwConnection: Integer): HRESULT; stdcall;
function EnumDAdvise(out enumAdvise: IEnumSTATDATA): HRESULT; stdcall;
function EnumFormatEtc(dwDirection: Integer;
out enumFormatEtc: IEnumFORMATETC): HRESULT; stdcall;
function GetCanonicalFormatEtc(const formatetc: tagFORMATETC;
out formatetcOut: tagFORMATETC): HRESULT; stdcall;
function GetData(const formatetcIn: tagFORMATETC;
out medium: tagSTGMEDIUM): HRESULT; stdcall;
function GetDataHere(const formatetc: tagFORMATETC;
out medium: tagSTGMEDIUM): HRESULT; stdcall;
function QueryGetData(const formatetc: tagFORMATETC): HRESULT; stdcall;
function SetData(const formatetc: tagFORMATETC; var medium: tagSTGMEDIUM;
fRelease: LongBool): HRESULT; stdcall;
end;
THyperlinkEvent = procedure(Sender: TObject; const ALinkRec: TLinkRec) of object;
TNavRequestEvent = procedure(Sender: TObject; AEditorCommand: Integer) of object;
TNavRequestEnabledEvent = procedure(Sender: TObject; AEditorCommand: Integer;
var AEnabled: Boolean) of object;
TTextEditor = class(TCustomControl, IDropTarget, IDropSource)
strict private class var
FHasLoadedCursors: Boolean;
private type
TTextEditorRegion = (terText, terSelectionBar);
TTextSpanAttribute = (tsaFindHighlight, tsaHyperlink);
TTextSpanAttributes = set of TTextSpanAttribute;
public const
DEFAULT_LINE_HIGHLIGHT_COLOR = $00EEEEEE;
DEFAULT_BRACKET_HIGHLIGHT_COLOR = $0077D9F5;
DEFAULT_RULER_WIDTH = 60;
DEFAULT_MARGIN_LEFT = 80;
DEFAULT_MARGIN_TOP = 4;
DEFAULT_MARGIN_RIGHT = 4;
DEFAULT_MARGIN_BOTTOM = 4;
DEFAULT_NOTIFICATION_MSG_DURATION = 5000;
public const
EN_NULL = 0;
EN_DRAG_MOVE = 1;
EN_DRAG_COPY = 2;
EN_READ_ONLY_ERROR = 3;
EN_INPUT_ERROR = 4;
EN_PRINTING = 5;
EN_SCROLL_MODE = 6;
EN_SCRIPT = 7;
EN_MULTICHAR = 8;
EN_READONLY = 9;
EN_MULTICARET = 10;
EN_MAX = 10;
private const
FNotificationStrs: array[0..EN_MAX] of string =
('',
SNotifyDragMove,
SNotifyDragCopy,
SNotifyReadOnlyError,
SNotifyInputError,
SNotifyPrinting,
SNotifyScrollMode,
SNotifyScript,
SNotifyMultiCharSelect,
SNotifyReadOnlyMode,
SNotifyMultiCaretMode);
private const
EDITOR_NOTIFY = $10000;
private const
WM_MOUSEHWHEEL = $020E;
private var
FTextFile: TTextFile;
FClassArray: TClassArray;
FBkColor: TColor;
FFgColor: TColor;
FSelBkColor: TColor;
FSelFgColor: TColor;
FFndBkColor: TColor;
FFndFgColor: TColor;
FLnkBkColor: TColor;
FLnkFgColor: TColor;
FUseSystemColors: Boolean;
FForegroundColor: TColor;
FBackgroundColor: TColor;
FFontSize: TSize;
FFont: TFont;
FLetterSpacing: Integer;
FLineSpacing: Integer;
FAutoIndent: Boolean;
FHandleHotkeys: Boolean;
FHandleBookmarkHotkeys: Boolean;
FSelForegroundColor: TColor;
FSelBackgroundColor: TColor;
FOnSelChange: TNotifyEvent;
FOnChange: TNotifyEvent;
FBeepOnInputError: Boolean;
FErrorMessageOnReadOnlyError: Boolean;
FOverwrite: Boolean;
FOLEDragging: Boolean;
FOLEInternalDrop: Boolean;
FDropLocation: TPoint;
FLastDropEffect: Integer;
FDoubleClicking: Boolean;
FIndentSize: Integer;
FScrollPos: TPoint;
FPrevCursorX, FPrevCursorY: Integer;
FMouseDownX, FMouseDownY: Integer;
FShowHiddenCharacters: Boolean;
FOnModified: TNotifyEvent;
FLineHighlight: Boolean;
FLineHighlightColor: TColor;
FOldCaretPosY: Integer;
FMatchBrackets: Boolean;
FBracketHighlight: Boolean;
FBracketPos1, FBracketPos2: TPoint;
FBracketHighlightColor: TColor;
FAutoReplace: Boolean;
FPopupMenu: TPopupMenu;
FListboxMenu: TPopupMenu;
FRulerMenu: TPopupMenu;
FImagePopup: TPopupMenu;
FTypeTimer: TTimer;
FMessageInterface: Boolean;
FInputTransform: TInputTransform;
FStartOver: Boolean;
FGLYPHBM: TBitmap;
FFONTBM: TBitmap;
FFallbackFonts: TStringList;
FGlyphSets: array of PGlyphSet;
FUnicodeFallback: Boolean;
FPasswordChar: Char;
FNumbersOnly: Boolean;
FHintWindow: HWND;
FToolInfo: TToolInfo;
FBalloonPoint: TPoint;
FBalloonPersistence: TBalloonPersistence;
FBalloonTimer: TTimer;
FTabLength: Integer;
FLabelStyle: Boolean;
FLabelEllipsis: Boolean;
FBlinkRemover: TTimer;
FAutoHeight: Boolean;
FMultiSize: Boolean;
FCurrentFormat: TFontRecord;
FFontSizes: array of TSize;
FAccumLineHeights: array of Integer;
FCachedHorizontalExtent: Integer;
FLineControls: TArray<TLineControlRecord>;
FNextControlID: Cardinal;
FOnBookmarksMoved: TNotifyEvent;
FFormattingProcessor: TFormattingProcessor;
FRulerWidth,
FMarginLeft,
FMarginRight,
FMarginTop,
FMarginBottom: Integer;
FRegion: TTextEditorRegion;
FSelectionBarInitialLine: Integer;
FRulerFont: TFont;
FCaretVisible: Boolean;
FNoScrollToCaret: Boolean;
FRulerColor: TColor;
FZoom: Integer;
FOnZoomChange: TNotifyEvent;
FPrintSettings: TPrintSettings;
FOnPrintProgress: TProgressEvent;
FOnPrintEnd: TProgressCompleteEvent;
FOnPrintBegin: TProgressStartEvent;
FRightLineColor: TColor;
FRightLinePos: Integer;
FRightLine: Boolean;
FBorderColor: TColor;
FBorderType: TBorderType;
FTextFileOwner: TTextFileOwner;
FRulerPopupMenu: TPopupMenu;
FSelectionBarBehaviour: TSelectionBarBehaviour;
FNotifications: array of Integer;
FOnNotification: TNotificationMessage;
FOnSimpleNotification: TSimpleNotificationMessage;
FScrollMode: Boolean;
FNotifyMsgDuration: Integer;
FOnCliGetPromptClass: TCliGetPromptClassEvent;
FOnCliInput: TCliInputEvent;
FScriptRunning: Boolean;
FScriptCounter: Integer;
FAbortScript: Boolean;
FDesiredColumn: Integer;
FPreserveDesiredColumn: Boolean;
FCliHistory: TList<string>;
FCliHistoryIndex: Integer;
FListBoxMode: Boolean;
FListBoxSelection: Boolean;
FOnListBoxChange: TNotifyEvent;
FOnListBoxSelect: TNotifyEvent;
FValidPaintState: Boolean;
FCliMultiOutput: Integer;
FMultiCharSelect: Boolean;
FMultiCharSelectDlgFrm: TForm;
FMultiCharReportView: Boolean;
Flv: HWND;
FMultiCharSelectDlgDefaultWndProc: TWndMethod;
FASHyphenAsteriskToggle: Boolean;
FNoVerifyFont: Boolean;
FDisabledEffect: TBitmapEffect;
FBitmapEffect: TBitmapEffect;
FRepeatExNum: Integer;
FRepeatExCommand: Integer;
FOnFindDataClear: TNotifyEvent;
FOnOverwriteChange: TNotifyEvent;
FVisualUpdateLock: Integer;
FScrollBehaviour: TScrollBehaviour;
FSPIScrollLines: Integer;
FCaretAfterEOL: Boolean;
FMultipleCarets: Boolean;
FCarets: TPointArray;
FAllowBitmapPaste: Boolean;
FWantTab, FWantReturn: Boolean;
FDragDataObj: IDataObject;
FDragCompatFmt: Boolean;
FRightDrag: Boolean;
FInsertionPoint: TPoint;
FDropMenu: TPopupMenu;
FDropMenuMove, FDropMenuCopy: TMenuItem;
FDropTargetHelper: IDropTargetHelper;
FExpectDragDrop: Boolean;
FDragButton: TMouseButton;
FDragButtonOLE: Integer;
FMouseContSel: Boolean;
FPDict: TDictionary<string, TFormattingProcessor>;
FDragScrollFirstChance: UInt64;
FXDRAG, FYDRAG: Integer;
FCliHistoryDialogFormClass: TFormClass;
FCustomMenuItems: TList<TMenuItem>;
FOnBeforeContextPopup: TNotifyEvent;
FLinks: THyperlinks;
FCharLinkIndex: Integer;
FPrevCharLinkIndex: Integer;
FOnHyperlinkClick: THyperlinkEvent;
FMouseDownLinkIndex: Integer;
FOnNavRequest: TNavRequestEvent;
FOnNavRequestGetEnabled: TNavRequestEnabledEvent;
FBrowserContextMenu: Boolean;
FUseRuxThemes: Boolean;
FTextHint: string;
FListBoxHideSelection: Boolean;
procedure SetUseSystemColors(const Value: Boolean);
procedure SetupColors;
procedure SetBackgroundColor(const Value: TColor);
procedure SetForegroundColor(const Value: TColor);
procedure SetupFontMetrics;
procedure SetFont(const Value: TFont);
procedure DrawLine(LineIndex: Integer; From, ATo: Integer; AAttributes: TTextSpanAttributes = []); overload;
procedure DrawSpan(const ATextSpan: TTextSpan; AAttributes: TTextSpanAttributes = []);
procedure ApplyFont(const AClassName: string; ATo: TCanvas = nil);
procedure ReapplyFont(ATo: TCanvas = nil); inline;
procedure FontChange(Sender: TObject);
procedure SetLetterSpacing(const Value: Integer);
procedure SetLineSpacing(const Value: Integer);
procedure TextFileChange(Sender: TObject; ChangeType: TChangeType; Data1,
Data2, Data3, Data4: Integer);
procedure TextFileCaretPosSelChange(Sender: TObject; ChangeType: TChangeType; Data1,
Data2, Data3, Data4: Integer);
procedure TextFileCaretPosChange(Sender: TObject);
procedure SetCaretAfterEOL(const Value: Boolean);
procedure TextFileInputError(Sender: TObject);
procedure SetAutoIndent(const Value: Boolean);
function GetText: string;
procedure SetText(const Value: string);
procedure SetSelBackgroundColor(const Value: TColor);
procedure SetSelForegroundColor(const Value: TColor);
procedure ApplyInteractiveFormatting(const X, Y: Integer; ATo: TCanvas = nil);
procedure ApplyCharacterColors(const X, Y: Integer; AAttributes: TTextSpanAttributes = []);
function LineHighlightIndex: Integer;
function GetCaretPos: TPoint;
function GetSelEndPos: TPoint;
procedure SetCaretPos(const Value: TPoint);
procedure SetSelEndPos(const Value: TPoint);
function GetSelType: TSelectionType;
procedure SetSelType(const Value: TSelectionType);
procedure VisualUpdate(ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer);
procedure UpdateCaret;
function GetSelText: string;
function CharLinkIndex(const ACaretPos: TPoint): Integer;
function IsCharLink(const ACaretPos: TPoint): Boolean; inline;
procedure ChangeCursor(Shift: TShiftState; Y: Integer; X: Integer); overload;
procedure ChangeCursor(Shift: TShiftState); overload;
procedure ChangeCursor; overload;
procedure SetIndentSize(const Value: Integer);
function GetSelLength: Integer;
function SafeSelLength: Integer;
procedure SetSelLength(const Value: Integer);
procedure UpdateScrollBars;
procedure SetScrollPosY(Value: Integer; Lim: Boolean = False);
procedure SetScrollPosX(Value: Integer);
function FirstVisibleLine(TrueValue: Boolean = False): Integer;
function LastVisibleLine(TrueValue: Boolean = False): Integer;
procedure DrawVisibleLine(LineIndex: Integer; From: Integer = 0);
function ScrollToCaret: Boolean;
procedure SetScrollPosXY(X, Y: Integer; Lim: Boolean = False);
procedure Escape(AAll: Boolean = False);
procedure SetEditMode(const Value: TEditMode);
procedure SetShowHiddenCharacters(const Value: Boolean);
function Reveal(const C: Char): Char;
procedure TextFileModified(Sender: TObject);
procedure SetLineHighlight(const Value: Boolean);
procedure SetLineHighlightColor(const Value: TColor);
procedure SetMatchBrackets(const Value: Boolean);
function IsBracketHighlight(const X, Y: Integer): Boolean; inline;
procedure SetBracketHighlightColor(const Value: TColor);
procedure MenuPopup(Sender: TObject);
procedure MenuItemMessage(Sender: TObject);
function GetSelStart: Integer;
procedure SetSelStart(const Value: Integer);
procedure SetOverwrite(const Value: Boolean);
procedure TypeTimerTimer(Sender: TObject);
procedure PostType;
procedure SetFindBackgroundColor(const Value: TColor);
procedure SetFindForegroundColor(const Value: TColor);
procedure SetLinkBackgroundColor(const Value: TColor);
procedure SetLinkForegroundColor(const Value: TColor);
procedure SelectFindItem(ItemIndex: Integer);
procedure SetSingleLine(const Value: Boolean);
function GetSingleLine: Boolean;
function GetFontChrs(const AFontName: TFontName; out GlyphSet: PGlyphSet): Boolean;
function ChrInGlyphSet(GlyphSet: PGlyphSet; Codepoint: Integer): Boolean; overload;
function ChrInGlyphSet(GlyphSet: PGlyphSet; Character: Char): Boolean; overload; inline;
procedure UseBestFont(const AChar: Char);
procedure SetFallbackFonts(const Value: TStringList);
procedure FallbackFontsChange(Sender: TObject);
procedure BuildFontDataArray;
procedure FreeFontDataArray;
procedure SetUnicodeFallback(const Value: Boolean);
procedure SetPasswordChar(const Value: Char);
function GetBalloonPosition: TPoint;
procedure BalloonTimerTimer(Sender: TObject);
procedure SetLabelStyle(const Value: Boolean);
procedure SetLabelEllipsis(const Value: Boolean);
procedure BlinkBracket;
procedure BlinkRemoverTimer(Sender: TObject);
procedure SetBracketHighlight(const PointA, PointB: TPoint);
procedure ClearBracketHighlight;
procedure HighlightCurrentBracket;
procedure SetAutoHeight(const Value: Boolean);
procedure AdjustHeight;
procedure SetMultiSize(const Value: Boolean);
function GetClassRecord(Index: Integer): TClassRecord;
function GetNumClasses: Integer;
procedure UpdateFontBoxSize(ClassIndex: Integer);
procedure UpdateFontBoxSizes;
procedure TextFileLineChange(Sender: TObject;
LineChangeType: TLineChangeType; From: Integer);
procedure RebuildLineCache;
procedure DoSetCaretPos; inline;
function GetTotalVerticalExtent: Integer;
function GetTotalHorizontalExtent: Integer;
procedure RecomputeHorizontalExtent;
function LineWidths(LineIndex: Integer): Integer;
function MaxLineWidth: Integer;
procedure TextFileLineClassChange(Sender: TObject; LineIndex: Integer);
procedure TextFileControlRemoved(Sender: TObject; ControlID: Integer);
procedure TextFileGetControlText(Sender: TObject; LineIndex: Integer;
var ControlText: string);
procedure InvalidateLineControl(LineIndex: Integer);
function GetLineTop(LineIndex: Integer): Integer;
function GetLineBottom(LineIndex: Integer): Integer;
function GetLineBottomVirtual(LineIndex: Integer): Integer;
function GetCharLeft(LineIndex, ColIndex: Integer): Integer;
function GetCharRight(LineIndex, ColIndex: Integer): Integer;
function ActivateControl: HWND;
procedure ImageMenuCommand(Sender: TObject);
function GetLine(Index: Integer): string;
procedure SetLine(Index: Integer; const Value: string);
function GetClass(Index: Integer): string;
procedure SetClass(Index: Integer; const Value: string);
procedure ForceSetClass(Index: Integer; const Value: string);
function GetLineCount: Integer;
function FileIsEmpty: Boolean;
procedure GotoSamePixelAtPrevLine(Shift: Boolean);
procedure GotoSamePixelAtNextLine(Shift: Boolean);
function GetBookmark(Index: Integer): TPoint;
function GetBookmarkCount: Integer;
function GetUsedBookmarkCount: Integer;
procedure TextFileBookmarksMoved(Sender: TObject);
function GetBookmarkDescr(BookmarkIndex: Integer): string;
procedure BookmarkHistoryRecord(const APoint: TPoint);
procedure SetFormattingProcessor(const Value: TFormattingProcessor;
AInitialize: Boolean = True);
procedure FormattingProcessorChanged(Sender: TObject);
function FormattingProcessorGetLineWidth(ALineIndex: Integer): Integer;
function FormattingProcessorGetChar(ALineIndex, ACol: Integer): Char;
function FormattingProcessorGetLineCount: Integer;
function FormattingProcessorGetWord(const APoint: TPoint;
APascalIdent: Boolean = False): string;
function FormattingProcessorGetWordBoundary(const APoint: TPoint; out SP,
EP: Integer): Boolean;
function FPFileChangeNotification(ChangeType: TChangeType; Data1, Data2,
Data3, Data4: Integer): TChangeRecord;
function TextContentRect: TRect;
function NonRulerRect: TRect;
function RulerRect: TRect;
function LeftColumnRect: TRect;
procedure DrawRuler;
procedure RulerFontChange(Sender: TObject);
procedure UpdateRuler;
procedure UpdateRulerLine(const ALineIndex: Integer);
procedure BinaryHideCaret;
procedure BinaryShowCaret;
procedure SetMarginBottom(const Value: Integer);
procedure SetMarginLeft(const Value: Integer);
procedure SetMarginRight(const Value: Integer);
procedure SetMarginTop(const Value: Integer);
procedure SetRulerWidth(const Value: Integer);
function GetRulerVisible: Boolean;
procedure SetRulerVisible(const Value: Boolean);
procedure SetRulerColor(const Value: TColor);
procedure ZoomImages;
procedure SetZoom(const Value: Integer);
procedure SetRightLine(const Value: Boolean);
procedure SetRightLineColor(const Value: TColor);
procedure SetRightLinePos(const Value: Integer);
procedure SetBorderColor(const Value: TColor);
procedure SetBorderType(const Value: TBorderType);
function GetWrapAt: string;
procedure SetWrapAt(const Value: string);
function GetFalse: Boolean;
procedure RestoreWrapAt(const Value: Boolean);
procedure SetTextFile(const Value: TTextFile);
procedure ConnectTextFileToEditor;
procedure DisconnectTextFileFromEditor;
function GetEditMode: TEditMode;
procedure SetFormattingProcessorSmple(const Value: TFormattingProcessor);
procedure RulerMenuCommand(Sender: TObject);
procedure RulerPropertiesApply(Sender: TObject);
function GetFunctionalSelectionBarWidth: Integer;
function CharAtVirtualPixelEx(Pixel: TPoint; CP: Boolean = False): TPoint;
function CharAtPhysicalPixelEx(Pixel: TPoint; CP: Boolean = False): TPoint;
function NotifyApp(const MsgID: Integer): Boolean;
function NotifyAppWithTimer(const MsgID: Integer): Boolean;
procedure RemoveNotification(const MsgID: Integer);
function GetNotification(AIndex: Integer): Integer;
function GetNotificationCount: Integer;
function GetNotificationStr(MsgID: Integer): string;
procedure TextFileReadOnlyError(Sender: TObject);
procedure UpdateScrollMode;
function GetLineComparer: TLineComparer;
procedure SetLineComparer(const Value: TLineComparer);
function GetSortReverseOrder: Boolean;
procedure SetSortReverseOrder(const Value: Boolean);
function CliHistoryUp: Boolean;
function CliHistoryDown: Boolean;
function GetCliHistory(Index: Integer): string;
procedure SetCliHistory(Index: Integer; const Value: string);
function GetCliHistoryCount: Integer;
function GetCliHistoryIndex: Integer;
procedure SetListBoxMode(const Value: Boolean);
procedure SetListBoxItemIndex(const Value: Integer);
function GetListBoxItemIndex: Integer;
procedure CliHistoryDialogListBoxSelect(Sender: TObject);
procedure NeedValidPaintState;
procedure CliHistoryDialogListBoxKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DoMultiCharSelect(AChrs: array of Char);
procedure MultiCharSelectDlgResize(Sender: TObject);
procedure MultiCharSelectDlgWndProc(var Message: TMessage);
procedure MultiCharSelectDlgActivate(Sender: TObject);
function CharInSet(AChar: Char; ASet: array of Char): Boolean;
function CharInAnyMultiCharSet(AChar: Char): Boolean;
procedure VerifyFont;
procedure SetDisabledEffect(const Value: TBitmapEffect);
procedure SetBitmapEffect(const Value: TBitmapEffect);
procedure TextFileFindDataClear(Sender: TObject);
procedure CheckCaretBeyondEOL;
procedure TextFileLockVisualUpdates(Sender: TObject);
procedure TextFileUnlockVisualUpdates(Sender: TObject);
procedure UpdateSPI;
procedure DoAutoReplace;
function GetCaretAfterEOL: Boolean;
procedure CreateNewCaretAt(const APoint: TPoint);
procedure EnterMultiCaretMode;
function GetLastMultiCaret: TPoint;
function IsCaretVisible: Boolean;
procedure IndicateInsertionPoint(const APoint: TPoint);
procedure RemoveInsertionPoint;
{$HINTS OFF}
procedure InvalidateChar(const AChar: TPoint);
{$HINTS ON}
procedure InvalidateCharAndPrev(const AChar: TPoint);
procedure GetDragDropEffect(var dwEffect: Integer; grfKeyState: Integer);
procedure DragDropNotify(dwEffect: Integer);
function FPFromString(const FPClassName: string): TFormattingProcessor;
function GetLastLine: string;
procedure SetLastLine(const AText: string);
procedure CustomizeMenu(AMenu: TMenu);
procedure DoHyperlinkClicked(AHyperlink: THyperlink);
procedure DoNavRequest(AEditorCommand: Integer);
function DoNavRequestGetEnabled(AEditorCommand: Integer): Boolean;
procedure SetUseRuxThemes(const Value: Boolean);
procedure SetTextHint(const Value: string);
protected
procedure Paint; override;
procedure KeyPress(var Key: Char); override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure DblClick; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
procedure WMMouseHWheel(var Message: TWMMouseWheel); message WM_MOUSEHWHEEL;
procedure WndProc(var Message: TMessage); override;
procedure Loaded; override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure WMContextMenu(var Message: TWMContextMenu);
message WM_CONTEXTMENU;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure SetListBoxSelection(AListBoxSelection: Boolean);
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure SetListBoxHideSelection(const Value: Boolean);
function IDropTarget.DragEnter = DropTargetDragEnter;
function DropTargetDragEnter(const dataObj: IDataObject;
grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT;
stdcall;
function IDropTarget.DragOver = DropTargetDragOver;
function DropTargetDragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HRESULT;
stdcall;
function IDropTarget.DragLeave = DropTargetDragLeave;
function DropTargetDragLeave: HRESULT;
stdcall;
function IDropTarget.Drop = DropTargetDrop;
function DropTargetDrop(const dataObj: IDataObject; grfKeyState:
Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall;
function GiveFeedback(dwEffect: Longint): HRESULT; stdcall;
function QueryContinueDrag(fEscapePRessed: BOOL; grfKeyState: Longint): HRESULT;
stdcall;
procedure SetEnabled(Value: Boolean); override;
strict private
class var FInstances: TList<TTextEditor>;
class constructor ClassCreate;
class destructor ClassDestroy;
class procedure UxThemeUpdate; static;
public
class var OnAddInstance: TNotifyEvent;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UseDefaultFallbackFonts;
function EditorCommand(Command: Integer; Param1: Integer = 0;
Param2: Integer = 0; Param3: Integer = 0; Param4: Integer = 0): Integer;
function CommandEnabled(Command: Integer): Boolean;
function CommandVisible(Command: Integer): Boolean;
function CommandChecked(Command: Integer): Boolean;
procedure BeginVisualUpdate;
procedure EndVisualUpdate(AUpdate: Boolean = False);
procedure CutToClipboard;
procedure CopyToClipboard;
procedure CopyAll;
procedure CopyLine;
function PasteFromClipboard: Boolean;
function PasteFromClipboardAsBlock: Boolean;
procedure ClearLine(LineIndex: Integer); overload;
procedure ClearLine; overload;
procedure AddLine(const AText: string; const AClassName: string); overload;
procedure AddLine(const AText: string); overload;
procedure AddLine; overload;
procedure BeginAddLine;
procedure EndAddLine;
procedure InsertLine(const AText: string; const AClassName: string; LineIndex: Integer); overload;
procedure InsertLine(const AText: string; LineIndex: Integer); overload;
procedure InsertLine(LineIndex: Integer); overload;
procedure InsertChar(const AChar: Char; AOverwrite: Boolean = False);
procedure InsertText(const AText: string);
procedure InsertTextAsBlock(const AText: string);
procedure SurroundText(const APrefix, APostfix: string);
procedure TransformText(Transformation: TTextTransformFunc;
const TransformName: string);
function TransformSelection(Transformation: TTextTransformFunc;
const TransformName: string): Boolean;
procedure ChrTransformText(Transformation: TChrTransformFunc;
const TransformName: string);
function ChrTransformSelection(Transformation: TChrTransformFunc;
const TransformName: string): Boolean;
function FillWithChar(const AChar: Char): Boolean;
property TextFile: TTextFile read FTextFile write SetTextFile;
property CaretPos: TPoint read GetCaretPos write SetCaretPos;
property SelEndPos: TPoint read GetSelEndPos write SetSelEndPos;
property SelectionType: TSelectionType read GetSelType write SetSelType;
function GetWordBoundary(const Point: TPoint; out StartPos, EndPos: Integer): Boolean; overload;
function GetWordBoundary(out StartPos, EndPos: Integer): Boolean; overload;
function GetWord(const Point: TPoint): string; overload;
function GetWord: string; overload;
function GetURLAtCaret(out AURL: string): Boolean;
function OpenURLAtCaret: Boolean;
function SelectWord: Boolean;
procedure SwapLinesAbove;
procedure SwapLinesBelow;
procedure SelectLines(const ALineA, ALineB: Integer);
procedure SelectLine(ALineIndex: Integer); overload;
procedure SelectLine; overload;
procedure SelectAll;
procedure SelectNone;
procedure SelectAllNone;
procedure Backspace(Word: Boolean = False);
procedure Delete(Word: Boolean = False);
procedure Return;
procedure NextHyperlink;
procedure PrevHyperlink;
procedure ReplaceCodepoint;
function CharAtVirtualPixel(Pixel: TPoint): TPoint;
function CharAtPhysicalPixel(Pixel: TPoint): TPoint;
function CaretPosAtVirtualPixel(Pixel: TPoint): TPoint;
function CaretPosAtPhysicalPixel(Pixel: TPoint): TPoint;
function VirtualPixelAtChar(const Point: TPoint): TPoint;
function PhysicalPixelAtChar(const Point: TPoint): TPoint;
function GetCharAtCaret: Char;
function GetCharBeforeCaret: Char;
procedure ClearSelection;
procedure MoveSelection(const ANewPos: TPoint);
procedure CopySelection(const ANewPos: TPoint);
procedure SetSizeHooks;
procedure RemoveSizeHooks;
procedure AddIndent;
procedure RemoveIndent;
procedure RemoveAllIndent;
procedure PageUp(Selection: Boolean = False);
procedure PageDown(Selection: Boolean = False);
function CanUndo: Boolean;
function Undo: Boolean;
function CanRedo: Boolean;
function Redo: Boolean;
function GotoHistoryVersion(Index: Integer): Boolean;
procedure ClearUndoHistory;
procedure MakeUndoRoot;
procedure TypeTimerEnd;
procedure AddUndoRecord(const AComment: string; UID: UNDONAMEID);
procedure Clear;
procedure NewFile;
procedure LoadFromFile(const FileName: TFileName; const Encoding: TEncoding);
procedure SaveToFile(const FileName: TFileName; TrimRight: Boolean = False);
procedure Print(const ATitle: string;
AFirstLine: Integer = 0; ALastLine: Integer = -1); overload;
procedure Print(AFirstLine: Integer = 0; ALastLine: Integer = -1); overload;
procedure PrintSelection(const ATitle: string); overload;
procedure PrintSelection; overload;
procedure PrintGUI(const ATitle: string);
property SelText: string read GetSelText write InsertText;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
function Find(AFindQuery: TFindQuery): Integer;
function FindNext: Integer;
function FindPrevious: Integer;
function FindFromTop: Integer;
property StartOver: Boolean read FStartOver write FStartOver;
function ReplaceAll(const FindQuery: TFindQuery;
const ReplaceText: string; SelOnly: Boolean = False): Integer;
function ShowBalloon(const ATitle, AText: string; AKind: TBalloonIconKind;
APersistence: TBalloonPersistence; const APoint: TPoint): Boolean;
procedure HideBalloon;
function BalloonVisible: Boolean;
procedure MoveBalloonPostScroll;
procedure AddClass(const AClassRecord: TClassRecord);
function RemoveClass(const AClassName: string): Boolean;
procedure ClearClasses;
function GetClassFromName(const AClassName: string; out AClassRecord: TClassRecord): Boolean;
function GetClassIndex(const AClassName: string): Integer;
function ClassExists(const AClassName: string): Boolean; overload; inline;
function ClassExists(const AClassName: string; out Index: Integer): Boolean; overload; inline;
property Classes[Index: Integer]: TClassRecord read GetClassRecord;
property ClassCount: Integer read GetNumClasses;
property LineControls: TArray<TLineControlRecord> read FLineControls;
procedure AddLineControl(AControl: TControl);
procedure InsertLineControl(AControl: TControl; LineIndex: Integer);
procedure ReceiveLineControl(AControl: TControl; LineIndex: Integer;
AllowUnprepared: Boolean = False);
procedure AddGraphic(AGraphic: TGraphic);
function DeleteControlAtLine(const LineIndex: Integer): Boolean;
function GetControlFromID(ID: Integer): TControl;
function GetIDFromControl(AControl: TControl): Integer;
function GetControlIDFromLine(LineIndex: Integer): Integer;
function GetLineFromControlID(ID: Integer): Integer;
function GetLineControlSize(LineIndex: Integer): TSize;
procedure ClearControls;
procedure UpdateLineControls;
procedure FixRemovedLineControlLines;
function LineIsControl(LineIndex: Integer): Boolean;
function GetControlFromLine(LineIndex: Integer): TControl;
function LineIsWinControlOrHasPopup(LineIndex: Integer): Boolean;
procedure CenterOnSelection(AReducedScroll: Boolean = False);
property TotalVerticalExtent: Integer read GetTotalVerticalExtent;
property TotalHorizontalExtent: Integer read GetTotalHorizontalExtent;
procedure DeleteAllLineControls;
procedure TidyControlIDs;
procedure InsertGraphic(AGraphic: TGraphic; LineIndex: Integer);
procedure ReceiveGraphic(AGraphic: TGraphic; LineIndex: Integer;
AllowUnprepared: Boolean = False);
function ControlInSelection: Boolean;
procedure TrimRight;
procedure ClearBookmarks; inline;
procedure AddBookmark(AIndex: Integer; const APoint: TPoint); overload; inline;
procedure AddBookmark(AIndex: Integer); overload; inline;
function AddBookmark(const APoint: TPoint): Integer; overload; inline;
function AddBookmark: Integer; overload; inline;
function GotoBookmark(AIndex: Integer): Boolean; inline;
function BookmarkUsed(AIndex: Integer): Boolean; inline;
function GetLineBookmark(ALineIndex: Integer): Integer;
property LineCount: Integer read GetLineCount;
property Lines[Index: Integer]: string read GetLine write SetLine;
function LineArray: TArray<string>;
property LineClasses[Index: Integer]: string read GetClass write SetClass;
property LastLine: string read GetLastLine write SetLastLine;
property Bookmarks[Index: Integer]: TPoint read GetBookmark;
property BookmarkCount: Integer read GetBookmarkCount;
property UsedBookmarkCount: Integer read GetUsedBookmarkCount;
procedure ExportToHTML(const FileName: TFileName);
procedure RemoveAllMargins;
procedure RestoreAllMargins;
procedure ZoomIn;
procedure ZoomOut;
procedure ResetZoom;
procedure WordWrap(ALineLength: Integer = 80; ANice: Boolean = True;
AChr: Char = #0);
procedure ActivateLinks(ALinks: THyperlinks);
property Notifications[AIndex: Integer]: Integer read GetNotification;
property NotificationCount: Integer read GetNotificationCount;
property NotificationStr[MsgID: Integer]: string read GetNotificationStr;
function HasNotificationMessage(MsgID: Integer): Boolean;
function Sort(AFirstLine, ALastLine: Integer): Boolean; overload;
function Sort: Boolean; overload;
function SortSelection: Boolean;
property LineComparer: TLineComparer read GetLineComparer write SetLineComparer;
property SortReverseOrder: Boolean read GetSortReverseOrder write SetSortReverseOrder;
function MakeLinesUnique: Boolean;
procedure TruncateAt(AFirstLine, ALastLine, AIndex: Integer;
AChar: Char = #0; PreserveChar: Boolean = False; AReverse: Boolean = False); overload;
procedure TruncateAt(AIndex: Integer;
AChar: Char = #0; PreserveChar: Boolean = False; AReverse: Boolean = False); overload;
procedure TruncateAtInSelection(AIndex: Integer;
AChar: Char = #0; PreserveChar: Boolean = False; AReverse: Boolean = False);
procedure Filter(const AFilterOptions: TFilterOptions); overload;
procedure Filter(const Contains, Starts, Ends: string; CaseSensitive: Boolean;
RemoveMatches: Boolean); overload;
procedure TruncateFileAt(Line, Col: Integer);
procedure CliNewPrompt;
procedure CliBeginOutput;
procedure CliEndOutput;
procedure CliWriteLn(const AStr, AClass: string); overload;
procedure CliWriteLn(const AStr: string); overload;
procedure CliWriteLn; overload;
procedure CliWrite(const AStr, AClass: string); overload;
procedure CliAddHistory(const AStr: string);
procedure CliClearHistory;
procedure CliClear;
property CliHistory[Index: Integer]: string read GetCliHistory write SetCliHistory;
property CliHistoryCount: Integer read GetCliHistoryCount;
property CliHistoryIndex: Integer read GetCliHistoryIndex;
function CliHistoryRecall(Index: Integer): Boolean;
function CliHistoryDialog(AFormClass: TFormClass = nil): Integer;
function CliHistoryDialogSelect(AFormClass: TFormClass = nil): Boolean;
property CliHistoryDialogFormClass: TFormClass read FCliHistoryDialogFormClass
write FCliHistoryDialogFormClass;
procedure RunScript(const AScript: TEditorScript; AIterations: Integer = 1;
ACounterInit: Integer = 1; ACounterInc: Integer = 1);
procedure AbortScript;
procedure LoadDefaultClasses;
procedure PushEditorState;
procedure RegisterFP(FormattingProcessor: TFormattingProcessor);
procedure AddMenuItem(AMenuItem: TMenuItem);
procedure AddMenuItems(AMenu: TMenuItem);
procedure RemoveMenuItem(AMenuItem: TMenuItem);
procedure ChInfoBalloon;
published
property Align;
property AlignWithMargins;
property Anchors;
property BorderType: TBorderType read FBorderType write SetBorderType default btThemeBorder;
property BorderWidth;
property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
property Enabled;
property Margins;
property PopupMenu;
property RulerPopupMenu: TPopupMenu read FRulerPopupMenu write FRulerPopupMenu;
property TabStop default True;
property TabOrder;
property OnClick;
property OnDblClick;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnMouseActivate;
property OnEnter;
property OnExit;
property UseRuxThemes: Boolean read FUseRuxThemes write SetUseRuxThemes default False;
property BrowserContextMenu: Boolean read FBrowserContextMenu write FBrowserContextMenu default False;
property BitmapEffect: TBitmapEffect read FBitmapEffect write SetBitmapEffect default beNone;
property DisabledEffect: TBitmapEffect read FDisabledEffect write SetDisabledEffect default beGrayscale;
property HandleHotkeys: Boolean read FHandleHotkeys write FHandleHotkeys default True;
property HandleBookmarkHotkeys: Boolean read FHandleBookmarkHotkeys write FHandleBookmarkHotkeys default True;
property UseSystemColors: Boolean read FUseSystemColors write SetUseSystemColors default True;
property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clWhite;
property ForegroundColor: TColor read FForegroundColor write SetForegroundColor default clBlack;
property SelBackgroundColor: TColor read FSelBackgroundColor write SetSelBackgroundColor default clBlack;
property SelForegroundColor: TColor read FSelForegroundColor write SetSelForegroundColor default clWhite;
property FindBackgroundColor: TColor read FFndBkColor write SetFindBackgroundColor default clYellow;
property FindForegroundColor: TColor read FFndFgColor write SetFindForegroundColor default clBlack;
property LinkBackgroundColor: TColor read FLnkBkColor write SetLinkBackgroundColor default clWhite;
property LinkForegroundColor: TColor read FLnkFgColor write SetLinkForegroundColor default clBlue;
property Font: TFont read FFont write SetFont;
property LetterSpacing: Integer read FLetterSpacing write SetLetterSpacing default 1;
property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 1;
property CaretAfterEOL: Boolean read GetCaretAfterEOL write SetCaretAfterEOL default True;
property AutoIndent: Boolean read FAutoIndent write SetAutoIndent default True;
property PlainText: string read GetText write SetText;
property BeepOnInputError: Boolean read FBeepOnInputError write FBeepOnInputError default True;
property ErrorMessageOnReadOnlyError: Boolean read FErrorMessageOnReadOnlyError write FErrorMessageOnReadOnlyError default True;
property Overwrite: Boolean read FOverwrite write SetOverwrite default False;
property IndentSize: Integer read FIndentSize write SetIndentSize default 2;
property EditMode: TEditMode read GetEditMode write SetEditMode default emText;
property ShowHiddenCharacters: Boolean read FShowHiddenCharacters write SetShowHiddenCharacters default False;
property LineHighlight: Boolean read FLineHighlight write SetLineHighlight default False;
property LineHighlightColor: TColor read FLineHighlightColor write SetLineHighlightColor default DEFAULT_LINE_HIGHLIGHT_COLOR;
property MatchBrackets: Boolean read FMatchBrackets write SetMatchBrackets default True;
property BracketHighlightColor: TColor read FBracketHighlightColor write SetBracketHighlightColor default DEFAULT_BRACKET_HIGHLIGHT_COLOR;
property AutoReplace: Boolean read FAutoReplace write FAutoReplace default False;
property MessageInterface: Boolean read FMessageInterface write FMessageInterface default True;
property InputTransform: TInputTransform read FInputTransform write FInputTransform default itNone;
property SingleLine: Boolean read GetSingleLine write SetSingleLine default False;
property FallbackFonts: TStringList read FFallbackFonts write SetFallbackFonts;
property UnicodeFallback: Boolean read FUnicodeFallback write SetUnicodeFallback default True;
property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
property NumbersOnly: Boolean read FNumbersOnly write FNumbersOnly default False;
property TabLength: Integer read FTabLength write FTabLength default 2;
property LabelStyle: Boolean read FLabelStyle write SetLabelStyle default False;
property LabelEllipsis: Boolean read FLabelEllipsis write SetLabelEllipsis default True;
property AutoHeight: Boolean read FAutoHeight write SetAutoHeight default True;
property MultiSize: Boolean read FMultiSize write SetMultiSize default False;
property FormattingProcessor: TFormattingProcessor read FFormattingProcessor write SetFormattingProcessorSmple;
property RulerFont: TFont read FRulerFont write FRulerFont;
property RulerVisible: Boolean read GetRulerVisible write SetRulerVisible stored False;
property MarginLeft: Integer read FMarginLeft write SetMarginLeft default DEFAULT_MARGIN_LEFT;
property MarginRight: Integer read FMarginRight write SetMarginRight default DEFAULT_MARGIN_Right;
property MarginTop: Integer read FMarginTop write SetMarginTop default DEFAULT_MARGIN_Top;
property MarginBottom: Integer read FMarginBottom write SetMarginBottom default DEFAULT_MARGIN_Bottom;
property RulerWidth: Integer read FRulerWidth write SetRulerWidth default DEFAULT_RULER_WIDTH;
property RulerColor: TColor read FRulerColor write SetRulerColor default clDefault;
property PrintSettings: TPrintSettings read FPrintSettings;
property Zoom: Integer read FZoom write SetZoom default 100;
property RightLine: Boolean read FRightLine write SetRightLine default False;
property RightLinePos: Integer read FRightLinePos write SetRightLinePos default 580;
property RightLineColor: TColor read FRightLineColor write SetRightLineColor default clSilver;
property WrapAt: string read GetWrapAt write SetWrapAt;
property WrapAtRestore: Boolean read GetFalse write RestoreWrapAt default False;
property TextFileOwner: TTextFileOwner read FTextFileOwner write FTextFileOwner default tfoEditor;
property SelectionBarBehaviour: TSelectionBarBehaviour read FSelectionBarBehaviour write FSelectionBarBehaviour default sbbAutoMixed;
property NotificationMsgDuration: Integer read FNotifyMsgDuration write FNotifyMsgDuration default DEFAULT_NOTIFICATION_MSG_DURATION;
property ListBoxSelection: Boolean read FListBoxSelection write SetListBoxSelection;
property ListBoxMode: Boolean read FListBoxMode write SetListBoxMode;
property ListBoxItemIndex: Integer read GetListBoxItemIndex write SetListBoxItemIndex default -1;
property ListBoxHideSelection: Boolean read FListBoxHideSelection write SetListBoxHideSelection;
property MultiCharSelect: Boolean read FMultiCharSelect write FMultiCharSelect default True;
property MultiCharReportView: Boolean read FMultiCharReportView write FMultiCharReportView default False;
property ScrollBehaviour: TScrollBehaviour read FScrollBehaviour write FScrollBehaviour default sbDefault;
property AllowBitmapPaste: Boolean read FAllowBitmapPaste write FAllowBitmapPaste default False;
property TextHint: string read FTextHint write SetTextHint;
property Visible;
property WantTab: Boolean read FWantTab write FWantTab default True;
property WantReturn: Boolean read FWantReturn write FWantReturn default True;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
property OnOverwriteChange: TNotifyEvent read FOnOverwriteChange write FOnOverwriteChange;
property OnBookmarksMoved: TNotifyEvent read FOnBookmarksMoved write FOnBookmarksMoved;
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
property OnPrintBegin: TProgressStartEvent read FOnPrintBegin write FOnPrintBegin;
property OnPrintProgress: TProgressEvent read FOnPrintProgress write FOnPrintProgress;
property OnPrintEnd: TProgressCompleteEvent read FOnPrintEnd write FOnPrintEnd;
property OnNotification: TNotificationMessage read FOnNotification write FOnNotification;
property OnSimpleNotification: TSimpleNotificationMessage read FOnSimpleNotification write FOnSimpleNotification;
property OnCliGetPromptClass: TCliGetPromptClassEvent read FOnCliGetPromptClass write FOnCliGetPromptClass;
property OnCliInput: TCliInputEvent read FOnCliInput write FOnCliInput;
property OnListBoxChange: TNotifyEvent read FOnListBoxChange write FOnListBoxChange;
property OnListBoxSelect: TNotifyEvent read FOnListBoxSelect write FOnListBoxSelect;
property OnFindDataClear: TNotifyEvent read FOnFindDataClear write FOnFindDataClear;
property OnBeforeContextPopup: TNotifyEvent read FOnBeforeContextPopup write FOnBeforeContextPopup;
property OnHyperlinkClick: THyperlinkEvent read FOnHyperlinkClick write FOnHyperlinkClick;
property OnNavRequest: TNavRequestEvent read FOnNavRequest write FOnNavRequest;
property OnNavRequestGetEnabled: TNavRequestEnabledEvent read FOnNavRequestGetEnabled write FOnNavRequestGetEnabled;
end;
procedure Register;
const
RTE_CURSOR_BASE = 10;
crBlock = TCursor(RTE_CURSOR_BASE + 1);
crBlockCopy = TCursor(RTE_CURSOR_BASE + 2);
crHand = TCursor(RTE_CURSOR_BASE + 3);
crHandHold = TCursor(RTE_CURSOR_BASE + 4);
crLineSel = TCursor(RTE_CURSOR_BASE + 5);
var
FixedWidthFonts: TStrings;
GlobalFileNumber: Integer = 1;
type
DynIntegerArray = array of Integer;
DynStringArray = array of string;
function FormatDataSize(const ASize: Int64): string;
function Split(const Str: string; const Delim: string): DynStringArray;
implementation
{$R TextEditorCursors.res}
{$WARN WIDECHAR_REDUCED OFF}
uses
Character, StrUtils, Clipbrd, IMouse, SHFolder, Dialogs, ShellAPI, Printers,
Themes, RulerPropertiesWin, MultiInput, StdCtrls, ComCtrls, PngImage, IOUtils;
var
CF_PNG: Cardinal;
function _scale(X: Integer): Integer;
begin
Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;
const
CARET_WIDTH = 2;
SCROLL_EXTRA = 120;
AUTO_HEIGHT_PADDING = 2;
procedure Register;
begin
RegisterComponents('Rejbrand 2015', [TTextEditor,
TVowelsAndConsonantsFormattingProcessor, TXMLFormattingProcessor,
TCSSFormattingProcessor, TINIFormattingProcessor, TPascalFormattingProcessor,
TAlgoSimFormattingProcessor, THTMLFormattingProcessor,
TMediaWikiFormattingProcessor, TBracketListFormattingProcessor,
TASRefFormattingProcessor, TAlgosim3FormattingProcessor]);
end;
function B(A: Boolean): Integer;
begin
if A then
Result := 1
else
Result := 0;
end;
function GetAppDataFolder: string;
var
i: Integer;
begin
SetLength(Result, MAX_PATH);
if SHGetFolderPath(0, CSIDL_APPDATA, 0, SHGFP_TYPE_CURRENT, PChar(Result)) <> S_OK then
Exit('');
i := Pos(#0, Result);
if i > 0 then
SetLength(Result, i-1);
end;
function GetAutoReplaceDataFileName: string;
const
Spec = '\Rejbrand\AutoReplace\1.0\autoreplace.dat';
begin
Result := TPath.GetHomePath + Spec;
if not TFile.Exists(Result) and TFile.Exists(TPath.GetPublicPath + Spec) then
begin
ForceDirectories(ExtractFilePath(Result));
TFile.Copy(TPath.GetPublicPath + Spec, Result);
end;
end;
function FontRecord(ASize: Integer; AStyle: TFontStyles; AColor: TColor): TFontRecord;
begin
Result.Size := ASize;
Result.Style := AStyle;
Result.Color := AColor;
end;
function MakeClass(const AName: string; ASize: Integer; AStyle: TFontStyles; AColor: TColor): TClassRecord;
begin
Result.Name := AName;
Result.Format := FontRecord(ASize, AStyle, AColor);
end;
function MakeFindQuery(const ASearchString: string; AMatchCase, AMatchWord, ALinebreak: Boolean): TFindQuery;
begin
Result.SearchString := ASearchString;
Result.MatchCase := AMatchCase;
Result.MatchWord := AMatchWord;
Result.Linebreak := ALinebreak;
Result.UCBlock := 0;
end;
function MakeFindQuery(UCBlock: Integer): TFindQuery; overload;
begin
Result.SearchString := '';
Result.MatchCase := False;
Result.MatchWord := False;
Result.Linebreak := False;
Result.UCBlock := UCBlock;
end;
function SamePoint(const Point1, Point2: TPoint): Boolean; inline;
begin
Result := (Point1.X = Point2.X) and (Point1.Y = Point2.Y);
end;
function SameChangeRecord(const ChangeRecord1, ChangeRecord2: TChangeRecord): Boolean; inline;
begin
Result := (ChangeRecord1.ChangeType = ChangeRecord2.ChangeType) and
(ChangeRecord1.Data1 = ChangeRecord2.Data1) and
(ChangeRecord1.Data2 = ChangeRecord2.Data2) and
(ChangeRecord1.Data3 = ChangeRecord2.Data3) and
(ChangeRecord1.Data4 = ChangeRecord2.Data4);
end;
function ChangeSubset(const ChangeRecord1, ChangeRecord2: TChangeRecord): Boolean;
function IsOneOfThem(const Y, X: Integer): Boolean;
begin
Result := ((Y = ChangeRecord2.Data1) and (X = ChangeRecord2.Data2))
OR
((Y = ChangeRecord2.Data3) and (X = ChangeRecord2.Data4));
end;
begin
Result := False;
case ChangeRecord2.ChangeType of
ctFile:
Exit(True);
ctLineRange:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit((ChangeRecord1.Data1 >= ChangeRecord2.Data1) and (ChangeRecord1.Data2 <= ChangeRecord2.Data2));
ctBlock:
Exit((ChangeRecord1.Data1 >= ChangeRecord2.Data1) and (ChangeRecord1.Data2 <= ChangeRecord2.Data2));
ctLine:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2));
ctLineFrom:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2));
ctChar:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2));
ctTwoChars:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2) and InRange(ChangeRecord1.Data3, ChangeRecord2.Data1, ChangeRecord2.Data2));
end;
ctBlock:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit(False);
ctBlock:
Exit((ChangeRecord1.Data1 >= ChangeRecord2.Data1) and (ChangeRecord1.Data2 <= ChangeRecord2.Data2) and (ChangeRecord1.Data3 >= ChangeRecord2.Data3) and (ChangeRecord1.Data4 <= ChangeRecord2.Data4));
ctLine:
Exit(False);
ctLineFrom:
Exit(False);
ctChar:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2) and InRange(ChangeRecord1.Data2, ChangeRecord2.Data3, ChangeRecord2.Data4));
ctTwoChars:
Exit(InRange(ChangeRecord1.Data1, ChangeRecord2.Data1, ChangeRecord2.Data2) and InRange(ChangeRecord1.Data2, ChangeRecord2.Data3, ChangeRecord2.Data4) and InRange(ChangeRecord1.Data3, ChangeRecord2.Data1, ChangeRecord2.Data2) and InRange(ChangeRecord1.Data4, ChangeRecord2.Data3, ChangeRecord2.Data4));
end;
ctLine:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 = ChangeRecord2.Data1));
ctBlock:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 = ChangeRecord2.Data1));
ctLine:
Exit(ChangeRecord1.Data1 = ChangeRecord2.Data1);
ctLineFrom:
Exit(ChangeRecord1.Data1 = ChangeRecord2.Data1);
ctChar:
Exit(ChangeRecord1.Data1 = ChangeRecord2.Data1);
ctTwoChars:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data3 = ChangeRecord2.Data1));
end;
ctLineFrom:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit((ChangeRecord2.Data2 = 0) and (ChangeRecord1.Data1 = ChangeRecord1.Data2) and (ChangeRecord1.Data1 = ChangeRecord2.Data1));
ctBlock:
Exit((ChangeRecord1.Data1 = ChangeRecord1.Data2) and (ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data3 >= ChangeRecord2.Data2));
ctLine:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord2.Data2 = 0));
ctLineFrom:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 >= ChangeRecord2.Data2));
ctChar:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 >= ChangeRecord2.Data2));
ctTwoChars:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 >= ChangeRecord2.Data2) and (ChangeRecord1.Data3 = ChangeRecord2.Data1) and (ChangeRecord1.Data4 >= ChangeRecord2.Data2));
end;
ctChar:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit(False);
ctBlock:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord2.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data3 = ChangeRecord2.Data2) and (ChangeRecord2.Data3 = ChangeRecord2.Data2));
ctLine:
Exit(False);
ctLineFrom:
Exit(False);
ctChar:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 = ChangeRecord2.Data2));
ctTwoChars:
Exit((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 = ChangeRecord2.Data2) and (ChangeRecord1.Data3 = ChangeRecord2.Data1) and (ChangeRecord1.Data4 = ChangeRecord2.Data2));
end;
ctTwoChars:
case ChangeRecord1.ChangeType of
ctNone:
Exit(True);
ctFile:
Exit(False);
ctLineRange:
Exit(False);
ctBlock:
Exit(((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord2.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data3 = ChangeRecord2.Data2) and (ChangeRecord2.Data3 = ChangeRecord2.Data2)) OR ((ChangeRecord1.Data1 = ChangeRecord2.Data3) and (ChangeRecord2.Data1 = ChangeRecord2.Data3) and (ChangeRecord1.Data3 = ChangeRecord2.Data4) and (ChangeRecord2.Data3 = ChangeRecord2.Data4)));
ctLine:
Exit(False);
ctLineFrom:
Exit(False);
ctChar:
Exit(((ChangeRecord1.Data1 = ChangeRecord2.Data1) and (ChangeRecord1.Data2 = ChangeRecord2.Data2)) OR ((ChangeRecord1.Data1 = ChangeRecord2.Data3) and (ChangeRecord1.Data2 = ChangeRecord2.Data4)));
ctTwoChars:
Exit(IsOneOfThem(ChangeRecord1.Data1, ChangeRecord1.Data2) and IsOneOfThem(ChangeRecord1.Data3, ChangeRecord1.Data4));
end;
end;
end;
function MakeChangeRecord(ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
Result.ChangeType := ChangeType;
Result.Data1 := Data1;
Result.Data2 := Data2;
Result.Data3 := Data3;
Result.Data4 := Data4;
end;
function ChangeUnion(const ChangeRecord1, ChangeRecord2: TChangeRecord): TChangeRecord;
begin
if (ChangeRecord1.ChangeType = ctFile) or (ChangeRecord2.ChangeType = ctFile) then
Exit(FILE_CHANGE_RECORD);
if ChangeSubset(ChangeRecord1, ChangeRecord2) then
Exit(ChangeRecord2);
if ChangeSubset(ChangeRecord2, ChangeRecord1) then
Exit(ChangeRecord1);
if (ChangeRecord1.ChangeType = ctChar) and (ChangeRecord1.ChangeType = ctChar) then
begin
Result.ChangeType := ctTwoChars;
Result.Data1 := ChangeRecord1.Data1;
Result.Data2 := ChangeRecord1.Data2;
Result.Data3 := ChangeRecord2.Data1;
Result.Data4 := ChangeRecord2.Data2;
Exit;
end;
if (ChangeRecord1.ChangeType = ctBlock) and (ChangeRecord2.ChangeType = ctBlock) then
begin
Result.ChangeType := ctBlock;
Result.Data1 := Min(ChangeRecord1.Data1, ChangeRecord2.Data1);
Result.Data2 := Max(ChangeRecord1.Data2, ChangeRecord2.Data2);
Result.Data3 := Min(ChangeRecord1.Data3, ChangeRecord2.Data3);
Result.Data4 := Max(ChangeRecord1.Data4, ChangeRecord2.Data4);
Exit;
end;
if (ChangeRecord1.ChangeType = ctLineRange) and (ChangeRecord2.ChangeType = ctLineRange) then
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Min(ChangeRecord1.Data1, ChangeRecord2.Data1);
Result.Data2 := Max(ChangeRecord1.Data2, ChangeRecord2.Data2);
Exit;
end;
if (ChangeRecord1.ChangeType = ctLineRange) and (ChangeRecord2.ChangeType in [ctLine, ctLineFrom, ctChar]) then
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Min(ChangeRecord1.Data1, ChangeRecord2.Data1);
Result.Data2 := Max(ChangeRecord1.Data2, ChangeRecord2.Data1);
Exit;
end;
if (ChangeRecord2.ChangeType = ctLineRange) and (ChangeRecord1.ChangeType in [ctLine, ctLineFrom, ctChar]) then
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Min(ChangeRecord2.Data1, ChangeRecord1.Data1);
Result.Data2 := Max(ChangeRecord2.Data2, ChangeRecord1.Data1);
Exit;
end;
Result := FILE_CHANGE_RECORD;
end;
function MakeEditorCommand(Verb: Integer; Param1: Integer = 0;
ParamType1: TParamType = ptConstant; Param2: Integer = 0;
ParamType2: TParamType = ptConstant; Param3: Integer = 0;
ParamType3: TParamType = ptConstant; Param4: Integer = 0;
ParamType4: TParamType = ptConstant): TEditorCommand;
begin
Result.Verb := Verb;
Result.Param1.ParamType := ParamType1;
Result.Param1.ParamValue := Param1;
Result.Param2.ParamType := ParamType2;
Result.Param2.ParamValue := Param2;
Result.Param3.ParamType := ParamType3;
Result.Param3.ParamValue := Param3;
Result.Param4.ParamType := ParamType4;
Result.Param4.ParamValue := Param4;
end;
function Occurrences(const Str: string; const Chr: Char): Integer; overload;
var
i: Integer;
begin
Result := 0;
for i := 1 to Str.Length do
if Str[i] = Chr then
Inc(Result);
end;
function Occurrences(const Str: string; const SubStr: string;
out indices: DynIntegerArray): Integer; overload;
const
ALLOC_BY = 4096;
var
i: Integer;
begin
Result := 0;
i := 0;
SetLength(indices, ALLOC_BY);
repeat
i := PosEx(SubStr, Str, i + 1);
if i > 0 then
begin
if Result = length(indices) then
SetLength(indices, Length(indices) + ALLOC_BY);
indices[Result] := i;
Inc(Result);
end;
until i = 0;
SetLength(indices, Result);
end;
function Occurrences2(const Str: string; const SubStr: string;
out indices: DynIntegerArray): Integer; overload;
const
ALLOC_BY = 4096;
var
i: Integer;
begin
Result := 0;
i := 0;
SetLength(indices, ALLOC_BY);
repeat
i := PosEx(SubStr, Str, i + 1);
if i > 0 then
begin
if Result = length(indices) then
SetLength(indices, Length(indices) + ALLOC_BY);
indices[Result] := i;
Inc(Result);
end;
until i = 0;
SetLength(indices, Result + 1);
indices[Result] := Length(Str) + 1;
end;
function FormatDataSize(const ASize: Int64): string;
const
prefixes: array[0..6] of string = ('', 'k', 'M', 'G', 'T', 'P', 'E');
var
val: real;
n: Integer;
begin
if ASize < 0 then
raise Exception.CreateFmt('FormatDataSize: Invalid data size %d.', [ASize]);
val := ASize;
for n := 0 to High(prefixes) do
begin
if (val <= 1000) or (n = High(prefixes)) then
begin
Result := FormatFloat('0.##', val) + #32 + prefixes[n] + 'B';
break;
end;
val := val / 1024;
end;
end;
function Split(const Str: string; const Delim: string): DynStringArray;
var
n: Integer;
indices: DynIntegerArray;
i: Integer;
begin
n := Occurrences2(Str, Delim, indices);
SetLength(Result, n + 1);
if n = 0 then
Result[0] := Str
else
begin
Result[0] := Copy(Str, 1, indices[0] - 1);
for i := 0 to n - 1 do
Result[i+1] := Copy(Str, indices[i] + Length(Delim), indices[i + 1] - indices[i] - Length(Delim));
end;
end;
function imod(const x: Integer; const y: Integer): Integer;
begin
if x >= 0 then
imod := x - floor(x/y) * y
else
imod := x + ceil(-x/y) * y;
end;
function ChrUpperCase(C: Char): Char;
begin
Result := AnsiUpperCase(C)[1];
end;
function ChrLowerCase(C: Char): Char;
begin
Result := AnsiLowerCase(C)[1];
end;
function ChrInvertCase(C: Char): Char;
begin
if C.IsUpper then
Result := AnsiLowerCase(C)[1]
else
Result := AnsiUpperCase(C)[1];
end;
function ChrROT13(C: Char): Char;
begin
if InRange(Ord(C), Ord('A'), Ord('Z')) then
Result := Chr(Ord('A') + (Ord(C) - Ord('A') + 13) mod 26)
else if InRange(Ord(C), Ord('a'), Ord('z')) then
Result := Chr(Ord('a') + (Ord(C) - Ord('a') + 13) mod 26)
else
Result := C;
end;
function ChrCaesar(N: Integer): TChrTransformFunc;
begin
Result := function(C: Char): Char
begin
if InRange(Ord(C), Ord('A'), Ord('Z')) then
Result := Chr(Ord('A') + imod((Ord(C) - Ord('A') + N), 26))
else if InRange(Ord(C), Ord('a'), Ord('z')) then
Result := Chr(Ord('a') + imod((Ord(C) - Ord('a') + N), 26))
else
Result := C;
end;
end;
function TxtVigenère(const Key: string; decode: Boolean = False): TTextTransformFunc;
var
n: Integer;
KeyChrs: array of Byte;
i: Integer;
factor: Integer;
begin
n := Length(Key);
SetLength(KeyChrs, n);
for i := 1 to n do
if InRange(Ord(Key[i]), Ord('A'), Ord('Z')) then
KeyChrs[i - 1] := Ord(Key[i]) - Ord('A')
else
raise Exception.Create('Invalid character in Vigenère key.');
factor := IfThen(decode, -1, 1);
Result := function(const AText: string): string
var
j: Integer;
begin
SetLength(Result, Length(AText));
for j := 1 to Length(AText) do
begin
if InRange(Ord(AText[j]), Ord('A'), Ord('Z')) then
Result[j] := Chr(Ord('A') + imod(Ord(AText[j]) - Ord('A') + factor * KeyChrs[(j - 1) mod n], 26))
else if InRange(Ord(AText[j]), Ord('a'), Ord('z')) then
Result[j] := Chr(Ord('a') + imod(Ord(AText[j]) - Ord('a') + factor * KeyChrs[(j - 1) mod n], 26))
else
Result[j] := AText[j];
end;
end;
end;
function TxtCamelCase(const AText: string): string;
var
i: Integer;
StartOfWord: Boolean;
begin
StartOfWord := True;
Result := AText;
for i := 1 to Length(AText) do
begin
if StartOfWord and IsCharAlpha(AText[i]) then
begin
Result[i] := AnsiUpperCase(AText[i])[1];
StartOfWord := False;
end
else if AText[i].IsWhiteSpace then
StartOfWord := True;
end;
end;
function TxtSentenceCase(const AText: string): string;
var
StartOfSentence: Boolean;
i: Integer;
begin
StartOfSentence := True;
Result := AText;
for i := 1 to AText.Length do
if StartOfSentence and IsCharAlpha(AText[i]) then
begin
Result[i] := AnsiUpperCase(AText[i])[1];
StartOfSentence := False;
end
else if AText[i] in ['.', '!', '?'] then
StartOfSentence := True;
end;
function ReverseText(const AText: string): string;
var
i, j: Integer;
begin
SetLength(Result, AText.Length);
if AText.IsEmpty then
Exit;
i := 1;
j := Result.Length;
while j > 0 do
begin
if (AText[i] = #13) and (i < AText.Length) and (AText[i + 1] = #10) then
begin
Result[j] := #10;
Result[j - 1] := #13;
Inc(i);
Dec(j);
end
else
Result[j] := AText[i];
Inc(i);
Dec(j);
end;
end;
function IsKeyDown(const AKey: Integer): Boolean; inline;
begin
Result := GetKeyState(AKey) and $8000 <> 0;
end;
function IsKeyOn(const AKey: Integer): Boolean;
begin
Result := GetKeyState(AKey) and 1 = 1;
end;
function GetScrollMode: Boolean;
var
AltDown, ScrlLockOn: Boolean;
begin
AltDown := IsKeyDown(VK_LMENU);
ScrlLockOn := IsKeyOn(VK_SCROLL);
Result := (AltDown xor ScrlLockOn) and not IsKeyDown(VK_SHIFT);
end;
procedure TTextEditor.ChangeCursor(Shift: TShiftState);
var
P: TPoint;
begin
if GetCursorPos(P) then
with ScreenToClient(P) do
ChangeCursor(Shift, Y, X);
end;
procedure TTextEditor.ChangeCursor(Shift: TShiftState; Y, X: Integer);
var
CP: TPoint;
LCursor: TCursor;
begin
if not (FValidPaintState and Visible) then Exit;
if FScriptRunning then
begin
Cursor := crHourGlass;
Exit;
end;
CP := CharAtPhysicalPixel(Point(X, Y));
if FScrollMode then
if csLButtonDown in ControlState then
begin
LCursor := crHandHold;
SetCursor(Screen.Cursors[crHandHold])
end
else
LCursor := crHand
else if X < GetFunctionalSelectionBarWidth then
LCursor := crLineSel
else if ((X >= FMarginLeft) and FTextFile.IsCharSel(CP)) and not SingleLine then
if ssCtrl in Shift then
LCursor := crBlockCopy
else
LCursor := crBlock
else if IsCharLink(CP) then
LCursor := crHandPoint
else
LCursor := crIBeam;
if FListBoxMode and (LCursor = crIBeam) then
LCursor := crArrow;
Cursor := LCursor;
end;
function TTextEditor.CaretPosAtVirtualPixel(Pixel: TPoint): TPoint;
begin
Result := CharAtVirtualPixelEx(Pixel, True);
end;
procedure TTextEditor.CenterOnSelection(AReducedScroll: Boolean);
var
p1, p2, p: TPoint;
begin
p1 := VirtualPixelAtChar(TextFile.CaretPos.Data);
if TextFile.HasSelection then
p2 := VirtualPixelAtChar(TextFile.CaretPos.SelEnd)
else
p2 := p1;
p.X := p1.X + (p2.X - p1.X) div 2 - ClientWidth div 2;
p.Y := p1.Y + (p2.Y - p1.Y) div 2 - ClientHeight div 2;
if AReducedScroll then
begin
if Abs(FScrollPos.X - p.X) < ClientWidth div 3 then
p.X := FScrollPos.X;
if Abs(FScrollPos.Y - p.Y) < ClientHeight div 3 then
p.Y := FScrollPos.Y;
end;
SetScrollPosXY(p.X, p.Y);
end;
function TTextEditor.CaretPosAtPhysicalPixel(Pixel: TPoint): TPoint;
begin
Result := CharAtPhysicalPixelEx(Pixel, True);
end;
function TTextEditor.ChrInGlyphSet(GlyphSet: PGlyphSet;
Codepoint: Integer): Boolean;
function InInterval(Val, Start, Length: Integer): Boolean; inline;
begin
InInterval := (Val >= Start) and (Val < Start + Length);
end;
var
i: Integer;
begin
Result := False;
if GlyphSet = nil then Exit;
for i := 0 to GlyphSet^.cRanges - 1 do
with GlyphSet^.ranges[i] do
if InInterval(Codepoint, Ord(wcLow), cGlyphs) then
Exit(True);
end;
function TTextEditor.ChrInGlyphSet(GlyphSet: PGlyphSet;
Character: Char): Boolean;
begin
Result := ChrInGlyphSet(GlyphSet, Ord(Character));
end;
function TTextEditor.ChrTransformSelection(Transformation: TChrTransformFunc;
const TransformName: string): Boolean;
begin
TypeTimerEnd;
Result := FTextFile.ChrTransform(Transformation);
if Result then
AddUndoRecord(Format(SUndoSelectionTransformed, [TransformName]), UID_UNKNOWN);
end;
procedure TTextEditor.ChrTransformText(Transformation: TChrTransformFunc;
const TransformName: string);
begin
TypeTimerEnd;
FTextFile.ChrTransformText(Transformation);
AddUndoRecord(Format(SUndoTextTransformed, [TransformName]), UID_UNKNOWN);
end;
procedure TTextEditor.ClearLine;
begin
TypeTimerEnd;
FTextFile.ClearLine;
AddUndoRecord(SUndoLineCleared, UID_DELETE);
end;
procedure TTextEditor.ClearSelection;
begin
TypeTimerEnd;
FTextFile.ClearSelection;
AddUndoRecord(SUndoSelectionCleared, UID_DELETE);
end;
procedure TTextEditor.ClearUndoHistory;
begin
FTypeTimer.Enabled := False;
FTextFile.ClearUndoHistory;
AddUndoRecord(SUndoFirstPost, UID_UNKNOWN);
end;
procedure TTextEditor.CliAddHistory(const AStr: string);
begin
if (FCliHistory.Count = 0) or (FCliHistory.Last <> AStr) then
FCliHistory.Add(AStr);
end;
procedure TTextEditor.CliBeginOutput;
begin
Inc(FCliMultiOutput);
end;
procedure TTextEditor.CliClear;
begin
EditMode := emText;
Clear;
EditMode := emConsole;
end;
procedure TTextEditor.CliClearHistory;
begin
FCliHistory.Clear;
end;
procedure TTextEditor.CliEndOutput;
begin
Dec(FCliMultiOutput);
if FCliMultiOutput = 0 then
CliNewPrompt;
end;
procedure TTextEditor.CliHistoryDialogListBoxSelect(Sender: TObject);
var
frm: TCustomForm;
begin
if Sender is TTextEditor then
begin
frm := GetParentForm(TTextEditor(Sender));
if Assigned(frm) then
frm.ModalResult := mrOk;
end;
end;
procedure TTextEditor.CliHistoryDialogListBoxKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
var
frm: TCustomForm;
begin
if Key = VK_ESCAPE then
if Sender is TTextEditor then
begin
frm := GetParentForm(TTextEditor(Sender));
if Assigned(frm) then
frm.ModalResult := mrCancel;
end;
end;
function TTextEditor.CliHistoryDialog(AFormClass: TFormClass): Integer;
var
frm: TForm;
lb: TTextEditor;
i: Integer;
begin
if AFormClass = nil then
AFormClass := TForm;
Result := -1;
frm := AFormClass.CreateNew(GetParentForm(Self));
try
frm.Caption := SCliHistoryDialogCaption;
if AFormClass = TForm then
begin
frm.BorderStyle := bsSizeToolWin;
frm.ClientWidth := 512;
frm.ClientHeight := 256;
with ClientToScreen(Point(ClientWidth div 2 - frm.ClientWidth div 2,
ClientHeight div 2 - frm.ClientHeight div 2)) do
begin
frm.Left := X;
frm.Top := Y;
end;
end;
lb := TTextEditor.Create(frm);
lb.Parent := frm;
lb.Align := alClient;
lb.BorderType := btNone;
lb.TabStop := True;
lb.UseSystemColors := Self.UseSystemColors;
lb.Color := Self.Color;
lb.Font.Assign(Self.Font);
lb.RulerFont.Assign(Self.RulerFont);
lb.LineHighlightColor := Self.LineHighlightColor;
if lb.Color = lb.LineHighlightColor then
begin
lb.Color := clWhite;
lb.Font.Color := clBlack;
lb.LineHighlightColor := DEFAULT_LINE_HIGHLIGHT_COLOR;
end;
lb.ListBoxMode := True;
lb.RulerWidth := _scale(32);
lb.MarginLeft := _scale(48);
lb.RulerColor := Self.RulerColor;
lb.MatchBrackets := False;
lb.CaretAfterEOL := False;
lb.UseRuxThemes := Self.UseRuxThemes;
lb.OnKeyDown := CliHistoryDialogListBoxKeyDown;
lb.OnListBoxSelect := CliHistoryDialogListBoxSelect;
lb.BeginAddLine;
try
for i := 0 to CliHistoryCount - 1 do
lb.AddLine(CliHistory[i]);
finally
lb.EndAddLine;
end;
if FCliHistoryIndex <> -1 then
lb.ListBoxItemIndex := FCliHistoryIndex;
lb.SetSizeHooks;
try
if frm.ShowModal = mrOk then
Result := lb.ListBoxItemIndex;
finally
lb.RemoveSizeHooks;
end;
finally
frm.Free;
end;
end;
function TTextEditor.CliHistoryDialogSelect(AFormClass: TFormClass): Boolean;
var
Idx: Integer;
begin
Idx := CliHistoryDialog(AFormClass);
Result := Idx <> -1;
if Result then
CliHistoryRecall(Idx);
end;
function TTextEditor.CliHistoryDown: Boolean;
begin
Result := InRange(FCliHistoryIndex, 0, FCliHistory.Count - 2);
if Result then
begin
Inc(FCliHistoryIndex);
TypeTimerEnd;
Lines[LineCount - 1] := FCliHistory[FCliHistoryIndex];
FTextFile.GotoEOF;
AddUndoRecord(SUndoCliHistory, UID_UNKNOWN);
end;
end;
function TTextEditor.CliHistoryRecall(Index: Integer): Boolean;
begin
Result := InRange(Index, 0, FCliHistory.Count - 1);
if Result then
begin
FCliHistoryIndex := Index;
TypeTimerEnd;
Lines[LineCount - 1] := FCliHistory[FCliHistoryIndex];
FTextFile.GotoEOF;
AddUndoRecord(SUndoCliHistory, UID_UNKNOWN);
end;
end;
function TTextEditor.CliHistoryUp: Boolean;
begin
Result := InRange(FCliHistoryIndex, 1, FCliHistory.Count);
if Result then
begin
Dec(FCliHistoryIndex);
TypeTimerEnd;
Lines[LineCount - 1] := FCliHistory[FCliHistoryIndex];
FTextFile.GotoEOF;
AddUndoRecord(SUndoCliHistory, UID_UNKNOWN);
end;
end;
procedure TTextEditor.CliNewPrompt;
var
ClassName: string;
begin
FTypeTimer.Enabled := False;
ClassName := '';
if Assigned(FOnCliGetPromptClass) then
FOnCliGetPromptClass(Self, ClassName);
if (LineCount = 0) or not Lines[LineCount - 1].IsEmpty or not SameText(LineClasses[LineCount - 1], ClassName) then
AddLine('', ClassName);
ClearUndoHistory;
FCliHistoryIndex := FCliHistory.Count;
end;
procedure TTextEditor.CliWriteLn(const AStr, AClass: string);
begin
if FTextFile.LineIsEmpty(LineCount - 1) then
begin
Lines[LineCount - 1] := AStr;
LineClasses[LineCount - 1] := AClass;
end
else
AddLine(AStr, AClass);
if FCliMultiOutput = 0 then
CliNewPrompt;
end;
procedure TTextEditor.CliWriteLn(const AStr: string);
begin
CliWriteLn(AStr, '');
end;
procedure TTextEditor.CliWrite(const AStr, AClass: string);
var
strs: TArray<string>;
start: Integer;
i: Integer;
begin
strs := AStr.Split([sLineBreak]);
if (Length(strs) > 0) and FTextFile.LineIsEmpty(LineCount - 1) then
begin
Lines[LineCount - 1] := strs[0];
LineClasses[LineCount - 1] := AClass;
start := 1;
end
else
start := 0;
BeginAddLine;
try
for i := start to High(strs) do
AddLine(strs[i], AClass);
finally
EndAddLine;
end;
if FCliMultiOutput = 0 then
CliNewPrompt;
end;
procedure TTextEditor.CliWriteLn;
begin
CliWriteLn('', '');
end;
procedure TTextEditor.CMMouseEnter(var Message: TMessage);
begin
inherited;
UpdateScrollMode;
end;
procedure TTextEditor.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FLinks) then
begin
FCharLinkIndex := -1;
FMouseDownLinkIndex := -1;
if FCharLinkIndex <> FPrevCharLinkIndex then
begin
if InRange(FPrevCharLinkIndex, 0, FLinks.Count - 1) then
with FLinks[FPrevCharLinkIndex] do
VisualUpdate(ctBlock, Location.Y, Location.Y, Location.X, EndPos);
if InRange(FCharLinkIndex, 0, FLinks.Count - 1) then
with FLinks[FCharLinkIndex] do
VisualUpdate(ctBlock, Location.Y, Location.Y, Location.X, EndPos);
end;
FPrevCharLinkIndex := FCharLinkIndex;
end;
Hint := '';
end;
procedure TTextEditor.ClearLine(LineIndex: Integer);
begin
FTextFile.ClearLine(LineIndex);
end;
function TTextEditor.CommandChecked(Command: Integer): Boolean;
begin
Result := False;
case Command and $FFFF of
EDITOR_COMMAND_TOGGLE_CARET_BEYOND_EOL:
Result := CaretAfterEOL;
end;
end;
function TTextEditor.CommandEnabled(Command: Integer): Boolean;
var
dummy: string;
begin
Result := True;
case Command and $FFFF of
EDITOR_COMMAND_BACK,
EDITOR_COMMAND_FORWARD:
Result := FBrowserContextMenu and DoNavRequestGetEnabled(Command and $FFFF);
EDITOR_COMMAND_PASTE:
Result := (Clipboard.HasFormat(CF_TEXT) or (FAllowBitmapPaste and Clipboard.HasFormat(CF_BITMAP) and not SingleLine)) and Enabled;
EDITOR_COMMAND_PASTE_AS_BLOCK:
Result := Clipboard.HasFormat(CF_TEXT) and Enabled;
EDITOR_COMMAND_CUT, EDITOR_COMMAND_CLEAR_SELECTION:
Result := FTextFile.HasSelection and Enabled;
EDITOR_COMMAND_COPY:
Result :=
Enabled
and
(
FListBoxMode and not FTextFile.CurrentLine.IsEmpty
or
FTextFile.HasSelection
or
not GetWord.IsEmpty
);
EDITOR_COMMAND_UNDO:
Result := CanUndo;
EDITOR_COMMAND_REDO:
Result := CanRedo;
EDITOR_COMMAND_SELECT_ALL:
Result := not FTextFile.Empty and Enabled;
EDITOR_COMMAND_COPY_ALL:
Result := not FTextFile.Empty;
EDITOR_COMMAND_COPY_LINE:
Result := not FTextFile.CurrentLine.IsEmpty;
EDITOR_COMMAND_ACTIVATE_CONTROL:
Result := LineIsWinControlOrHasPopup(CaretPos.Y);
EDITOR_COMMAND_CLASS_MENU:
Result := not LineIsControl(CaretPos.Y);
EDITOR_COMMAND_OPEN_URL_AT_CARET:
Result := GetURLAtCaret(dummy);
EDITOR_COMMAND_SEL_UPPER_CASE .. EDITOR_COMMAND_SEL_INVERT_CASE,
EDITOR_COMMAND_SEL_ROT13 .. EDITOR_COMMAND_SEL_CAESAR:
Result := FTextFile.HasSelection;
EDITOR_COMMAND_SEL_CAMEL_CASE .. EDITOR_COMMAND_SEL_SENTENCE_CASE,
EDITOR_COMMAND_SEL_VIGENERE, EDITOR_COMMAND_SEL_REVERSE:
Result := FTextFile.HasSelection and (FTextFile.CaretPos.SelectionType = stLineBased);
EDITOR_COMMAND_SORT_ALL, EDITOR_COMMAND_SORT:
Result := FTextFile.LineCount >= 2;
EDITOR_COMMAND_SORT_SEL:
Result := FTextFile.HasSelection;
EDITOR_COMMAND_ABORT_SCRIPT:
Result := FScriptRunning;
EDITOR_COMMAND_SAVE, EDITOR_COMMAND_SET_EDIT_MODE:
Result := not FTextFile.StrictReadOnly;
end;
end;
function TTextEditor.CommandVisible(Command: Integer): Boolean;
var
dummy: string;
begin
Result := True;
case Command and $FFFF of
EDITOR_COMMAND_BACK,
EDITOR_COMMAND_FORWARD:
Result := FBrowserContextMenu;
EDITOR_COMMAND_UNDO,
EDITOR_COMMAND_REDO,
EDITOR_COMMAND_CUT,
EDITOR_COMMAND_PASTE,
EDITOR_COMMAND_CLEAR_SELECTION,
EDITOR_COMMAND_CLEAR_LINE:
Result := EditMode <> emReadOnly;
EDITOR_COMMAND_ACTIVATE_CONTROL:
Result := LineIsWinControlOrHasPopup(CaretPos.Y);
EDITOR_COMMAND_BOOKMARK_SET_MENU,
EDITOR_COMMAND_BOOKMARK_GO_MENU,
EDITOR_COMMAND_BOOKMARK_CLEAR_MENU:
Result := not SingleLine;
EDITOR_COMMAND_CLASS_MENU:
Result := (ClassCount > 0) and FTextFile.UseLineClasses;
EDITOR_COMMAND_OPEN_URL_AT_CARET:
Result := GetURLAtCaret(dummy);
EDITOR_COMMAND_SEL_TRANSFORM_MENU:
Result := FTextFile.HasSelection and (EditMode <> emReadOnly);
EDITOR_COMMAND_PRINT_DIALOG:
Result := FBrowserContextMenu;
EDITOR_COMMAND_TOGGLE_CARET_BEYOND_EOL:
Result := not SingleLine and not FBrowserContextMenu;
end;
end;
function TTextEditor.ControlInSelection: Boolean;
var
FirstPoint, SecondPoint: TPoint;
i: Integer;
begin
Result := False;
if not FTextFile.ControlAware then Exit;
FTextFile.CaretPos.GetSelBdry(FirstPoint, SecondPoint);
for i := FirstPoint.Y to SecondPoint.Y do
if LineIsControl(i) then
Exit(True);
end;
procedure TTextEditor.CopyAll;
begin
Clipboard.AsText := GetText;
end;
procedure TTextEditor.CopyLine;
begin
if FTextFile.LineExists(CaretPos.Y) then
Clipboard.AsText := GetLine(CaretPos.Y);
end;
procedure TTextEditor.CopySelection(const ANewPos: TPoint);
var
S: string;
begin
if FTextFile.IsCharSel(ANewPos) then Exit;
TypeTimerEnd;
S := SelText;
FTextFile.CaretPos.SetPoint(ANewPos);
FTextFile.InsertText(S);
AddUndoRecord(SUndoMouseCopy, UID_DRAGDROP);
end;
procedure TTextEditor.CopyToClipboard;
var
CP: TPoint;
begin
if FListBoxMode and not FTextFile.HasSelection then
CopyLine
else
if FTextFile.HasSelection then
FTextFile.CopyToClipboard
else if not GetWord.IsEmpty then
begin
CP := CaretPos;
SelectWord;
FTextFile.CopyToClipboard;
Sleep(250);
CaretPos := CP;
end;
end;
procedure TTextEditor.FallbackFontsChange(Sender: TObject);
begin
BuildFontDataArray;
Invalidate;
end;
procedure TTextEditor.BalloonTimerTimer(Sender: TObject);
begin
FBalloonTimer.Enabled := False;
HideBalloon;
end;
procedure TTextEditor.UpdateSPI;
begin
SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, FSPIScrollLines, 0);
end;
constructor TTextEditor.Create(AOwner: TComponent);
var
item, item2: TMenuItem;
begin
inherited;
FCharLinkIndex := -1;
FMouseDownLinkIndex := -1;
FPrevCharLinkIndex := -1;
FPDict := TDictionary<string, TFormattingProcessor>.Create;
FInsertionPoint := Point(-1, -1);
FWantReturn := True;
FWantTab := True;
FAllowBitmapPaste := False;
UpdateSPI;
FMultipleCarets := False;
SetLength(FCarets, 0);
FCaretAfterEOL := True;
FScrollBehaviour := sbDefault;
FIndentSize := 2;
FAutoIndent := True;
FVisualUpdateLock := 0;
FBitmapEffect := beNone;
FDisabledEffect := beGrayscale;
Width := 400;
Height := 200;
DoubleBuffered := True;
FNoVerifyFont := False;
FMultiCharReportView := False;
FASHyphenAsteriskToggle := False;
FMultiCharSelect := True;
FValidPaintState := False;
FCliHistoryIndex := -1;
FCliHistory := TList<string>.Create;
FPreserveDesiredColumn := False;
FScriptCounter := 0;
FAbortScript := False;
FScriptRunning := False;
FNotifyMsgDuration := DEFAULT_NOTIFICATION_MSG_DURATION;
SetLength(FNotifications, 0);
FSelectionBarBehaviour := sbbAutoMixed;
FTextFileOwner := tfoEditor;
FBorderColor := clSilver;
FRightLine := False;
FRightLinePos := 580;
FRightLineColor := clSilver;
FPrintSettings := TPrintSettings.Create;
FZoom := 100;
FRulerColor := clDefault;
FNoScrollToCaret := False;
FRulerWidth := DEFAULT_RULER_WIDTH;
FMarginLeft := DEFAULT_MARGIN_LEFT;
FMarginRight := DEFAULT_MARGIN_RIGHT;
FMarginTop := DEFAULT_MARGIN_TOP;
FMarginBottom := DEFAULT_MARGIN_BOTTOM;
FNextControlID := 0;
FCachedHorizontalExtent := 0;
FMultiSize := False;
FAutoHeight := True;
FLabelStyle := False;
FLabelEllipsis := True;
FTabLength := 2;
FBalloonTimer := TTimer.Create(nil);
FBalloonTimer.Enabled := False;
FBalloonTimer.Interval := 10000;
FBalloonTimer.OnTimer := BalloonTimerTimer;
FNumbersOnly := False;
FPasswordChar := #0;
FGLYPHBM := TBitmap.Create;
FFONTBM := TBitmap.Create;
FUnicodeFallback := True;
FFallbackFonts := TStringList.Create;
FFallbackFonts.OnChange := FallbackFontsChange;
FBorderType := btThemeBorder;
FStartOver := True;
FFndBkColor := clYellow;
FFndFgColor := clBlack;
FLnkBkColor := clWhite;
FLnkFgColor := clBlue;
FInputTransform := itNone;
FMessageInterface := True;
FAutoReplace := False;
FScrollPos := Point(0, 0);
FBracketHighlight := False;
FShowHiddenCharacters := False;
FLineHighlight := False;
FLineHighlightColor := DEFAULT_LINE_HIGHLIGHT_COLOR;
FBracketHighlightColor := DEFAULT_BRACKET_HIGHLIGHT_COLOR;
FDoubleClicking := False;
Cursor := crIBeam;
FUseSystemColors := True;
FBackgroundColor := clWhite;
FForegroundColor := clBlack;
FSelBackgroundColor := clBlack;
FSelForegroundColor := clWhite;
FLetterSpacing := 1;
FLineSpacing := 1;
FTextFile := TTextFile.Create;
ConnectTextFileToEditor;
FTextFile.AutoIndent := True;
FFont := TFont.Create;
VerifyFont;
FFont.OnChange := FontChange;
SetupColors;
FHandleHotkeys := True;
FHandleBookmarkHotkeys := True;
FBeepOnInputError := True;
FErrorMessageOnReadOnlyError := True;
FOverwrite := False;
FMatchBrackets := True;
FRulerFont := TFont.Create;
FRulerFont.OnChange := RulerFontChange;
ControlStyle := ControlStyle + [csPannable];
FTypeTimer := TTimer.Create(nil);
FTypeTimer.Enabled := False;
FTypeTimer.Interval := 2000;
FTypeTimer.OnTimer := TypeTimerTimer;
if not FHasLoadedCursors then
begin
Screen.Cursors[crBlock] := LoadImage(hInstance, 'SELHOVER', IMAGE_CURSOR,
0, 0, LR_DEFAULTCOLOR);
Screen.Cursors[crBlockCopy] := LoadImage(hInstance, 'SELCOPY', IMAGE_CURSOR,
0, 0, LR_DEFAULTCOLOR);
Screen.Cursors[crHand] := LoadImage(hInstance, 'HAND', IMAGE_CURSOR, 0, 0,
LR_DEFAULTCOLOR);
Screen.Cursors[crHandHold] := LoadImage(hInstance, 'HANDHOLD', IMAGE_CURSOR,
0, 0, LR_DEFAULTCOLOR);
Screen.Cursors[crLineSel] := LoadImage(hInstance, 'LINESEL', IMAGE_CURSOR,
0, 0, LR_DEFAULTCOLOR);
FHasLoadedCursors := True;
end;
FPopupMenu := TPopupMenu.Create(nil);
FPopupMenu.OnPopup := MenuPopup;
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuOpenURL;
item.Hint := SMenuOpenURLHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_OPEN_URL_AT_CARET;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuBack;
item.Hint := SMenuBackHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_BACK;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuForward;
item.Hint := SMenuForwardHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_FORWARD;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuUndo;
item.Hint := SMenuUndoHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_UNDO;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuRedo;
item.Hint := SMenuRedoHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_REDO;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuCut;
item.Hint := SMenuCutHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_CUT;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuCopy;
item.Hint := SMenuCopyHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_COPY;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuPaste;
item.Hint := SMenuPasteHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_PASTE;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuClear;
item.Hint := SMenuClearHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_CLEAR_SELECTION;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuSelectAll;
item.Hint := SMenuSelectAllHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_SELECT_ALL;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuSetBookmark;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_BOOKMARK_SET_MENU;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuGotoBookmark;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_BOOKMARK_GO_MENU;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuClearBookmark;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_BOOKMARK_CLEAR_MENU;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuClasses;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_CLASS_MENU;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuActivateControl;
item.Hint := SMenuActivateControlHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_ACTIVATE_CONTROL;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuTransform;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_SEL_TRANSFORM_MENU;
FPopupMenu.Items.Add(item);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformUpperCase;
item2.Hint := SMenuTransformUpperCaseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_UPPER_CASE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformLowerCase;
item2.Hint := SMenuTransformLowerCaseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_LOWER_CASE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformInvertCase;
item2.Hint := SMenuTransformInvertCaseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_INVERT_CASE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformCamelCase;
item2.Hint := SMenuTransformCamelCaseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_CAMEL_CASE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformSentenceCase;
item2.Hint := SMenuTransformSentenceCaseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_SENTENCE_CASE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := '-';
item2.OnClick := MenuItemMessage;
item2.Tag := 0;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformReverse;
item2.Hint := SMenuTransformReverseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_REVERSE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformROT13;
item2.Hint := SMenuTransformROT13Hint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_ROT13;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformCaesar;
item2.Hint := SMenuTransformCaesarHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_CAESAR;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformVigenere;
item2.Hint := SMenuTransformVigenereHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_VIGENERE;
item.Add(item2);
item2 := TMenuItem.Create(item);
item2.Caption := SMenuTransformVigenereInverse;
item2.Hint := SMenuTransformVigenereInverseHint;
item2.OnClick := MenuItemMessage;
item2.Tag := EDITOR_COMMAND_SEL_VIGENERE or $00010000;
item.Add(item2);
item := TMenuItem.Create(FPopupMenu);
item.Caption := '-';
item.Tag := 0;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SPrint;
item.Hint := SPrintHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_PRINT_DIALOG;
FPopupMenu.Items.Add(item);
item := TMenuItem.Create(FPopupMenu);
item.Caption := SMenuToggleCaretBeyondEOL;
item.Hint := SMenuToggleCaretBeyondEOLHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_TOGGLE_CARET_BEYOND_EOL;
FPopupMenu.Items.Add(item);
FImagePopup := TPopupMenu.Create(nil);
item := TMenuItem.Create(FImagePopup);
item.Caption := SMenuCopyImage;
item.Hint := SMenuCopyImageHint;
item.OnClick := ImageMenuCommand;
item.Tag := IMAGE_COMMAND_COPY;
FImagePopup.Items.Add(item);
item := TMenuItem.Create(FImagePopup);
item.Caption := SMenuDeleteImage;
item.Hint := SMenuDeleteImageHint;
item.OnClick := ImageMenuCommand;
item.Tag := IMAGE_COMMAND_REMOVE;
FImagePopup.Items.Add(item);
item := TMenuItem.Create(FImagePopup);
item.Caption := SMenuChangeImage;
item.Hint := SMenuChangeImageHint;
item.OnClick := ImageMenuCommand;
item.Tag := IMAGE_COMMAND_CHANGE;
FImagePopup.Items.Add(item);
FRulerMenu := TPopupMenu.Create(nil);
item := TMenuItem.Create(FRulerMenu);
item.Caption := SMenuRulerProperties;
item.Hint := SMenuRulerPropertiesHint;
item.OnClick := RulerMenuCommand;
item.Tag := RULER_COMMAND_PROPERTIES;
FRulerMenu.Items.Add(item);
FListboxMenu := TPopupMenu.Create(nil);
FListboxMenu.OnPopup := MenuPopup;
item := TMenuItem.Create(FListboxMenu);
item.Caption := SMenuCopyLine;
item.Hint := SMenuCopyLineHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_COPY_LINE;
FListboxMenu.Items.Add(item);
item := TMenuItem.Create(FListboxMenu);
item.Caption := SMenuCopyAll;
item.Hint := SMenuCopyAllHint;
item.OnClick := MenuItemMessage;
item.Tag := EDITOR_COMMAND_COPY_ALL;
FListboxMenu.Items.Add(item);
FDropMenu := TPopupMenu.Create(nil);
FDropMenuMove := TMenuItem.Create(FDropMenu);
FDropMenuMove.Caption := SMoveHere;
FDropMenu.Items.Add(FDropMenuMove);
FDropMenuCopy := TMenuItem.Create(FDropMenu);
FDropMenuCopy.Caption := SCopyHere;
FDropMenu.Items.Add(FDropMenuCopy);
item := TMenuItem.Create(FDropMenu);
item.Caption := '-';
FDropMenu.Items.Add(item);
item := TMenuItem.Create(FDropMenu);
item.Caption := SCancel;
FDropMenu.Items.Add(item);
FCustomMenuItems := TList<TMenuItem>.Create;
UseDefaultFallbackFonts;
BuildFontDataArray;
FBlinkRemover := TTimer.Create(nil);
FBlinkRemover.Enabled := False;
FBlinkRemover.Interval := 500;
FBlinkRemover.OnTimer := BlinkRemoverTimer;
TabStop := True;
OleInitialize(nil);
CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_INPROC_SERVER,
IID_IDropTargetHelper, FDropTargetHelper);
FXDRAG := Abs(GetSystemMetrics(SM_CXDRAG));
FYDRAG := Abs(GetSystemMetrics(SM_CYDRAG));
if Assigned(FInstances) then
FInstances.Add(Self);
AddUndoRecord(SUndoNewFile, UID_UNKNOWN);
if Assigned(OnAddInstance) then
OnAddInstance(Self);
end;
procedure TTextEditor.ImageMenuCommand(Sender: TObject);
var
bm: TBitmap;
begin
if not (FImagePopup.PopupComponent is TImage) then Exit;
if not (Sender is TMenuItem) then Exit;
case TMenuItem(Sender).Tag of
IMAGE_COMMAND_COPY:
if TImage(FImagePopup.PopupComponent).Picture.Graphic is TIcon then
begin
bm := TBitmap.Create;
try
bm.SetSize(TImage(FImagePopup.PopupComponent).Picture.Width,
TImage(FImagePopup.PopupComponent).Picture.Height);
bm.Canvas.Draw(0, 0, TImage(FImagePopup.PopupComponent).Picture.Graphic);
Clipboard.Assign(bm);
finally
bm.Free;
end;
end
else
Clipboard.Assign(TImage(FImagePopup.PopupComponent).Picture);
IMAGE_COMMAND_REMOVE:
FTextFile.ClearLine(
GetLineFromControlID(GetIDFromControl(TControl(FImagePopup.PopupComponent))));
IMAGE_COMMAND_CHANGE:
if EditMode = emText then
with TOpenDialog.Create(nil) do
try
Options := [ofPathMustExist, ofFileMustExist];
Filter := SImageFilter;
Title := SOpenImageDialogCaption;
if Execute then
begin
TImage(FImagePopup.PopupComponent).Picture.LoadFromFile(FileName);
ZoomImages;
TextFileLineClassChange(Sender,
GetLineFromControlID(GetIDFromControl(TControl(FImagePopup.PopupComponent))));
TextFileChange(Self, ctFile, 0, 0, 0, 0);
end;
finally
Free;
end;
end;
end;
procedure TTextEditor.RulerPropertiesApply(Sender: TObject);
begin
if Sender is TRulerPropertiesFrm then
with TRulerPropertiesFrm(Sender) do
begin
RulerFont.Assign(PrFont);
RulerColor := PrColor;
RulerWidth := PrWidth;
end;
end;
procedure TTextEditor.RulerMenuCommand(Sender: TObject);
var
LRulerPropertiesFrm: TRulerPropertiesFrm;
begin
if not (Sender is TMenuItem) then Exit;
case TMenuItem(Sender).Tag of
RULER_COMMAND_PROPERTIES:
begin
LRulerPropertiesFrm := TRulerPropertiesFrm.Create(nil);
try
LRulerPropertiesFrm.PrFont.Assign(FRulerFont);
LRulerPropertiesFrm.PrColor := FRulerColor;
LRulerPropertiesFrm.PrWidth := FRulerWidth;
LRulerPropertiesFrm.OnApply := RulerPropertiesApply;
LRulerPropertiesFrm.ShowModal;
finally
LRulerPropertiesFrm.Free;
end;
end;
end;
end;
procedure TTextEditor.TextFileGetControlText(Sender: TObject; LineIndex: Integer;
var ControlText: string);
var
ctl: TControl;
len: Integer;
begin
ControlText := '';
ctl := GetControlFromLine(LineIndex);
if Assigned(ctl) then
begin
if ctl is TWinControl then
begin
SetLength(ControlText, 128);
len := GetWindowText(TWinControl(ctl).Handle, PChar(ControlText),
Length(ControlText));
SetLength(ControlText, len);
end
else
ControlText := SPicture;
end;
end;
procedure TTextEditor.TextFileBookmarksMoved(Sender: TObject);
begin
UpdateRuler;
if Assigned(FOnBookmarksMoved) then
FOnBookmarksMoved(Self);
end;
procedure TTextEditor.BlinkRemoverTimer(Sender: TObject);
begin
FBlinkRemover.Enabled := False;
if FMatchBrackets then
HighlightCurrentBracket;
end;
function TTextEditor.BookmarkUsed(AIndex: Integer): Boolean;
begin
Result := not SamePoint(Bookmarks[AIndex], EMPTY_BOOKMARK);
end;
procedure TTextEditor.BuildFontDataArray;
var
i: Integer;
begin
FreeFontDataArray;
SetLength(FGlyphSets, 1 + FFallbackFonts.Count);
for i := Low(FGlyphSets) to High(FGlyphSets) do
FGlyphSets[i] := nil;
if Screen.Fonts.IndexOf(FFont.Name) <> -1 then
GetFontChrs(FFont.Name, FGlyphSets[0]);
for i := 0 to FFallbackFonts.Count - 1 do
if Screen.Fonts.IndexOf(FFallbackFonts[i]) <> -1 then
GetFontChrs(FFallbackFonts[i], FGlyphSets[i + 1]);
end;
procedure TTextEditor.FreeFontDataArray;
var
i: Integer;
begin
for i := Low(FGlyphSets) to High(FGlyphSets) do
if FGlyphSets[i] <> nil then
FreeMem(FGlyphSets[i]);
SetLength(FGlyphSets, 0);
end;
procedure TTextEditor.TypeTimerEnd;
begin
if FTypeTimer.Enabled then
TypeTimerTimer(Self);
end;
procedure TTextEditor.TypeTimerTimer(Sender: TObject);
begin
FTypeTimer.Enabled := False;
AddUndoRecord(SUndoTyped, UID_TYPING);
end;
procedure TTextEditor.PostType;
begin
FTypeTimer.Enabled := False;
FTypeTimer.Enabled := True;
end;
procedure TTextEditor.PrevHyperlink;
var
i: Integer;
begin
if (FLinks = nil) or (FLinks.Count = 0) then
Exit;
for i := FLinks.Count - 1 downto 0 do
if (FLinks[i].Location.Y < CaretPos.Y) or ((FLinks[i].Location.Y = CaretPos.Y) and (FLinks[i].Location.X < CaretPos.X)) then
begin
CaretPos := FLinks[i].Location;
Break;
end;
end;
procedure TTextEditor.Print(AFirstLine, ALastLine: Integer);
begin
Print(ExtractFileName(FTextFile.FileName), AFirstLine, ALastLine);
end;
procedure TTextEditor.PrintGUI(const ATitle: string);
var
dlg: TPrintDialog;
begin
dlg := TPrintDialog.Create(nil);
try
if TextFile.HasSelection then
dlg.Options := [poSelection]
else
dlg.Options := [];
if dlg.Execute then
begin
if dlg.PrintRange = prSelection then
PrintSelection(ATitle)
else
Print(ATitle);
end;
finally
dlg.Free;
end;
end;
procedure TTextEditor.PrintSelection(const ATitle: string);
var
FirstPoint, SecondPoint: TPoint;
begin
if not FTextFile.HasSelection then Exit;
FTextFile.CaretPos.GetSelBdry(FirstPoint, SecondPoint);
Print(ATitle, FirstPoint.Y, SecondPoint.Y);
end;
procedure TTextEditor.PrintSelection;
begin
PrintSelection(ExtractFileName(FTextFile.FileName));
end;
procedure TTextEditor.PushEditorState;
begin
TypeTimerEnd;
if Assigned(FTextFile) then
begin
if Assigned(FFormattingProcessor) then
FTextFile.EditorState.FormattingProcessor := FFormattingProcessor.ClassName
else
FTextFile.EditorState.FormattingProcessor := '';
FTextFile.EditorState.ScrollPos := FScrollPos;
FTextFile.EditorState.MultiSize := FMultiSize;
FTextFile.EditorState.Overwrite := FOverwrite;
FTextFile.EditorState.HiddenChrs := FShowHiddenCharacters;
FTextFile.EditorState.RulerVisible := RulerVisible;
FTextFile.EditorState.ZoomLevel := FZoom;
if Assigned(FFormattingProcessor) then
FTextFile.EditorState.FFPCacheLen := FFormattingProcessor.GetCache(FTextFile.EditorState.FFPCache)
else
begin
FTextFile.EditorState.FFPCacheLen := 0;
FTextFile.EditorState.FFPCache := nil;
end;
FTextFile.EditorState.Valid := True;
end;
end;
function TTextEditor.QueryContinueDrag(fEscapePRessed: BOOL;
grfKeyState: Longint): HRESULT;
begin
if fEscapePressed then
Result := DRAGDROP_S_CANCEL
else if (grfKeyState and FDragButtonOLE) = 0 then
Result := DRAGDROP_S_DROP
else
Result := S_OK;
end;
procedure TTextEditor.Print(const ATitle: string;
AFirstLine: Integer = 0; ALastLine: Integer = -1);
var
x, y: Integer;
px, py: Integer;
fs: TSize;
WrapList: TIntegerDynArray;
LineLength, ChrsPerLine: Integer;
procedure CheckNewPage;
begin
if py + fs.cy > Printer.PageHeight - FPrintSettings.VerticalMargin then
begin
Printer.NewPage;
py := FPrintSettings.VerticalMargin;
end;
end;
function WrapNow: Boolean;
function ShouldWrapAt(X: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(WrapList) to High(WrapList) do
if WrapList[i] = X then
Exit(True);
end;
begin
Result := FPrintSettings.WordWrap and
(
((not FPrintSettings.NiceWordWrap) and (px > Printer.PageWidth - FPrintSettings.HorizontalMargin))
or
(FPrintSettings.NiceWordWrap and (ShouldWrapAt(x)))
)
end;
function Scale(const ASize: TSize): TSize;
begin
Result.cx := ASize.cx * 6;
Result.cy := ASize.cy * 6;
end;
var
ctl: TControl;
begin
if ALastLine = -1 then ALastLine := LineCount - 1;
NotifyApp(EN_PRINTING);
if Assigned(FOnPrintBegin) then
FOnPrintBegin(Self, ALastLine - AFirstLine + 1);
Enabled := False;
try
with Printer do
begin
BeginDoc;
Title := ATitle;
py := FPrintSettings.VerticalMargin;
for y := AFirstLine to ALastLine do
begin
ApplyFont(LineClasses[y], Canvas);
if LineIsControl(y) then
fs := Scale(GetLineControlSize(y))
else
fs := Canvas.TextExtent('M');
CheckNewPage;
px := FPrintSettings.HorizontalMargin;
LineLength := FTextFile.VirtualLineWidths[y];
ChrsPerLine := (PageWidth - 2*FPrintSettings.HorizontalMargin) div fs.cx;
if FPrintSettings.WordWrap then
begin
if FPrintSettings.NiceWordWrap then
FTextFile.FindWhereToWrap(y, ChrsPerLine, WrapList)
else
SetLength(WrapList, 0);
end;
for x := 0 to LineLength - 1 do
begin
if WrapNow then
begin
Inc(py, fs.cy + LineSpacing);
CheckNewPage;
px := FPrintSettings.HorizontalMargin;
if FPrintSettings.ShowWordWrapIcon then
begin
Canvas.Font.Color := FPrintSettings.WordWrapIconColor;
Canvas.Font.Style := [];
Canvas.TextOut(px - 3 * fs.cx div 2, py, FPrintSettings.WordWrapIcon);
end;
end;
if LineIsControl(y) then
begin
ctl := GetControlFromLine(y);
if ctl is TWinControl then
with TBitmap.Create do
try
SetSize(ctl.Width, ctl.Height);
TWinControl(ctl).PaintTo(Canvas, 0, 0);
StretchBlt(Printer.Handle, px, py, fs.cx, fs.cy,
Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
finally
Free;
end
else if ctl is TGraphicControl then
with TBitmap.Create do
try
SetSize(ctl.Width, ctl.Height);
Canvas.Lock;
TGraphicControl(ctl).Perform(WM_PAINT, Canvas.Handle, 0);
Canvas.Unlock;
StretchBlt(Printer.Handle, px, py, fs.cx, fs.cy,
Canvas.Handle, 0, 0, Width, Height, SRCCOPY);
finally
Free;
end
end
else
begin
ReapplyFont(Canvas);
ApplyInteractiveFormatting(x, y, Canvas);
Canvas.TextOut(px, py, FTextFile.Character[y, x]);
end;
Inc(px, fs.cx);
end;
Inc(py, fs.cy);
if Assigned(FOnPrintProgress) then
if not FOnPrintProgress(Self, y - AFirstLine + 1, ALastLine - AFirstLine + 1) then
begin
Abort;
SysUtils.Abort;
end;
end;
EndDoc;
end;
finally
Enabled := True;
RemoveNotification(EN_PRINTING);
if Assigned(FOnPrintEnd) then
FOnPrintEnd(Self);
end;
end;
procedure TTextEditor.MenuPopup(Sender: TObject);
var
i, j: Integer;
subitem: TMenuItem;
URL: string;
LPopupMenu: TPopupMenu;
begin
if Sender is TPopupMenu then
LPopupMenu := TPopupMenu(Sender)
else
LPopupMenu := FPopupMenu;
for i := 0 to LPopupMenu.Items.Count - 1 do
begin
if FCustomMenuItems.Contains(LPopupMenu.Items[i]) then
Continue;
LPopupMenu.Items[i].Enabled := CommandEnabled(LPopupMenu.Items[i].Tag);
LPopupMenu.Items[i].Visible := CommandVisible(LPopupMenu.Items[i].Tag);
LPopupMenu.Items[i].Checked := CommandChecked(LPopupMenu.Items[i].Tag);
case LPopupMenu.Items[i].Tag of
EDITOR_COMMAND_OPEN_URL_AT_CARET:
if GetURLAtCaret(URL) then
LPopupMenu.Items[i].Hint := Format(SMenuOpenURLHint, [URL]);
EDITOR_COMMAND_SEL_TRANSFORM_MENU:
for j := 0 to LPopupMenu.Items[i].Count - 1 do
begin
LPopupMenu.Items[i].Items[j].Enabled := CommandEnabled(LPopupMenu.Items[i].Items[j].Tag);
LPopupMenu.Items[i].Items[j].Visible := CommandVisible(LPopupMenu.Items[i].Items[j].Tag);
end;
EDITOR_COMMAND_BOOKMARK_SET_MENU:
begin
LPopupMenu.Items[i].Clear;
for j := 0 to BookmarkCount - 1 do
begin
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := GetBookmarkDescr(j);
subitem.Hint := SMenuSetBookmarkItemHint;
if InRange(j, 1, 9) then
subitem.ShortCut := ShortCut(Ord('0') + j, [ssShift, ssCtrl]);
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_BOOKMARK_SET or (j shl 16);
LPopupMenu.Items[i].Add(subitem);
end;
end;
EDITOR_COMMAND_BOOKMARK_GO_MENU:
begin
LPopupMenu.Items[i].Clear;
for j := 0 to BookmarkCount - 1 do
begin
if not BookmarkUsed(j) then Continue;
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := GetBookmarkDescr(j);
subitem.Hint := SMenuGotoBookmarkItemHint;
if InRange(j, 1, 9) then
subitem.ShortCut := ShortCut(Ord('0') + j, [ssCtrl]);
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_BOOKMARK_GO or (j shl 16);
LPopupMenu.Items[i].Add(subitem);
end;
if UsedBookmarkCount = 0 then
begin
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := SMenuNoBookmarksSetParen;
subitem.Enabled := False;
LPopupMenu.Items[i].Add(subitem);
end;
end;
EDITOR_COMMAND_BOOKMARK_CLEAR_MENU:
begin
LPopupMenu.Items[i].Clear;
for j := 0 to BookmarkCount - 1 do
begin
if not BookmarkUsed(j) then Continue;
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := GetBookmarkDescr(j);
subitem.Hint := SMenuClearBookmarkItemHint;
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_BOOKMARK_CLEAR or (j shl 16);
LPopupMenu.Items[i].Add(subitem);
end;
if UsedBookmarkCount = 0 then
begin
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := SMenuNoBookmarksSetParen;
subitem.Enabled := False;
LPopupMenu.Items[i].Add(subitem);
end
else
begin
subitem := TMenUItem.Create(LPopupMenu.Items[i]);
subitem.Caption := '-';
LPopupMenu.Items[i].Add(subitem);
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := SMenuClearAllBookmarks;
subitem.Hint := SMenuClearAllBookmarksHint;
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_BOOKMARK_CLEAR_ALL;
LPopupMenu.Items[i].Add(subitem);
end;
end;
EDITOR_COMMAND_CLASS_MENU:
begin
LPopupMenu.Items[i].Clear;
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := SMenuUseNoClass;
subitem.Hint := SMenuUseNoClassHint;
subitem.Checked := Length(LineClasses[CaretPos.Y]) = 0;
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_CLASS_REMOVE;
LPopupMenu.Items[i].Add(subitem);
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := '-';
LPopupMenu.Items[i].Add(subitem);
for j := 0 to ClassCount - 1 do
begin
subitem := TMenuItem.Create(LPopupMenu.Items[i]);
subitem.Caption := Classes[j].Name;
subitem.Hint := SMenuClassesItemHint;
subitem.Checked := SameStr(LineClasses[CaretPos.Y], Classes[j].Name);
subitem.OnClick := MenuItemMessage;
subitem.Tag := EDITOR_COMMAND_CLASS_USE or (j shl 16);
LPopupMenu.Items[i].Add(subitem);
end;
end;
end;
end;
if Assigned(FOnBeforeContextPopup) then
FOnBeforeContextPopup(Self);
end;
function TTextEditor.MakeLinesUnique: Boolean;
begin
TypeTimerEnd;
Result := FTextFile.MakeLinesUnique;
if Result then
AddUndoRecord(SUndoMadeLinesUnique, UID_UNKNOWN);
end;
procedure TTextEditor.MakeUndoRoot;
begin
FTypeTimer.Enabled := False;
FTextFile.ClearUndoHistory;
AddUndoRecord(SUndoInitialText, UID_UNKNOWN);
end;
function TTextEditor.MaxLineWidth: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to FTextFile.LineCount - 1 do
if LineWidths(i) > Result then
Result := LineWidths(i);
end;
procedure TTextEditor.MenuItemMessage(Sender: TObject);
begin
if not Enabled then Exit;
if Sender is TMenuItem then
with Sender as TMenuItem do
EditorCommand(Tag);
end;
procedure TTextEditor.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_HSCROLL or WS_VSCROLL or 0*WS_CLIPCHILDREN;
ControlStyle := ControlStyle - [csNeedsBorderPaint];
case FBorderType of
btNone: ;
btWin32ThinLine:
Params.Style := Params.Style or WS_BORDER;
btWin32SunkenEdge:
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
btThemeBorder:
begin
Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
ControlStyle := ControlStyle + [csNeedsBorderPaint];
end;
btSimpleColor: ;
end;
end;
procedure TTextEditor.CreateWnd;
begin
inherited;
FHintWindow := CreateWindowEx(0, TOOLTIPS_CLASS, nil, WS_POPUP or TTS_ALWAYSTIP
or TTS_NOPREFIX or TTS_BALLOON, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Handle, 0, HInstance, nil);
if FHintWindow <> 0 then
begin
FToolInfo.cbSize := sizeof(FToolInfo);
FToolInfo.uFlags := TTF_TRANSPARENT or TTF_CENTERTIP or TTF_IDISHWND or
TTF_TRACK or 0*TTF_ABSOLUTE;
FToolInfo.hwnd := Handle;
FToolInfo.uId := Handle;
FToolInfo.hInst := 0;
FToolInfo.lpszText := '';
SendMessage(FHintWindow, TTM_ADDTOOL, 0, LParam(@FToolInfo));
SendMessage(FHintWindow, TTM_SETMAXTIPWIDTH, _scale(800), 0);
end;
OleCheck(RegisterDragDrop(Handle, Self));
end;
function TTextEditor.GetTotalVerticalExtent: Integer;
begin
if FMultiSize then
Result := FAccumLineHeights[FTextFile.LineCount - 1] + FFontSizes[FTextFile.LineCount - 1].cy
else
Result := FFontSize.cy * FTextFile.LineCount;
end;
function TTextEditor.GetURLAtCaret(out AURL: string): Boolean;
var
Idx: Integer;
begin
if FTextFile = nil then
Exit(False);
Idx := CharLinkIndex(CaretPos);
if Assigned(FLinks) and InRange(Idx, 0, FLinks.Count - 1) then
begin
AURL := FLinks[Idx].URL;
Exit(True);
end;
Result := FTextFile.GetURLAtCaret(AURL);
end;
function TTextEditor.GetUsedBookmarkCount: Integer;
begin
if Assigned(FTextFile) then
Result := FTextFile.UsedBookmarkCount
else
Result := 0;
end;
function TTextEditor.GetTotalHorizontalExtent: Integer;
begin
if FMultiSize then
Result := FCachedHorizontalExtent
else
Result := FFontSize.cx * FTextFile.MaxLineWidth
end;
function TTextEditor.IsCaretVisible: Boolean;
begin
Result := FCaretVisible and PtInRect(TextContentRect, PhysicalPixelAtChar(GetCaretPos));
end;
function TTextEditor.IsCharLink(const ACaretPos: TPoint): Boolean;
begin
Result := CharLinkIndex(ACaretPos) <> -1;
end;
procedure TTextEditor.UpdateScrollBars;
var
ScrollInfo: TScrollInfo;
OldVScroll, NewVScroll, OldHScroll, NewHScroll, OldCaretVisible: Boolean;
begin
if SingleLine then
begin
ShowScrollBar(Handle, SB_BOTH, False);
Exit;
end;
OldVScroll := GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0;
OldHScroll := GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0;
OldCaretVisible := IsCaretVisible;
ScrollInfo.cbSize := sizeof(TScrollInfo);
ScrollInfo.fMask := SIF_ALL;
ScrollInfo.nMin := 0;
ScrollInfo.nMax := max(GetTotalVerticalExtent, FScrollPos.Y + ClientHeight - FMarginTop - FMarginBottom - 1);
ScrollInfo.nPage := max(0, ClientHeight - FMarginTop - FMarginBottom);
ScrollInfo.nPos := FScrollPos.Y;
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
ScrollInfo.cbSize := sizeof(TScrollInfo);
ScrollInfo.fMask := SIF_ALL;
ScrollInfo.nMin := 0;
ScrollInfo.nMax := max(GetTotalHorizontalExtent, FScrollPos.X - FMarginLeft - FMarginRight + ClientWidth - 1);
ScrollInfo.nPage := max(0, ClientWidth - FMarginLeft - FMarginRight);
ScrollInfo.nPos := FScrollPos.X;
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
NewVScroll := GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0;
NewHScroll := GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0;
if OldCaretVisible and ((OldVScroll xor NewVScroll) or (OldHScroll xor NewHScroll)) then
ScrollToCaret;
end;
procedure TTextEditor.UpdateScrollMode;
var
OldScrollMode: Boolean;
begin
FScrollMode := GetScrollMode;
OldScrollMode := HasNotificationMessage(EN_SCROLL_MODE);
if FScrollMode and not OldScrollMode then
NotifyApp(EN_SCROLL_MODE)
else if OldScrollMode and not FScrollMode then
RemoveNotification(EN_SCROLL_MODE);
end;
procedure TTextEditor.CustomizeMenu(AMenu: TMenu);
var
i: Integer;
begin
if FCustomMenuItems = nil then
Exit;
if AMenu = nil then
Exit;
for i := 0 to FCustomMenuItems.Count - 1 do
begin
if Assigned(FCustomMenuItems[i].Parent) then
FCustomMenuItems[i].Parent.Remove(FCustomMenuItems[i]);
AMenu.Items.Add(FCustomMenuItems[i]);
end;
end;
procedure TTextEditor.CutToClipboard;
begin
TypeTimerEnd;
FTextFile.CutToClipboard;
AddUndoRecord(SUndoCutToClipboard, UID_CUT);
end;
function TTextEditor.FPFileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord;
var
TC1, TC2: Cardinal;
begin
TC1 := GetTickCount;
Result := FFormattingProcessor.FileChangeNotification(ChangeType, Data1, Data2, Data3, Data4);
TC2 := GetTickCount;
if TC2 - TC1 > 5000 then
if MessageBox(0, PChar(SFPSlowText), PChar(SFPSlowTitle), MB_ICONQUESTION or MB_YESNO) = ID_YES then
FormattingProcessor := nil;
end;
function TTextEditor.FPFromString(
const FPClassName: string): TFormattingProcessor;
begin
if not FPDict.TryGetValue(FPClassName, Result) then
Result := nil;
end;
procedure TTextEditor.TextFileChange(Sender: TObject; ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer);
var
IFCR: TChangeRecord;
begin
if FTextFile.Empty then
ListBoxSelection := False;
if Assigned(FLinks) then
begin
FreeAndNil(FLinks);
FCharLinkIndex := -1;
FPrevCharLinkIndex := -1;
FMouseDownLinkIndex := -1;
Invalidate;
end;
if Assigned(FFormattingProcessor) then
begin
IFCR := FPFileChangeNotification(ChangeType, Data1, Data2, Data3, Data4);
with ChangeUnion(IFCR, MakeChangeRecord(ChangeType, Data1, Data2, Data3, Data4)) do
VisualUpdate(ChangeType, Data1, Data2, Data3, Data4);
end
else
VisualUpdate(ChangeType, Data1, Data2, Data3, Data4);
if FMultiSize then
RecomputeHorizontalExtent;
UpdateScrollBars;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TTextEditor.TextFileInputError(Sender: TObject);
begin
if FBeepOnInputError then
Beep;
NotifyAppWithTimer(EN_INPUT_ERROR);
end;
procedure TTextEditor.TextFileReadOnlyError(Sender: TObject);
begin
if FErrorMessageOnReadOnlyError then
MessageBox(Handle, PChar(SReadOnlyErrorText),
PChar(SReadOnlyErrorTitle), MB_ICONINFORMATION or MB_OK);
NotifyAppWithTimer(EN_READ_ONLY_ERROR);
end;
procedure TTextEditor.TextFileModified(Sender: TObject);
begin
if BalloonVisible and (Ord(FBalloonPersistence) <= Ord(bpModify)) then
HideBalloon;
if Assigned(FOnModified) then
FOnModified(Self);
end;
function TTextEditor.TransformSelection(
Transformation: TTextTransformFunc; const TransformName: string): Boolean;
begin
Result := FTextFile.HasSelection and (SelectionType = stLineBased);
if Result then
begin
TypeTimerEnd;
FTextFile.InsertText(Transformation(SelText));
AddUndoRecord(Format(SUndoSelectionTransformed, [TransformName]), UID_UNKNOWN);
end;
end;
procedure TTextEditor.TransformText(Transformation: TTextTransformFunc;
const TransformName: string);
begin
TypeTimerEnd;
PlainText := Transformation(PlainText);
AddUndoRecord(Format(SUndoTextTransformed, [TransformName]), UID_UNKNOWN);
end;
procedure TTextEditor.TrimRight;
begin
TypeTimerEnd;
FTextFile.TrimRight;
AddUndoRecord(SUndoTrimRight, UID_UNKNOWN);
end;
procedure TTextEditor.TruncateAt(AIndex: Integer; AChar: Char;
PreserveChar: Boolean; AReverse: Boolean);
begin
TruncateAt(0, LineCount - 1, AIndex, AChar, PreserveChar, AReverse);
end;
procedure TTextEditor.TruncateAtInSelection(AIndex: Integer; AChar: Char;
PreserveChar: Boolean; AReverse: Boolean);
var
FirstLine, SecondLine: Integer;
begin
FirstLine := Min(CaretPos.Y, SelEndPos.Y);
SecondLine := Max(CaretPos.Y, SelEndPos.Y);
TruncateAt(FirstLine, SecondLine, AIndex, AChar, PreserveChar, AReverse);
end;
procedure TTextEditor.TruncateFileAt(Line, Col: Integer);
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.TruncateFileAt(Line, Col);
AddUndoRecord(SUndoFileTruncated, UID_UNKNOWN);
end;
procedure TTextEditor.TruncateAt(AFirstLine, ALastLine, AIndex: Integer;
AChar: Char; PreserveChar: Boolean; AReverse: Boolean);
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.TruncateAt(AFirstLine, ALastLine, AIndex, AChar, PreserveChar, AReverse);
AddUndoRecord(SUndoLinesTruncated, UID_UNKNOWN);
end;
function TTextEditor.GetLineComparer: TLineComparer;
begin
Result := FTextFile.LineComparer;
end;
function TTextEditor.GetLineControlSize(LineIndex: Integer): TSize;
var
i: Integer;
ID: Integer;
begin
Result := FFontSize;
if not (LineIsControl(LineIndex) and TryStrToInt(Copy(FTextFile.Lines[LineIndex],
Length(LINE_CONTROL_PREFIX) + 1), ID))
then
Exit;
for i := 0 to High(FLineControls) do
if (FLineControls[i].ID = ID) and Assigned(FLineControls[i].Control) then
begin
Result.cx := FLineControls[i].Control.Width + 2*CARET_WIDTH;
Result.cy := FLineControls[i].Control.Height;
Break;
end;
end;
function TTextEditor.GetLineCount: Integer;
begin
Result := FTextFile.LineCount;
end;
function TTextEditor.GetLineFromControlID(ID: Integer): Integer;
var
i: Integer;
IDStr: string;
begin
Result := -1;
IDStr := IntToStr(ID);
for i := 0 to FTextFile.LineCount - 1 do
if LineIsControl(i) and SameStr(Copy(FTextFile.Lines[i], Length(LINE_CONTROL_PREFIX) + 1), IDStr) then
Exit(i);
end;
procedure TTextEditor.ReapplyFont(ATo: TCanvas);
begin
if ATo = nil then ATo := Canvas;
ATo.Font.Size := FCurrentFormat.Size;
ATo.Font.Color := FCurrentFormat.Color;
ATo.Font.Style := FCurrentFormat.Style;
end;
procedure TTextEditor.RebuildLineCache;
var
nLines: Integer;
i: Integer;
ci: Integer;
begin
NeedValidPaintState;
nLines := FTextFile.LineCount;
SetLength(FFontSizes, nLines);
for i := 0 to nLines - 1 do
begin
if SameStr(FTextFile.Classes[i], LINE_CONTROL_CLASS) then
FFontSizes[i] := GetLineControlSize(i)
else
begin
ci := GetClassIndex(FTextFile.Classes[i]);
if ci <> -1 then
FFontSizes[i] := FClassArray[ci].Format.BoxSize
else
FFontSizes[i] := FFontSize;
end;
end;
SetLength(FAccumLineHeights, nLines);
FAccumLineHeights[0] := 0;
for i := 1 to nLines - 1 do
FAccumLineHeights[i] := FAccumLineHeights[i - 1] + FFontSizes[i - 1].cy;
end;
procedure TTextEditor.ReceiveGraphic(AGraphic: TGraphic; LineIndex: Integer;
AllowUnprepared: Boolean);
var
img: TImage;
begin
img := TImage.Create(Self);
try
img.AutoSize := False;
img.Stretch := True;
img.Proportional := True;
img.Center := True;
img.Cursor := crArrow;
img.Picture.Graphic := AGraphic;
img.PopupMenu := FImagePopup;
if Assigned(AGraphic) then
begin
img.Width := AGraphic.Width;
img.Height := AGraphic.Height;
end;
ReceiveLineControl(img, LineIndex, AllowUnprepared);
except
img.Free;
raise;
end;
end;
procedure TTextEditor.ReceiveLineControl(AControl: TControl;
LineIndex: Integer; AllowUnprepared: Boolean);
var
CtlId: Integer;
begin
if not FTextFile.LineExists(LineIndex) then
raise Exception.Create('Line doesn''t exist.');
CtlId := GetControlIDFromLine(LineIndex);
if CtlId = -1 then
begin
if not AllowUnprepared then
raise Exception.Create('Line isn''t a control line.');
CtlId := FNextControlID;
FTextFile.Classes[LineIndex] := LINE_CONTROL_CLASS;
FTextFile.Lines[LineIndex] := LINE_CONTROL_PREFIX + CtlId.ToString;
end;
SetLength(FLineControls, Length(FLineControls) + 1);
FLineControls[High(FLineControls)].ID := CtlId;
FLineControls[High(FLineControls)].Control := AControl;
FLineControls[High(FLineControls)].OriginalSize := AControl.BoundsRect.Size;
MultiSize := True;
FTextFile.ControlAware := True;
FNextControlID := Succ(Max(FNextControlID, CtlId));
AControl.Visible := False;
AControl.Parent := Self;
end;
procedure TTextEditor.RecomputeHorizontalExtent;
begin
if FMultiSize then
FCachedHorizontalExtent := MaxLineWidth
else
FCachedHorizontalExtent := FFontSize.cx * FTextFile.MaxLineWidth;
end;
procedure TTextEditor.TextFileLineChange(Sender: TObject;
LineChangeType: TLineChangeType; From: Integer);
begin
if FMultiSize then
begin
RebuildLineCache;
UpdateLineControls;
end;
if RulerVisible then
if LineChangeType = lctAppend then
UpdateRulerLine(LineCount - 1)
else
UpdateRuler;
end;
procedure TTextEditor.TextFileLineClassChange(Sender: TObject;
LineIndex: Integer);
begin
if FMultiSize then
begin
RebuildLineCache;
RecomputeHorizontalExtent;
UpdateScrollBars;
VisualUpdate(ctLineRange, LineIndex, FTextFile.LineCount - 1, 0, 0);
VisualUpdate(ctPostFile, 0, 0, 0, 0);
UpdateLineControls;
UpdateRuler;
end
else
VisualUpdate(ctLine, LineIndex, 0, 0, 0);
if CaretPos.Y = LineIndex then
UpdateCaret
else
DoSetCaretPos;
end;
procedure TTextEditor.TextFileControlRemoved(Sender: TObject;
ControlID: Integer);
var
i: Integer;
j: Integer;
begin
Exit;
for i := 0 to High(FLineControls) do
if FLineControls[i].ID = ControlID then
begin
FLineControls[i].Control.Free;
for j := i to High(FLineControls) - 1 do
FLineControls[j] := FLineControls[j + 1];
SetLength(FLineControls, Length(FLineControls) - 1);
Break;
end;
end;
function TTextEditor.ClassExists(const AClassName: string): Boolean;
begin
Result := GetClassIndex(AClassName) <> -1;
end;
class constructor TTextEditor.ClassCreate;
begin
FInstances := TList<TTextEditor>.Create;
TUx.RegisterCallback(UxThemeUpdate);
end;
class destructor TTextEditor.ClassDestroy;
begin
FreeAndNil(FInstances);
end;
function TTextEditor.ClassExists(const AClassName: string;
out Index: Integer): Boolean;
begin
Index := GetClassIndex(AClassName);
Result := Index <> -1;
end;
procedure TTextEditor.Clear;
begin
Escape(True);
TypeTimerEnd;
ListBoxSelection := False;
FTextFile.Clear;
FTextFile.ControlAware := False;
AddUndoRecord(SUndoTextCleared, UID_UNKNOWN);
end;
procedure TTextEditor.ClearBookmarks;
begin
TypeTimerEnd;
FTextFile.ClearBookmarks;
AddUndoRecord(SUndoBookmarksCleared, UID_UNKNOWN);
UpdateRuler;
end;
procedure TTextEditor.ClearBracketHighlight;
begin
if FBracketHighlight then
begin
FBracketHighlight := False;
VisualUpdate(ctTwoChars, FBracketPos1.Y, FBracketPos1.X, FBracketPos2.Y,
FBracketPos2.X);
end;
end;
procedure TTextEditor.ClearClasses;
begin
SetLength(FClassArray, 0);
end;
procedure TTextEditor.ClearControls;
var
i: Integer;
begin
for i := 0 to High(FLineControls) do
FLineControls[i].Control.Free;
SetLength(FLineControls, 0);
end;
procedure TTextEditor.SetBracketHighlight(const PointA, PointB: TPoint);
begin
if FBracketHighlight then
ClearBracketHighlight;
FBracketHighlight := True;
FBracketPos1 := PointA;
FBracketPos2 := PointB;
VisualUpdate(ctTwoChars, FBracketPos1.Y, FBracketPos1.X, FBracketPos2.Y,
FBracketPos2.X);
end;
procedure TTextEditor.HighlightCurrentBracket;
var
BracketPos: TPoint;
begin
ClearBracketHighlight;
BracketPos := FTextFile.MatchBracket(FTextFile.CaretPos.Data);
if BracketPos.Y <> -1 then
SetBracketHighlight(CaretPos, BracketPos);
end;
procedure TTextEditor.TextFileCaretPosChange(Sender: TObject);
begin
if (not FPreserveDesiredColumn) and FMultiSize then
FDesiredColumn := FTextFile.CaretPos.X * FFontSizes[FTextFile.CaretPos.Y].cx;
if BalloonVisible and (Ord(FBalloonPersistence) <= Ord(bpCaretPos)) then
HideBalloon;
ChangeCursor;
if FMultiSize and (FTextFile.CaretPos.Y <> FOldCaretPosY) then
UpdateCaret;
if (EditMode = emConsole) and (FTextFile.CaretPos.Y <> FOldCaretPosY) then
UpdateCaret;
if FTextFile.CaretPos.Y <> FOldCaretPosY then
begin
UpdateRulerLine(FTextFile.CaretPos.Y);
UpdateRulerLine(FOldCaretPosY);
end;
if (not ScrollToCaret) and Focused then
DoSetCaretPos;
if (FListBoxMode or FLineHighlight) and (FTextFile.CaretPos.Y <> FOldCaretPosY) then
begin
VisualUpdate(ctLine, FOldCaretPosY, 0, 0, 0);
VisualUpdate(ctLine, FTextFile.CaretPos.Y, 0, 0, 0);
end;
if FMatchBrackets then
HighlightCurrentBracket;
if FListBoxMode and (FTextFile.CaretPos.Y <> FOldCaretPosY) then
if Assigned(FOnListBoxChange) then
FOnListBoxChange(Self);
FOldCaretPosY := FTextFile.CaretPos.Y;
if FMultiCharSelect and HasNotificationMessage(EN_MULTICHAR) then
RemoveNotification(EN_MULTICHAR);
if Assigned(FOnSelChange) then
FOnSelChange(Self);
end;
function TTextEditor.ScrollToCaret: Boolean;
var
CaretPixel: TPoint;
NewX, NewY: Integer;
_ScrollExtra: Integer;
begin
if FNoScrollToCaret then Exit(False);
CaretPixel := VirtualPixelAtChar(FTextFile.CaretPos.Data);
if (SCROLL_EXTRA < ClientWidth div 2) and not SingleLine then
_ScrollExtra := SCROLL_EXTRA
else
_ScrollExtra := 0;
if FScrollPos.X + ClientWidth - FMarginLeft - FMarginRight < CaretPixel.X + CARET_WIDTH then
NewX := CaretPixel.X - ClientWidth + FMarginLeft + FMarginRight + CARET_WIDTH + _ScrollExtra
else if FScrollPos.X > CaretPixel.X then
NewX := Max(CaretPixel.X - _ScrollExtra, 0)
else
NewX := FScrollPos.X;
if FScrollPos.Y + ClientHeight - FMarginTop - FMarginBottom < CaretPixel.Y + FFontSize.cy then
NewY := CaretPixel.Y - ClientHeight + FMarginTop + FMarginBottom + FFontSize.cy
else if FScrollPos.Y > CaretPixel.Y then
NewY := CaretPixel.Y
else
NewY := FScrollPos.Y;
Result := (NewX <> FScrollPos.X) or (NewY <> FScrollPos.Y);
if Result then
SetScrollPosXY(NewX, NewY);
end;
procedure TTextEditor.TextFileCaretPosSelChange(Sender: TObject;
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer);
begin
VisualUpdate(ChangeType, Data1, Data2, Data3, Data4);
end;
procedure TTextEditor.WMContextMenu(var Message: TWMContextMenu);
var
p: TPoint;
PmMain: TPopupMenu;
PmRuler: TPopupMenu;
ctl: TControl;
begin
if Assigned(PopupMenu) then
PmMain := PopupMenu
else if FListBoxMode then
PmMain := FListboxMenu
else
PmMain := FPopupMenu;
CustomizeMenu(PmMain);
if Assigned(RulerPopupMenu) then
PmRuler := RulerPopupMenu
else
PmRuler := FRulerMenu;
if (Message.XPos = -1) and (Message.YPos = -1) then
if Windows.GetCaretPos(p) and not FListBoxMode then
with ClientToScreen(p) do
if FMultiSize then
PmMain.Popup(x, y + FFontSizes[CaretPos.Y].cy)
else
PmMain.Popup(x, y + FFontSize.cy)
else
with ClientToScreen(Point(ClientWidth div 2, ClientHeight div 2)) do
PmMain.Popup(x, Y)
else
begin
p := ScreenToClient(SmallPointToPoint(Message.Pos));
if (p.X >= ClientWidth) or (p.Y >= ClientHeight) then
begin
inherited;
Exit;
end
else if p.X >= GetFunctionalSelectionBarWidth then
begin
ctl := ControlAtPos(p, True);
if ctl <> nil then
Message.Result := ctl.Perform(WM_CONTEXTMENU, TMessage(Message).WParam, TMessage(Message).LParam);
if Message.Result = 0 then
PmMain.Popup(Message.XPos, Message.YPos)
end
else if p.X < FRulerWidth then
PmRuler.Popup(Message.XPos, Message.YPos);
end;
Message.Result := 1;
end;
procedure TTextEditor.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure TTextEditor.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
Message.Result := Message.Result or DLGC_WANTCHARS or DLGC_WANTARROWS or
IfThen(FWantTab, DLGC_WANTTAB) or IfThen(FWantReturn, DLGC_WANTALLKEYS);
end;
procedure TTextEditor.WMHScroll(var Message: TWMHScroll);
var
ScrollInfo: TScrollInfo;
begin
inherited;
case Message.ScrollCode of
SB_LEFT:
SetScrollPosX(0);
SB_RIGHT:
SetScrollPosX(FFontSize.cx * FTextFile.MaxLineWidth);
SB_LINELEFT:
SetScrollPosX(FScrollPos.X - FFontSize.cx);
SB_LINERIGHT:
SetScrollPosX(FScrollPos.X + FFontSize.cx);
SB_PAGELEFT:
SetScrollPosX(FScrollPos.X - ClientWidth + FMarginLeft + FMarginRight);
SB_PAGERIGHT:
SetScrollPosX(FScrollPos.X + ClientWidth - FMarginLeft - FMarginRight);
SB_THUMBTRACK:
begin
ScrollInfo.cbSize := sizeof(TScrollInfo);
ScrollInfo.fMask := SIF_TRACKPOS;
GetScrollInfo(Handle, SB_HORZ, ScrollInfo);
SetScrollPosX(ScrollInfo.nTrackPos);
end;
end;
end;
procedure TTextEditor.SetScrollPosX(Value: Integer);
var
OldScrollPos, diff: Integer;
TCR: TRect;
begin
if Value < 0 then Value := 0;
OldScrollPos := FScrollPos.X;
FScrollPos.X := Value;
diff := OldScrollPos - Value;
if diff = 0 then Exit;
UpdateScrollBars;
TCR := TextContentRect;
if Abs(diff) < ClientWidth - FMarginLeft - FMarginRight then
ScrollWindowEx(Handle, diff, 0, @TCR, @TCR, 0, nil, SW_INVALIDATE or SW_SCROLLCHILDREN)
else
Invalidate;
DoSetCaretPos;
if FTextFile.ControlAware then
UpdateLineControls;
MoveBalloonPostScroll;
end;
procedure TTextEditor.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
if FTextFile = nil then
Exit;
Escape(True);
DestroyCaret;
FCaretVisible := False;
if SingleLine then
SelectNone;
if SingleLine or not FTextHint.IsEmpty and FTextFile.Empty then
Invalidate;
if FListBoxMode and FListBoxHideSelection then
Invalidate;
end;
procedure TTextEditor.WMMouseHWheel(var Message: TWMMouseWheel);
begin
inherited;
if SingleLine then
begin
Message.Result := 0;
Exit;
end;
if GetKeyState(VK_LMENU) < 0 then
begin
if Message.WheelDelta < 0 then
FTextFile.Left
else
FTextFile.Right;
Message.Result := 1;
Exit;
end;
if (Message.Keys and MK_SHIFT) <> 0 then
SetScrollPosX(FScrollPos.X + Sign(Message.WheelDelta))
else
SetScrollPosX(FScrollPos.X + Round(FFontSize.cx * Message.WheelDelta / WHEEL_DELTA));
Message.Result := 1;
end;
procedure TTextEditor.WMMouseWheel(var Message: TWMMouseWheel);
var
ShiftState: TShiftState;
begin
inherited;
if SingleLine then
begin
Message.Result := 0;
Exit;
end;
ShiftState := [];
if IsKeyDown(VK_CONTROL) then
Include(ShiftState, ssCtrl);
if Message.Keys and MK_LBUTTON <> 0 then
Include(ShiftState, ssLeft);
if Message.Keys and MK_MBUTTON <> 0 then
Include(ShiftState, ssMiddle);
if Message.Keys and MK_RBUTTON <> 0 then
Include(ShiftState, ssRight);
if Message.Keys and MK_SHIFT <> 0 then
Include(ShiftState, ssShift);
if IsKeyDown(VK_LMENU) then
Include(ShiftState, ssAlt);
if ssCtrl in ShiftState then
begin
if Message.WheelDelta < 0 then
ZoomOut
else
ZoomIn;
Message.Result := 1;
Exit;
end;
if ssAlt in ShiftState then
begin
if Message.WheelDelta < 0 then
FTextFile.Down
else
FTextFile.Up;
Update;
Message.Result := 1;
Exit;
end;
if (ssShift in ShiftState) or (FScrollBehaviour = sbPixel) then
SetScrollPosY(FScrollPos.Y - Sign(Message.WheelDelta), True)
else if FScrollBehaviour = sbLine then
SetScrollPosY(FScrollPos.Y - Round(FFontSize.cy * Message.WheelDelta / WHEEL_DELTA), True)
else
if FSPIScrollLines >= 0 then
SetScrollPosY(FScrollPos.Y - Round(FFontSize.cy * FSPIScrollLines * Message.WheelDelta / WHEEL_DELTA), True)
else if FSPIScrollLines = -1 then
SetScrollPosY(FScrollPos.Y - Round(ClientHeight * Message.WheelDelta / WHEEL_DELTA), True);
Message.Result := 1;
with ScreenToClient(Message.Pos) do
ChangeCursor(ShiftState, Y, X);
end;
procedure TTextEditor.WMNCActivate(var Message: TWMNCActivate);
begin
inherited;
end;
procedure TTextEditor.WMNCCalcSize(var Message: TWMNCCalcSize);
var
R: TRect;
begin
DefaultHandler(Message);
R := Message.CalcSize_Params.rgrc0;
InflateRect(R, -BorderWidth, -BorderWidth);
Message.CalcSize_Params.rgrc0 := R;
Message.Result := 0;
end;
procedure TTextEditor.WMNCHitTest(var Message: TWMNCHitTest);
var
pnt: TPoint;
WS: Integer;
R: TRect;
ClientWidth, ClientHeight: Integer;
begin
if FBorderType = btSimpleColor then
begin
Windows.GetClientRect(Handle, R);
ClientWidth := R.Right - R.Left;
ClientHeight := R.Bottom - R.Top;
pnt := ScreenToClient(SmallPointToPoint(Message.Pos));
WS := GetWindowLong(Handle, GWL_STYLE);
if PtInRect(R, pnt) then
Message.Result := HTCLIENT
else if ((WS and WS_VSCROLL) <> 0) and
InRange(pnt.X, ClientWidth, ClientWidth + GetSystemMetrics(SM_CXVSCROLL)) and
InRange(pnt.Y, 0, ClientHeight) then
Message.Result := HTVSCROLL
else if ((WS and WS_HSCROLL) <> 0) and
InRange(pnt.Y, ClientHeight, ClientHeight + GetSystemMetrics(SM_CYHSCROLL)) and
InRange(pnt.X, 0, ClientWidth) then
Message.Result := HTHSCROLL
else
Message.Result := HTBORDER;
end
else
inherited;
end;
procedure TTextEditor.WMNCPaint(var Message: TWMNCPaint);
var
dc: HDC;
WS: Integer;
OldColor: TColor;
R: TRect;
Width, Height: Integer;
begin
if FBorderType = btSimpleColor then
begin
DefaultHandler(Message);
GetWindowRect(Handle, R);
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
OldColor := Brush.Color;
dc := GetWindowDC(Handle);
try
WS := GetWindowLong(Handle, GWL_STYLE);
if ((WS and WS_VSCROLL) <> 0) and ((WS and WS_HSCROLL) <> 0) then
begin
Brush.Color := clBtnFace;
FillRect(dc, Rect(Width - BorderWidth - GetSystemMetrics(SM_CXVSCROLL),
Height - BorderWidth - GetSystemMetrics(SM_CXHSCROLL),
Width - BorderWidth,
Height - BorderWidth),
Brush.Handle);
end;
ExcludeClipRect(dc, BorderWidth, BorderWidth,
Width - BorderWidth, Height - BorderWidth);
Brush.Color := FBorderColor;
FillRect(dc, Rect(0, 0, Width, Height), Brush.Handle);
Message.Result := 0;
finally
ReleaseDC(Handle, dc);
Brush.Color := OldColor;
end;
end
else
inherited;
end;
procedure TTextEditor.WMPaint(var Message: TWMPaint);
begin
if Assigned(FDropTargetHelper) and Assigned(FDragDataObj) then
FDropTargetHelper.Show(False);
inherited;
if Assigned(FDropTargetHelper) and Assigned(FDragDataObj) then
FDropTargetHelper.Show(True);
end;
procedure TTextEditor.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
NeedValidPaintState;
UpdateCaret;
UpdateScrollMode;
if SingleLine and FLabelStyle or not FTextHint.IsEmpty and FTextFile.Empty then
Invalidate;
if SingleLine then
begin
TextFile.GotoSOF;
SelectAll;
end;
if FListBoxMode and FListBoxHideSelection then
Invalidate;
end;
procedure TTextEditor.WMSize(var Message: TWMSize);
begin
inherited;
UpdateScrollBars;
DoSetCaretPos;
end;
procedure TTextEditor.WMVScroll(var Message: TWMVScroll);
var
ScrollInfo: TScrollInfo;
begin
inherited;
case Message.ScrollCode of
SB_TOP:
SetScrollPosY(0);
SB_BOTTOM:
SetScrollPosY(FFontSize.cy * FTextFile.LineCount);
SB_LINEUP:
SetScrollPosY(FScrollPos.Y - FFontSize.cy);
SB_LINEDOWN:
SetScrollPosY(FScrollPos.Y + FFontSize.cy);
SB_PAGEUP:
SetScrollPosY(FScrollPos.Y - ClientHeight + FMarginTop + FMarginBottom);
SB_PAGEDOWN:
SetScrollPosY(FScrollPos.Y + ClientHeight - FMarginTop - FMarginBottom);
SB_THUMBTRACK:
begin
ScrollInfo.cbSize := sizeof(TScrollInfo);
ScrollInfo.fMask := SIF_TRACKPOS;
GetScrollInfo(Handle, SB_VERT, ScrollInfo);
SetScrollPosY(ScrollInfo.nTrackPos);
end;
end;
end;
procedure TTextEditor.WndProc(var Message: TMessage);
function REFontInc(Old, Delta: Integer): Integer;
function rnd(x: real): Integer;
begin
if Delta > 0 then
Result := ceil(x)
else
Result := floor(x);
end;
begin
Result := Old + Delta;
if Result < 1 then
Result := 1
else if Result <= 28 then
Result := 2*rnd(Result / 2)
else if Result <= 36 then
Result := 36
else if Result <= 48 then
Result := 48
else if Result <= 72 then
Result := 72
else if Result <= 80 then
Result := 80
else
Result := 10*rnd(Result / 10);
if Result > 1638 then
Result := 1638;
end;
const
ECM_FIRST = $1500;
EM_SETCUEBANNER = ECM_FIRST + 1;
EM_GETCUEBANNER = ECM_FIRST + 2;
EM_SHOWBALLOONTIP = ECM_FIRST + 3;
EM_HIDEBALLOONTIP = ECM_FIRST + 4;
EM_GETSCROLLPOS = WM_USER + 221;
EM_SETSCROLLPOS = WM_USER + 222;
EM_GETTOUCHOPTIONS = WM_USER + 310;
EM_GETZOOM = WM_USER + 224;
EM_SETZOOM = WM_USER + 225;
EM_SETFONTSIZE = WM_USER + 223;
type
PCHARRANGE = ^CHARRANGE;
PTEXTRANGE = ^TEXTRANGE;
var
s: string;
i: Integer;
begin
case Message.Msg of
WM_MOUSEWHEEL:
begin
WMMouseWheel(TWMMouseWheel(Message));
Exit;
end;
WM_MOUSEHWHEEL:
begin
WMMouseHWheel(TWMMouseWheel(Message));
Exit;
end;
end;
inherited;
case Message.Msg of
WM_SYSCHAR:
begin
if TWMSysChar(Message).CharCode = 32 then
UpdateScrollMode;
end;
WM_TIMER:
if Message.WParam and EDITOR_NOTIFY <> 0 then
begin
RemoveNotification(Message.WParam and $FFFF);
if not KillTimer(Handle, Message.WParam) then
RaiseLastOSError;
Message.Result := 0;
Exit;
end;
end;
if not FMessageInterface then Exit;
case Message.Msg of
WM_UNDO:
Message.Result := B(Undo);
EM_UNDO:
Message.Result := B(Undo);
EM_REDO:
Message.Result := B(Redo);
EM_CANUNDO:
Message.Result := B(CanUndo);
EM_CANREDO:
Message.Result := B(CanRedo);
WM_CUT:
CutToClipboard;
WM_COPY:
CopyToClipboard;
WM_PASTE:
PasteFromClipboard;
WM_CLEAR:
ClearSelection;
EM_SETSEL:
begin
if Message.WParam = NativeUInt(-1) then
SelectNone
else if (Message.WParam = 0) and (Message.LParam = -1) then
SelectAll
else if (Integer(Message.WParam) >= 0) and (Message.LParam >= 0) then
begin
FTextFile.CaretPos.SetPoint(FTextFile.GetPointOfIndex(Message.WParam));
FTextFile.CaretPos.SetPoint(FTextFile.GetPointOfIndex(Message.LParam), True);
end;
end;
EM_CHARFROMPOS:
Message.Result := FTextFile.GetIndexOfPoint(CaretPosAtPhysicalPixel(Point(PPOINTL(Message.LParam)^.x, PPOINTL(Message.LParam)^.y)));
EM_EMPTYUNDOBUFFER:
ClearUndoHistory;
EM_GETCUEBANNER:
Message.Result := 0;
EM_GETFIRSTVISIBLELINE:
Message.Result := FirstVisibleLine;
EM_GETHANDLE:
Message.Result := 0;
EM_GETLINE:
begin
if InRange(Message.WParam, 0, FTextFile.LineCount - 1) then
begin
s := FTextFile.Lines[Message.WParam];
i := Min(PWord(Message.LParam)^, Length(s));
Move(s, PChar(Message.LParam)^, i * sizeof(Char));
Message.Result := i;
end
else
Message.Result := 0;
end;
EM_GETLINECOUNT:
Message.Result := FTextFile.LineCount;
EM_GETMARGINS:
Message.Result := 0;
EM_GETMODIFY:
Message.Result := B(FTextFile.FileModified);
EM_GETPASSWORDCHAR:
Message.Result := Ord(FPasswordChar);
EM_GETSEL:
begin
if FTextFile.HasSelection then
begin
if Message.WParam <> 0 then
PDWORD(Message.WParam)^ := FTextFile.GetIndexOfPoint(FTextFile.CaretPos.FirstPoint);
if Message.LParam <> 0 then
PDWORD(Message.LParam)^ := FTextFile.GetIndexOfPoint(FTextFile.CaretPos.LastPoint) + 1;
end
else
begin
if Message.WParam <> 0 then
PDWORD(Message.WParam)^ := SelStart;
if Message.LParam <> 0 then
PDWORD(Message.LParam)^ := SelStart;
end;
end;
EM_GETTHUMB:
Message.Result := FScrollPos.Y;
EM_GETWORDBREAKPROC:
Message.Result := 0;
EM_HIDEBALLOONTIP:
begin
HideBalloon;
Message.Result := 1;
end;
EM_LINEFROMCHAR:
if Message.WParam = NativeUInt(-1) then
Message.Result := FTextFile.CaretPos.FirstPoint.Y
else if InRange(Message.WParam, 0, FTextFile.NumCharacters - 1) then
Message.Result := FTextFile.GetPointOfIndex(Message.WParam).Y
else
Message.Result := -1;
EM_LINEINDEX:
if Message.WParam = NativeUInt(-1) then
Message.Result := FTextFile.GetIndexOfPoint(Point(0, FTextFile.CaretPos.FirstPoint.Y))
else if InRange(Message.WParam, 0, FTextFile.LineCount - 1) then
Message.Result := FTextFile.GetIndexOfPoint(Point(0, Message.WParam))
else
Message.Result := -1;
EM_LINELENGTH:
if Message.WParam = NativeUInt(-1) then
with FTextFile.CaretPos.LastPoint do
Message.Result := FTextFile.CaretPos.FirstPoint.X + (FTextFile.VirtualLineWidths[Y] - X)
else if InRange(Message.WParam, 0, FTextFile.LineCount - 1) then
Message.Result := FTextFile.VirtualLineWidths[Message.WParam]
else
Message.Result := 0;
EM_LINESCROLL:
begin
SetScrollPosXY(FScrollPos.X + FFontSize.cx * NativeInt(Message.WParam), FScrollPos.Y + FFontSize.cy * Message.LParam);
Message.Result := IfThen(SingleLine, 0, 1);
end;
EM_POSFROMCHAR:
with VirtualPixelAtChar(FTextFile.GetPointOfIndex(Message.LParam)) do
begin
PPOINTL(Message.WParam)^.x := X;
PPointL(Message.WParam)^.y := Y;
end;
EM_REPLACESEL:
begin
InsertText(PChar(Message.LParam)^);
if Message.WParam = 0 then
ClearUndoHistory;
end;
EM_SCROLL:
begin
if (Message.WParam = SB_LINEDOWN) or (Message.WParam = SB_LINEUP) then
Message.Result := (1 shr 16) or 1
else if (Message.WParam = SB_PAGEDOWN) or (Message.WParam = SB_PAGEUP) then
Message.Result := (1 shr 16) or (ClientHeight div FFontSize.cy)
else
Message.Result := 0;
if Message.Result <> 0 then
Perform(WM_VSCROLL, Message.wParam, 0);
end;
EM_SCROLLCARET:
Message.Result := B(ScrollToCaret);
EM_SETCUEBANNER:
Message.Result := 0;
EM_SETMODIFY:
FTextFile.FileModified := Message.WParam <> 0;
EM_SETPASSWORDCHAR:
SetPasswordChar(chr(Message.WParam));
EM_SETREADONLY:
begin
if Message.WParam <> 0 then
EditMode := emReadOnly
else if EditMode = emReadOnly then
EditMode := emText;
Message.Result := 1;
end;
EM_SETTABSTOPS:
Message.Result := 0;
EM_SHOWBALLOONTIP:
with PEDITBALLOONTIP(Message.LParam)^ do
begin
if cbStruct = sizeof(TEditBalloonTip) then
Message.Result := B(ShowBalloon(pszTitle, pszText,
TBalloonIconKind(ttiIcon), bpRemain, CaretPos))
else
Message.Result := 0;
end;
EM_CANPASTE:
if Message.WParam = 0 then
Message.Result := B(Clipboard.HasFormat(CF_TEXT) or (Clipboard.HasFormat(CF_BITMAP) and not SingleLine))
else
Message.Result := B((Message.WParam = CF_TEXT) or (Message.WParam = CF_UNICODETEXT) or ((Message.WParam = CF_BITMAP) and not SingleLine));
EM_EXGETSEL:
begin
if FTextFile.AllSelected then
begin
PCHARRANGE(Message.LParam)^.cpMin := 0;
PCHARRANGE(Message.LParam)^.cpMax := -1;
end
else if FTextFile.HasSelection then
begin
PCHARRANGE(Message.LParam)^.cpMin := FTextFile.GetIndexOfPoint(FTextFile.CaretPos.FirstPoint);
PCHARRANGE(Message.LParam)^.cpMin := FTextFile.GetIndexOfPoint(FTextFile.CaretPos.LastPoint) + 1
end
else
begin
PCHARRANGE(Message.LParam)^.cpMin := FTextFile.GetIndexOfPoint(FTextFile.CaretPos.FirstPoint);
PCHARRANGE(Message.LParam)^.cpMin := PCHARRANGE(@Message.LParam)^.cpMin;
end;
end;
EM_EXLINEFROMCHAR:
Message.Result := FTextFile.GetPointOfIndex(Message.LParam).Y;
EM_FINDTEXT:
;
EM_FINDTEXTEX:
;
EM_GETREDONAME:
if CanRedo then
Message.Result := FTextFile.HistoryManager.UndoData[FTextFile.HistoryManager.HistoryIndex + 1].UID
else
Message.Result := 0;
EM_GETSCROLLPOS:
begin
PPOINT(Message.LParam)^ := FScrollPos;
Message.Result := 1;
end;
EM_GETSELTEXT:
begin
s := SelText;
i := Length(SelText);
Move(s, PChar(Message.LParam), i * sizeof(Char));
Message.Result := i;
end;
EM_GETTEXTLENGTHEX:
if (PDWORD(Message.WParam)^ and GTL_USECRLF) <> 0 then
Message.Result := FTextFile.VirtualTextLength
else
Message.Result := FTextFile.NumCharacters;
EM_GETTEXTMODE:
Message.Result := TM_PLAINTEXT or TM_MULTILEVELUNDO or TM_MULTICODEPAGE;
EM_GETTEXTRANGE:
with PTEXTRANGE(Message.LParam)^ do
begin
if (chrg.cpMin = 0) and (chrg.cpMax = -1) then
s := PlainText + #0
else
s := Copy(PlainText, chrg.cpMin + 1, chrg.cpMax - chrg.cpMin) + #0;
Move(s[1], lpstrText^, Length(s))
end;
EM_GETTOUCHOPTIONS:
Message.Result := 0;
EM_GETUNDONAME:
if CanUndo then
Message.Result := FTextFile.HistoryManager.UndoData[FTextFile.HistoryManager.HistoryIndex].UID
else
Message.Result := 0;
EM_GETZOOM:
begin
Message.WParam := FZoom;
Message.LParam := 100;
Message.Result := 1;
end;
EM_HIDESELECTION:
;
EM_SELECTIONTYPE:
if FTextFile.HasSelection then
Message.Result := SEL_TEXT or IfThen(SelLength > 1, SEL_MULTICHAR)
else
Message.Result := SEL_EMPTY;
EM_SETBKGNDCOLOR:
begin
Message.Result := FBkColor;
SetUseSystemColors(Message.WParam <> 0);
if not FUseSystemColors then
SetBackgroundColor(Message.LParam);
end;
EM_SETCHARFORMAT:
;
EM_SETFONTSIZE:
begin
Message.Result := B(InRange(Message.WParam, -1637, 1638));
if Message.Result <> 0 then
FFont.Size := REFontInc(FFont.Size, Message.WParam);
end;
EM_SETSCROLLPOS:
begin
Message.Result := 1;
with PPoint(Message.LParam)^ do
SetScrollPosXY(X, Y);
end;
EM_SETZOOM:
begin
Message.Result := B((Message.WParam > 0) and (Message.LParam > 0));
if Message.Result <> 0 then
SetZoom(100 * NativeInt(Message.WParam) div Message.LParam);
end;
EM_STOPGROUPTYPING:
if FTypeTimer.Enabled then
TypeTimerTimer(Self);
end;
end;
procedure TTextEditor.WordWrap(ALineLength: Integer; ANice: Boolean;
AChr: Char);
begin
TypeTimerEnd;
FTextFile.WordWrap(ALineLength, ANice, AChr);
AddUndoRecord(SUndoWordWrap, UID_UNKNOWN);
end;
procedure TTextEditor.TextFileFindDataClear(Sender: TObject);
begin
Invalidate;
if Assigned(FOnFindDataClear) then
FOnFindDataClear(Self);
end;
procedure TTextEditor.TextFileLockVisualUpdates(Sender: TObject);
begin
Inc(FVisualUpdateLock);
end;
procedure TTextEditor.BeginVisualUpdate;
begin
Inc(FVisualUpdateLock);
end;
procedure TTextEditor.TextFileUnlockVisualUpdates(Sender: TObject);
begin
Dec(FVisualUpdateLock);
if FVisualUpdateLock = 0 then
DoSetCaretPos;
end;
procedure TTextEditor.TidyControlIDs;
var
i, j: Integer;
c: Integer;
OldCtlID: Integer;
NewLineControls: TArray<TLineControlRecord>;
LineControlRecord: TLineControlRecord;
begin
try
SetLength(NewLineControls, Length(FLineControls));
c := 1;
for i := 0 to FTextFile.LineCount - 1 do
if LineIsControl(i) then
begin
OldCtlID := GetControlIDFromLine(i);
if OldCtlID = -1 then
raise Exception.Create('Invalid control line.');
LineControlRecord.ID := -1;
for j := 0 to High(FLineControls) do
if FLineControls[j].ID = OldCtlID then
begin
LineControlRecord := FLineControls[j];
Break;
end;
if LineControlRecord.ID = -1 then
raise Exception.Create('Control not found in list.');
LineControlRecord.ID := c;
if c > Length(NewLineControls) then
raise Exception.Create('Too many line control references.');
NewLineControls[c - 1] := LineControlRecord;
FTextFile.Lines[i] := LINE_CONTROL_PREFIX + c.ToString;
Inc(c);
end;
SetLength(NewLineControls, c - 1);
FLineControls := NewLineControls;
except
DeleteAllLineControls;
end;
end;
procedure TTextEditor.EndVisualUpdate(AUpdate: Boolean = False);
begin
Dec(FVisualUpdateLock);
if FVisualUpdateLock = 0 then
begin
Invalidate;
DoSetCaretPos;
if AUpdate then Update;
end;
end;
procedure TTextEditor.ConnectTextFileToEditor;
begin
FTextFile.OnChange := TextFileChange;
FTextFile.OnCaretPosChange := TextFileCaretPosChange;
FTextFile.OnCaretPosSelChange := TextFileCaretPosSelChange;
FTextFile.OnInputError := TextFileInputError;
FTextFile.OnReadOnlyError := TextFileReadOnlyError;
FTextFile.OnFileModified := TextFileModified;
FTextFile.OnLineChange := TextFileLineChange;
FTextFile.OnLineClassChange := TextFileLineClassChange;
FTextFile.OnControlRemoved := TextFileControlRemoved;
FTextFile.OnGetControlText := TextFileGetControlText;
FTextFile.OnBookmarksMoved := TextFileBookmarksMoved;
FTextFile.OnFindDataClear := TextFileFindDataClear;
FTextFile.OnLockVisualUpdates := TextFileLockVisualUpdates;
FTextFile.OnUnlockVisualUpdates := TextFileUnlockVisualUpdates;
FTextFile.IndentSize := Self.IndentSize;
FTextFile.AutoIndent := Self.AutoIndent;
FTextFile.CaretAfterEOL := FCaretAfterEOL ;
end;
procedure TTextEditor.DisconnectTextFileFromEditor;
begin
FTextFile.OnChange := nil;
FTextFile.OnCaretPosChange := nil;
FTextFile.OnCaretPosSelChange := nil;
FTextFile.OnInputError := nil;
FTextFile.OnFileModified := nil;
FTextFile.OnLineChange := nil;
FTextFile.OnLineClassChange := nil;
FTextFile.OnControlRemoved := nil;
FTextFile.OnGetControlText := nil;
FTextFile.OnBookmarksMoved := nil;
FTextFile.OnLockVisualUpdates := nil;
FTextFile.OnUnlockVisualUpdates := nil;
end;
procedure TTextEditor.ZoomImages;
var
i: Integer;
begin
for i := 0 to High(FLineControls) do
if FLineControls[i].Control is TImage then
begin
FLineControls[i].Control.Width := Round(FZoom * TImage(FLineControls[i].Control).Picture.Width / 100);
FLineControls[i].Control.Height := Round(FZoom * TImage(FLineControls[i].Control).Picture.Height / 100);
end
else if not FLineControls[i].OriginalSize.IsZero then
begin
FLineControls[i].Control.Width := Round(FZoom * FLineControls[i].OriginalSize.cx / 100);
FLineControls[i].Control.Height := Round(FZoom * FLineControls[i].OriginalSize.cy / 100);
end;
end;
procedure TTextEditor.ZoomIn;
begin
Zoom := Zoom + 10;
end;
procedure TTextEditor.ZoomOut;
begin
Zoom := Max(Zoom - 10, 10);
end;
procedure TTextEditor.SetScrollPosY(Value: Integer; Lim: Boolean = False);
var
OldScrollPos, diff: Integer;
TCR: TRect;
begin
if (Value < 0) or SingleLine then Value := 0;
if Lim then
begin
if GetLineBottomVirtual(LineCount - 1) < (ClientHeight - FMarginTop - FMarginBottom) then
Value := 0
else if Value > GetLineBottomVirtual(LineCount - 1) - (ClientHeight - FMarginTop - FMarginBottom) then
Value := GetLineBottomVirtual(LineCount - 1) - (ClientHeight - FMarginTop - FMarginBottom);
end;
OldScrollPos := FScrollPos.Y;
FScrollPos.Y := Value;
diff := OldScrollPos - Value;
if diff = 0 then Exit;
UpdateScrollBars;
TCR := TextContentRect;
TCR.Left := 0;
if Abs(diff) < ClientHeight - FMarginTop - FMarginBottom then
ScrollWindowEx(Handle, 0, diff, @TCR, @TCR, 0, nil, SW_INVALIDATE or SW_SCROLLCHILDREN)
else
Invalidate;
UpdateRuler;
DoSetCaretPos;
if FTextFile.ControlAware then
UpdateLineControls;
MoveBalloonPostScroll;
end;
procedure TTextEditor.SetScrollPosXY(X, Y: Integer; Lim: Boolean = False);
var
OldScrollPos: TPoint;
diffX, diffY: Integer;
TCR: TRect;
begin
if SingleLine then Y := 0;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
if Lim then
begin
if GetLineBottomVirtual(LineCount - 1) < (ClientHeight - FMarginTop - FMarginBottom) then
Y := 0
else if Y > GetLineBottomVirtual(LineCount - 1) - (ClientHeight - FMarginTop - FMarginBottom) then
Y := GetLineBottomVirtual(LineCount - 1) - (ClientHeight - FMarginTop - FMarginBottom);
end;
if (X = FScrollPos.X) then
begin
SetScrollPosY(Y);
Exit;
end
else if (Y = FScrollPos.Y) then
begin
SetScrollPosX(X);
Exit;
end;
OldScrollPos := FScrollPos;
FScrollPos := Point(X, Y);
diffX := OldScrollPos.X - X;
diffY := OldScrollPos.Y - Y;
UpdateScrollBars;
TCR := TextContentRect;
if (Abs(diffY) < ClientHeight - FMarginTop - FMarginBottom) and (Abs(diffX) < ClientWidth - FMarginLeft - FMarginRight) then
ScrollWindowEx(Handle, diffX, diffY, @TCR, @TCR, 0, nil, SW_INVALIDATE or SW_SCROLLCHILDREN)
else
Invalidate;
UpdateRuler;
DoSetCaretPos;
if FTextFile.ControlAware then
UpdateLineControls;
MoveBalloonPostScroll;
end;
procedure TTextEditor.UpdateLineControls;
var
i: Integer;
LineIndex: Integer;
begin
for i := 0 to High(FLineControls) do
begin
if not Assigned(FLineControls[i].Control) then Continue;
LineIndex := GetLineFromControlID(FLineControls[i].ID);
if LineIndex = -1 then
begin
FLineControls[i].Control.Visible := False;
Continue;
end;
FLineControls[i].Control.Visible := True;
FLineControls[i].Control.SetBounds(FMarginLeft - FScrollPos.X + CARET_WIDTH,
FMarginTop + FAccumLineHeights[LineIndex] - FScrollPos.Y,
FLineControls[i].Control.Width,
FLineControls[i].Control.Height);
end;
if FTextFile.ControlAware and (FMarginLeft > 0) then
InvalidateRect(Handle, Rect(FRulerWidth, 0, FMarginLeft, ClientHeight), False);
end;
procedure TTextEditor.FontChange(Sender: TObject);
begin
VerifyFont;
SetupFontMetrics;
BuildFontDataArray;
AdjustHeight;
Invalidate;
end;
procedure TTextEditor.UpdateRuler;
begin
InvalidateRect(Handle, RulerRect, False);
end;
procedure TTextEditor.RulerFontChange(Sender: TObject);
begin
UpdateRuler;
end;
function TTextEditor.GetCaretAfterEOL: Boolean;
begin
FCaretAfterEOL := FTextFile.CaretAfterEOL;
Result := FCaretAfterEOL;
end;
function TTextEditor.GetCaretPos: TPoint;
begin
Result := FTextFile.CaretPos.Data;
end;
function TTextEditor.GetCharAtCaret: Char;
begin
if (SelLength = 1) and (SafeSelLength = 1) then
Result := SelText[1]
else if FTextFile.CaretPos.X < FTextFile.VirtualLineWidths[FTextFile.CaretPos.Y] then
Result := FTextFile.Lines[FTextFile.CaretPos.Y][FTextFile.CaretPos.X + 1]
else
Result := #0;
end;
function TTextEditor.GetCharBeforeCaret: Char;
begin
if (SelLength = 1) and (SafeSelLength = 1) then
Result := SelText[1]
else if FTextFile.CharacterExists(FTextFile.CaretPos.Y, FTextFile.CaretPos.X - 1) then
Result := FTextFile.Lines[FTextFile.CaretPos.Y][FTextFile.CaretPos.X]
else
Result := #0;
end;
function TTextEditor.GetClassRecord(Index: Integer): TClassRecord;
begin
Result := FClassArray[Index];
end;
function TTextEditor.GetCliHistory(Index: Integer): string;
begin
Result := FCliHistory[Index];
end;
function TTextEditor.GetCliHistoryCount: Integer;
begin
Result := FCliHistory.Count;
end;
function TTextEditor.GetCliHistoryIndex: Integer;
begin
Result := FCliHistoryIndex;
end;
function TTextEditor.GetControlFromID(ID: Integer): TControl;
var
i: Integer;
begin
Result := nil;
for i := Low(FLineControls) to High(FLineControls) do
if FLineControls[i].ID = ID then
Exit(FLineControls[i].Control);
end;
function TTextEditor.GetControlFromLine(LineIndex: Integer): TControl;
var
ID: Integer;
begin
ID := GetControlIDFromLine(LineIndex);
if ID <> -1 then
Result := GetControlFromID(ID)
else
Result := nil;
end;
function TTextEditor.GetControlIDFromLine(LineIndex: Integer): Integer;
var
tmp: Integer;
begin
Result := -1;
if LineIsControl(LineIndex) and TryStrToInt(Copy(FTextFile.Lines[LineIndex],
Length(LINE_CONTROL_PREFIX) + 1), tmp) then Result := tmp;
end;
function TTextEditor.GetEditMode: TEditMode;
begin
Result := FTextFile.EditMode;
end;
function TTextEditor.GetClass(Index: Integer): string;
begin
Result := FTextFile.Classes[Index];
end;
function TTextEditor.GetClassFromName(const AClassName: string;
out AClassRecord: TClassRecord): Boolean;
var
i: Integer;
begin
for i := Low(FClassArray) to High(FClassArray) do
if SameStr(AClassName, FClassArray[i].Name) then
begin
AClassRecord := FClassArray[i];
Exit(True);
end;
Result := False;
end;
function TTextEditor.GetClassIndex(const AClassName: string): Integer;
var
i: Integer;
begin
if not AClassName.IsEmpty then
for i := Low(FClassArray) to High(FClassArray) do
if SameStr(AClassName, FClassArray[i].Name) then
Exit(i);
Result := -1;
end;
function TTextEditor.GetFalse: Boolean;
begin
Result := False;
end;
function TTextEditor.GetFontChrs(const AFontName: TFontName;
out GlyphSet: PGlyphSet): Boolean;
var
size: Integer;
begin
FGLYPHBM.Canvas.Font.Name := AFontName;
size := GetFontUnicodeRanges(FGLYPHBM.Canvas.Handle, nil);
GetMem(GlyphSet, size);
Result := GetFontUnicodeRanges(FGLYPHBM.Canvas.Handle, GlyphSet) > 0;
end;
function TTextEditor.GetIDFromControl(AControl: TControl): Integer;
var
i: Integer;
begin
for i := Low(FLineControls) to High(FLineControls) do
if FLineControls[i].Control = AControl then
Exit(FLineControls[i].ID);
Result := -1;
end;
function TTextEditor.GetNotification(AIndex: Integer): Integer;
begin
Result := FNotifications[AIndex];
end;
function TTextEditor.GetNotificationCount: Integer;
begin
Result := Length(FNotifications);
end;
function TTextEditor.GetNotificationStr(MsgID: Integer): string;
begin
Result := FNotificationStrs[MsgID];
end;
function TTextEditor.GetNumClasses: Integer;
begin
Result := Length(FClassArray);
end;
function TTextEditor.GetRulerVisible: Boolean;
begin
Result := FRulerWidth > 0;
end;
function TTextEditor.GetSelEndPos: TPoint;
begin
Result := FTextFile.CaretPos.SelEnd;
end;
function TTextEditor.GetSelLength: Integer;
begin
Result := FTextFile.SelLength;
end;
function TTextEditor.GetSelStart: Integer;
begin
Result := FTextFile.SelStart;
end;
function TTextEditor.GetSelText: string;
begin
Result := FTextFile.SelText;
end;
function TTextEditor.GetSelType: TSelectionType;
begin
Result := FTextFile.CaretPos.SelectionType;
end;
function TTextEditor.GetSingleLine: Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.SingleLine;
end;
function TTextEditor.GetSortReverseOrder: Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.SortReverseOrder;
end;
function TTextEditor.GetText: string;
begin
if Assigned(FTextFile) then
Result := FTextFile.PlainText
else
Result := '';
end;
function TTextEditor.GetWord: string;
begin
if Assigned(FTextFile) then
Result := FTextFile.GetWord
else
Result := '';
end;
function TTextEditor.GetWord(const Point: TPoint): string;
begin
if Assigned(FTextFile) then
Result := FTextFile.GetWord(Point)
else
Result := '';
end;
function TTextEditor.GetWordBoundary(out StartPos, EndPos: Integer): Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.GetWordBoundary(StartPos, EndPos);
end;
function TTextEditor.GetWrapAt: string;
begin
if Assigned(FTextFile) then
Result := FTextFile.WrapAt
else
Result := '';
end;
function TTextEditor.GiveFeedback(dwEffect: Longint): HRESULT;
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
function TTextEditor.GotoBookmark(AIndex: Integer): Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.GotoBookmark(AIndex);
end;
function TTextEditor.GotoHistoryVersion(Index: Integer): Boolean;
begin
if FTypeTimer.Enabled then
TypeTimerTimer(Self);
FNoScrollToCaret := True;
try
Result := FTextFile.GotoHistoryVersion(Index);
if FTextFile.ControlAware then
FixRemovedLineControlLines;
finally
FNoScrollToCaret := False;
end;
if Result then
CenterOnSelection(True);
end;
procedure TTextEditor.GotoSamePixelAtNextLine(Shift: Boolean);
var
px: TPoint;
begin
if FTextFile = nil then
Exit;
if FTextFile.AtLastLine then
begin
TextFileInputError(Self);
Exit;
end;
if not FMultiSize then
begin
FTextFile.Down(Shift);
Exit;
end;
px := VirtualPixelAtChar(CaretPos);
if FDesiredColumn <> 0 then
px.X := FDesiredColumn;
Inc(px.Y, FFontSizes[CaretPos.Y].cy + FFontSizes[CaretPos.Y + 1].cy div 2);
FPreserveDesiredColumn := True;
try
FTextFile.CaretPos.SetPoint(CaretPosAtVirtualPixel(px), Shift);
finally
FPreserveDesiredColumn := False;
end;
end;
procedure TTextEditor.GotoSamePixelAtPrevLine(Shift: Boolean);
var
px: TPoint;
begin
if FTextFile = nil then
Exit;
if CaretPos.Y = 0 then
begin
TextFileInputError(Self);
Exit;
end;
if not FMultiSize then
begin
FTextFile.Up(Shift);
Exit;
end;
px := VirtualPixelAtChar(CaretPos);
if FDesiredColumn <> 0 then
px.X := FDesiredColumn;
Dec(px.Y, FFontSizes[CaretPos.Y - 1].cy div 2);
FPreserveDesiredColumn := True;
try
FTextFile.CaretPos.SetPoint(CaretPosAtVirtualPixel(px), Shift);
finally
FPreserveDesiredColumn := False;
end;
end;
function TTextEditor.HasNotificationMessage(MsgID: Integer): Boolean;
var
i: Integer;
begin
for i := Low(FNotifications) to High(FNotifications) do
if FNotifications[i] = MsgID then
Exit(True);
Result := False;
end;
procedure TTextEditor.HideBalloon;
begin
if FHintWindow <> 0 then
SendMessage(FHintWindow, TTM_TRACKACTIVATE, 0, LParam(@FToolInfo));
end;
function TTextEditor.GetWordBoundary(const Point: TPoint; out StartPos,
EndPos: Integer): Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.GetWordBoundary(Point, StartPos, EndPos);
end;
function UnicodeSuperscript(const AChar: Char): Char;
begin
Result := AChar;
case AChar of
'0':
Result := '⁰';
'1':
Result := '¹';
'2':
Result := '²';
'3':
Result := '³';
'4':
Result := '⁴';
'5':
Result := '⁵';
'6':
Result := '⁶';
'7':
Result := '⁷';
'8':
Result := '⁸';
'9':
Result := '⁹';
'+':
Result := '⁺';
'-', '−':
Result := '⁻';
'=':
Result := '⁼';
'(':
Result := '⁽';
')':
Result := '⁾';
'n':
Result := 'ⁿ';
end;
end;
function UnicodeSubscript(const AChar: Char): Char;
begin
Result := AChar;
case AChar of
'0':
Result := '₀';
'1':
Result := '₁';
'2':
Result := '₂';
'3':
Result := '₃';
'4':
Result := '₄';
'5':
Result := '₅';
'6':
Result := '₆';
'7':
Result := '₇';
'8':
Result := '₈';
'9':
Result := '₉';
'+':
Result := '₊';
'-', '−':
Result := '₋';
'=':
Result := '₌';
'(':
Result := '₍';
')':
Result := '₎';
end;
end;
function UnicodeCircled(const AChar: Char): Char;
begin
Result := AChar;
if InRange(Ord(AChar), Ord('A'), Ord('Z')) then
Result := chr($24B6 + Ord(AChar) - Ord('A'))
else if InRange(Ord(AChar), Ord('a'), Ord('z')) then
Result := chr($24D0 + Ord(AChar) - Ord('a'))
else if InRange(Ord(AChar), Ord('1'), Ord('9')) then
Result := chr($2460 + Ord(AChar) - Ord('1'))
else if AChar = '0' then
Result := #$24EA;
end;
function UnicodeParenthesized(const AChar: Char): Char;
begin
Result := AChar;
if InRange(Ord(AChar), Ord('a'), Ord('z')) then
Result := chr($249C + Ord(AChar) - Ord('a'))
else if InRange(Ord(AChar), Ord('1'), Ord('9')) then
Result := chr($2474 + Ord(AChar) - Ord('1'))
end;
function UnicodeFullStop(const AChar: Char): Char;
begin
Result := AChar;
if InRange(Ord(AChar), Ord('1'), Ord('9')) then
Result := chr($2488 + Ord(AChar) - Ord('1'))
end;
function UnicodeDoublyCircled(const AChar: Char): Char;
begin
Result := AChar;
if InRange(Ord(AChar), Ord('1'), Ord('9')) then
Result := chr($24F5 + Ord(AChar) - Ord('1'))
end;
function TTextEditor.GetBalloonPosition: TPoint;
begin
Result := ClientToScreen(PhysicalPixelAtChar(FBalloonPoint));
Inc(Result.Y, FFontSize.cy);
Inc(Result.X, CARET_WIDTH div 2);
end;
function TTextEditor.GetBookmark(Index: Integer): TPoint;
begin
Result := FTextFile.Bookmarks[Index];
end;
function TTextEditor.GetBookmarkCount: Integer;
begin
if Assigned(FTextFile) then
Result := FTextFile.BookmarkCount
else
Result := 0;
end;
function TTextEditor.GetBookmarkDescr(BookmarkIndex: Integer): string;
begin
if not InRange(BookmarkIndex, 0, BookmarkCount - 1) then
Exit(SBookmarkDescriptionInvalid);
if BookmarkUsed(BookmarkIndex) then
Result := Format(SBookmarkDescription,
[BookmarkIndex, Bookmarks[BookmarkIndex].Y + 1, Bookmarks[BookmarkIndex].X + 1])
else
Result := Format(SBookmarkDescriptionEmpty, [BookmarkIndex]);
end;
procedure TTextEditor.InsertChar(const AChar: Char; AOverwrite: Boolean = False);
var
BChar: Char;
begin
if FTextFile.ControlAware and LineIsControl(FTextFile.CaretPos.Y) then
begin
TextFileInputError(Self);
ShowBalloon(SControlLineInputTitle, SControlLineInputText, bikError, bpCaretPos,
GetCaretPos);
Exit;
end;
if FNumbersOnly and not AChar.IsDigit then
begin
TextFileInputError(Self);
ShowBalloon(SNumOnlyErrorTitle, SNumOnlyErrorText, bikError, bpCaretPos,
GetCaretPos);
Exit;
end;
BChar := AChar;
case FInputTransform of
itUpperCase:
BChar := AnsiUpperCase(AChar)[1];
itLowerCase:
BChar := AnsiLowerCase(AChar)[1];
itSuperscript:
BChar := UnicodeSuperscript(AChar);
itSubscript:
BChar := UnicodeSubscript(AChar);
itCircled:
BChar := UnicodeCircled(AChar);
itParenthesized:
BChar := UnicodeParenthesized(AChar);
itFullStop:
BChar := UnicodeFullStop(AChar);
itDoublyCircled:
BChar := UnicodeDoublyCircled(AChar);
end;
if FMultipleCarets then
FTextFile.MultiInsertChar(FCarets, BChar, Overwrite)
else
FTextFile.InsertChar(BChar, AOverwrite);
PostType;
if FMatchBrackets and ((BChar = '❩') or (BChar = ')') or (BChar = '}') or (BChar = ']')) then
BlinkBracket;
end;
procedure TTextEditor.InsertGraphic(AGraphic: TGraphic; LineIndex: Integer);
var
img: TImage;
begin
img := TImage.Create(Self);
try
img.AutoSize := True;
img.Stretch := False;
img.Proportional := True;
img.Center := True;
img.Cursor := crArrow;
img.Picture.Graphic := AGraphic;
img.PopupMenu := FImagePopup;
InsertLineControl(img, LineIndex);
except
img.Free;
raise;
end;
end;
procedure TTextEditor.InsertLine(const AText, AClassName: string;
LineIndex: Integer);
begin
if FTextFile = nil then
Exit;
FTextFile.InsertLine(AText, AClassName, LineIndex);
end;
procedure TTextEditor.InsertLine(const AText: string; LineIndex: Integer);
begin
if FTextFile = nil then
Exit;
FTextFile.InsertLine(AText, LineIndex);
end;
procedure TTextEditor.InsertLine(LineIndex: Integer);
begin
if FTextFile = nil then
Exit;
FTextFile.InsertLine('', LineIndex);
end;
procedure TTextEditor.RemoveAllMargins;
begin
if FMarginLeft + FMarginRight + FMarginTop + FMarginBottom > 0 then
begin
FMarginLeft := 0;
FMarginRight := 0;
FMarginTop := 0;
FMarginBottom := 0;
FRulerWidth := 0;
UpdateScrollBars;
Invalidate;
DoSetCaretPos;
end;
end;
procedure TTextEditor.InsertLineControl(AControl: TControl; LineIndex: Integer);
begin
if FTextFile = nil then
Exit;
MultiSize := True;
FTextFile.ControlAware := True;
SetLength(FLineControls, Length(FLineControls) + 1);
FLineControls[High(FLineControls)].ID := FNextControlID;
FLineControls[High(FLineControls)].Control := AControl;
InsertLine(LINE_CONTROL_PREFIX + FNextControlID.ToString, LINE_CONTROL_CLASS, LineIndex);
Inc(FNextControlID);
AControl.Parent := Self;
AControl.Visible := True;
end;
procedure TTextEditor.BlinkBracket;
var
start: TPoint;
NewBracket: TPoint;
begin
NewBracket := Point(FTextFile.CaretPos.X - 1, FTextFile.CaretPos.Y);
start := FTextFile.MatchBracket(NewBracket);
if start.Y <> -1 then
begin
SetBracketHighlight(NewBracket, start);
FBlinkRemover.Enabled := False;
FBlinkRemover.Enabled := True;
end;
end;
procedure TTextEditor.InsertText(const AText: string);
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.InsertText(AText);
AddUndoRecord(SUndoTextInserted, UID_UNKNOWN);
end;
procedure TTextEditor.InsertTextAsBlock(const AText: string);
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.InsertTextAsBlock(AText);
AddUndoRecord(SUndoTextInserted, UID_UNKNOWN);
end;
function TTextEditor.Undo: Boolean;
begin
if FTextFile = nil then
Exit(False);
if FTypeTimer.Enabled then
TypeTimerTimer(Self);
FNoScrollToCaret := True;
try
Result := FTextFile.Undo;
if Result and FTextFile.ControlAware then
FixRemovedLineControlLines;
finally
FNoScrollToCaret := False;
end;
if Result then
CenterOnSelection(True);
end;
function TTextEditor.TextContentRect: TRect;
begin
Result := ClientRect;
Inc(Result.Left, FMarginLeft);
Inc(Result.Top, FMarginTop);
Dec(Result.Right, FMarginRight);
Dec(Result.Bottom, FMarginBottom);
end;
procedure TTextEditor.UpdateCaret;
begin
if FTextFile = nil then
Exit;
if not Focused then Exit;
if FListBoxMode then Exit;
if FMultiSize then
CreateCaret(
Handle,
IfThen((FTextFile.EditMode = emReadOnly) or ((FTextFile.EditMode = emConsole) and (FTextFile.CaretPos.Y < FTextFile.LineCount - 1)), 1, 0),
IfThen(FOverwrite, FFontSizes[FTextFile.CaretPos.Y].cx, CARET_WIDTH),
FFontSizes[FTextFile.CaretPos.Y].cy
)
else
CreateCaret(
Handle,
IfThen((FTextFile.EditMode = emReadOnly) or ((FTextFile.EditMode = emConsole) and (FTextFile.CaretPos.Y < FTextFile.LineCount - 1)), 1, 0),
IfThen(FOverwrite, FFontSize.cx, CARET_WIDTH),
FFontSize.cy
);
ShowCaret(Handle);
FCaretVisible := True;
DoSetCaretPos;
end;
procedure TTextEditor.MultiCharSelectDlgResize(Sender: TObject);
begin
if Sender is TForm then
with TForm(Sender) do
SetWindowPos(Flv, HWND_TOP, 0, 0, ClientWidth, ClientHeight,
SWP_NOOWNERZORDER or SWP_NOZORDER or SWP_SHOWWINDOW);
end;
procedure TTextEditor.MultiCharSelectDlgWndProc(var Message: TMessage);
type
LPNMLVKEYDOWN = ^NMLVKEYDOWN;
NMLVKEYDOWN = packed record
hdr: NMHDR;
wVKey: WORD;
flags: UINT;
end;
var
index: Integer;
buf: array[0..32] of Char;
begin
FMultiCharSelectDlgDefaultWndProc(Message);
case Message.Msg of
WM_NOTIFY:
if PNMHDR(Message.LParam).hwndFrom = Flv then
case PNMHDR(Message.LParam).code of
LVN_KEYDOWN:
if LPNMLVKEYDOWN(Message.LParam).wVKey = VK_ESCAPE then
FMultiCharSelectDlgFrm.ModalResult := mrCancel;
NM_RETURN, NM_DBLCLK:
begin
index := ListView_GetNextItem(Flv, -1, LVNI_SELECTED);
if index <> -1 then
begin
ListView_GetItemText(Flv, index, 1, @buf[0], Length(buf));
if (buf[0] = 'U') and (buf[1]= '+') then
FMultiCharSelectDlgFrm.Tag := StrToInt('$' + Copy(PChar(@buf[0]), 3));
end;
FMultiCharSelectDlgFrm.ModalResult := mrOk;
end;
end;
end;
end;
procedure TTextEditor.MultiCharSelectDlgActivate(Sender: TObject);
begin
Windows.SetFocus(Flv);
end;
procedure TTextEditor.DoMultiCharSelect(AChrs: array of Char);
var
frm: TForm;
lv: HWND;
c: Char;
tvi: TLVTileViewInfo;
li: TLVItem;
cl: TLVColumn;
index: Integer;
il: TImageList;
bm: TBitmap;
i: Integer;
R: TRect;
S: string;
const
colinfo: array[0..1] of Integer = (1, 2);
begin
frm := TForm.Create(nil);
lv := 0;
try
frm.Caption := SMultiSelectCaption;
frm.BorderStyle := bsSizeToolWin;
frm.Width := 600;
frm.Height := 400;
frm.OnActivate := MultiCharSelectDlgActivate;
frm.OnResize := MultiCharSelectDlgResize;
FMultiCharSelectDlgFrm := frm;
FMultiCharSelectDlgDefaultWndProc := frm.WindowProc;
frm.WindowProc := MultiCharSelectDlgWndProc;
with ClientToScreen(Point(ClientWidth div 2 - frm.ClientWidth div 2,
ClientHeight div 2 - frm.ClientHeight div 2)) do
begin
frm.Left := X;
frm.Top := Y;
end;
il := TImageList.Create(frm);
il.Width := 64;
il.Height := 64;
bm := TBitmap.Create;
try
bm.SetSize(64, 64);
R := Rect(0, 0, bm.Width, bm.Height);
bm.Canvas.Font.Assign(Self.Font);
bm.Canvas.Font.Height := 64;
bm.Canvas.Font.Color := clBlack;
for c in AChrs do
begin
bm.Canvas.Brush.Color := clWhite;
bm.Canvas.FillRect(R);
S := c;
bm.Canvas.TextRect(R, S, [tfSingleLine, tfCenter, tfVerticalCenter]);
il.Add(bm, nil);
end;
finally
bm.Free;
end;
lv := CreateWindowEx(0, WC_LISTVIEW, nil,
WS_CHILD or WS_VISIBLE or LVS_REPORT or LVS_NOSORTHEADER or LVS_SINGLESEL or LVS_AUTOARRANGE,
0, 0, frm.ClientWidth, frm.ClientHeight, frm.Handle, 0, HInstance, nil);
Flv := lv;
ListView_SetExtendedListViewStyle(lv, LVS_EX_AUTOSIZECOLUMNS or LVS_EX_FULLROWSELECT);
ListView_SetImageList(lv, il.Handle, LVSIL_NORMAL);
if not FMultiCharReportView then
begin
ListView_SetView(lv, LV_VIEW_TILE);
tvi.cbSize := sizeof(tvi);
tvi.dwMask := LVTVIM_COLUMNS;
tvi.cLines := 2;
ListView_SetTileViewInfo(lv, tvi);
end;
cl.mask := LVCF_SUBITEM or LVCF_TEXT or LVCF_ORDER or LVCF_WIDTH;
cl.iSubItem := 0;
cl.pszText := PChar(SMultiCharDlgLvColumnTitleDescription);
cl.iOrder := 0;
cl.cx := 200;
ListView_InsertColumn(lv, 0, cl);
cl.iSubItem := 1;
cl.pszText := PChar(SMultiCharDlgLvColumnTitleCodepoint);
cl.iOrder := 1;
cl.cx := 75;
ListView_InsertColumn(lv, 1, cl);
cl.iSubItem := 2;
cl.pszText := PChar(SMultiCharDlgLvColumnTitleBlock);
cl.iOrder := 2;
cl.cx := 200;
ListView_InsertColumn(lv, 2, cl);
li.mask := LVIF_TEXT or LVIF_IMAGE or LVIF_STATE or LVIF_COLUMNS;
li.stateMask := 0;
li.iSubItem := 0;
li.state := 0;
li.iImage := 0;
li.cColumns := 2;
li.puColumns := PUINT(@colinfo[0]);
ListView_SetItemCount(lv, Length(AChrs));
i := 0;
for c in AChrs do
begin
li.iImage := i;
Inc(i);
li.pszText := PChar(UCD.GetChrName(c));
index := ListView_InsertItem(lv, li);
ListView_SetItemText(lv, index, 1, PChar(UCD.GetChrCodepointStr(c)));
ListView_SetItemText(lv, index, 2, PChar(UCD.GetChrBlock(c)));
end;
frm.Tag := 0;
if frm.ShowModal = mrOk then
if frm.Tag <> 0 then
begin
Backspace;
InsertChar(Chr(frm.Tag));
end;
finally
if lv <> 0 then DestroyWindow(lv);
frm.Free;
end;
end;
procedure TTextEditor.DoNavRequest(AEditorCommand: Integer);
begin
if Assigned(FOnNavRequest) then
FOnNavRequest(Self, AEditorCommand);
end;
function TTextEditor.DoNavRequestGetEnabled(AEditorCommand: Integer): Boolean;
begin
Result := False;
if Assigned(FOnNavRequestGetEnabled) then
FOnNavRequestGetEnabled(Self, AEditorCommand, Result);
end;
procedure TTextEditor.DoSetCaretPos;
var
pt: TPoint;
begin
if FVisualUpdateLock > 0 then Exit;
if FListBoxMode or not Focused then Exit;
if FMultiSize then
pt := Point(FMarginLeft +
FTextFile.CaretPos.X * FFontSizes[FTextFile.CaretPos.Y].cx - FScrollPos.X,
FMarginTop + FAccumLineHeights[FTextFile.CaretPos.Y] - FScrollPos.Y)
else
pt := Point(FMarginLeft + FTextFile.CaretPos.X * FFontSize.cx - FScrollPos.X,
FMarginTop + FTextFile.CaretPos.Y * FFontSize.cy - FScrollPos.Y);
if PtInRect(TextContentRect, pt) then
begin
BinaryShowCaret;
Windows.SetCaretPos(pt.X, pt.Y)
end
else
BinaryHideCaret;
end;
procedure TTextEditor.BinaryHideCaret;
begin
if FCaretVisible then
begin
HideCaret(Handle);
FCaretVisible := False;
end;
end;
procedure TTextEditor.BinaryShowCaret;
begin
if not FCaretVisible then
begin
ShowCaret(Handle);
FCaretVisible := True;
end;
end;
function TTextEditor.GetLineTop(LineIndex: Integer): Integer;
begin
if FMultiSize then
Result := FMarginTop + FAccumLineHeights[LineIndex] - FScrollPos.Y
else
Result := FMarginTop + FFontSize.cy * LineIndex - FScrollPos.Y;
end;
function TTextEditor.GetListBoxItemIndex: Integer;
begin
if FListBoxSelection and not FTextFile.Empty then
Result := FTextFile.CaretPos.Y
else
Result := -1;
end;
function TTextEditor.GetLastMultiCaret: TPoint;
begin
if Length(FCarets) > 0 then
Result := FCarets[High(FCarets)]
else
Result := CaretPos;
end;
function TTextEditor.GetLine(Index: Integer): string;
begin
if FTextFile.LineExists(Index) then
Result := FTextFile.Lines[Index]
else
raise Exception.CreateFmt('Line index %d out of bounds.', [Index]);
end;
function TTextEditor.GetLineBookmark(ALineIndex: Integer): Integer;
var
i: Integer;
begin
for i := 0 to FTextFile.BookmarkCount - 1 do
if FTextFile.Bookmarks[i].Y = ALineIndex then
Exit(i);
Result := -1;
end;
function TTextEditor.GetLineBottom(LineIndex: Integer): Integer;
begin
if FMultiSize then
Result := FMarginTop + FAccumLineHeights[LineIndex] + FFontSizes[LineIndex].cy - FScrollPos.Y
else
Result := FMarginTop + FFontSize.cy * (LineIndex + 1) - FScrollPos.Y;
end;
function TTextEditor.GetLineBottomVirtual(LineIndex: Integer): Integer;
begin
if FMultiSize then
Result := FMarginTop + FAccumLineHeights[LineIndex] + FFontSizes[LineIndex].cy
else
Result := FMarginTop + FFontSize.cy * (LineIndex + 1);
end;
function TTextEditor.GetCharLeft(LineIndex, ColIndex: Integer): Integer;
begin
if FMultiSize then
Result := FMarginLeft + FFontSizes[LineIndex].cx * ColIndex - FScrollPos.X
else
Result := FMarginLeft + FFontSize.cx * ColIndex - FScrollPos.X;
end;
function TTextEditor.GetCharRight(LineIndex, ColIndex: Integer): Integer;
begin
if FMultiSize then
Result := FMarginLeft + FFontSizes[LineIndex].cx * (ColIndex + 1) - FScrollPos.X
else
Result := FMarginLeft + FFontSize.cx * (ColIndex + 1) - FScrollPos.X;
end;
procedure TTextEditor.VisualUpdate(ChangeType: TChangeType; Data1, Data2, Data3,
Data4: Integer);
var
i: Integer;
begin
if (FVisualUpdateLock > 0) or not (FValidPaintState and Visible) then Exit;
begin
case ChangeType of
ctFile:
Invalidate;
ctLineRange:
InvalidateRect(Handle, Rect(0, GetLineTop(Data1), ClientWidth, GetLineBottom(Data2)), False);
ctBlock:
if FMultiSize then
for i := max(FirstVisibleLine, Data1) to min(LastVisibleLine, Data2) do
InvalidateRect(Handle, Rect(GetCharLeft(i, Data3), GetLineTop(i), GetCharRight(i, Data4), GetLineBottom(i)), False)
else
InvalidateRect(Handle, Rect(GetCharLeft(Data1, Data3), GetLineTop(Data1), GetCharRight(Data1, Data4), GetLineBottom(Data2)), False);
ctLine:
InvalidateRect(Handle, Rect(0, GetLineTop(Data1), ClientWidth, GetLineBottom(Data1)), False);
ctLineFrom:
InvalidateRect(Handle, Rect(GetCharLeft(Data1, Data2), GetLineTop(Data1), ClientWidth, GetLineBottom(Data1)), False);
ctChar:
InvalidateRect(Handle, Rect(GetCharLeft(Data1, Data2), GetLineTop(Data1), GetCharRight(Data1, Data2), GetLineBottom(Data1)), False);
ctTwoChars:
begin
InvalidateRect(Handle, Rect(GetCharLeft(Data1, Data2), GetLineTop(Data1), GetCharRight(Data1, Data2), GetLineBottom(Data1)), False);
InvalidateRect(Handle, Rect(GetCharLeft(Data3, Data4), GetLineTop(Data3), GetCharRight(Data3, Data4), GetLineBottom(Data3)), False);
end;
ctPostFile:
InvalidateRect(Handle, Rect(0, GetLineBottom(FTextFile.LineCount - 1), ClientWidth, ClientHeight), False);
end;
Update;
end
end;
function TTextEditor.EditorCommand(Command, Param1, Param2, Param3,
Param4: Integer): Integer;
var
S: string;
i: Integer;
begin
Result := 0;
if (Command and $FFFF0000) <> 0 then
begin
Param1 := Command shr 16;
Command := Command and $0000FFFF;
end;
case Command of
EDITOR_COMMAND_RIGHT:
FTextFile.Right(Param1 <> 0, Param2 <> 0, Param3 <> 0);
EDITOR_COMMAND_LEFT:
FTextFile.Left(Param1 <> 0, Param2 <> 0, Param3 <> 0);
EDITOR_COMMAND_DOWN:
FTextFile.Down(Param1 <> 0, Param2 <> 0);
EDITOR_COMMAND_UP:
FTextFile.Up(Param1 <> 0, Param2 <> 0);
EDITOR_COMMAND_HOME:
FTextFile.Home(Param1 <> 0, Param2 <> 0);
EDITOR_COMMAND_END:
FTextFile.KEnd(Param1 <> 0, Param2 <> 0);
EDITOR_COMMAND_PAGE_UP:
PageUp(Param1 <> 0);
EDITOR_COMMAND_PAGE_DOWN:
PageDown(Param1 <> 0);
EDITOR_COMMAND_BACKSPACE:
Backspace(Param1 <> 0);
EDITOR_COMMAND_DELETE:
Delete(Param1 <> 0);
EDITOR_COMMAND_CLEAR_SELECTION:
ClearSelection;
EDITOR_COMMAND_SELECT_ALL:
SelectAll;
EDITOR_COMMAND_SELECT_NONE:
SelectNone;
EDITOR_COMMAND_SELECT_ALL_NONE:
SelectAllNone;
EDITOR_COMMAND_SELECT_WORD:
Result := B(SelectWord);
EDITOR_COMMAND_SELECT_LINE:
SelectLine;
EDITOR_COMMAND_CLEAR_LINE:
ClearLine(Param1);
EDITOR_COMMAND_CUT:
CutToClipboard;
EDITOR_COMMAND_COPY:
CopyToClipboard;
EDITOR_COMMAND_PASTE:
PasteFromClipboard;
EDITOR_COMMAND_UNDO:
Result := B(Undo);
EDITOR_COMMAND_REDO:
Result := B(Redo);
EDITOR_COMMAND_CLEAR_UNDO_BUFFER:
ClearUndoHistory;
EDITOR_COMMAND_GOTO_SOF:
FTextFile.GotoSOF(Param1 <> 0);
EDITOR_COMMAND_GOTO_EOF:
FTextFile.GotoEOF(Param1 <> 0);
EDITOR_COMMAND_RETURN:
Return;
EDITOR_COMMAND_CHAR:
InsertChar(Char(Param1), Param2 <> 0);
EDITOR_COMMAND_GET_AT_SOF:
Result := B(FTextFile.AtSOF);
EDITOR_COMMAND_GET_AT_EOL:
Result := B(FTextFile.AtEOL);
EDITOR_COMMAND_GET_BEYOND_EOL:
Result := B(FTextFile.AtOrBeyondEOL);
EDITOR_COMMAND_GET_AT_EOF:
Result := B(FTextFile.AtEOF);
EDITOR_COMMAND_GET_AT_LAST_LINE:
Result := B(FTextFile.AtLastLine);
EDITOR_COMMAND_GET_HAS_SELECTION:
Result := B(FTextFile.HasSelection);
EDITOR_COMMAND_GET_LINE_NUMBER_0:
Result := FTextFile.CaretPos.Y;
EDITOR_COMMAND_GET_COL_NUMBER_0:
Result := FTextFile.CaretPos.X;
EDITOR_COMMAND_GET_CHR_INDEX:
Result := SelStart;
EDITOR_COMMAND_GOTO_POINT:
FTextFile.CaretPos.SetPoint(Param1, Param2, Param3 <> 0);
EDITOR_COMMAND_GOTO_INDEX:
SelStart := Param1;
EDITOR_COMMAND_GET_SEL_LENGTH:
Result := SelLength;
EDITOR_COMMAND_SET_SEL_LENGTH:
SelLength := Param1;
EDITOR_COMMAND_GET_EDIT_MODE:
Result := Ord(FTextFile.EditMode);
EDITOR_COMMAND_SET_EDIT_MODE:
SetEditMode(TEditMode(Param1));
EDITOR_COMMAND_GET_SELECTION_MODE:
Result := Ord(GetSelType);
EDITOR_COMMAND_SET_SELECTION_MODE:
SetSelType(TSelectionType(Param1));
EDITOR_COMMAND_GET_OVERWRITE:
Result := B(FOverwrite);
EDITOR_COMMAND_SET_OVERWRITE:
SetOverwrite(Param1 <> 0);
EDITOR_COMMAND_GET_AUTO_REPLACE:
Result := B(FAutoReplace);
EDITOR_COMMAND_SET_AUTO_REPLACE:
AutoReplace := Param1 <> 0;
EDITOR_COMMAND_GET_CHAR:
Result := Integer(GetCharAtCaret);
EDITOR_COMMAND_ADD_INDENT:
AddIndent;
EDITOR_COMMAND_REMOVE_INDENT:
RemoveIndent;
EDITOR_COMMAND_TRIM_INDENT:
RemoveAllIndent;
EDITOR_COMMAND_SWAP_UP:
SwapLinesAbove;
EDITOR_COMMAND_SWAP_DOWN:
SwapLinesBelow;
EDITOR_COMMAND_GET_AUTO_INDENT:
Result := B(FAutoIndent);
EDITOR_COMMAND_SET_AUTO_INDENT:
SetAutoIndent(Param1 <> 0);
EDITOR_COMMAND_GET_CARET_BEYOND_EOL:
Result := B(FTextFile.CaretAfterEOL);
EDITOR_COMMAND_SET_CARET_BEYOND_EOL:
SetCaretAfterEOL(Param1 <> 0);
EDITOR_COMMAND_GET_NUM_CHARACTERS:
Result := FTextFile.NumCharacters;
EDITOR_COMMAND_GET_TEXT_SIZE:
Result := FTextFile.VirtualTextLength;
EDITOR_COMMAND_GET_NUM_LINES:
Result := FTextFile.LineCount;
EDITOR_COMMAND_GET_MAX_WIDTH:
Result := FTextFile.MaxLineWidth;
EDITOR_COMMAND_SCROLL_TO_CARET:
Result := B(ScrollToCaret);
EDITOR_COMMAND_CENTER_ON_SELECTION:
CenterOnSelection(Param1 <> 0);
EDITOR_COMMAND_REPLACE_TOKEN:
DoAutoReplace;
EDITOR_COMMAND_REPLACE_CODEPOINT:
FTextFile.ReplaceCodepoint;
EDITOR_COMMAND_UPDATE_SCROLLBARS:
UpdateScrollBars;
EDITOR_COMMAND_UPDATE_CARET:
UpdateCaret;
EDITOR_COMMAND_UPDATE_CURSOR:
ChangeCursor;
EDITOR_COMMAND_REDRAW:
Invalidate;
EDITOR_COMMAND_REDRAW_LINE:
VisualUpdate(ctLine, Param1, 0, 0, 0);
EDITOR_COMMAND_REDRAW_LINE_RANGE:
VisualUpdate(ctLineRange, Param1, Param2, 0, 0);
EDITOR_COMMAND_REDRAW_BLOCK:
VisualUpdate(ctBlock, Param1, Param2, Param3, Param4);
EDITOR_COMMAND_GET_MODIFIED:
Result := B(FTextFile.FileModified);
EDITOR_COMMAND_SET_MODIFIED:
FTextFile.FileModified := Param1 <> 0;
EDITOR_COMMAND_NEW:
NewFile;
EDITOR_COMMAND_CLEAR:
FTextFile.Clear;
EDITOR_COMMAND_OPEN:
LoadFromFile(PChar(Param1), TEncoding.UTF8);
EDITOR_COMMAND_SAVE:
SaveToFile(PChar(Param1));
EDITOR_COMMAND_GET_HIDDEN:
Result := B(FShowHiddenCharacters);
EDITOR_COMMAND_SET_HIDDEN:
SetShowHiddenCharacters(Param1 <> 0);
EDITOR_COMMAND_SET_SELECTION:
begin
FTextFile.CaretPos.SetPoint(Param1, Param2, False);
FTextFile.CaretPos.SetPoint(Param3, Param4, True);
end;
EDITOR_COMMAND_GET_MATCH_BRACKETS:
Result := B(FMatchBrackets);
EDITOR_COMMAND_SET_MATCH_BRACKETS:
SetMatchBrackets(Param1 <> 0);
EDITOR_COMMAND_GET_BRACKET_HIGHLIGHT:
Result := B(FBracketHighlight);
EDITOR_COMMAND_GET_SCROLL_POS_X:
Result := FScrollPos.X;
EDITOR_COMMAND_GET_SCROLL_POS_Y:
Result := FScrollPos.Y;
EDITOR_COMMAND_SET_SCROLL_POS:
SetScrollPosXY(Param1, Param2);
EDITOR_COMMAND_REDRAW_CHAR:
VisualUpdate(ctChar, Param1, Param2, 0, 0);
EDITOR_COMMAND_REDRAW_CHARS:
VisualUpdate(ctChar, Param1, Param2, Param3, Param4);
EDITOR_COMMAND_GET_INDENT:
Result := FIndentSize;
EDITOR_COMMAND_SET_INDENT:
SetIndentSize(Param1);
EDITOR_COMMAND_GET_TAB_LENGTH:
Result := FTabLength;
EDITOR_COMMAND_SET_TAB_LENGTH:
FTabLength := Param1;
EDITOR_COMMAND_GET_SINGLE_LINE:
Result := B(SingleLine);
EDITOR_COMMAND_SET_SINGLE_LINE:
SetSingleLine(Param1 <> 0);
EDITOR_COMMAND_GET_LABEL_MODE:
Result := B(FLabelStyle);
EDITOR_COMMAND_SET_LABEL_MODE:
SetLabelStyle(Param1 <> 0);
EDITOR_COMMAND_GET_ELLIPSIS_MODE:
Result := B(FLabelEllipsis);
EDITOR_COMMAND_SET_ELLIPSIS_MODE:
SetLabelEllipsis(Param1 <> 0);
EDITOR_COMMAND_GET_INPUT_TRANSFORM:
Result := Ord(FInputTransform);
EDITOR_COMMAND_SET_INPUT_TRANSFORM:
FInputTransform := TInputTransform(Param1);
EDITOR_COMMAND_GET_NUMBERS_ONLY:
Result := B(FNumbersOnly);
EDITOR_COMMAND_SET_NUMBERS_ONLY:
FNumbersOnly := Param1 <> 0;
EDITOR_COMMAND_GET_PASSWORD_CHAR:
Result := Ord(FPasswordChar);
EDITOR_COMMAND_SET_PASSWORD_CHAR:
SetPasswordChar(Chr(Param1));
EDITOR_COMMAND_GET_UNICODE_FALLBACK:
Result := B(FUnicodeFallback);
EDITOR_COMMAND_SET_UNICODE_FALLBACK:
SetUnicodeFallback(Param1 <> 0);
EDITOR_COMMAND_ESCAPE:
Escape(Param1 <> 0);
EDITOR_COMMAND_USE_DEFAULT_FALLBACK_FONTS:
UseDefaultFallbackFonts;
EDITOR_COMMAND_SHOW_BALLOON:
Result := B(ShowBalloon(PChar(Param1), PChar(Param2), TBalloonIconKind(Param3),
TBalloonPersistence(Param4), CaretPos));
EDITOR_COMMAND_HIDE_BALLOON:
HideBalloon;
EDITOR_COMMAND_SHOW_BALLOON_POS:
Result := B(ShowBalloon(PChar(Param1), PChar(Param2), TBalloonIconKind(Byte(Param3)),
TBalloonPersistence(Byte(Param3 shr 8)), FTextFile.GetPointOfIndex(Param4)));
EDITOR_COMMAND_IS_BALLOON_VISIBLE:
Result := B(BalloonVisible);
EDITOR_COMMAND_ADJUST_HEIGHT:
begin
Result := B(SingleLine);
if Result <> 0 then
ClientHeight := FFontSize.cy + AUTO_HEIGHT_PADDING;
end;
EDITOR_COMMAND_GET_UNDO_LENGTH:
Result := FTextFile.HistoryManager.Count;
EDITOR_COMMAND_GET_UNDO_SIZE:
Result := FTextFile.HistoryManager.Size;
EDITOR_COMMAND_GET_UNDO_MAX_SIZE:
Result := FTextFile.HistoryManager.MaxSize;
EDITOR_COMMAND_SET_UNDO_MAX_SIZE:
FTextFile.HistoryManager.MaxSize := Param1;
EDITOR_COMMAND_GET_UNDO_FIRST_INDEX:
Result := FTextFile.HistoryManager.FirstItem;
EDITOR_COMMAND_GET_UNDO_LAST_INDEX:
Result := FTextFile.HistoryManager.LastItem;
EDITOR_COMMAND_GET_UNDO_POSITION:
Result := FTextFile.HistoryManager.HistoryIndex;
EDITOR_COMMAND_WINDOWS_MESSAGE:
Result := Perform(Param1, Param2, Param3);
EDITOR_COMMAND_COPY_ALL:
CopyAll;
EDITOR_COMMAND_COPY_LINE:
CopyLine;
EDITOR_COMMAND_FIND:
Result := Find(MakeFindQuery(PChar(Param1), Param2 <> 0, Param3 <> 0,
Param4 <> 0));
EDITOR_COMMAND_GET_FIND_COUNT:
Result := FTextFile.FindCount;
EDITOR_COMMAND_FIND_NEXT:
Result := FindNext;
EDITOR_COMMAND_FIND_PREV:
Result := FindPrevious;
EDITOR_COMMAND_FIND_FROM_TOP:
Result := FindFromTop;
EDITOR_COMMAND_GET_START_OVER:
Result := B(FStartOver);
EDITOR_COMMAND_SET_START_OVER:
FStartOver := Param1 <> 0;
EDITOR_COMMAND_REPLACE_ALL:
Result := ReplaceAll(MakeFindQuery(PChar(Param1), (Param3 and 1) <> 0,
(Param3 and 2) <> 0, (Param3 and 4) <> 0), PChar(Param2));
EDITOR_COMMAND_ADD_UNDO_RECORD:
AddUndoRecord(PChar(Param1), UNDONAMEID(Param2));
EDITOR_COMMAND_POSTTYPE:
PostType;
EDITOR_COMMAND_TYPE_TIMER_EMD:
TypeTimerEnd;
EDITOR_COMMAND_TYPE_TIMER_DISABLE:
FTypeTimer.Enabled := False;
EDITOR_COMMAND_TYPE_TIMER_DISCONNECT:
FTypeTimer.OnTimer := nil;
EDITOR_COMMAND_TYPE_TIMER_CONNECT:
FTypeTimer.OnTimer := TypeTimerTimer;
EDITOR_COMMAND_GET_ENABLED:
Result := B(Enabled);
EDITOR_COMMAND_SET_ENABLED:
Enabled := Param1 <> 0;
EDITOR_COMMAND_IS_FOCUSED:
Result := B(Focused);
EDITOR_COMMAND_TRY_FOCUS:
begin
Result := B(CanFocus);
if Result <> 0 then
SetFocus;
end;
EDITOR_COMMAND_GET_FIRST_VISIBLE_LINE:
Result := FirstVisibleLine(True);
EDITOR_COMMAND_GET_LAST_VISIBLE_LINE:
Result := LastVisibleLine(True);
EDITOR_COMMAND_RECOMPUTE_HOR_EXTENT:
begin
RecomputeHorizontalExtent;
Result := FCachedHorizontalExtent;
end;
EDITOR_COMMAND_ACTIVATE_CONTROL:
Result := ActivateControl;
EDITOR_COMMAND_REMOVE_LINE_CONTROL:
Result := B(FTextFile.DeleteControlAtLine(Param1));
EDITOR_COMMAND_ADD_LINE_CONTROL:
AddLineControl(TControl(Param1));
EDITOR_COMMAND_ADD_GRAPHICS:
AddGraphic(TGraphic(Param1));
EDITOR_COMMAND_INSERT_LINE_CONTROL:
InsertLineControl(TControl(Param1), Param2);
EDITOR_COMMAND_INSERT_GRAPHICS:
InsertGraphic(TGraphic(Param1), Param2);
EDITOR_COMMAND_TRIM_RIGHT:
TrimRight;
EDITOR_COMMAND_BOOKMARK_SET:
AddBookmark(Param1);
EDITOR_COMMAND_BOOKMARK_GO:
GotoBookmark(Param1);
EDITOR_COMMAND_BOOKMARK_CLEAR:
AddBookmark(Param1, EMPTY_BOOKMARK);
EDITOR_COMMAND_BOOKMARK_CLEAR_ALL:
ClearBookmarks;
EDITOR_COMMAND_CLASS_USE:
SetClass(CaretPos.Y, Classes[Param1].Name);
EDITOR_COMMAND_CLASS_REMOVE:
SetClass(CaretPos.Y, '');
EDITOR_COMMAND_SET_FP:
SetFormattingProcessor(TFormattingProcessor(Param1));
EDITOR_COMMAND_EXPORT_HTML:
ExportToHTML(PChar(Param1));
EDITOR_COMMAND_OPEN_URL_AT_CARET:
OpenURLAtCaret;
EDITOR_COMMAND_SELECT_LINE_INDEX:
SelectLine(Param1);
EDITOR_COMMAND_SELECT_LINE_RANGE:
SelectLines(Param1, Param2);
EDITOR_COMMAND_DISABLE_SCROLL_TO_CARET:
FNoScrollToCaret := True;
EDITOR_COMMAND_ENABLE_SCROLL_TO_CARET:
FNoScrollToCaret := False;
EDITOR_COMMAND_CREATE_SELECTION:
FTextFile.CaretPos.CreateSelection(Point(Param1, Param2),
Point(Param3, Param4), stLineBased);
EDITOR_COMMAND_CREATE_BLOCK_SELECTION:
FTextFile.CaretPos.CreateSelection(Point(Param1, Param2),
Point(Param3, Param4), stBlock);
EDITOR_COMMAND_GET_LINE_HIGHLIGHT:
Result := B(FLineHighlight);
EDITOR_COMMAND_SET_LINE_HIGHLIGHT:
SetLineHighlight(Param1 <> 0);
EDITOR_COMMAND_REDRAW_RULER:
UpdateRuler;
EDITOR_COMMAND_REDRAW_RULER_LINE:
UpdateRulerLine(Param1);
EDITOR_COMMAND_PRINT:
if Param1 <> 0 then
Print(PChar(Param1), Param2, Param3)
else
Print(Param2, Param3);
EDITOR_COMMAND_PRINT_SELECTION:
if Param1 <> 0 then
PrintSelection(PChar(Param1))
else
PrintSelection;
EDITOR_COMMAND_SET_PRINT_MARGINS:
begin
FPrintSettings.HorizontalMargin := Param1;
FPrintSettings.VerticalMargin := Param2;
end;
EDITOR_COMMAND_SET_PRINT_WW_OPTIONS:
begin
FPrintSettings.WordWrap := Param1 <> 0;
FPrintSettings.NiceWordWrap := Param2 <> 0;
if Param3 = 0 then
FPrintSettings.ShowWordWrapIcon := False
else
begin
FPrintSettings.ShowWordWrapIcon := True;
FPrintSettings.WordWrapIcon := Char(Param3);
FPrintSettings.WordWrapIconColor := TColor(Param4);
end;
end;
EDITOR_COMMAND_PRINT_DIALOG:
begin
with TPrintDialog.Create(nil) do
try
if FTextFile.HasSelection then
Options := [poSelection, poWarning]
else
Options := [poWarning];
if Execute then
if PrintRange = prSelection then
PrintSelection(SDefaultPrintJobTitle)
else
Print(SDefaultPrintJobTitle);
finally
Free;
end;
end;
EDITOR_COMMAND_GET_PRINT_VMARGIN:
Result := FPrintSettings.VerticalMargin;
EDITOR_COMMAND_GET_PRINT_HMARGIN:
Result := FPrintSettings.HorizontalMargin;
EDITOR_COMMAND_GET_PRINT_WW_OPTIONS:
Result := B(FPrintSettings.WordWrap) or
(B(FPrintSettings.NiceWordWrap) shl 16);
EDITOR_COMMAND_GET_PRINT_WW_CHAR:
if FPrintSettings.ShowWordWrapIcon then
Result := Ord(FPrintSettings.WordWrapIcon)
else
Result := 0;
EDITOR_COMMAND_GET_PRINT_WW_COLOR:
Result := FPrintSettings.WordWrapIconColor;
EDITOR_COMMAND_WORDWRAP:
WordWrap(Param1, Param2 <> 0, Char(Param3));
EDITOR_COMMAND_UPPER_CASE:
ChrTransformText(ChrUpperCase, STransformNameUpperCase);
EDITOR_COMMAND_LOWER_CASE:
ChrTransformText(ChrLowerCase, STransformNameLowerCase);
EDITOR_COMMAND_INVERT_CASE:
ChrTransformText(ChrInvertCase, STransformNameInvertCase);
EDITOR_COMMAND_SEL_UPPER_CASE:
ChrTransformSelection(ChrUpperCase, STransformNameUpperCase);
EDITOR_COMMAND_SEL_LOWER_CASE:
ChrTransformSelection(ChrLowerCase, STransformNameLowerCase);
EDITOR_COMMAND_SEL_INVERT_CASE:
ChrTransformSelection(ChrInvertCase, STransformNameInvertCase);
EDITOR_COMMAND_CAMEL_CASE:
TransformText(TxtCamelCase, STransformNameCamelCase);
EDITOR_COMMAND_SENTENCE_CASE:
TransformText(TxtSentenceCase, STransformNameSentenceCase);
EDITOR_COMMAND_SEL_CAMEL_CASE:
TransformSelection(TxtCamelCase, STransformNameCamelCase);
EDITOR_COMMAND_SEL_SENTENCE_CASE:
TransformSelection(TxtSentenceCase, STransformNameSentenceCase);
EDITOR_COMMAND_SEL_REVERSE:
TransformSelection(ReverseText, STransformNameReverse);
EDITOR_COMMAND_ROT13:
ChrTransformText(ChrRot13, STransformNameRot13);
EDITOR_COMMAND_SEL_ROT13:
ChrTransformSelection(ChrRot13, STransformNameRot13);
EDITOR_COMMAND_CAESAR:
if (Param1 <> 0) or TMultiInputBox.NumInputBox(GetParentForm(Self), SCaesarNTitle, SCaesarNText, Param1, Ord('A') - Ord('Z') - 1, Ord('Z') - Ord('A') + 1) then
ChrTransformText(ChrCaesar(Param1), Format(STransformNameCaesarN, [Param1]));
EDITOR_COMMAND_SEL_CAESAR:
if (Param1 <> 0) or TMultiInputBox.NumInputBox(GetParentForm(Self), SCaesarNTitle, SCaesarNText, Param1, Ord('A') - Ord('Z') - 1, Ord('Z') - Ord('A') + 1) then
ChrTransformSelection(ChrCaesar(Param1), Format(STransformNameCaesarN, [Param1]));
EDITOR_COMMAND_VIGENERE:
if Param2 <> 0 then
TransformText(TxtVigenère(PChar(Param2), Param1 <> 0), STransformNameVigenere)
else
if TMultiInputBox.TextInputBox(GetParentForm(Self), SVigenereTitle, SVigenereText, S, ecUpperCase, False, [aoCapitalAZ]) then
TransformText(TxtVigenère(S, Param1 <> 0), STransformNameVigenere);
EDITOR_COMMAND_SEL_VIGENERE:
if Param2 <> 0 then
TransformSelection(TxtVigenère(PChar(Param2), Param1 <> 0), STransformNameVigenere)
else
if TMultiInputBox.TextInputBox(GetParentForm(Self), SVigenereTitle, SVigenereText, S, ecUpperCase, False, [aoCapitalAZ]) then
TransformSelection(TxtVigenère(S, Param1 <> 0), STransformNameVigenere);
EDITOR_COMMAND_UPDATE_SCROLL_MODE:
UpdateScrollMode;
EDITOR_COMMAND_GET_SCROLL_MODE:
Result := B(FScrollMode);
EDITOR_COMMAND_SORT:
Result := B(Sort(Param1, Param2));
EDITOR_COMMAND_SORT_ALL:
Result := B(Sort);
EDITOR_COMMAND_SORT_SEL:
Result := B(SortSelection);
EDITOR_COMMAND_SET_LINE_COMPARER:
SetLineComparer(TLineComparer(Param1));
EDITOR_COMMAND_GET_LINE_COMPARER:
Result := Integer(@LineComparer);
EDITOR_COMMAND_SET_SORT_REVERSE:
SortReverseOrder := Param1 <> 0;
EDITOR_COMMAND_GET_SORT_REVERSE:
Result := B(SortReverseOrder);
EDITOR_COMMAND_MAKE_LINES_UNIQUE:
Result := B(MakeLinesUnique);
EDITOR_COMMAND_CLI_NEW_PROMPT:
CliNewPrompt;
EDITOR_COMMAND_CLI_WRITELN:
CliWriteLn(PChar(Param1), PChar(Param2));
EDITOR_COMMAND_ABORT_SCRIPT:
FAbortScript := True;
EDITOR_COMMAND_WRITE_INT:
SelText := IntToStr(Param1);
EDITOR_COMMAND_ABORT_SCRIPT_IF_EOL:
if FTextFile.AtOrBeyondEOL then
FAbortScript := True;
EDITOR_COMMAND_ABORT_SCRIPT_IF_LL:
if FTextFile.AtLastLine then
FAbortScript := True;
EDITOR_COMMAND_ABORT_SCRIPT_IF_EOF:
if FTextFile.AtOrBeyondEOF then
FAbortScript := True;
EDITOR_COMMAND_ABORT_SCRIPT_IF_SOF:
if FTextFile.AtSOF then
FAbortScript := True;
EDITOR_COMMAND_SET_SCRIPT_COUNTER:
FScriptCounter := Param1;
EDITOR_COMMAND_GET_SCRIPT_COUNTER:
Result := FScriptCounter;
EDITOR_COMMAND_GET_LINE_NUMBER_1:
Result := FTextFile.CaretPos.Y + 1;
EDITOR_COMMAND_GET_COL_NUMBER_1:
Result := FTextFile.CaretPos.X + 1;
EDITOR_COMMAND_WRITE_DATE:
SelText := DateToStr(Date);
EDITOR_COMMAND_WRITE_TIME:
SelText := TimeToStr(Time);
EDITOR_COMMAND_WRITE_DATETIME:
SelText := DateTimeToStr(Now);
EDITOR_COMMAND_GET_TICKCOUNT:
Result := GetTickCount;
EDITOR_COMMAND_GET_RANDOM_INTEGER:
if Param2 > Param1 then
Result := RandomRange(Param1, Param2)
else
Result := RandomRange(0, MaxInt);
EDITOR_COMMAND_FIX_REMOVED_LINE_CONTROLS:
FixRemovedLineControlLines;
EDITOR_COMMAND_CLI_HISTORY_UP:
Result := B(CliHistoryUp);
EDITOR_COMMAND_CLI_HISTORY_DOWN:
Result := B(CliHistoryDown);
EDITOR_COMMAND_CLI_HISTORY_CLEAR:
CliClearHistory;
EDITOR_COMMAND_CLI_HISTORY_ADD:
CliAddHistory(PChar(Param1));
EDITOR_COMMAND_CLI_GET_HISTORY_LENGTH:
Result := CliHistoryCount;
EDITOR_COMMAND_CLI_GET_HISTORY_INDEX:
Result := CliHistoryIndex;
EDITOR_COMMAND_CLI_HISTORY_RECALL:
Result := B(CliHistoryRecall(Param1));
EDITOR_COMMAND_BEGIN_ADD_LINES:
BeginAddLine;
EDITOR_COMMAND_END_ADD_LINES:
EndAddLine;
EDITOR_COMMAND_GET_LISTBOX_MODE:
Result := B(ListBoxMode);
EDITOR_COMMAND_SET_LISTBOX_MODE:
ListBoxMode := Param1 <> 0;
EDITOR_COMMAND_WRITE_STRING:
SelText := PChar(Param1);
EDITOR_COMMAND_WRITE_INPUT_DIALOG:
begin
S := PChar(Param3);
if TMultiInputBox.TextInputBox(GetParentForm(Self), PChar(Param1), PChar(Param2), S) then
SelText := S;
end;
EDITOR_COMMAND_SET_AS_HYPHEN_ASTERISK_TOGGLE:
FASHyphenAsteriskToggle := Param1 <> 0;
EDITOR_COMMAND_SET_MULTI_CHAR_SELECT:
MultiCharSelect := Param1 <> 0;
EDITOR_COMMAND_GET_MULTI_CHAR_SELECT:
Result := B(FMultiCharSelect);
EDITOR_COMMAND_SET_MULTI_CHAR_REPORT_VIEW:
MultiCharReportView := Param1 <> 0;
EDITOR_COMMAND_GET_MULTI_CHAR_REPORT_VIEW:
Result := B(FMultiCharReportView);
EDITOR_COMMAND_SET_NO_VERIFY_FONT:
FNoVerifyFont := Param1 <> 0;
EDITOR_COMMAND_SET_DOUBLE_BUFFERING:
DoubleBuffered := Param1 <> 0;
EDITOR_COMMAND_REPLACE_ALL_IN_SELECTION:
Result := ReplaceAll(MakeFindQuery(PChar(Param1), (Param3 and 1) <> 0,
(Param3 and 2) <> 0, (Param3 and 4) <> 0), PChar(Param2), True);
EDITOR_COMMAND_SET_BITMAP_EFFECT:
if InRange(Param1, Ord(Low(TBitmapEffect)), Ord(High(TBitmapEffect))) then
begin
Result := 1;
BitmapEffect := TBitmapEffect(Param1);
end
else
Result := 0;
EDITOR_COMMAND_GET_BITMAP_EFFECT:
Result := Ord(FBitmapEffect);
EDITOR_COMMAND_SET_DISABLED_EFFECT:
if InRange(Param1, Ord(Low(TBitmapEffect)), Ord(High(TBitmapEffect))) then
begin
Result := 1;
DisabledEffect := TBitmapEffect(Param1);
end
else
Result := 0;
EDITOR_COMMAND_GET_DISABLED_EFFECT:
Result := Ord(FDisabledEffect);
EDITOR_COMMAND_REPEAT:
for i := 1 to trunc(Param1) do
EditorCommand(Param2, Param3, Param4);
EDITOR_COMMAND_REPEAT_EX_SET_NUM:
FRepeatExNum := trunc(Param1);
EDITOR_COMMAND_REPEAT_EX_SET_COMMAND:
FRepeatExCommand := trunc(Param1);
EDITOR_COMMAND_REPEAT_EX:
for i := 1 to FRepeatExNum do
EditorCommand(FRepeatExCommand, Param1, Param2, Param3, Param4);
EDITOR_COMMAND_RESTORE_MARGINS:
RestoreAllMargins;
EDITOR_COMMAND_FILL_WITH_CHAR:
Result := B(FillWithChar(Char(Param1)));
EDITOR_COMMAND_PASTE_AS_BLOCK:
Result := B(PasteFromClipboardAsBlock);
EDITOR_COMMAND_TRUNCATE_AT:
TruncateAt(Param1, Param2, Param3, Char(Word(Param4)), Param4 and $FFFF0000 <> 0);
EDITOR_COMMAND_TRUNCATE_AT_IN_FILE:
TruncateAt(Param1, Char(Word(Param2)), Param3 <> 0);
EDITOR_COMMAND_TRUNCATE_AT_IN_SELECTION:
TruncateAtInSelection(Param1, Char(Word(Param2)), Param3 <> 0);
EDITOR_COMMAND_GET_JUST_OPENED:
Result := B(FTextFile.RecentlyOpened);
EDITOR_COMMAND_LOAD_DEFAULT_CLASSES:
LoadDefaultClasses;
EDITOR_COMMAND_BEGIN_VISUAL_UPDATE:
BeginVisualUpdate;
EDITOR_COMMAND_END_VISUAL_UPDATE:
EndVisualUpdate(Param1 <> 0);
EDITOR_COMMAND_SURROUND_SEL:
SurroundText(PChar(Param1), PChar(Param2));
EDITOR_COMMAND_FILTER_LINES:
if Param1 = SizeOf(TFilterOptions) then
begin
Filter(PFilterOptions(Param2)^);
Result := 1;
end
else
Result := 0;
EDITOR_COMMAND_UPDATE_SPI:
UpdateSPI;
EDITOR_COMMAND_SET_STRICT_READONLY:
FTextFile.StrictReadOnly := Param1 <> 0;
EDITOR_COMMAND_REMOVE_GHOST_BOOKMARKS:
Result := B(FTextFile.RemoveGhostBookmarks);
EDITOR_COMMAND_CHARACTER_FIND:
Result := Find(MakeFindQuery(Param1));
EDITOR_COMMAND_BACK:
DoNavRequest(EDITOR_COMMAND_BACK);
EDITOR_COMMAND_FORWARD:
DoNavRequest(EDITOR_COMMAND_FORWARD);
EDITOR_COMMAND_REFRESH:
DoNavRequest(EDITOR_COMMAND_REFRESH);
EDITOR_COMMAND_TOGGLE_CARET_BEYOND_EOL:
CaretAfterEOL := not CaretAfterEOL;
end;
end;
procedure TTextEditor.EndAddLine;
begin
FTextFile.EndAddLine;
end;
procedure TTextEditor.AbortScript;
begin
FAbortScript := True;
end;
function TTextEditor.ActivateControl: HWND;
var
ctl: TControl;
begin
Result := 0;
ctl := GetControlFromLine(CaretPos.Y);
if Assigned(ctl) and (ctl is TWinControl) then
begin
TWinControl(ctl).SetFocus;
Result := TWinControl(ctl).Handle;
end
else if Assigned(ctl) and (ctl is TImage) and Assigned(TImage(ctl).PopupMenu) then
begin
TImage(ctl).PopupMenu.PopupComponent := TImage(ctl);
with ClientToScreen(Point(0, GetLineTop(CaretPos.Y))) do
TImage(ctl).PopupMenu.Popup(X, Y);
Result := Handle;
end;
end;
procedure TTextEditor.ActivateLinks(ALinks: THyperlinks);
begin
FreeAndNil(FLinks);
FLinks := ALinks;
FCharLinkIndex := -1;
FMouseDownLinkIndex := -1;
FPrevCharLinkIndex := -1;
Invalidate;
end;
procedure TTextEditor.Escape(AAll: Boolean);
begin
if FTextFile = nil then
Exit;
if FMultipleCarets then
begin
FMultipleCarets := False;
SetLength(FCarets, 0);
Invalidate;
RemoveNotification(EN_MULTICARET);
if not AAll then Exit;
end;
if BalloonVisible then
begin
HideBalloon;
if not AAll then Exit;
end;
if (EditMode = emConsole) and FTextFile.AtLastLine and not AAll then
ClearLine;
end;
procedure TTextEditor.ExportToHTML(const FileName: TFileName);
function Q(const S: string): string;
begin
if Pos(#32, S) > 0 then
Result := '"' + S + '"'
else
Result := S;
end;
function MakeClassName(const S: string): string;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(S) do
if S[i].IsLetterOrDigit then
Result := Result + S[i];
end;
function HtmlEscape(const C: Char): string;
begin
if C = '<' then
Result := '<'
else if C = '>' then
Result := '>'
else if C = '&' then
Result := '&'
else
Result := C;
end;
var
SL: TStringList;
DocumentName, FPName: string;
Indent: string;
rules: TCSSRules;
oldc, c: Integer;
i: Integer;
j: Integer;
L: string;
begin
Indent := DupeString(#32, FIndentSize);
DocumentName := FTextFile.FileName;
if DocumentName = '' then
DocumentName := SDefaultFileName;
if Assigned(FFormattingProcessor) then
FPName := FFormattingProcessor.ClassName
else
FPName := SNoInteractiveFormattingParen;
SL := TStringList.Create;
try
SL.Add('<!DOCTYPE html>');
SL.Add('');
SL.Add('<html xmlns="http://www.w3.org/1999/xhtml">');
SL.Add('<head>');
SL.Add('');
SL.Add('<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />');
SL.Add('<title>' + ExtractFileName(DocumentName) + '</title>');
SL.Add('');
SL.Add('<style>');
SL.Add('main {');
SL.Add(Indent + 'background-color: ' + CSSColor(FBackgroundColor) + ';');
SL.Add(Indent + 'color: ' + CSSColor(FForegroundColor) + ';');
SL.Add('}');
SL.Add('pre {');
SL.Add(Indent + 'font-family: ' + Q(FFont.Name) + ', "DejaVu Sans Mono", Consolas, "Lucida Console", monospace;');
SL.Add('}');
if (Length(FClassArray) > 0) and FTextFile.UseLineClasses then
begin
SL.Add('');
for i := 0 to High(FClassArray) do
begin
SL.Add('.' + MakeClassName(FClassArray[i].Name) + ' {');
SL.Add(Indent + 'font-size: ' + IntToStr(FClassArray[i].Format.Size) + 'pt;');
SL.Add(Indent + 'color: ' + CSSColor(FClassArray[i].Format.Color) + ';');
if fsBold in FClassArray[i].Format.Style then
SL.Add(Indent + 'font-weight: ' + 'bold;');
if fsItalic in FClassArray[i].Format.Style then
SL.Add(Indent + 'font-style: ' + 'italic;');
if fsUnderline in FClassArray[i].Format.Style then
SL.Add(Indent + 'text-decoration: ' + 'underline;');
SL.Add('}');
end;
end;
if Assigned(FFormattingProcessor) then
begin
SL.Add('');
rules := FFormattingProcessor.GetCSSRules;
for i := Low(rules) to High(rules) do
begin
SL.Add('.' + rules[i].Selector + ' {');
for j := Low(rules[i].Declarations) to High(rules[i].Declarations) do
SL.Add(Indent + rules[i].Declarations[j].CSSProperty + ': ' + rules[i].Declarations[j].Value + ';');
SL.Add('}');
end;
end;
SL.Add('</style>');
SL.Add('');
SL.Add('</head>');
SL.Add('');
SL.Add('<body>');
SL.Add('');
SL.Add('<header>');
SL.Add('');
SL.Add(Indent + '<h1>' + ExtractFileName(DocumentName) + '</h1>');
SL.Add('');
SL.Add(Indent + '<dl>');
SL.Add(Indent + Indent + '<dt>' + SHTMLExportFileName + '</dt>');
SL.Add(Indent + Indent + '<dd>' + DocumentName + '</dd>');
SL.Add(Indent + Indent + '<dt>' + SHTMLExportDate + '</dt>');
SL.Add(Indent + Indent + '<dd><time>' + FormatDateTime('yyyy"-"mm"-"dd', Date) + '</time></dd>');
SL.Add(Indent + Indent + '<dt>' + SHTMLExportTime + '</dt>');
SL.Add(Indent + Indent + '<dd><time>' + FormatDateTime('hh":"mm":"ss', Time) + '</time></dd>');
SL.Add(Indent + Indent + '<dt>' + SHTMLExportFP + '</dt>');
SL.Add(Indent + Indent + '<dd>' + FPName + '</dd>');
SL.Add(Indent + '</dl>');
SL.Add('');
SL.Add('</header>');
SL.Add('');
SL.Add('<main>');
SL.Add('');
SL.Add(Indent + '<pre>');
oldc := -1;
c := -1;
for i := 0 to FTextFile.LineCount - 1 do
begin
L := '';
if LineClasses[i] <> '' then
L := '<span class="' + MakeClassName(LineClasses[i]) + '">';
if c <> -1 then
L := L + '<span class="' + rules[c].Selector + '">';
for j := 0 to FTextFile.PhysicalLineWidths[i] - 1 do
begin
if Assigned(FFormattingProcessor) then
c := FFormattingProcessor.GetCharCSSClass(i, j, FTextFile.Character[i, j]);
if c <> oldc then
begin
if oldc <> -1 then
L := L + '</span>';
if c shr 16 = 0 then
L := L + '<span class="' + rules[c].Selector + '">'
else
L := L + '<span class="' + rules[c and $FFFF].Selector + ' ' + rules[c shr 16].Selector + '">'
end;
L := L + HtmlEscape(FTextFile.Character[i, j]);
oldc := c;
end;
if c <> -1 then
L := L + '</span>';
if LineClasses[i] <> '' then
L := L + '</span>';
SL.Add(L);
end;
SL.Add('</pre>');
SL.Add('');
SL.Add('</main>');
SL.Add('');
SL.Add('</body>');
SL.Add('</html>');
SL.SaveToFile(FileName, TEncoding.UTF8);
finally
SL.Free;
end;
end;
function TTextEditor.CharInSet(AChar: Char; ASet: array of Char): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(ASet) to High(ASet) do
if AChar = ASet[i] then
Exit(True);
end;
function TTextEditor.CharLinkIndex(const ACaretPos: TPoint): Integer;
var
i: Integer;
begin
if FLinks = nil then
Exit(-1);
for i := 0 to FLinks.Count - 1 do
if ACaretPos.Y = FLinks[i].Location.Y then
if InRange(ACaretPos.X, FLinks[i].Location.X, FLinks[i].EndPos) then
Exit(i);
Result := -1;
end;
function TTextEditor.CharInAnyMultiCharSet(AChar: Char): Boolean;
begin
Result := CharInSet(AChar, MultiCharHyphen) or CharInSet(AChar, MultiCharAsterisk) or
CharInSet(AChar, MultiCharDoubleQuote) or CharInSet(AChar, MultiCharSingleQuote);
end;
procedure TTextEditor.KeyDown(var Key: Word; Shift: TShiftState);
var
c: Char;
PrevListBoxSelection: Boolean;
begin
inherited;
UpdateScrollMode;
if Key in [VK_SHIFT, VK_CONTROL, VK_MENU, VK_SCROLL] then
ChangeCursor(Shift);
if (EditMode = emConsole) and (Key = VK_F7) then
begin
CliHistoryDialogSelect(FCliHistoryDialogFormClass);
Exit;
end;
if (Key = VK_F9) and FMultiCharSelect then
begin
c := GetCharBeforeCaret;
if CharInSet(c, MultiCharHyphen) then
DoMultiCharSelect(MultiCharHyphen)
else if CharInSet(c, MultiCharAsterisk) then
DoMultiCharSelect(MultiCharAsterisk)
else if CharInSet(c, MultiCharDoubleQuote) then
DoMultiCharSelect(MultiCharDoubleQuote)
else if CharInSet(c, MultiCharSingleQuote) then
DoMultiCharSelect(MultiCharSingleQuote);
Exit;
end;
if FScrollMode then
begin
case Key of
VK_UP:
SetScrollPosY(FScrollPos.Y - IfThen(ssCtrl in Shift, 1, FFontSize.cy));
VK_DOWN:
SetScrollPosY(FScrollPos.Y + IfThen(ssCtrl in Shift, 1, FFontSize.cy));
VK_LEFT:
SetScrollPosX(FScrollPos.X - IfThen(ssCtrl in Shift, 1, FFontSize.cx));
VK_RIGHT:
SetScrollPosX(FScrollPos.X + IfThen(ssCtrl in Shift, 1, FFontSize.cx));
VK_PRIOR:
SetScrollPosY(FScrollPos.Y - ClientHeight);
VK_NEXT:
SetScrollPosY(FScrollPos.Y + ClientHeight);
VK_HOME:
SetScrollPosY(0);
VK_END:
SetScrollPosY(FTextFile.LineCount * FFontSize.cy - ClientHeight);
end;
Exit;
end;
if [ssShift, ssCtrl] <= Shift then
case Key of
VK_UP:
begin
ListBoxSelection := True;
SwapLinesAbove;
Exit;
end;
VK_DOWN:
begin
ListBoxSelection := True;
SwapLinesBelow;
Exit;
end;
Ord('1')..Ord('9'):
if FHandleBookmarkHotkeys then
begin
AddBookmark(Key - Ord('0'));
Exit;
end;
end;
if (ssCtrl in Shift) and (FTextFile.EditMode = emText) then
case Key of
VK_UP:
begin
with GetLastMultiCaret do
if Y > 0 then
CreateNewCaretAt(Point(X, Y - 1));
Exit;
end;
VK_DOWN:
begin
with GetLastMultiCaret do
if Y < LineCount - 1 then
CreateNewCaretAt(Point(X, Y + 1));
Exit;
end;
end;
if FHandleBookmarkHotkeys and (Shift = [ssCtrl]) and
(Key in [Ord('1')..Ord('9')]) then
begin
GotoBookmark(Ord(key) - Ord('0'));
Exit;
end;
PrevListBoxSelection := FListBoxSelection;
if
Key in
[
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END, VK_PRIOR, VK_NEXT
]
then
ListBoxSelection := not FTextFile.Empty;
case Key of
VK_BACK:
Backspace(ssCtrl in Shift);
VK_DELETE:
begin
Delete(ssCtrl in Shift);
if FMatchBrackets then
TextFileCaretPosChange(Self);
end;
VK_LEFT:
if not FListBoxMode then
FTextFile.Left(ssCtrl in Shift, ssShift in Shift, ssAlt in Shift);
VK_RIGHT:
if not FListBoxMode then
FTextFile.Right(ssCtrl in Shift, ssShift in Shift, ssAlt in Shift);
VK_UP:
if (FTextFile.EditMode = emConsole) and FTextFile.AtLastLine and not (ssCtrl in Shift) and not FTextFile.HasSelection then
CliHistoryUp
else if FListBoxMode and not PrevListBoxSelection and not FTextFile.Empty then
ListBoxSelection := True
else if FMultiSize and not (ssAlt in Shift) then
GotoSamePixelAtPrevLine(ssShift in Shift)
else
FTextFile.Up(ssShift in Shift, ssAlt in Shift);
VK_DOWN:
if (FTextFile.EditMode = emConsole) and FTextFile.AtLastLine and not (ssCtrl in Shift) and not FTextFile.HasSelection then
CliHistoryDown
else if FListBoxMode and not PrevListBoxSelection and not FTextFile.Empty then
ListBoxSelection := True
else if FMultiSize and not (ssAlt in Shift) then
GotoSamePixelAtNextLine(ssShift in Shift)
else
FTextFile.Down(ssShift in Shift, ssAlt in Shift);
VK_RETURN:
begin
if FAutoReplace then DoAutoReplace;
Return;
end;
VK_HOME:
if FListBoxMode and (LineCount <> 0) then
CaretPos := Point(0, 0)
else
FTextFile.Home(ssCtrl in Shift, ssShift in Shift);
VK_END:
if FListBoxMode and (LineCount <> 0) then
CaretPos := Point(0, LineCount - 1)
else
FTextFile.KEnd(ssCtrl in Shift, ssShift in Shift);
VK_PRIOR:
PageUp(ssShift in Shift);
VK_NEXT:
PageDown(ssShift in Shift);
VK_INSERT:
SetOverwrite(not FOverwrite);
VK_ESCAPE:
Escape;
VK_PAUSE:
if not FTextFile.StrictReadOnly and not FListBoxMode then
case EditMode of
emText:
EditMode := emReadOnly;
emConsole: ;
emReadOnly:
EditMode := emText;
end;
end;
if FHandleHotkeys then
begin
if [ssShift, ssCtrl] <= Shift then
case Key of
Ord('A'):
begin
if not FTextFile.SelectWord then
TextFileInputError(Self);
Exit;
end;
end;
if Shift = [ssCtrl] then
case Key of
Ord('Z'):
Undo;
Ord('Y'):
Redo;
Ord('X'):
CutToClipboard;
Ord('C'):
CopyToClipboard;
Ord('V'):
PasteFromClipboard;
Ord('D'):
ClearLine;
Ord('A'):
SelectAllNone;
Ord('L'):
SelectLine;
Ord('U'):
ReplaceCodepoint;
Ord('M'):
EnterMultiCaretMode;
Ord('H'):
Backspace;
Ord('J'):
InsertChar(#9, FOverwrite);
VK_OEM_PLUS, VK_ADD:
ZoomIn;
VK_OEM_MINUS, VK_SUBTRACT:
ZoomOut;
Ord('0'), VK_NUMPAD0:
ResetZoom;
VK_F1:
ChInfoBalloon;
end;
end;
end;
procedure TTextEditor.EnterMultiCaretMode;
begin
if EditMode <> emText then Exit;
if not FMultipleCarets then
begin
NotifyApp(EN_MULTICARET);
FMultipleCarets := True;
CreateNewCaretAt(CaretPos);
end;
end;
procedure TTextEditor.CreateNewCaretAt(const APoint: TPoint);
var
i: Integer;
begin
if EditMode <> emText then Exit;
EnterMultiCaretMode;
for i := Low(FCarets) to High(FCarets) do
if SamePoint(FCarets[i], APoint) then
Exit;
SetLength(FCarets, Length(FCarets) + 1);
FCarets[High(FCarets)] := APoint;
Invalidate;
end;
function TTextEditor.ReplaceAll(const FindQuery: TFindQuery;
const ReplaceText: string; SelOnly: Boolean = False): Integer;
begin
if FTextFile.SingleLine and FindQuery.Linebreak then
Exit(0);
TypeTimerEnd;
FTextFile.Find(FindQuery, True);
Result := FTextFile.ReplaceAll(ReplaceText, SelOnly);
if Result > 0 then AddUndoRecord(Format(SUndoReplacedAll,
[Result, FindQuery.SearchString, ReplaceText]), UID_UNKNOWN);
end;
procedure TTextEditor.ReplaceCodepoint;
begin
TypeTimerEnd;
if FTextFile.ReplaceCodepoint then
AddUndoRecord(SUndoUnicodeReplacedCodepoint, UID_UNKNOWN);
end;
procedure TTextEditor.ResetZoom;
begin
Zoom := 100;
end;
procedure TTextEditor.RestoreAllMargins;
begin
if TextFile.ControlAware then Exit;
FMarginLeft := DEFAULT_MARGIN_LEFT;
FMarginRight := DEFAULT_MARGIN_RIGHT;
FMarginTop := DEFAULT_MARGIN_TOP;
FMarginBottom := DEFAULT_MARGIN_BOTTOM;
FRulerWidth := DEFAULT_RULER_WIDTH;
UpdateScrollBars;
Invalidate;
DoSetCaretPos;
end;
procedure TTextEditor.RestoreWrapAt(const Value: Boolean);
begin
if csDesigning in ComponentState then
begin
if MessageBox(0, PChar(SRestoreWrapAtText), PChar(SRestoreWrapAtCaption), MB_ICONQUESTION or MB_YESNOCANCEL) = ID_YES then
WrapAt := DEFAULT_WRAP_AT
end
else
WrapAt := DEFAULT_WRAP_AT;
end;
procedure TTextEditor.MoveBalloonPostScroll;
var
p: TPoint;
begin
if BalloonVisible then
if Ord(FBalloonPersistence) <= Ord(bpScroll) then
HideBalloon
else
begin
p := GetBalloonPosition;
if PtInRect(TextContentRect, ScreenToClient(p)) then
SendMessage(FHintWindow, TTM_TRACKPOSITION, 0, MakeLParam(p.x, p.y))
else
HideBalloon;
end;
end;
procedure TTextEditor.MoveSelection(const ANewPos: TPoint);
var
S: string;
begin
if FTextFile.IsCharSel(ANewPos) then Exit;
TypeTimerEnd;
S := SelText;
FTextFile.AddBookmark(INTERNAL_BOOKMARK, ANewPos);
try
FTextFile.ClearSelection;
FTextFile.GotoBookmark(INTERNAL_BOOKMARK);
FTextFile.InsertText(S);
AddUndoRecord(SUndoMouseMove, UID_DRAGDROP);
finally
FTextFile.AddBookmark(INTERNAL_BOOKMARK, EMPTY_BOOKMARK);
end;
end;
procedure TTextEditor.Return;
var
accept: Boolean;
S: string;
Idx: Integer;
begin
if FMultipleCarets then
begin
TextFileInputError(Self);
Exit;
end;
if FListBoxMode then
begin
if Assigned(FOnListBoxSelect) and (ListBoxItemIndex <> -1) then
FOnListBoxSelect(Self);
Exit;
end;
if (EditMode = emConsole) and FTextFile.AtLastLine then
begin
S := Lines[LineCount - 1];
accept := True;
if Assigned(FOnCliInput) then
FOnCliInput(Self, S, accept);
if accept then
begin
CliAddHistory(S);
CliNewPrompt;
end;
Exit;
end;
if (EditMode = emReadOnly) and Assigned(FLinks) then
begin
Idx := CharLinkIndex(CaretPos);
if InRange(Idx, 0, FLinks.Count - 1) then
DoHyperlinkClicked(FLinks[Idx]);
end;
FTextFile.Return;
PostType;
end;
procedure TTextEditor.Backspace(Word: Boolean = False);
begin
if FMultipleCarets then
FTextFile.MultiBackspace(FCarets)
else
FTextFile.Backspace(Word);
PostType;
end;
function TTextEditor.BalloonVisible: Boolean;
begin
Result := (FHintWindow <> 0) and
(SendMessage(FHintWindow, TTM_GETCURRENTTOOL, 0, 0) <> 0);
end;
procedure TTextEditor.BeginAddLine;
begin
FTextFile.BeginAddLine;
end;
procedure TTextEditor.SwapLinesAbove;
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
if FTextFile.SwapLinesAbove then
AddUndoRecord(SUndoLinesSwapped, UID_UNKNOWN);
end;
procedure TTextEditor.SwapLinesBelow;
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
if FTextFile.SwapLinesBelow then
AddUndoRecord(SUndoLinesSwapped, UID_UNKNOWN);
end;
procedure TTextEditor.DoAutoReplace;
var
StartPos, Index: Integer;
begin
if FTextFile.CanAutoReplace(StartPos, Index) then
begin
TypeTimerEnd;
FTextFile.DoAutoReplace(StartPos, Index);
AddUndoRecord(SUndoAutoReplaced, UID_UNKNOWN);
end;
end;
procedure TTextEditor.DoHyperlinkClicked(AHyperlink: THyperlink);
begin
if Assigned(FOnHyperlinkClick) then
FOnHyperlinkClick(Self, AHyperlink.ToRecord);
end;
procedure TTextEditor.KeyPress(var Key: Char);
var
PrevCh: Char;
begin
inherited;
if (EditMode = emConsole) and not FTextFile.AtLastLine and not Key.IsControl then
FTextFile.GotoEOF;
if Key = #9 then
begin
if (EditMode = emReadOnly) and Assigned(FLinks) then
begin
if IsKeyDown(VK_SHIFT) then
PrevHyperlink
else
NextHyperlink;
Exit;
end;
InsertText(DupeString(#32, FTabLength));
Exit;
end;
if Key.IsControl or FScrollMode then Exit;
if FAutoReplace and not Key.IsLetterOrDigit then
DoAutoReplace;
if FASHyphenAsteriskToggle then
begin
PrevCh := GetCharBeforeCaret;
if (PrevCh = '-') and (Key = '-') then
begin
FTextFile.Character[CaretPos.Y, CaretPos.X - 1] := #$2212;
Exit;
end;
if (PrevCh = #$2212) and (Key = '-') then
begin
FTextFile.Character[CaretPos.Y, CaretPos.X - 1] := '-';
Exit;
end;
if (PrevCh = #$22C5) and (Key = '*') then
begin
FTextFile.Character[CaretPos.Y, CaretPos.X - 1] := #$00D7;
Exit;
end;
if (PrevCh = #$00D7) and (Key = '*') then
begin
FTextFile.Character[CaretPos.Y, CaretPos.X - 1] := '*';
Exit;
end;
if (PrevCh = '*') and (Key = '*') then
begin
FTextFile.Character[CaretPos.Y, CaretPos.X - 1] := #$22C5;
Exit;
end;
end;
InsertChar(Key, FOverwrite);
if FMultiCharSelect and not FScriptRunning then
if CharInAnyMultiCharSet(Key) then
NotifyAppWithTimer(EN_MULTICHAR);
end;
procedure TTextEditor.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited;
if Key = VK_MENU then
UpdateScrollMode;
if Key in [VK_SHIFT, VK_CONTROL, VK_MENU, VK_SCROLL] then
ChangeCursor(Shift);
end;
function TTextEditor.GetFunctionalSelectionBarWidth: Integer;
begin
Result := FRulerWidth;
case FSelectionBarBehaviour of
sbbAlwaysSelect:
Result := FMarginLeft;
sbbNeverSelect:
Result := FRulerWidth;
sbbAuto:
if FRulerWidth > 0 then
Result := FRulerWidth
else
Result := FMarginLeft;
sbbAutoMixed:
if FRulerWidth > 0 then
Result := FRulerWidth
else
Result := FMarginLeft div 2;
end;
end;
procedure TTextEditor.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
ChSel: Boolean;
R: TRect;
begin
inherited;
UpdateScrollMode;
FExpectDragDrop := False;
FDragButton := mbLeft;
FMouseContSel := False;
FPrevCursorX := X;
FPrevCursorY := Y;
FMouseDownX := X;
FMouseDownY := Y;
if CanFocus and not Focused then
SetFocus;
ChangeCursor(Shift, Y, X);
if FMultipleCarets then
begin
CreateNewCaretAt(CharAtPhysicalPixelEx(Point(X, Y), True));
Exit;
end;
if FScrollMode then
begin
Exit;
end;
if FDoubleClicking then
begin
FDoubleClicking := False;
ControlState := ControlState - [csLButtonDown];
Exit;
end;
if X < GetFunctionalSelectionBarWidth then
begin
FRegion := terSelectionBar;
if Button = mbLeft then
begin
SelectLine(CaretPosAtPhysicalPixel(Point(X, Y)).Y);
FSelectionBarInitialLine := CaretPos.Y;
R := LeftColumnRect;
with ClientToScreen(Point(0, 0)) do OffsetRect(R, X, Y);
ClipCursor(@R);
end;
Exit;
end;
FRegion := terText;
ChSel := (X >= FMarginLeft) and FTextFile.IsCharSel(CharAtPhysicalPixel(Point(X, Y)));
if ChSel and (Button in [mbLeft, mbRight]) and not SingleLine then
begin
FExpectDragDrop := True;
FDragButton := Button;
Exit;
end;
if Assigned(FLinks) then
begin
FMouseDownLinkIndex := CharLinkIndex(CharAtPhysicalPixel(Point(X,Y)));
if InRange(FMouseDownLinkIndex, 0, FLinks.Count - 1) then
FTextFile.CaretPos.SetPoint(FLinks[FMouseDownLinkIndex].Location, False);
end
else
FMouseDownLinkIndex := -1;
if (((Button in [mbLeft, mbRight]) and not ChSel) or (SingleLine and (Button = mbLeft))) and (FMouseDownLinkIndex = -1) then
begin
SetListBoxSelection(True);
FTextFile.CaretPos.SetPoint(CaretPosAtPhysicalPixel(Point(X,Y)), ssShift in Shift);
FMouseContSel := True;
end;
end;
procedure TTextEditor.MouseMove(Shift: TShiftState; X, Y: Integer);
var
ΔX, ΔY: Integer;
P: TPoint;
OLEDidDrop: Boolean;
DropEffect: Integer;
begin
inherited;
if FOLEDragging then
Exit;
ΔX := X - FPrevCursorX;
ΔY := Y - FPrevCursorY;
FPrevCursorX := X;
FPrevCursorY := Y;
ChangeCursor(Shift, Y, X);
if FScrollMode and (csLButtonDown in ControlState) then
begin
SetScrollPosXY(FScrollPos.X - ΔX, FScrollPos.Y - ΔY);
Exit;
end;
if FExpectDragDrop and
((Abs(X - FMouseDownX) > FXDRAG) or (Abs(Y - FMouseDownY) > FYDRAG)) and
(((FDragButton = mbLeft) and IsKeyDown(VK_LBUTTON)) or ((FDragButton = mbRight) and IsKeyDown(VK_RBUTTON))) and
not SingleLine then
begin
FExpectDragDrop := False;
if ControlInSelection then
begin
TextFileInputError(Self);
Exit;
end;
OLEDidDrop := False;
FOLEDragging := True;
FOLEInternalDrop := False;
FDragButtonOLE := IfThen(FDragButton = mbRight, MK_RBUTTON, MK_LBUTTON);
try
OLEDidDrop := DoDragDrop(
TTextEditorDataObject.Create(Self),
Self,
DROPEFFECT_COPY or IfThen(EditMode <> emReadOnly, DROPEFFECT_MOVE),
DropEffect
) = DRAGDROP_S_DROP;
finally
FOLEDragging := False;
FMouseContSel := False;
if not IsKeyDown(VK_LBUTTON) then
ControlState := ControlState - [csLButtonDown];
if OLEDidDrop then
begin
if FOLEInternalDrop then
begin
case DropEffect of
DROPEFFECT_MOVE:
MoveSelection(FDropLocation);
DROPEFFECT_COPY:
CopySelection(FDropLocation);
end;
end
else
if DropEffect = DROPEFFECT_MOVE then
begin
TypeTimerEnd;
FTextFile.ClearSelection;
AddUndoRecord(SUndoMouseMoveExtDst, UID_DRAGDROP);
end;
end;
end;
Exit;
end;
if FMouseContSel and IsKeyDown(VK_LBUTTON) and (FRegion = terText) then
begin
if ssCtrl in Shift then
SelectionType := stBlock;
P := CaretPosAtPhysicalPixel(Point(X, Y));
if (not FTextFile.HasSelection) and (FTextFile.CaretPos.Y = P.Y) and
(FTextFile.CaretPos.X >= FTextFile.VirtualLineWidths[FTextFile.CaretPos.Y]) and
(P.X >= FTextFile.VirtualLineWidths[FTextFile.CaretPos.Y]) and
(FTextFile.CaretPos.SelectionType = stLineBased) then
FTextFile.CaretPos.SetPoint(P, False)
else
FTextFile.CaretPos.SetPoint(P, True);
end;
if (csLButtonDown in ControlState) and (FRegion = terSelectionBar) then
SelectLines(FSelectionBarInitialLine, CaretPosAtPhysicalPixel(Point(X, Y)).Y);
if Assigned(FLinks) then
begin
P := CharAtPhysicalPixel(Point(X, Y));
FCharLinkIndex := CharLinkIndex(P);
if FCharLinkIndex <> FPrevCharLinkIndex then
begin
if InRange(FPrevCharLinkIndex, 0, FLinks.Count - 1) then
with FLinks[FPrevCharLinkIndex] do
VisualUpdate(ctBlock, Location.Y, Location.Y, Location.X, EndPos);
if InRange(FCharLinkIndex, 0, FLinks.Count - 1) then
with FLinks[FCharLinkIndex] do
begin
VisualUpdate(ctBlock, Location.Y, Location.Y, Location.X, EndPos);
Hint := URL;
end
else
Hint := '';
end;
FPrevCharLinkIndex := FCharLinkIndex;
end;
end;
procedure TTextEditor.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
Idx: Integer;
begin
inherited;
FExpectDragDrop := False;
FDragButton := mbLeft;
FMouseContSel := False;
if FOLEDragging then
begin
FMouseDownLinkIndex := -1;
Exit;
end;
ClipCursor(nil);
if not FScrollMode and Assigned(FLinks) and (FCharLinkIndex <> -1) then
begin
Idx := CharLinkIndex(CharAtPhysicalPixel(Point(X, Y)));
if InRange(Idx, 0, FLinks.Count - 1) and (Idx = FMouseDownLinkIndex) then
DoHyperlinkClicked(FLinks[Idx]);
end;
FMouseDownLinkIndex := -1;
end;
procedure TTextEditor.NewFile;
var
WasControlAware: Boolean;
begin
Escape(True);
WasControlAware := FTextFile.ControlAware;
FTypeTimer.Enabled := False;
ListBoxSelection := False;
FTextFile.NewFile;
ClearControls;
CliClearHistory;
FMultiSize := False;
AddUndoRecord(SUndoNewFile, UID_UNKNOWN);
UpdateCaret;
if WasControlAware then
RestoreAllMargins;
end;
procedure TTextEditor.NextHyperlink;
var
i: Integer;
begin
if (FLinks = nil) or (FLinks.Count = 0) then
Exit;
for i := 0 to FLinks.Count - 1 do
if (FLinks[i].Location.Y > CaretPos.Y) or ((FLinks[i].Location.Y = CaretPos.Y) and (FLinks[i].Location.X > CaretPos.X)) then
begin
CaretPos := FLinks[i].Location;
Break;
end;
end;
function TTextEditor.NonRulerRect: TRect;
begin
Result := ClientRect;
Inc(Result.Left, FRulerWidth);
end;
function TTextEditor.NotifyApp(const MsgID: Integer): Boolean;
var
i: Integer;
j: Integer;
begin
Result := Assigned(FOnNotification) or Assigned(FOnSimpleNotification);
for i := 0 to High(FNotifications) do
if FNotifications[i] = MsgID then
begin
for j := i to High(FNotifications) - 1 do
FNotifications[j] := FNotifications[j + 1];
SetLength(FNotifications, High(FNotifications));
end;
SetLength(FNotifications, Length(FNotifications) + 1);
FNotifications[High(FNotifications)] := MsgID;
if Assigned(FOnNotification) then
FOnNotification(Self, MsgID);
if Assigned(FOnSimpleNotification) then
FOnSimpleNotification(Self, MsgID, FNotificationStrs[MsgID]);
end;
function TTextEditor.NotifyAppWithTimer(const MsgID: Integer): Boolean;
begin
Result := NotifyApp(MsgID);
if SetTimer(Handle, EDITOR_NOTIFY or MsgID, FNotifyMsgDuration, nil) = 0 then
RaiseLastOSError;
end;
function TTextEditor.OpenURLAtCaret: Boolean;
var
Idx: Integer;
URL: string;
begin
Idx := CharLinkIndex(CaretPos);
if Assigned(FLinks) and InRange(Idx, 0, FLinks.Count - 1) then
begin
DoHyperlinkClicked(FLinks[Idx]);
Exit(True);
end;
Result := GetURLAtCaret(URL) and
(ShellExecute(0, nil, PChar(URL), nil, nil, SW_SHOWNORMAL) > 32);
end;
procedure TTextEditor.DblClick;
begin
inherited;
FDoubleClicking := True;
if FListBoxMode then
begin
if Assigned(FOnListBoxSelect) and (ListBoxItemIndex <> -1) then
FOnListBoxSelect(Self);
Exit;
end;
if not SelectWord then
TextFileInputError(Self);
end;
procedure TTextEditor.Delete(Word: Boolean);
begin
FTextFile.Delete(Word);
PostType;
end;
procedure TTextEditor.DeleteAllLineControls;
var
i: Integer;
begin
for i := 0 to FTextFile.LineCount - 1 do
if FTextFile.Classes[i] = LINE_CONTROL_CLASS then
begin
FTextFile.Classes[i] := '';
FTextFile.Lines[i] := '';
end;
if FMultiSize then
begin
RebuildLineCache;
RecomputeHorizontalExtent;
UpdateScrollBars;
end;
Invalidate;
UpdateCaret;
try
for i := 0 to High(FLineControls) do
FLineControls[i].Control.Free;
finally
SetLength(FLineControls, 0);
end;
FTextFile.ControlAware := False;
CheckCaretBeyondEOL;
end;
function TTextEditor.DeleteControlAtLine(const LineIndex: Integer): Boolean;
begin
Result := FTextFile.DeleteControlAtLine(LineIndex);
if Length(FLineControls) = 0 then
FTextFile.ControlAware := False;
end;
procedure TTextEditor.CheckCaretBeyondEOL;
begin
if (not CaretAfterEOL) and (not FTextFile.HasSelection) and (CaretPos.X > FTextFile.VirtualLineWidths[CaretPos.Y]) then
FTextFile.KEnd;
end;
procedure TTextEditor.ChInfoBalloon;
var
C: Char;
S: string;
const
YesNoStr: array[Boolean] of string = ('No', 'Yes');
begin
C := GetCharAtCaret;
S := Format('%s'#13#10'%s',
[
UCD.GetChrCodepointStr(C),
UCD.GetChrBlock(C)
]
);
ShowBalloon(UCD.GetChrName(C), S, bikInfo, bpCaretPos, CaretPos);
end;
destructor TTextEditor.Destroy;
begin
if Assigned(FInstances) then
FInstances.Remove(Self);
OleUninitialize;
FBlinkRemover.Free;
FTypeTimer.Free;
FCustomMenuItems.Free;
FDropMenu.Free;
FRulerFont.Free;
FRulerMenu.Free;
FListboxMenu.Free;
FImagePopup.Free;
if Assigned(FPopupMenu) then FPopupMenu.CloseMenu;
FPopupMenu.Free;
FFont.Free;
if FTextFileOwner = tfoEditor then
FreeAndNil(FTextFile);
FFONTBM.Free;
FGLYPHBM.Free;
FFallbackFonts.Free;
FreeFontDataArray;
FBalloonTimer.Free;
FPrintSettings.Free;
FPDict.Free;
FCliHistory.Free;
FLinks.Free;
inherited;
end;
procedure TTextEditor.DestroyWnd;
begin
RevokeDragDrop(Handle);
inherited;
end;
function TTextEditor.FileIsEmpty: Boolean;
begin
Result := (FTextFile.LineCount = 1) and FTextFile.LineIsEmpty(0) and (FTextFile.Classes[0] = '');
end;
function TTextEditor.FillWithChar(const AChar: Char): Boolean;
begin
TypeTimerEnd;
Result := FTextFile.FillWithChar(AChar);
if Result then
AddUndoRecord(Format(SUndoFillWithChar, [AChar]), UID_UNKNOWN);
end;
procedure TTextEditor.Filter(const Contains, Starts, Ends: string;
CaseSensitive, RemoveMatches: Boolean);
var
FilterOptions: TFilterOptions;
begin
FilterOptions.RemoveMatchingLines := RemoveMatches;
FilterOptions.Contains := Contains;
FilterOptions.StartsWith := Starts;
FilterOptions.EndsWith := Ends;
FilterOptions.MatchCase := CaseSensitive;
Filter(FilterOptions);
end;
procedure TTextEditor.Filter(const AFilterOptions: TFilterOptions);
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.Filter(AFilterOptions);
AddUndoRecord(SUndoLinesFiltered, UID_UNKNOWN);
end;
procedure TTextEditor.AddLine(const AText: string; const AClassName: string);
begin
if FTextFile = nil then
Exit;
if FListBoxMode then EditMode := emText;
if FileIsEmpty then
begin
Lines[0] := AText;
if AClassName <> '' then
LineClasses[0] := AClassName;
end
else
FTextFile.AddLine(AText, AClassName);
if FListBoxMode then EditMode := emReadOnly;
end;
procedure TTextEditor.UpdateFontBoxSize(ClassIndex: Integer);
begin
FFONTBM.Canvas.Font.Assign(FFont);
FFONTBM.Canvas.Font.Size := Ceil(FClassArray[ClassIndex].Format.Size * FZoom / 100);
FFONTBM.Canvas.Font.Style := FClassArray[ClassIndex].Format.Style;
FFONTBM.Canvas.Font.Color := FClassArray[ClassIndex].Format.Color;
FClassArray[ClassIndex].Format.BoxSize := FFONTBM.Canvas.TextExtent('M');
end;
procedure TTextEditor.UpdateFontBoxSizes;
var
i: Integer;
begin
for i := 0 to High(FClassArray) do
UpdateFontBoxSize(i);
end;
procedure TTextEditor.BookmarkHistoryRecord(const APoint: TPoint);
begin
if SamePoint(APoint, EMPTY_BOOKMARK) then
AddUndoRecord(SUndoBookmarkCleared, UID_UNKNOWN)
else
AddUndoRecord(SUndoBookmarkAdded, UID_UNKNOWN)
end;
procedure TTextEditor.UpdateRulerLine(const ALineIndex: Integer);
begin
if InRange(ALineIndex, 0, LineCount - 1) then
InvalidateRect(Handle,
Rect(0, GetLineTop(ALineIndex), FRulerWidth, GetLineBottom(ALineIndex)),
False);
end;
function TTextEditor.AddBookmark(const APoint: TPoint): Integer;
begin
if FTextFile = nil then
raise Exception.Create('No text file.');
TypeTimerEnd;
Result := FTextFile.AddBookmark(APoint);
if Result <> -1 then
begin
BookmarkHistoryRecord(APoint);
UpdateRulerLine(APoint.Y);
end;
end;
procedure TTextEditor.AddBookmark(AIndex: Integer);
var
OldLine: Integer;
begin
if FTextFile = nil then
raise Exception.Create('No text file.');
OldLine := Bookmarks[AIndex].Y;
TypeTimerEnd;
FTextFile.AddBookmark(AIndex);
AddUndoRecord(SUndoBookmarkAdded, UID_UNKNOWN);
UpdateRulerLine(OldLine);
UpdateRulerLine(CaretPos.Y);
end;
procedure TTextEditor.AddBookmark(AIndex: Integer; const APoint: TPoint);
var
OldLine: Integer;
begin
if FTextFile = nil then
raise Exception.Create('No text file.');
OldLine := Bookmarks[AIndex].Y;
TypeTimerEnd;
FTextFile.AddBookmark(AIndex, APoint);
BookmarkHistoryRecord(APoint);
UpdateRulerLine(OldLine);
UpdateRulerLine(APoint.Y);
end;
function TTextEditor.AddBookmark: Integer;
begin
if FTextFile = nil then
raise Exception.Create('No text file.');
TypeTimerEnd;
Result := FTextFile.AddBookmark;
if Result <> -1 then
begin
AddUndoRecord(SUndoBookmarkAdded, UID_UNKNOWN);
UpdateRulerLine(CaretPos.Y);
end;
end;
procedure TTextEditor.AddClass(const AClassRecord: TClassRecord);
var
i: Integer;
begin
for i := Low(FClassArray) to High(FClassArray) do
if SameStr(AClassRecord.Name, FClassArray[i].Name) then
begin
FClassArray[i].Format := AClassRecord.Format;
UpdateFontBoxSize(i);
Exit;
end;
SetLength(FClassArray, Length(FClassArray) + 1);
FClassArray[High(FClassArray)] := AClassRecord;
UpdateFontBoxSize(High(FClassArray));
end;
procedure TTextEditor.AddGraphic(AGraphic: TGraphic);
begin
InsertGraphic(AGraphic, LineCount - 1);
end;
procedure TTextEditor.AddIndent;
begin
if FTextFile = nil then
Exit;
TypeTimerEnd;
FTextFile.AddIndent;
AddUndoRecord(SUndoIndentIncreased, UID_UNKNOWN);
end;
procedure TTextEditor.AddLine;
begin
AddLine('', '');
end;
procedure TTextEditor.AddLineControl(AControl: TControl);
begin
InsertLineControl(AControl, LineCount);
end;
procedure TTextEditor.AddMenuItem(AMenuItem: TMenuItem);
begin
if FCustomMenuItems = nil then
Exit;
if AMenuItem = nil then
Exit;
FCustomMenuItems.Add(AMenuItem);
end;
procedure TTextEditor.AddMenuItems(AMenu: TMenuItem);
var
i: Integer;
begin
if FCustomMenuItems = nil then
Exit;
if AMenu = nil then
Exit;
for i := 0 to AMenu.Count - 1 do
AddMenuItem(AMenu[i]);
end;
procedure TTextEditor.AddLine(const AText: string);
begin
AddLine(AText, '');
end;
procedure TTextEditor.AddUndoRecord(const AComment: string; UID: UNDONAMEID);
begin
Assert(not FTypeTimer.Enabled);
if FScriptRunning then Exit;
FTextFile.AddUndoRecord(AComment, UID);
end;
procedure TTextEditor.ApplyFont(const AClassName: string; ATo: TCanvas = nil);
var
UseDefFont: Boolean;
ClassIndex: Integer;
begin
if ATo = nil then ATo := Canvas;
UseDefFont := (AClassName = '') or (Length(FClassArray) = 0) or
not ClassExists(AClassName, ClassIndex);
if UseDefFont then
begin
ATo.Font.Name := FFont.Name;
ATo.Font.Size := Ceil(FFont.Size * FZoom / 100);
ATo.Font.Style := FFont.Style;
ATo.Font.Color := FFgColor;
end
else
begin
ATo.Font.Name := FFont.Name;
ATo.Font.Size := Ceil(IfThen(FMultiSize, FClassArray[ClassIndex].Format.Size, FFont.Size) * FZoom / 100);
ATo.Font.Style := FClassArray[ClassIndex].Format.Style;
ATo.Font.Color := FClassArray[ClassIndex].Format.Color;
end;
FCurrentFormat.Size := ATo.Font.Size;
FCurrentFormat.Style := ATo.Font.Style;
FCurrentFormat.Color := ATo.Font.Color;
end;
procedure TTextEditor.ApplyInteractiveFormatting(const X, Y: Integer; ATo: TCanvas = nil);
var
FontRecord: TFontRecord;
TC1, TC2: Cardinal;
begin
if not Assigned(FFormattingProcessor) then Exit;
if ATo = nil then ATo := Canvas;
FontRecord := FCurrentFormat;
TC1 := GetTickCount;
FFormattingProcessor.GetCharFormat(Y, X, FTextFile.Character[Y, X], FontRecord);
TC2 := GetTickCount;
ATo.Font.Color := FontRecord.Color;
ATo.Font.Style := FontRecord.Style;
if TC2 - TC1 > 500 then
if MessageBox(0, PChar(SFPSlowText), PChar(SFPSlowTitle), MB_ICONQUESTION or MB_YESNO) = ID_YES then
FormattingProcessor := nil;
end;
function TTextEditor.IsBracketHighlight(const X, Y: Integer): Boolean;
begin
Result := FBracketHighlight and
(((X=FBracketPos1.X) and (Y=FBracketPos1.Y)) or ((X=FBracketPos2.X) and (Y=FBracketPos2.Y)));
end;
procedure TTextEditor.ApplyCharacterColors(const X, Y: Integer; AAttributes: TTextSpanAttributes);
begin
if FTextFile.IsCharSel(X, Y) then
begin
Canvas.Brush.Color := FSelBkColor;
Canvas.Font.Color := FSelFgColor;
end
else if tsaFindHighlight in AAttributes then
begin
Canvas.Brush.Color := FFndBkColor;
Canvas.Font.Color := FFndFgColor;
end
else if tsaHyperlink in AAttributes then
begin
if
Assigned(FLinks)
and
InRange(FCharLinkIndex, 0, FLinks.Count - 1)
and
(Y = FLinks[FCharLinkIndex].Location.Y)
and
InRange(X, FLinks[FCharLinkIndex].Location.X, FLinks[FCharLinkIndex].EndPos)
then
begin
Canvas.Brush.Color := FLnkFgColor;
Canvas.Font.Color := FLnkBkColor;
end
else
begin
Canvas.Brush.Color := FLnkBkColor;
Canvas.Font.Color := FLnkFgColor;
end;
end
else if IsBracketHighlight(X, Y) then
Canvas.Brush.Color := FBracketHighlightColor
else if FListBoxMode and (Y = LineHighlightIndex) and (Focused or not FListBoxHideSelection) then
begin
Canvas.Brush.Color := FSelBkColor;
Canvas.Font.Color := FSelFgColor;
end
else if FLineHighlight and (Y = LineHighlightIndex) then
Canvas.Brush.Color := FLineHighlightColor
else
Canvas.Brush.Color := FBkColor
end;
const
UNICODE_NULL = #0;
UNICODE_BACKSPACE = #8;
UNICODE_LF = #$000A;
UNICODE_CR = #$000D;
UNICODE_SPACE = ' ' ;
UNICODE_HORIZONTAL_TAB = #$09 ;
UNICODE_NO_BREAK_SPACE = #$A0 ;
UNICODE_NARROW_NO_BREAK_SPACE = #$202F ;
UNICODE_ZERO_WIDTH_SPACE = #$200B ;
UNICODE_ZERO_WIDTH_NON_JOINER = #$200C ;
UNICODE_EN_SPACE = #$2002 ;
UNICODE_EM_SPACE = #$2003 ;
UNICODE_THIN_SPACE = #$2009 ;
UNICODE_HAIR_SPACE = #$200A ;
UNICODE_MEDIUM_MATHEMATICAL_SPACE = #$205F ;
UNICODE_FIGURE_SPACE = #$2007 ;
UNICODE_PUNCTUATION_SPACE = #$2008 ;
UNICODE_THREE_PER_EM_SPACE = #$2004 ;
UNICODE_FOUR_PER_EM_SPACE = #$2005 ;
UNICODE_SIX_PER_EM_SPACE = #$2006 ;
UNICODE_MIDDLE_DOT = '·' ;
UNICODE_WHITE_CIRCLE = '○' ;
UNICODE_DOTTED_CIRCLE = '◌' ;
UNICODE_CIRCLE_WITH_VERTICAL_FILL = '◍' ;
UNICODE_BLACK_CIRCLE = '●' ;
UNICODE_WHITE_BULLET = '◦' ;
UNICODE_LOWER_HALF_CIRCLE = '◡' ;
UNICODE_CIRCLE_WITH_UPPER_RIGHT_QUADRANT_BLACK = '◔' ;
UNICODE_CIRCLE_WITH_RIGHT_HALF_BLACK = '◑' ;
UNICODE_CIRCLE_WITH_ALL_BUT_UPPER_LEFT_QUADRANT_BLACK = '◕' ;
UNICODE_BLACK_RIGHTPOINTING_POINTER = '►' ;
UNICODE_WHITE_SMALL_SQUARE = '▫' ;
UNICODE_WHITE_DIAMOND = '◇' ;
UNICODE_WHITE_SQUARE = '□' ;
UNICODE_BULLSEYE = '◎' ;
UNICODE_FISHEYE = '◉' ;
UNICODE_LIGHT_VERTICAL_BAR = '❘' ;
UNICODE_LOZENGE = '◊' ;
UNICODE_WHITE_VERTICAL_RECTANGLE = '▯' ;
UNICODE_WHITE_RECTANGLE = '▭' ;
UNICODE_SUBSCRIPT_THREE = '₃' ;
UNICODE_SUBSCRIPT_FOUR = '₄' ;
UNICODE_SUBSCRIPT_SIX = '₆' ;
UNICODE_SYMBOL_FOR_NULL = '␀' ;
UNICODE_SYMBOL_FOR_BACKSPACE = '␈' ;
UNICODE_SYMBOL_FOR_LINE_FEED = #$240A ;
UNICODE_SYMBOL_FOR_CARRIAGE_RETURN = #$240D ;
UNICODE_FULL_BLOCK = #$2588 ;
function TTextEditor.Reveal(const C: Char): Char;
begin
Result := C;
if FPasswordChar <> #0 then
Exit(FPasswordChar);
if not FShowHiddenCharacters then Exit;
case C of
UNICODE_NULL:
Result := UNICODE_SYMBOL_FOR_NULL;
UNICODE_BACKSPACE:
Result := UNICODE_SYMBOL_FOR_BACKSPACE;
UNICODE_SPACE:
Result := UNICODE_MIDDLE_DOT;
UNICODE_HORIZONTAL_TAB:
Result := UNICODE_BLACK_RIGHTPOINTING_POINTER;
UNICODE_NO_BREAK_SPACE:
Result := UNICODE_WHITE_DIAMOND;
UNICODE_NARROW_NO_BREAK_SPACE:
Result := UNICODE_LOZENGE;
UNICODE_ZERO_WIDTH_SPACE:
Result := UNICODE_LOWER_HALF_CIRCLE;
UNICODE_HAIR_SPACE:
Result := UNICODE_CIRCLE_WITH_UPPER_RIGHT_QUADRANT_BLACK;
UNICODE_THIN_SPACE:
Result := UNICODE_CIRCLE_WITH_RIGHT_HALF_BLACK;
UNICODE_EN_SPACE:
Result := UNICODE_CIRCLE_WITH_ALL_BUT_UPPER_LEFT_QUADRANT_BLACK;
UNICODE_EM_SPACE:
Result := UNICODE_BLACK_CIRCLE;
UNICODE_MEDIUM_MATHEMATICAL_SPACE:
Result := UNICODE_WHITE_SMALL_SQUARE;
UNICODE_FIGURE_SPACE:
Result := UNICODE_BULLSEYE;
UNICODE_PUNCTUATION_SPACE:
Result := UNICODE_FISHEYE;
UNICODE_ZERO_WIDTH_NON_JOINER:
Result := UNICODE_LIGHT_VERTICAL_BAR;
UNICODE_THREE_PER_EM_SPACE:
Result := UNICODE_SUBSCRIPT_THREE;
UNICODE_FOUR_PER_EM_SPACE:
Result := UNICODE_SUBSCRIPT_FOUR;
UNICODE_SIX_PER_EM_SPACE:
Result := UNICODE_SUBSCRIPT_SIX;
UNICODE_LF:
Result := UNICODE_SYMBOL_FOR_LINE_FEED;
UNICODE_CR:
Result := UNICODE_SYMBOL_FOR_CARRIAGE_RETURN;
end;
if Result <> C then
Canvas.Font.Color := $00BBBBFF;
end;
function TTextEditor.RulerRect: TRect;
begin
Result := Rect(0, 0, FRulerWidth, ClientHeight);
end;
procedure TTextEditor.RunScript(const AScript: TEditorScript; AIterations: Integer = 1;
ACounterInit: Integer = 1; ACounterInc: Integer = 1);
function PP(AParam: TScriptParam): Integer;
begin
Result := AParam.ParamValue;
case AParam.ParamType of
ptConstant:
Result := AParam.ParamValue;
ptCommand:
Result := EditorCommand(AParam.ParamValue);
end;
end;
var
i: Integer;
j: Integer;
label
Done;
begin
if FScriptRunning then Exit;
TypeTimerEnd;
NotifyApp(EN_SCRIPT);
FScriptRunning := True;
ChangeCursor;
FAbortScript := False;
try
FScriptCounter := ACounterInit;
for j := 1 to AIterations do
begin
for i := Low(AScript) to High(AScript) do
with AScript[i] do
begin
EditorCommand(Verb, PP(Param1), PP(Param2), PP(Param3), PP(Param4));
Application.ProcessMessages;
if IsKeyDown(VK_ESCAPE) and Application.Active then
FAbortScript := True;
if FAbortScript then
goto Done;
end;
Inc(FScriptCounter, ACounterInc);
end;
Done:
finally
FScriptRunning := False;
RemoveNotification(EN_SCRIPT);
ChangeCursor;
FTypeTimer.Enabled := False;
if FAbortScript then
AddUndoRecord(SUndoScriptAbort, UID_UNKNOWN)
else
AddUndoRecord(SUndoScript, UID_UNKNOWN);
end;
end;
procedure TTextEditor.DrawVisibleLine(LineIndex: Integer; From: Integer = 0);
begin
if InRange(LineIndex, 0, FTextFile.LineCount - 1) then
DrawLine(LineIndex, From, FTextFile.VirtualLineWidths[LineIndex] - 1);
end;
function TTextEditor.DropTargetDragEnter(const dataObj: IDataObject;
grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT;
var
helperptt: TPoint;
begin
if Assigned(FDropTargetHelper) then
begin
helperptt := pt;
FDropTargetHelper.DragEnter(Handle, dataObj, helperptt, dwEffect);
end;
FDragDataObj := dataObj;
FDragCompatFmt := dataObj.QueryGetData(FORMATETC_UNICODETEXT) = S_OK;
FRightDrag := (grfKeyState and MK_RBUTTON) <> 0;
GetDragDropEffect(dwEffect, grfKeyState);
FLastDropEffect := -1;
FDragScrollFirstChance := 0;
Result := S_OK;
end;
function TTextEditor.DropTargetDragLeave: HRESULT;
begin
if Assigned(FDropTargetHelper) then
FDropTargetHelper.DragLeave;
FDragCompatFmt := False;
FRightDrag := False;
FDragDataObj := nil;
Result := S_OK;
RemoveInsertionPoint;
try
RemoveNotification(EN_DRAG_MOVE);
RemoveNotification(EN_DRAG_COPY);
except
end;
FLastDropEffect := -1;
FDragScrollFirstChance := 0;
end;
function TTextEditor.DropTargetDragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HRESULT;
var
helperptt, PhysCP: TPoint;
Δx, Δy: Integer;
begin
if Assigned(FDropTargetHelper) then
begin
helperptt := pt;
FDropTargetHelper.DragOver(helperptt, dwEffect);
end;
GetDragDropEffect(dwEffect, grfKeyState);
PhysCP := Self.ScreenToClient(pt);
if PhysCP.y < 2 * FFontSize.cy then
Δy := -2*FFontSize.cy
else if PhysCP.y > ClientHeight - 2 * FFontSize.cy then
Δy := 2*FFontSize.cy
else
Δy := 0;
if PhysCP.x < FMarginLeft + 2 * FFontSize.cx then
Δx := -2*FFontSize.cx
else if PhysCP.x > ClientWidth - 2 * FFontSize.cx then
Δx := 2*FFontSize.cx
else
Δx := 0;
if (dwEffect <> DROPEFFECT_NONE) and ((Δx <> 0) or (Δy <> 0)) then
begin
if FDragScrollFirstChance = 0 then
FDragScrollFirstChance := GetTickCount
else if GetTickCount - FDragScrollFirstChance > 1000 then
SetScrollPosXY(FScrollPos.X + Δx, FScrollPos.Y + Δy, True);
end;
IndicateInsertionPoint(CaretPosAtPhysicalPixel(PhysCP));
DragDropNotify(dwEffect);
Result := S_OK;
end;
function TTextEditor.DropTargetDrop(const dataObj: IDataObject;
grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT;
var
medium: TStgMedium;
txtbuf: PChar;
helperptt, PhysCurPos: TPoint;
ctxidx: Cardinal;
OldForegroundWindow: HWND;
begin
Result := S_OK;
try
try
if Assigned(FDropTargetHelper) then
begin
helperptt := pt;
FDropTargetHelper.Drop(dataObj, helperptt, dwEffect);
end;
FDragCompatFmt := dataObj.QueryGetData(FORMATETC_UNICODETEXT) = S_OK;
PhysCurPos := Self.ScreenToClient(pt);
FDropLocation := CaretPosAtPhysicalPixel(PhysCurPos);
if FOLEDragging then
begin
FOLEInternalDrop := True;
if FTextFile.IsCharSel(FDropLocation) then
begin
dwEffect := DROPEFFECT_NONE;
Exit;
end;
end;
if FRightDrag and FDragCompatFmt then
begin
OldForegroundWindow := 0;
if Assigned(FDropMenuMove) then
FDropMenuMove.Enabled := (dwEffect and DROPEFFECT_MOVE) <> 0;
if Assigned(FDropMenuCopy) then
FDropMenuCopy.Enabled := (dwEffect and DROPEFFECT_COPY) <> 0;
if Application.MainForm <> nil then
begin
OldForegroundWindow := GetForegroundWindow;
SetForegroundWindow(Application.MainForm.Handle);
end;
ctxidx := Cardinal(TrackPopupMenu(FDropMenu.Handle, TPM_RETURNCMD or TPM_NONOTIFY or TPM_RIGHTBUTTON, pt.X, pt.Y, 0, Handle, nil));
if ctxidx = GetMenuItemID(FDropMenu.Handle, 0) then
dwEffect := DROPEFFECT_MOVE
else if ctxidx = GetMenuItemID(FDropMenu.Handle, 1) then
dwEffect := DROPEFFECT_COPY
else
begin
dwEffect := DROPEFFECT_NONE;
if OldForegroundWindow <> 0 then
SetForegroundWindow(OldForegroundWindow);
end;
end
else
GetDragDropEffect(dwEffect, grfKeyState);
if (dwEffect <> DROPEFFECT_NONE) then
begin
if FOLEDragging then
begin
end
else
begin
if dataObj.GetData(FORMATETC_UNICODETEXT, medium) = S_OK then
try
if medium.tymed = TYMED_HGLOBAL then
begin
txtbuf := GlobalLock(medium.hGlobal);
if Assigned(txtbuf) then
try
TypeTimerEnd;
FTextFile.CaretPos.SetPoint(FDropLocation);
FTextFile.InsertText(txtbuf);
case dwEffect of
DROPEFFECT_MOVE:
AddUndoRecord(SUndoMouseMoveExtSrc, UID_DRAGDROP);
DROPEFFECT_COPY:
AddUndoRecord(SUndoMouseCopyExtSrc, UID_DRAGDROP);
else
AddUndoRecord(SUndoTextInserted, UID_DRAGDROP);
end;
finally
GlobalUnlock(medium.hGlobal);
end
else
Result := E_UNEXPECTED;
end
else
Result := E_UNEXPECTED;
finally
ReleaseStgMedium(medium);
end
else
Result := E_UNEXPECTED;
end;
end;
finally
FDragCompatFmt := False;
FDragDataObj := nil;
RemoveInsertionPoint;
RemoveNotification(EN_DRAG_MOVE);
RemoveNotification(EN_DRAG_COPY);
end;
except
Result := E_UNEXPECTED;
end;
end;
procedure TTextEditor.IndicateInsertionPoint(const APoint: TPoint);
begin
if FInsertionPoint <> APoint then
begin
if FInsertionPoint.Y <> -1 then
InvalidateCharAndPrev(FInsertionPoint);
FInsertionPoint := APoint;
InvalidateCharAndPrev(FInsertionPoint);
end;
end;
function TTextEditor.SafeSelLength: Integer;
begin
Result := Length(SelText);
end;
procedure TTextEditor.SaveToFile(const FileName: TFileName; TrimRight: Boolean = False);
begin
FTextFile.SaveToFile(FileName, TrimRight);
end;
procedure TTextEditor.DrawLine(LineIndex: Integer; From, ATo: Integer; AAttributes: TTextSpanAttributes);
var
i: Integer;
x, y: Integer;
FontSize: TSize;
C: Char;
begin
if not InRange(LineIndex, 0, FTextFile.LineCount - 1) then
Exit;
HideCaret(Handle);
try
IntersectClipRect(Canvas.Handle, FMarginLeft, FMarginTop, ClientWidth - FMarginRight, ClientHeight - FMarginBottom);
ApplyFont(FTextFile.Classes[LineIndex]);
if FMultiSize then
begin
y := FAccumLineHeights[LineIndex];
FontSize.cx := FFontSizes[LineIndex].cx;
FontSize.cy := FFontSizes[LineIndex].cy;
end
else
begin
y := LineIndex * FFontSize.cy;
FontSize.cx := FFontSize.cx;
FontSize.cy := FFontSize.cy;
end;
if FListBoxMode and (LineIndex = LineHighlightIndex) and (Focused or not FListBoxHideSelection) then
Canvas.Brush.Color := FSelBkColor
else if FLineHighlight and (LineIndex = LineHighlightIndex) then
Canvas.Brush.Color := FLineHighlightColor
else
Canvas.Brush.Color := FBkColor;
Canvas.FillRect(Rect(FMarginLeft + From * FontSize.cx - FScrollPos.X,
FMarginTop + y - FScrollPos.y,
IfThen(ATo = FTextFile.VirtualLineWidths[LineIndex] - 1, ClientWidth - FMarginRight, FMarginLeft + (ATo+1) * FontSize.cx - FScrollPos.X),
FMarginTop + y + FontSize.cy - FScrollPos.y));
if FTextFile.ControlAware and LineIsControl(LineIndex) then
begin
Canvas.Brush.Color := IfThen(FTextFile.IsCharSel(0, LineIndex), FSelBkColor, Canvas.Brush.Color);
Canvas.FillRect(Rect(FMarginLeft - FScrollPos.X, FMarginTop + y - FScrollPos.Y,
FMarginLeft + FontSize.cx - FScrollPos.X, FMarginTop + y + FontSize.cy - FScrollPos.Y));
InvalidateLineControl(LineIndex);
Exit;
end;
From := Max(From, (FScrollPos.X + Max(0, Canvas.ClipRect.Left - FMarginLeft)) div FontSize.cx);
ATo := Min(ATo, (FScrollPos.X + ClientWidth - FMarginLeft - FMarginRight - Max(0, ClientWidth - Canvas.ClipRect.Right - FMarginRight) + 1) div FontSize.cx);
for i := From to Min(ATo, FTextFile.VirtualLineWidths[LineIndex] - 1) do
begin
x := i * FontSize.cx;
ReapplyFont;
C := Reveal(FTextFile.Character[LineIndex, i]);
if C = UNICODE_FULL_BLOCK then
begin
Canvas.Brush.Color := Canvas.Font.Color;
Canvas.FillRect(Rect(FMarginLeft + x - FScrollPos.X,
FMarginTop + y - FScrollPos.Y,
FMarginLeft + x + FontSize.cx - FScrollPos.X,
FMarginTop + y + FontSize.cy - FScrollPos.Y));
end
else
begin
ApplyInteractiveFormatting(i, LineIndex);
ApplyCharacterColors(i, LineIndex, AAttributes);
if FUnicodeFallback then UseBestFont(C);
Canvas.FillRect(Rect(FMarginLeft + x - FScrollPos.X,
FMarginTop + y - FScrollPos.Y,
FMarginLeft + x + FontSize.cx - FScrollPos.X,
FMarginTop + y + FontSize.cy - FScrollPos.Y));
Canvas.TextRect(Rect(FMarginLeft + x - FScrollPos.X,
FMarginTop + y - FScrollPos.Y,
FMarginLeft + x - FScrollPos.X + FontSize.cx,
FMarginTop + y - FScrollPos.Y + FontSize.cy),
FMarginLeft + x - FScrollPos.X,
FMarginTop + y - FScrollPos.Y,
C);
end;
end;
finally
ShowCaret(Handle);
end;
end;
procedure TTextEditor.InvalidateLineControl(LineIndex: Integer);
var
ctl: TControl;
begin Exit;
ctl := GetControlFromLine(LineIndex);
if Assigned(ctl) then
ctl.Invalidate;
end;
procedure TTextEditor.UseBestFont(const AChar: Char);
function ChrFits: Boolean;
begin
with Canvas.TextExtent(AChar) do
Result := (cx <= FFontSize.cx) and (cy <= FFontSize.cy);
end;
var
i: Integer;
Changed: Boolean;
begin
Changed := False;
if not SameStr(Canvas.Font.Name, FFont.Name) then
Canvas.Font.Name := FFont.Name;
if Canvas.Font.Size <> FCurrentFormat.Size then
Canvas.Font.Size := FCurrentFormat.Size;
if ChrInGlyphSet(FGlyphSets[0], AChar) then Exit;
for i := 0 to FFallbackFonts.Count - 1 do
if ChrInGlyphSet(FGlyphSets[i + 1], AChar) then
begin
Canvas.Font.Name := FFallbackFonts[i];
Changed := True;
Break;
end;
if Changed then
while not ChrFits do
Canvas.Font.Size := Canvas.Font.Size - 1;
end;
procedure TTextEditor.UseDefaultFallbackFonts;
begin
FFallbackFonts.Clear;
FFallbackFonts.Add('Arial Unicode MS');
FFallbackFonts.Add('Lucida Sans Unicode');
FFallbackFonts.Add('DejaVu Sans Mono');
FFallbackFonts.Add('Consolas');
FFallbackFonts.Add('Segoe UI');
end;
class procedure TTextEditor.UxThemeUpdate;
var
Editor: TTextEditor;
begin
if Assigned(FInstances) then
for Editor in FInstances do
if Editor.UseRuxThemes then
begin
Editor.SetupColors;
Editor.Invalidate;
end;
end;
procedure TTextEditor.PageDown(Selection: Boolean);
var
NewY: Integer;
begin
NewY := EnsureRange(FTextFile.CaretPos.Y + (ClientHeight - FMarginTop - FMarginBottom) div FFontSize.cy, 0, FTextFile.LineCount - 1);
if NewY = FTextFile.CaretPos.Y then
begin
TextFileInputError(Self);
Exit;
end;
if FTextFile.CaretAfterEOL then
FTextFile.CaretPos.SetY(NewY, Selection)
else
FTextFile.CaretPos.SetPoint(Min(FTextFile.CaretPos.X, FTextFile.VirtualLineWidths[NewY]), NewY, Selection);
end;
procedure TTextEditor.PageUp(Selection: Boolean);
var
NewY: Integer;
begin
NewY := EnsureRange(FTextFile.CaretPos.Y - (ClientHeight - FMarginTop - FMarginBottom) div FFontSize.cy, 0, FTextFile.LineCount - 1);
if NewY = FTextFile.CaretPos.Y then
begin
TextFileInputError(Self);
Exit;
end;
if FTextFile.CaretAfterEOL then
FTextFile.CaretPos.SetY(NewY, Selection)
else
FTextFile.CaretPos.SetPoint(Min(FTextFile.CaretPos.X, FTextFile.VirtualLineWidths[NewY]), NewY, Selection);
end;
procedure TTextEditor.DrawRuler;
var
R: TRect;
S: string;
y: Integer;
bm: Integer;
RulerBkColor, RulerFgColor: TColor;
begin
if not RulerVisible then Exit;
if FRulerColor = clDefault then
begin
RulerBkColor := FBkColor;
RulerFgColor := FFgColor;
end
else
begin
RulerBkColor := FRulerColor;
RulerFgColor := FRulerFont.Color;
end;
SelectClipRgn(Canvas.Handle, 0);
Canvas.Brush.Color := RulerBkColor;
Canvas.FillRect(RulerRect);
Canvas.Font.Assign(FRulerFont);
Canvas.Font.Size := Ceil(Canvas.Font.Size * FZoom / 100);
for y := FirstVisibleLine to LastVisibleLine do
begin
R := Rect(0, GetLineTop(y), FRulerWidth, GetLineBottom(y));
S := IntToStr(y + 1);
if CaretPos.Y = y then
begin
Canvas.Brush.Color := FSelBkColor;
Canvas.FillRect(R);
Canvas.Font.Color := FSelFgColor;
end
else
begin
Canvas.Brush.Color := RulerBkColor;
Canvas.Font.Color := RulerFgColor;
end;
Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfRight]);
bm := GetLineBookmark(y);
if bm <> -1 then
begin
S := 'BM' + IntToStr(bm);
Canvas.Brush.Color := FSelBkColor;
Canvas.Font.Color := FSelFgColor;
Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfLeft]);
end;
end;
end;
procedure TTextEditor.DrawSpan(const ATextSpan: TTextSpan;
AAttributes: TTextSpanAttributes);
var
y: Integer;
begin
if ATextSpan.A.Y = ATextSpan.B.Y then
DrawLine(ATextSpan.A.Y, ATextSpan.A.X, ATextSpan.B.X - 1, AAttributes)
else
begin
DrawLine(ATextSpan.A.Y, ATextSpan.A.X, FTextFile.PhysicalLineWidths[ATextSpan.A.Y] - 1, AAttributes);
for y := ATextSpan.A.Y + 1 to ATextSpan.B.Y - 1 do
DrawLine(y, 0, FTextFile.PhysicalLineWidths[y] - 1, AAttributes);
DrawLine(ATextSpan.B.Y, 0, ATextSpan.B.X - 1, AAttributes);
end;
end;
procedure TTextEditor.NeedValidPaintState;
begin
if not FValidPaintState then
begin
SetupFontMetrics;
AdjustHeight;
end;
FValidPaintState := True;
end;
procedure TTextEditor.InvalidateChar(const AChar: TPoint);
begin
if InRange(AChar.Y, 0, LineCount - 1) then
InvalidateRect(
Handle,
Rect(
GetCharLeft(AChar.Y, AChar.X),
GetLineTop(AChar.Y),
GetCharRight(AChar.Y, AChar.X + 1),
GetLineBottom(AChar.Y)
),
False
)
else
Invalidate;
end;
procedure TTextEditor.InvalidateCharAndPrev(const AChar: TPoint);
begin
if InRange(AChar.Y, 0, LineCount - 1) then
InvalidateRect(
Handle,
Rect(
GetCharLeft(AChar.Y, AChar.X - 1),
GetLineTop(AChar.Y),
GetCharRight(AChar.Y, AChar.X + 1),
GetLineBottom(AChar.Y)
),
False
)
else
Invalidate;
end;
procedure TTextEditor.Paint;
var
i: Integer;
R: TRect;
OCR: TRect;
FVL, LVL: Integer;
begin
inherited;
NeedValidPaintState;
OCR := Canvas.ClipRect;
if OCR.Right > FRulerWidth then
begin
Canvas.Brush.Color := FBkColor;
Canvas.FillRect(NonRulerRect);
Canvas.Font.Assign(FFont);
Canvas.Font.Color := FFgColor;
FVL := FirstVisibleLine;
LVL := LastVisibleLine;
if not FTextHint.IsEmpty and not Focused and FTextFile.Empty then
begin
R := ClientRect;
Canvas.Font.Name := 'Segoe UI';
Canvas.Font.Size := 9;
Canvas.Font.Style := [fsItalic];
Canvas.Font.Color := clGrayText;
DrawText(Canvas.Handle, #32 + FTextHint, 1 + FTextHint.Length,
R, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or
IfThen(FLabelEllipsis, DT_END_ELLIPSIS))
end
else if SingleLine and not Focused and FLabelStyle then
begin
R := ClientRect;
DrawText(Canvas.Handle, FTextFile.Lines[0], FTextFile.VirtualLineWidths[0],
R, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or
IfThen(FLabelEllipsis, DT_END_ELLIPSIS))
end
else
for i := FVL to LVL do
DrawVisibleLine(i);
if Assigned(FLinks) then
for i := 0 to FLinks.Count - 1 do
if InRange(FLinks[i].Location.Y, FVL, LVL) then
DrawLine(FLinks[i].Location.Y, FLinks[i].Location.X, FLinks[i].EndPos, [tsaHyperlink]);
for i := Low(FTextFile.FFindData) to High(FTextFile.FFindData) do
if (FTextFile.FFindData[i].A.Y <= LVL) and (FTextFile.FFindData[i].B.Y >= FVL) then
DrawSpan(FTextFile.FFindData[i], [tsaFindHighlight]);
end;
if OCR.Left < FRulerWidth then
DrawRuler;
if FRightLine then
begin
SelectClipRgn(Canvas.Handle, 0);
Canvas.Pen.Color := FRightLineColor;
Canvas.MoveTo(FMarginLeft + FRightLinePos - FScrollPos.X, FMarginTop);
Canvas.LineTo(FMarginLeft + FRightLinePos - FScrollPos.X,
ClientHeight - FMarginBottom);
end;
if FMultipleCarets then
begin
IntersectClipRect(Canvas.Handle, FMarginLeft, FMarginTop, ClientWidth - FMarginRight, ClientHeight - FMarginBottom);
Canvas.Pen.Color := FFgColor;
Canvas.Pen.Width := CARET_WIDTH;
for i := Low(FCarets) to High(FCarets) do
begin
with PhysicalPixelAtChar(FCarets[i]) do
Canvas.MoveTo(X, Y);
Canvas.LineTo(Canvas.PenPos.X, GetLineBottom(FCarets[i].Y) - 1);
end;
end;
if FInsertionPoint.Y <> -1 then
begin
IntersectClipRect(Canvas.Handle, FMarginLeft, FMarginTop, ClientWidth - FMarginRight, ClientHeight - FMarginBottom);
Canvas.Pen.Color := FFgColor;
Canvas.Pen.Width := CARET_WIDTH;
with PhysicalPixelAtChar(FInsertionPoint) do
Canvas.MoveTo(X, Y);
Canvas.LineTo(Canvas.PenPos.X, GetLineBottom(FInsertionPoint.Y) - 1);
end;
BitmapEffects.BitmapEffect(Self, Canvas, FBitmapEffect);
if not Enabled then
BitmapEffects.BitmapEffect(Self, Canvas, FDisabledEffect);
end;
function TTextEditor.Find(AFindQuery: TFindQuery): Integer;
begin
Result := FTextFile.Find(AFindQuery);
FStartOver := True;
Invalidate;
end;
procedure TTextEditor.SelectFindItem(ItemIndex: Integer);
begin
FNoScrollToCaret := True;
try
with FTextFile do
begin
CaretPos.SetPoint(FindData[ItemIndex].B);
CaretPos.SetPoint(FindData[ItemIndex].A, True);
end;
finally
FNoScrollToCaret := False;
end;
CenterOnSelection(True);
FStartOver := False;
end;
function TTextEditor.LeftColumnRect: TRect;
begin
Result := Rect(0, 0, FMarginLeft, ClientHeight);
end;
procedure TTextEditor.SelectLine(ALineIndex: Integer);
begin
if Assigned(FTextFile) then
FTextFile.SelectLine(ALineIndex);
end;
function TTextEditor.FindFromTop: Integer;
begin
if FTextFile.FindCount = 0 then
Exit(-1);
if FStartOver then
begin
SelectFindItem(0);
Result := 0;
end
else
Result := FindNext;
end;
function TTextEditor.FindNext: Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to FTextFile.FindCount - 1 do
if (FTextFile.FindData[i].A.Y > FTextFile.CaretPos.Y) or
((FTextFile.FindData[i].A.Y = FTextFile.CaretPos.Y) and
(FTextFile.FindData[i].A.X > FTextFile.CaretPos.X)) then
begin
SelectFindItem(i);
Result := i;
break;
end;
end;
function TTextEditor.FindPrevious: Integer;
var
i: Integer;
begin
Result := -1;
for i := FTextFile.FindCount - 1 downto 0 do
if (FTextFile.FindData[i].A.Y < FTextFile.CaretPos.Y) or
((FTextFile.FindData[i].A.Y = FTextFile.CaretPos.Y) and
(FTextFile.FindData[i].A.X < FTextFile.CaretPos.X)) then
begin
SelectFindItem(i);
Result := i;
break;
end;
end;
function TTextEditor.FirstVisibleLine(TrueValue: Boolean = False): Integer;
var
i: Integer;
ClipRectTop, MX: Integer;
begin
if TrueValue then
ClipRectTop := 0
else
ClipRectTop := Canvas.ClipRect.Top;
MX := Max(0, ClipRectTop - FMarginTop);
if FMultiSize then
begin
Result := FTextFile.LineCount - 1;
for i := 0 to FTextFile.LineCount - 1 do
if FAccumLineHeights[i] + FFontSizes[i].cy > FScrollPos.Y + MX then
Exit(i);
end
else
Result := EnsureRange((FScrollPos.Y + MX) div FFontSize.cy, 0, FTextFile.LineCount - 1);
end;
procedure TTextEditor.FixRemovedLineControlLines;
var
i: Integer;
begin
for i := 0 to LineCount - 1 do
if LineIsControl(i) and not Assigned(GetControlFromLine(i)) then
begin
Lines[i] := '[' + SRemovedControl + ']';
ForceSetClass(i, '');
end;
end;
function TTextEditor.GetLastLine: string;
begin
if LineCount > 0 then
Result := Lines[LineCount - 1]
else
Result := '';
end;
procedure TTextEditor.SetLastLine(const AText: string);
begin
if LineCount > 0 then
Lines[LineCount - 1] := AText
else
AddLine(AText);
end;
function TTextEditor.LastVisibleLine(TrueValue: Boolean = False): Integer;
var
i: Integer;
ClipRectBottom, MN: Integer;
begin
if TrueValue then
ClipRectBottom := ClientHeight - FMarginBottom
else
ClipRectBottom := Canvas.ClipRect.Bottom;
MN := Min(ClipRectBottom - FMarginTop, ClientHeight - FMarginTop - FMarginBottom);
if FMultiSize then
begin
Result := FTextFile.LineCount - 1;
for i := 1 to FTextFile.LineCount - 1 do
if FAccumLineHeights[i] > FScrollPos.Y + MN then
Exit(i - 1);
end
else
Result := EnsureRange((FScrollPos.Y + MN + 1) div FFontSize.cy, 0, FTextFile.LineCount - 1);
end;
function TTextEditor.LineArray: TArray<string>;
begin
Result := FTextFile.LineArray;
end;
function TTextEditor.LineHighlightIndex: Integer;
begin
if FListBoxMode then
Result := ListBoxItemIndex
else
Result := FTextFile.CaretPos.Y;
end;
function TTextEditor.LineIsControl(LineIndex: Integer): Boolean;
begin
Result := SameStr(FTextFile.Classes[LineIndex], LINE_CONTROL_CLASS);
end;
function TTextEditor.LineIsWinControlOrHasPopup(LineIndex: Integer): Boolean;
var
ctl: TControl;
begin
ctl := GetControlFromLine(LineIndex);
Result := Assigned(ctl) and
((ctl is TWinControl) or ((ctl is TImage) and Assigned(TImage(ctl).PopupMenu)));
end;
function TTextEditor.LineWidths(LineIndex: Integer): Integer;
begin
if FMultiSize and LineIsControl(LineIndex) then
Result := GetLineControlSize(LineIndex).cx
else
Result := FTextFile.VirtualLineWidths[LineIndex] * FFontSizes[LineIndex].cx;
end;
procedure TTextEditor.LoadDefaultClasses;
var
HeadingColor: TColor;
begin
if GetSysColor(COLOR_WINDOW) = DWORD(clWhite) then
HeadingColor := clNavy
else
HeadingColor := clWindowText;
AddClass(MakeClass('Heading 1', 28, [], HeadingColor));
AddClass(MakeClass('Heading 2', 16, [], HeadingColor));
AddClass(MakeClass('Heading 3', 12, [], HeadingColor));
AddClass(MakeClass('Heading 4', 10, [fsBold], HeadingColor));
AddClass(MakeClass('Heading 5', 10, [fsItalic], HeadingColor));
AddClass(MakeClass('Heading 6', 10, [], HeadingColor));
end;
procedure TTextEditor.DragDropNotify(dwEffect: Integer);
begin
if dwEffect <> FLastDropEffect then
begin
case dwEffect of
DROPEFFECT_COPY:
begin
RemoveNotification(EN_DRAG_MOVE);
NotifyApp(EN_DRAG_COPY);
end;
DROPEFFECT_MOVE:
begin
RemoveNotification(EN_DRAG_COPY);
NotifyApp(EN_DRAG_MOVE);
end;
else
RemoveNotification(EN_DRAG_MOVE);
RemoveNotification(EN_DRAG_COPY);
end;
FLastDropEffect := dwEffect;
end;
end;
procedure TTextEditor.GetDragDropEffect(var dwEffect: Integer; grfKeyState: Integer);
begin
if FDragCompatFmt then
if ((grfKeyState and MK_CONTROL) <> 0) and ((dwEffect and DROPEFFECT_COPY) <> 0) then
dwEffect := DROPEFFECT_COPY
else if ((dwEffect and DROPEFFECT_MOVE) <> 0) then
dwEffect := DROPEFFECT_MOVE
else if ((dwEffect and DROPEFFECT_COPY) <> 0) then
dwEffect := DROPEFFECT_COPY
else
dwEffect := DROPEFFECT_NONE
else
dwEffect := DROPEFFECT_NONE
end;
procedure TTextEditor.RemoveInsertionPoint;
begin
if FInsertionPoint.Y <> -1 then
begin
InvalidateCharAndPrev(FInsertionPoint);
FInsertionPoint := Point(-1, -1);
end;
end;
procedure TTextEditor.RemoveMenuItem(AMenuItem: TMenuItem);
begin
if FCustomMenuItems = nil then
Exit;
if AMenuItem = nil then
Exit;
FCustomMenuItems.Remove(AMenuItem);
end;
procedure TTextEditor.Loaded;
begin
inherited;
end;
procedure TTextEditor.LoadFromFile(const FileName: TFileName;
const Encoding: TEncoding);
var
WasControlAware: Boolean;
begin
try
WasControlAware := FTextFile.ControlAware;
Escape(True);
FTypeTimer.Enabled := False;
FMultiSize := False;
ListBoxSelection := False;
FTextFile.LoadFromFile(FileName, Encoding);
AddUndoRecord(SUndoDocumentLoaded, UID_UNKNOWN);
UpdateCaret;
if WasControlAware then
RestoreAllMargins;
except
NewFile;
raise;
end;
end;
function TTextEditor.PasteFromClipboard: Boolean;
var
gr: TBitmap;
png: TPngImage absolute gr;
h: THandle;
p: Pointer;
ms: TMemoryStream;
begin
Result := False;
TypeTimerEnd;
if (EditMode = emConsole) and not FTextFile.AtLastLine then
FTextFile.GotoEOF;
if FNumbersOnly and Clipboard.HasFormat(CF_TEXT) then
begin
var S := Clipboard.AsText;
for var i := 1 to S.Length do
if not S[i].IsDigit then
begin
TextFileInputError(Self);
ShowBalloon(SNumOnlyErrorTitle, SNumOnlyErrorText, bikError, bpCaretPos,
GetCaretPos);
Exit;
end;
end;
if Clipboard.HasFormat(CF_TEXT) and FMultipleCarets then
begin
FTextFile.MultiInsertText(FCarets, Clipboard.AsText);
Result := True;
end
else if Clipboard.HasFormat(CF_TEXT) then
Result := FTextFile.PasteFromClipboard
else if FAllowBitmapPaste and Clipboard.HasFormat(CF_PNG) and not SingleLine then
begin
Clipboard.Open;
try
h := Clipboard.GetAsHandle(CF_PNG);
if h <> 0 then
begin
p := GlobalLock(h);
try
ms := TMemoryStream.Create;
try
ms.WriteBuffer(p^, GlobalSize(h));
png := TPngImage.Create;
try
ms.Position := 0;
png.LoadFromStream(ms);
FTextFile.ClearSelection;
InsertGraphic(png, CaretPos.Y);
Result := True;
finally
png.Free;
end;
finally
ms.Free;
end;
finally
GlobalUnlock(h);
end;
end;
finally
Clipboard.Close;
end;
end
else if FAllowBitmapPaste and Clipboard.HasFormat(CF_BITMAP) and not SingleLine then
begin
gr := TBitmap.Create;
try
gr.Assign(Clipboard);
FTextFile.ClearSelection;
InsertGraphic(gr, CaretPos.Y);
finally
gr.Free;
end;
Result := True;
end
else
Result := False;
if Result then
AddUndoRecord(SUndoPastedFromClipboard, UID_PASTE);
end;
function TTextEditor.PasteFromClipboardAsBlock: Boolean;
begin
TypeTimerEnd;
Result := FTextFile.PasteFromClipboardAsBlock;
if Result then
AddUndoRecord(SUndoPastedFromClipboard, UID_PASTE);
end;
function TTextEditor.PhysicalPixelAtChar(const Point: TPoint): TPoint;
begin
Result := VirtualPixelAtChar(Point);
Dec(Result.X, FScrollPos.X);
Dec(Result.Y, FScrollPos.Y);
Inc(Result.X, FMarginLeft);
Inc(Result.Y, FMarginTop);
end;
function TTextEditor.VirtualPixelAtChar(const Point: TPoint): TPoint;
begin
if FMultiSize then
begin
Result.X := Point.X * FFontSizes[Point.Y].cx;
Result.Y := FAccumLineHeights[Point.Y];
end
else
begin
Result.X := Point.X * FFontSize.cx;
Result.Y := Point.Y * FFontSize.cy;
end;
end;
function TTextEditor.Redo: Boolean;
begin
if FTypeTimer.Enabled then
TypeTimerTimer(Self);
FNoScrollToCaret := True;
try
Result := FTextFile.Redo;
if FTextFile.ControlAware then
FixRemovedLineControlLines;
finally
FNoScrollToCaret := False;
end;
if Result then
CenterOnSelection(True);
end;
procedure TTextEditor.RegisterFP(FormattingProcessor: TFormattingProcessor);
begin
FPDict.AddOrSetValue(FormattingProcessor.ClassName, FormattingProcessor);
end;
procedure TTextEditor.RemoveAllIndent;
begin
TypeTimerEnd;
FTextFile.RemoveAllIndent;
AddUndoRecord(SUndoIndentRemoved, UID_UNKNOWN);
end;
function TTextEditor.RemoveClass(const AClassName: string): Boolean;
var
i: Integer;
j: Integer;
begin
Result := False;
for i := 0 to High(FClassArray) do
if SameStr(AClassName, FClassArray[i].Name) then
begin
for j := i to High(FClassArray) - 1 do
FClassArray[j] := FClassArray[j + 1];
SetLength(FClassArray, Length(FClassArray) - 1);
Exit(True);
end;
end;
procedure TTextEditor.RemoveIndent;
begin
TypeTimerEnd;
FTextFile.RemoveIndent;
AddUndoRecord(SUndoIndentDecreased, UID_UNKNOWN);
end;
procedure TTextEditor.RemoveNotification(const MsgID: Integer);
function GetMostRecentNotification(out AMsg: Cardinal; out AStr: string): Boolean;
begin
Result := Length(FNotifications) > 0;
if Result then
begin
AMsg := FNotifications[High(FNotifications)];
AStr := FNotificationStrs[AMsg];
end
else
begin
AMsg := 0;
AStr := '';
end;
end;
var
i: Integer;
j: Integer;
LastMsg: Cardinal;
LastStr: string;
begin
for i := High(FNotifications) downto 0 do
if FNotifications[i] = MsgID then
begin
for j := i to High(FNotifications) - 1 do
FNotifications[j] := FNotifications[j + 1];
SetLength(FNotifications, High(FNotifications));
if Assigned(FOnNotification) then
FOnNotification(Self, MsgID, True);
if Assigned(FOnSimpleNotification) then
begin
GetMostRecentNotification(LastMsg, LastStr);
FOnSimpleNotification(Self, LastMsg, LastStr);
end;
break;
end;
end;
procedure TTextEditor.SelectAll;
begin
if FTextFile = nil then
Exit;
FNoScrollToCaret := True;
try
FTextFile.SelectAll;
finally
FNoScrollToCaret := False;
end;
end;
procedure TTextEditor.SelectAllNone;
begin
FNoScrollToCaret := True;
try
FTextFile.SelectAllNone;
finally
FNoScrollToCaret := False;
end;
end;
procedure TTextEditor.SelectLine;
begin
if Assigned(FTextFile) then
FTextFile.SelectLine;
end;
procedure TTextEditor.SelectLines(const ALineA, ALineB: Integer);
begin
if FTextFile = nil then
Exit;
FNoScrollToCaret := True;
try
FTextFile.SelectLines(ALineA, ALineB);
finally
FNoScrollToCaret := False;
end;
end;
procedure TTextEditor.SelectNone;
begin
if Assigned(FTextFile) then
FTextFile.SelectNone;
end;
function TTextEditor.SelectWord: Boolean;
begin
Result := Assigned(FTextFile) and FTextFile.SelectWord;
end;
procedure TTextEditor.AdjustHeight;
begin
if SingleLine and FAutoHeight then
ClientHeight := FFontSize.cy + AUTO_HEIGHT_PADDING;
end;
procedure TTextEditor.SetAutoHeight(const Value: Boolean);
begin
if FAutoHeight <> Value then
begin
FAutoHeight := Value;
AdjustHeight;
end;
end;
procedure TTextEditor.SetAutoIndent(const Value: Boolean);
begin
FAutoIndent := Value;
FTextFile.AutoIndent := Value;
end;
procedure TTextEditor.SetBackgroundColor(const Value: TColor);
begin
if FBackgroundColor <> Value then
begin
FBackgroundColor := Value;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.SetBitmapEffect(const Value: TBitmapEffect);
begin
if FBitmapEffect <> Value then
begin
FBitmapEffect := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetBorderColor(const Value: TColor);
begin
FBorderColor := Value;
if (FBorderColor <> Value) and (FBorderType = btSimpleColor) then
Invalidate;
end;
procedure TTextEditor.SetBorderType(const Value: TBorderType);
begin
if FBorderType <> Value then
begin
if Value <> btSimpleColor then
BorderWidth := 0;
FBorderType := Value;
HideBalloon;
RecreateWnd;
end;
end;
procedure TTextEditor.SetBracketHighlightColor(const Value: TColor);
begin
if FBracketHighlightColor <> Value then
begin
FBracketHighlightColor := Value;
if FBracketHighlight then
VisualUpdate(ctTwoChars, FBracketPos1.Y, FBracketPos1.X, FBracketPos2.Y, FBracketPos2.X)
end;
end;
procedure TTextEditor.SetCaretAfterEOL(const Value: Boolean);
begin
FTextFile.CaretAfterEOL := Value;
FCaretAfterEOL := FTextFile.CaretAfterEOL;
end;
procedure TTextEditor.SetCaretPos(const Value: TPoint);
var
X, Y: Integer;
begin
Y := EnsureRange(Value.Y, 0, LineCount - 1);
if CaretAfterEOL then
X := Max(Value.X, 0)
else
X := EnsureRange(Value.X, 0, FTextFile.VirtualLineWidths[Y]);
FTextFile.CaretPos.SetPoint(X, Y);
end;
procedure TTextEditor.SetClass(Index: Integer; const Value: string);
begin
if LineIsControl(Index) then Exit;
FTextFile.Classes[Index] := Value;
TextFileLineClassChange(Self, Index);
end;
procedure TTextEditor.SetCliHistory(Index: Integer; const Value: string);
begin
FCliHistory[Index] := Value;
end;
procedure TTextEditor.SetDisabledEffect(const Value: TBitmapEffect);
begin
if FDisabledEffect <> Value then
begin
FDisabledEffect := Value;
if not Enabled then
Invalidate;
end;
end;
procedure TTextEditor.SetEditMode(const Value: TEditMode);
begin
if (FTextFile.EditMode = emReadOnly) and FTextFile.StrictReadOnly then
Exit;
if (Value = emReadOnly) and (FTextFile.EditMode <> emReadOnly) then
NotifyApp(EN_READONLY)
else if (Value <> emReadOnly) and (FTextFile.EditMode = emReadOnly) then
RemoveNotification(EN_READONLY);
FTextFile.EditMode := Value;
UpdateCaret;
end;
procedure TTextEditor.SetEnabled(Value: Boolean);
begin
inherited;
SetupColors;
Invalidate;
end;
procedure TTextEditor.SetFallbackFonts(const Value: TStringList);
begin
FFallbackFonts.Assign(Value);
BuildFontDataArray;
Invalidate;
end;
procedure TTextEditor.SetFindBackgroundColor(const Value: TColor);
begin
if FFndBkColor <> Value then
begin
FFndBkColor := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetFindForegroundColor(const Value: TColor);
begin
if FFndFgColor <> Value then
begin
FFndFgColor := Value;
Invalidate;
end;
end;
procedure TTextEditor.VerifyFont;
const
GoodFonts: array[0..5] of string = ('DejaVu Sans Mono', 'Consolas',
'Lucida Console', 'Courier New', 'Courier', 'Fixedsys');
var
i: Integer;
begin
if FNoVerifyFont then Exit;
if FixedWidthFonts.IndexOf(FFont.Name) = -1 then
begin
for i := Low(GoodFonts) to High(GoodFonts) do
if FixedWidthFonts.IndexOf(GoodFonts[i]) <> -1 then
begin
FFont.Name := GoodFonts[i];
Exit;
end;
if FixedWidthFonts.Count > 0 then
FFont.Name := FixedWidthFonts[0];
end;
end;
procedure TTextEditor.SetFont(const Value: TFont);
begin
FFont.Assign(Value);
VerifyFont;
SetupFontMetrics;
BuildFontDataArray;
AdjustHeight;
Invalidate;
end;
procedure TTextEditor.SetForegroundColor(const Value: TColor);
begin
if FForegroundColor <> Value then
begin
FForegroundColor := Value;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.ForceSetClass(Index: Integer; const Value: string);
begin
FTextFile.Classes[Index] := Value;
TextFileLineClassChange(Self, Index);
end;
procedure TTextEditor.FormattingProcessorChanged(Sender: TObject);
begin
Invalidate;
end;
function TTextEditor.FormattingProcessorGetLineWidth(ALineIndex: Integer): Integer;
begin
Result := FTextFile.PhysicalLineWidths[ALineIndex]
end;
function TTextEditor.FormattingProcessorGetChar(ALineIndex, ACol: Integer): Char;
begin
Result := FTextFile.UnsafeGetChar(ALineIndex, ACol);
end;
function TTextEditor.FormattingProcessorGetLineCount: Integer;
begin
Result := FTextFile.LineCount;
end;
function TTextEditor.FormattingProcessorGetWord(const APoint: TPoint; APascalIdent: Boolean = False): string;
begin
Result := FTextFile.GetWord(APoint, APascalIdent);
end;
function TTextEditor.FormattingProcessorGetWordBoundary(const APoint: TPoint; out SP, EP: Integer): Boolean;
begin
Result := FTextFile.GetWordBoundary(APoint, SP, EP);
end;
procedure TTextEditor.SetFormattingProcessor(const Value: TFormattingProcessor; AInitialize: Boolean = True);
begin
if FFormattingProcessor <> Value then
begin
FFormattingProcessor := Value;
if Assigned(FFormattingProcessor) then
begin
FFormattingProcessor.OnGetLineWidth := FormattingProcessorGetLineWidth;
FFormattingProcessor.OnGetChar := FormattingProcessorGetChar;
FFormattingProcessor.OnGetLineCount := FormattingProcessorGetLineCount;
FFormattingProcessor.OnGetWord := FormattingProcessorGetWord;
FFormattingProcessor.OnGetWordBoundary := FormattingProcessorGetWordBoundary;
FFormattingProcessor.OnChange := FormattingProcessorChanged;
if AInitialize then
FPFileChangeNotification(ctFile, 0, 0, 0, 0);
end;
Invalidate;
end;
end;
procedure TTextEditor.SetFormattingProcessorSmple(
const Value: TFormattingProcessor);
begin
SetFormattingProcessor(Value, True);
end;
procedure TTextEditor.SetIndentSize(const Value: Integer);
begin
FIndentSize := Value;
FTextFile.IndentSize := Value;
end;
procedure TTextEditor.SetLabelEllipsis(const Value: Boolean);
begin
if FLabelEllipsis <> Value then
begin
FLabelEllipsis := Value;
if SingleLine and (not Focused) and FLabelStyle then
Invalidate;
end;
end;
procedure TTextEditor.SetLabelStyle(const Value: Boolean);
begin
if FLabelStyle <> Value then
begin
FLabelStyle := Value;
if SingleLine and not Focused then
Invalidate;
end;
end;
procedure TTextEditor.SetLetterSpacing(const Value: Integer);
begin
if FLetterSpacing <> Value then
begin
FLetterSpacing := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetLine(Index: Integer; const Value: string);
begin
if FTextFile.LineExists(Index) then
FTextFile.Lines[Index] := Value
else
raise Exception.CreateFmt('Line index %d out of bounds.', [Index]);
FTextFile.Lines[Index] := Value;
TextFileChange(Self, ctLine, Index, 0, 0, 0);
with FTextFile do
if (CaretPos.Y = Index) and (not CaretAfterEOL) and
(CaretPos.X > VirtualLineWidths[CaretPos.Y]) then
KEnd;
end;
procedure TTextEditor.SetLineComparer(const Value: TLineComparer);
begin
FTextFile.LineComparer := Value;
end;
procedure TTextEditor.SetLineHighlight(const Value: Boolean);
begin
if FLineHighlight <> Value then
begin
FLineHighlight := Value;
VisualUpdate(ctLine, FTextFile.CaretPos.Y, 0, 0, 0);
end;
end;
procedure TTextEditor.SetLineHighlightColor(const Value: TColor);
begin
if FLineHighlightColor <> Value then
begin
FLineHighlightColor := Value;
VisualUpdate(ctLine, FTextFile.CaretPos.Y, 0, 0, 0);
end;
end;
procedure TTextEditor.SetLineSpacing(const Value: Integer);
begin
if FLineSpacing <> Value then
begin
FLineSpacing := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetLinkBackgroundColor(const Value: TColor);
begin
if FLnkBkColor <> Value then
begin
FLnkBkColor := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetLinkForegroundColor(const Value: TColor);
begin
if FLnkFgColor <> Value then
begin
FLnkFgColor := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetListBoxHideSelection(const Value: Boolean);
begin
if FListBoxHideSelection <> Value then
begin
FListBoxHideSelection := Value;
if FListBoxMode then
Invalidate;
end;
end;
procedure TTextEditor.SetListBoxItemIndex(const Value: Integer);
begin
if Value >= 0 then
begin
if ListBoxSelection and (FTextFile.CaretPos.Y = Value) then
Exit;
FTextFile.CaretPos.SetPoint(0, Value);
ListBoxSelection := True;
end
else
begin
ListBoxSelection := False;
end;
end;
procedure TTextEditor.SetListBoxMode(const Value: Boolean);
begin
if FListBoxMode <> Value then
begin
FListBoxMode := Value;
if FListBoxMode then
begin
RemoveAllMargins;
EditMode := emReadOnly;
LineHighlight := True;
MatchBrackets := False;
ErrorMessageOnReadOnlyError := False;
DestroyCaret;
end
else
begin
EditMode := emText;
UpdateCaret;
DoSetCaretPos;
end;
end;
end;
procedure TTextEditor.SetListBoxSelection(AListBoxSelection: Boolean);
begin
if FListBoxSelection <> AListBoxSelection then
begin
FListBoxSelection := AListBoxSelection and not FTextFile.Empty;
if FListBoxMode then
begin
VisualUpdate(ctLine, FTextFile.CaretPos.Y, 0, 0, 0);
if FListBoxSelection then
if Assigned(FOnListBoxChange) then
FOnListBoxChange(Self);
end;
end;
end;
procedure TTextEditor.SetMarginBottom(const Value: Integer);
begin
if (Value < 0) or SingleLine then Exit;
if FMarginBottom <> Value then
begin
FMarginBottom := Value;
UpdateScrollBars;
Invalidate;
if FTextFile.ControlAware then
UpdateLineControls;
DoSetCaretPos;
end;
end;
procedure TTextEditor.SetMarginLeft(const Value: Integer);
begin
if (Value < 0) or SingleLine then Exit;
if FMarginLeft <> Value then
begin
FMarginLeft := Value;
FRulerWidth := Min(FRulerWidth, FMarginLeft);
UpdateScrollBars;
Invalidate;
if FTextFile.ControlAware then
UpdateLineControls;
DoSetCaretPos;
end;
end;
procedure TTextEditor.SetMarginRight(const Value: Integer);
begin
if (Value < 0) or SingleLine then Exit;
if FMarginRight <> Value then
begin
FMarginRight := Value;
UpdateScrollBars;
Invalidate;
if FTextFile.ControlAware then
UpdateLineControls;
DoSetCaretPos;
end;
end;
procedure TTextEditor.SetMarginTop(const Value: Integer);
begin
if (Value < 0) or SingleLine then Exit;
if FMarginTop <> Value then
begin
FMarginTop := Value;
UpdateScrollBars;
Invalidate;
if FTextFile.ControlAware then
UpdateLineControls;
DoSetCaretPos;
end;
end;
procedure TTextEditor.SetMatchBrackets(const Value: Boolean);
begin
if FMatchBrackets <> Value then
begin
FMatchBrackets := Value;
if (not FMatchBrackets) and FBracketHighlight then
begin
FBracketHighlight := False;
VisualUpdate(ctTwoChars, FBracketPos1.Y, FBracketPos1.X, FBracketPos2.Y, FBracketPos2.X);
end;
if FMatchBrackets then
TextFileCaretPosChange(Self);
end;
end;
procedure TTextEditor.SetMultiSize(const Value: Boolean);
begin
if not FMultiSize and not Value then
Exit;
FMultiSize := Value;
if FMultiSize then
begin
RebuildLineCache;
RecomputeHorizontalExtent;
end
else
DeleteAllLineControls;
Invalidate;
if FMultiSize and FTextFile.ControlAware then
UpdateLineControls;
end;
procedure TTextEditor.SetOverwrite(const Value: Boolean);
begin
if FOverwrite <> Value then
begin
FOverwrite := Value;
UpdateCaret;
if Assigned(FOnOverwriteChange) then
FOnOverwriteChange(Self);
end;
end;
procedure TTextEditor.SetPasswordChar(const Value: Char);
begin
if FPasswordChar <> Value then
begin
FPasswordChar := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetRightLine(const Value: Boolean);
begin
if FRightLine <> Value then
begin
FRightLine := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetRightLineColor(const Value: TColor);
begin
FRightLineColor := Value;
if FRightLine and (FRightLineColor <> Value) then
Invalidate;
end;
procedure TTextEditor.SetRightLinePos(const Value: Integer);
begin
FRightLinePos := Value;
if FRightLine and (FRightLinePos <> Value) then
Invalidate;
end;
procedure TTextEditor.SetRulerColor(const Value: TColor);
begin
if FRulerColor <> Value then
begin
FRulerColor := Value;
if RulerVisible then
UpdateRuler;
end;
end;
procedure TTextEditor.SetRulerVisible(const Value: Boolean);
begin
if SingleLine then Exit;
if Value and not RulerVisible then
SetRulerWidth(DEFAULT_RULER_WIDTH)
else if RulerVisible and not Value then
SetRulerWidth(0);
end;
procedure TTextEditor.SetRulerWidth(const Value: Integer);
begin
if (Value < 0) or SingleLine then Exit;
if FRulerWidth <> Value then
begin
Inc(FMarginLeft, Value - FRulerWidth);
FRulerWidth := Value;
UpdateScrollBars;
Invalidate;
DoSetCaretPos;
if FTextFile.ControlAware then
UpdateLineControls;
end;
end;
procedure TTextEditor.SetSelBackgroundColor(const Value: TColor);
begin
if FSelBackgroundColor <> Value then
begin
FSelBackgroundColor := Value;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.SetSelEndPos(const Value: TPoint);
begin
FTextFile.CaretPos.SetPoint(Value, True);
end;
procedure TTextEditor.SetSelForegroundColor(const Value: TColor);
begin
if FSelForegroundColor <> Value then
begin
FSelForegroundColor := Value;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.SetSelLength(const Value: Integer);
begin
FTextFile.SelLength := Value;
end;
procedure TTextEditor.SetSelStart(const Value: Integer);
begin
FTextFile.SelStart := Value;
end;
procedure TTextEditor.SetSelType(const Value: TSelectionType);
begin
FTextFile.CaretPos.SelectionType := Value;
end;
procedure TTextEditor.SetShowHiddenCharacters(const Value: Boolean);
begin
if FShowHiddenCharacters <> Value then
begin
FShowHiddenCharacters := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetSingleLine(const Value: Boolean);
begin
FTextFile.SingleLine := Value;
if Value then
begin
FRulerWidth := 0;
FMarginLeft := 0;
FMarginRight := 0;
FMarginTop := 0;
FMarginBottom := 0;
end;
FWantTab := not Value;
FWantReturn := not Value;
AdjustHeight;
Invalidate;
end;
function SetWindowSubclass(hWnd: HWND; pfnSubclass: SUBCLASSPROC;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; stdcall; external ComCtl32;
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: SUBCLASSPROC;
uIdSubclass: UINT_PTR): BOOL; stdcall; external ComCtl32;
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; external ComCtl32;
function ParentFormWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
lParam: LPARAM; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
case uMsg of
WM_WINDOWPOSCHANGED:
if TObject(dwRefData) is TTextEditor then
TTextEditor(dwRefData).MoveBalloonPostScroll;
end;
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
procedure TTextEditor.SetSizeHooks;
var
Ctl: TWinControl;
begin
Ctl := Self;
repeat
SetWindowSubclass(Ctl.Handle, ParentFormWndProc, NativeUInt(Self), NativeUInt(Self));
Ctl := Ctl.Parent;
until Ctl = nil;
end;
procedure TTextEditor.RemoveSizeHooks;
var
Ctl: TWinControl;
begin
Ctl := Self;
repeat
RemoveWindowSubclass(Ctl.Handle, ParentFormWndProc, NativeUInt(Self));
Ctl := Ctl.Parent;
until Ctl = nil;
end;
procedure TTextEditor.SetSortReverseOrder(const Value: Boolean);
begin
FTextFile.SortReverseOrder := Value;
end;
procedure TTextEditor.SetText(const Value: string);
begin
TypeTimerEnd;
FTextFile.PlainText := Value;
AddUndoRecord(SUndoTextSet, UID_UNKNOWN);
end;
procedure TTextEditor.SetTextFile(const Value: TTextFile);
var
WasControlAware: Boolean;
ptr: PByte;
begin
if not Enabled or FScriptRunning then
Exit;
Escape(True);
TypeTimerEnd;
if FTextFile <> Value then
begin
FreeAndNil(FLinks);
FListBoxSelection := False;
ClearBracketHighlight;
WasControlAware := TextFile.ControlAware;
DeleteAllLineControls;
DisconnectTextFileFromEditor;
if FTextFileOwner = tfoEditor then
FreeAndNil(FTextFile)
else
begin
if Assigned(FFormattingProcessor) then
FTextFile.EditorState.FormattingProcessor := FFormattingProcessor.ClassName
else
FTextFile.EditorState.FormattingProcessor := '';
FTextFile.EditorState.ScrollPos := FScrollPos;
FTextFile.EditorState.MultiSize := FMultiSize;
FTextFile.EditorState.Overwrite := FOverwrite;
FTextFile.EditorState.HiddenChrs := FShowHiddenCharacters;
FTextFile.EditorState.RulerVisible := RulerVisible;
FTextFile.EditorState.ZoomLevel := FZoom;
if FFormattingProcessor <> nil then
begin
if Assigned(FTextFile.EditorState.FPCache) then
begin
FreeMem(FTextFile.EditorState.FPCache);
FTextFile.EditorState.FPCache := nil;
FTextFile.EditorState.FPCacheLen := 0;
end;
FTextFile.EditorState.FPCacheLen := FFormattingProcessor.GetCache(ptr);
FTextFile.EditorState.FPCache := ptr;
FFormattingProcessor.ClearCache;
end;
FTextFile.EditorState.Valid := True;
end;
if Assigned(Value) then
FTextFile := Value
else
begin
FTextFileOwner := tfoEditor;
FTextFile := TTextFile.Create;
end;
FOldCaretPosY := FTextFile.CaretPos.Y;
ConnectTextFileToEditor;
if FTextFile.EditorState.Valid then
begin
MultiSize := FTextFile.EditorState.MultiSize;
Overwrite := FTextFile.EditorState.Overwrite;
ShowHiddenCharacters := FTextFile.EditorState.HiddenChrs;
RulerVisible := FTextFile.EditorState.RulerVisible;
Zoom := FTextFile.EditorState.ZoomLevel;
FFormattingProcessor := nil;
SetFormattingProcessor(
FPFromString(FTextFile.EditorState.FormattingProcessor),
FTextFile.EditorState.FPCache = nil);
if Assigned(FFormattingProcessor) and Assigned(FTextFile.EditorState.FPCache) then
begin
if not FFormattingProcessor.RestoreCache(FTextFile.EditorState.FPCache,
FTextFile.EditorState.FPCacheLen) then
FPFileChangeNotification(ctFile, 0, 0, 0, 0);
FreeMem(FTextFile.EditorState.FPCache);
FTextFile.EditorState.FPCache := nil;
FTextFile.EditorState.FPCacheLen := 0;
end;
SetScrollPosXY(FTextFile.EditorState.ScrollPos.X,
FTextFile.EditorState.ScrollPos.Y);
end
else
begin
MultiSize := FTextFile.ControlAware;
FFormattingProcessor := nil;
SetScrollPosXY(0, 0);
end;
UpdateCaret;
UpdateScrollBars;
Invalidate;
if HasNotificationMessage(EN_READONLY) and (EditMode <> emReadOnly) then
RemoveNotification(EN_READONLY)
else if (EditMode = emReadOnly) and not HasNotificationMessage(EN_READONLY) then
NotifyApp(EN_READONLY);
if WasControlAware then
RestoreAllMargins;
end;
end;
procedure TTextEditor.SetTextHint(const Value: string);
begin
if FTextHint <> Value then
begin
FTextHint := Value;
if (TextFile = nil) or TextFile.Empty then
Invalidate;
end;
end;
procedure TTextEditor.SetUnicodeFallback(const Value: Boolean);
begin
if FUnicodeFallback <> Value then
begin
FUnicodeFallback := Value;
Invalidate;
end;
end;
procedure TTextEditor.SetupColors;
begin
if FUseRuxThemes then
begin
FBkColor := clWindow;
FFgColor := IfThen(Enabled, clWindowText, clGrayText);
FSelBkColor := TUx.ThemeData.ActiveCaptionColor;
FSelFgColor := TUx.ThemeData.ActiveCaptionTextColor;
end
else if FUseSystemColors then
begin
FBkColor := clWindow;
FFgColor := IfThen(Enabled, clWindowText, clGrayText);
FSelBkColor := clHighlight;
FSelFgColor := clHighlightText;
end
else
begin
FBkColor := FBackgroundColor;
FFgColor := FForegroundColor;
FSelBkColor := FSelBackgroundColor;
FSelFgColor := FSelForegroundColor;
end;
end;
procedure TTextEditor.SetupFontMetrics;
begin
Canvas.Font.Assign(FFont);
Canvas.Font.Size := Ceil(Canvas.Font.Size * FZoom / 100);
FFontSize := Canvas.TextExtent('M');
Inc(FFontSize.cx, LetterSpacing);
Inc(FFontSize.cy, LineSpacing);
end;
procedure TTextEditor.SetUseRuxThemes(const Value: Boolean);
begin
if FUseRuxThemes <> Value then
begin
FUseRuxThemes := Value;
UseSystemColors := True;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.SetUseSystemColors(const Value: Boolean);
begin
if FUseSystemColors <> Value then
begin
FUseSystemColors := Value;
SetupColors;
Invalidate;
end;
end;
procedure TTextEditor.SetWrapAt(const Value: string);
begin
FTextFile.WrapAt := Value;
end;
procedure TTextEditor.SetZoom(const Value: Integer);
begin
if FZoom <> Value then
begin
FZoom := Value;
SetupFontMetrics;
if FMultiSize then
begin
if FTextFile.ControlAware then
ZoomImages;
UpdateFontBoxSizes;
RebuildLineCache;
RecomputeHorizontalExtent;
end;
UpdateScrollBars;
DoSetCaretPos;
if FTextFile.ControlAware then
UpdateLineControls;
Invalidate;
UpdateCaret;
if Assigned(FOnZoomChange) then
FOnZoomChange(Self);
end;
end;
function TTextEditor.ShowBalloon(const ATitle, AText: string; AKind: TBalloonIconKind;
APersistence: TBalloonPersistence; const APoint: TPoint): Boolean;
var
p: TPoint;
begin
Result := FHintWindow <> 0;
if Result then
begin
FBalloonPoint := APoint;
FBalloonPersistence := APersistence;
p := GetBalloonPosition;
FToolInfo.lpszText := PChar(AText);
Result := Result and (SendMessage(FHintWIndow, TTM_SETTITLE, Ord(AKind),
LPARAM(PChar(ATitle))) <> 0);
SendMessage(FHintWindow, TTM_UPDATETIPTEXT, 0, LPARAM(@FToolInfo));
SendMessage(FHintWindow, TTM_TRACKACTIVATE, 1, LPARAM(@FToolInfo));
SendMessage(FHintWindow, TTM_TRACKPOSITION, 0, MakeLParam(p.x, p.y));
if Ord(APersistence) <= Ord(bpTime) then
begin
FBalloonTimer.Enabled := False;
FBalloonTimer.Enabled := True;
end;
end;
end;
function TTextEditor.Sort(AFirstLine, ALastLine: Integer): Boolean;
begin
TypeTimerEnd;
Result := FTextFile.Sort(AFirstLine, ALastLine, FTextFile.HasBookmarks);
if Result then AddUndoRecord(SUndoSorted, UID_UNKNOWN);
end;
function TTextEditor.Sort: Boolean;
begin
Result := Sort(0, LineCount - 1);
end;
function TTextEditor.SortSelection: Boolean;
var
FirstPoint, SecondPoint: TPoint;
begin
Result := False;
if not FTextFile.HasSelection then Exit;
FTextFile.CaretPos.GetSelBdry(FirstPoint, SecondPoint);
Result := Sort(FirstPoint.Y, SecondPoint.Y);
end;
procedure TTextEditor.SurroundText(const APrefix, APostfix: string);
begin
TypeTimerEnd;
FTextFile.SurroundText(APrefix, APostfix);
AddUndoRecord(Format(SUndoTextSurrounded, [APrefix, APostfix]), UID_UNKNOWN);
end;
function TTextEditor.CanRedo: Boolean;
begin
Result := FTextFile.CanRedo;
end;
function TTextEditor.CanUndo: Boolean;
begin
Result := FTextFile.CanUndo or FTypeTimer.Enabled;
end;
procedure TTextEditor.ChangeCursor;
var
ShiftState: TShiftState;
begin
ShiftState := [];
if IsKeyDown(VK_SHIFT) then
Include(ShiftState, ssShift);
if IsKeyDown(VK_CONTROL) then
Include(ShiftState, ssCtrl);
if IsKeyDown(VK_MENU) then
Include(ShiftState, ssAlt);
ChangeCursor(ShiftState);
end;
function TTextEditor.CharAtPhysicalPixel(Pixel: TPoint): TPoint;
begin
Result := CharAtPhysicalPixelEx(Pixel);
end;
function TTextEditor.CharAtVirtualPixel(Pixel: TPoint): TPoint;
begin
Result := CharAtVirtualPixelEx(Pixel);
end;
function TTextEditor.CharAtPhysicalPixelEx(Pixel: TPoint; CP: Boolean = False): TPoint;
begin
Inc(Pixel.Y, FScrollPos.Y - FMarginTop);
Inc(Pixel.X, FScrollPos.X - FMarginLeft);
Result := CharAtVirtualPixelEx(Pixel, CP);
end;
function TTextEditor.CharAtVirtualPixelEx(Pixel: TPoint; CP: Boolean = False): TPoint;
var
FontSizecx: Integer;
i: Integer;
begin
if FMultiSize then
begin
Result.Y := FTextFile.LineCount - 1;
for i := 0 to High(FAccumLineHeights) do
if FAccumLineHeights[i] > Pixel.Y then
begin
Result.Y := i - 1;
break;
end;
if Result.Y < 0 then
Result.Y := 0;
FontSizecx := FFontSizes[Result.Y].cx;
end
else
begin
Result.Y := EnsureRange(Pixel.Y div FFontSize.cy, 0, FTextFile.LineCount - 1);
FontSizecx := FFontSize.cx;
end;
if FTextFile.CaretAfterEOL then
Result.X := Max(0, (Pixel.X + IfThen(CP, 1) * FontSizecx div 2) div FontSizecx)
else
Result.X := EnsureRange((Pixel.X + IfThen(CP, 1) * FontSizecx div 2) div FontSizecx, 0, FTextFile.VirtualLineWidths[Result.Y]);
end;
procedure TTextFile.AddLine(const ALine: string);
begin
AddLine(ALine, '');
end;
procedure TTextFile.GotoSOF(Selection: Boolean = False);
begin
FCaretPos.SetPoint(0, 0, Selection);
end;
procedure TTextFile.GotoEOF(Selection: Boolean = False);
begin
FCaretPos.SetPoint(VirtualLineWidths[LineCount - 1], LineCount - 1, Selection);
end;
function TTextFile.GotoHistoryVersion(Index: Integer): Boolean;
var
UndoData: TUndoDataItem;
begin
Result := FHistoryManager.GotoVersion(Index, UndoData);
if not Result then Exit;
ApplyUndoRecord(UndoData);
end;
function TTextFile.GotoBookmark(AIndex: Integer): Boolean;
begin
Result := InRange(AIndex, Low(FBookmarks), High(FBookmarks)) and
(not SamePoint(FBookmarks[AIndex], EMPTY_BOOKMARK)) and
ValidCaretPos(FBookmarks[AIndex]);
if Result then
FCaretPos.SetPoint(FBookmarks[AIndex]);
end;
procedure TTextFile.GotoBottomRight(Selection: Boolean = False);
begin
FCaretPos.SetPoint(GetMaxLineWidth, LineCount - 1, Selection);
end;
function TTextFile.HasQueryResult(const AFindQuery: TFindQuery): Boolean;
begin
Result := CompareFindQuery(AFindQuery) and FFindResultValid;
end;
function TTextFile.HasSelection: Boolean;
begin
Result := not SamePoint(FCaretPos.Data, FCaretPos.SelEnd);
end;
procedure TTextFile.Home(AFile: Boolean = False; Selection: Boolean = False);
begin
if AFile then
GotoSOF(Selection)
else
begin
if FCaretPos.X > 0 then
FCaretPos.SetX(0, Selection)
else
FCaretPos.SetX(GetIndent, Selection);
end;
end;
procedure TTextFile.KEnd(AFile: Boolean = False; Selection: Boolean = False);
begin
if AFile then
GotoEOF(Selection)
else
FCaretPos.SetX(VirtualLineWidths[FCaretPos.Y], Selection);
end;
const
FIND_DATA_ALLOC_BY = 4096;
procedure TTextFile.AddBookmark(AIndex: Integer);
begin
AddBookmark(AIndex, FCaretPos.Data);
end;
procedure TTextFile.AddBookmark(AIndex: Integer; const APoint: TPoint);
begin
Assert(InRange(AIndex, Low(FBookmarks), High(FBookmarks)));
FBookmarks[AIndex] := APoint;
end;
function TTextFile.AddBookmark: Integer;
begin
Result := AddBookmark(FCaretPos.Data);
end;
procedure TTextFile.AddFindData(const A: TPoint);
var
B: TPoint;
begin
B.Y := A.Y;
B.X := A.X + 1;
AddFindData(A, B);
end;
function TTextFile.AddBookmark(const APoint: TPoint): Integer;
begin
Result := GetEmptyBookmarkIndex;
if Result > -1 then
AddBookmark(Result, APoint);
end;
procedure TTextFile.AddFindData(const A, B: TPoint);
begin
if FFindDataActualLength = Length(FFindData) then
SetLength(FFindData, Length(FFindData) + FIND_DATA_ALLOC_BY);
FFindData[FFindDataActualLength].A := A;
FFindData[FFindDataActualLength].B := B;
Inc(FFindDataActualLength);
end;
procedure TTextFile.AddIndent;
var
FirstPoint, SecondPoint: TPoint;
i: Integer;
IndentStep: string;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FirstPoint.Y < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
IndentStep := DupeString(#32, FIndentSize);
for i := FirstPoint.Y to SecondPoint.Y do
if not (FControlAware and IsControlLine(i)) then
FLines[i] := IndentStep + FLines[i];
FCaretPos.InternalPush(FIndentSize);
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
Modified;
PushBookmarksEx(FirstPoint.Y, SecondPoint.Y, FIndentSize);
end;
procedure TTextFile.AddLine(const ALine: string; const AClassName: string);
begin
if EditMode = emReadOnly then
begin
IssueReadOnlyError;
Exit;
end;
if FSingleLine then
raise EInvalidOperation.Create(SInvalidOpMsgSingleLineModeInsertLine);
InternalAddLine(ALine, AClassName);
if FMultiAddLineMode <= 0 then
begin
LineArrayChanged;
Changed(ctLine, High(FLines), 0);
GotoEOF;
Modified;
end;
end;
procedure TTextFile.AddUndoRecord(const AComment: string; UID: UNDONAMEID);
begin
FHistoryManager.Add(GetText, GetClassesAsText, FCaretPos.Data,
FCaretPos.SelEnd, FCaretPos.SelectionType, Now, AComment, FBookmarks, Ord(UID));
end;
procedure TTextFile.AddUndoRecord;
begin
FHistoryManager.Add(GetText, GetClassesAsText, FCaretPos.Data,
FCaretPos.SelEnd, FCaretPos.SelectionType, Now, '', FBookmarks);
end;
function TTextFile.AllSelected: Boolean;
var
FirstPoint, SecondPoint: TPoint;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
Result := (FirstPoint.Y = 0) and (FirstPoint.X = 0) and (SecondPoint.Y = LineCount - 1) and (SecondPoint.X >= VirtualLineWidths[LineCount - 1]);
end;
procedure TTextFile.Backspace(Word: Boolean = False);
var
LW, PWB: Integer;
Len: Integer;
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and not AtLastLine) then
begin
IssueReadOnlyError;
Exit;
end;
if HasSelection then
begin
ClearSelection;
Exit;
end;
if AtSOF then
begin
IssueInputError;
Exit;
end;
if FControlAware and IsControlLine then
begin
if FCaretPos.X > 1 then
Left
else if FCaretPos.X = 1 then
begin
DeleteControlAtLine(FCaretPos.Y);
FCaretPos.SetX(0);
Changed(ctLine, FCaretPos.Y);
Modified;
end
else if FCaretPos.X = 0 then
begin
if (FCaretPos.Y > 0) and LineIsEmpty(FCaretPos.Y - 1) then
begin
InternalDeleteLine(FCaretPos.Y - 1);
QushBookmarks(FCaretPos.Y - 1, 1);
LineArrayChanged;
FCaretPos.SetPoint(0, FCaretPos.Y - 1);
Changed(ctLineRange, FCaretPos.Y, LineCount - 1);
PostFileChanged(1);
Modified;
end
else
IssueInputError;
end;
Exit;
end;
if (EditMode = emConsole) and (FCaretPos.X = 0) then
Exit ;
if FControlAware and (FCaretPos.X = 0) and (FCaretPos.Y > 0) and
IsControlLine(FCaretPos.Y - 1) and not LineIsEmpty(FCaretPos.Y) then
begin
IssueInputError;
Exit;
end;
if (FCaretPos.X = 0) and (FCaretPos.Y > 0) then
begin
LW := VirtualLineWidths[FCaretPos.Y - 1];
if LineIsEmpty(FCaretPos.Y - 1) and not SameStr(FClasses[FCaretPos.Y - 1], FClasses[FCaretPos.Y]) then
begin
FClasses[FCaretPos.Y - 1] := FClasses[FCaretPos.Y];
LineClassChanged(FCaretPos.Y - 1);
end;
FLines[FCaretPos.Y - 1] := FLines[FCaretPos.Y - 1] + FLines[FCaretPos.Y];
InternalDeleteLine(FCaretPos.Y);
QushBookmarks(FCaretPos.Y - 1, LW);
LineArrayChanged;
FCaretPos.SetPoint(LW, FCaretPos.Y - 1);
Changed(ctLineRange, FCaretPos.Y, LineCount - 1, 2);
PostFileChanged(1);
Modified;
Exit;
end;
if Word then
PWB := PrevWordBoundary
else
PWB := FCaretPos.X - 1;
Len := FCaretPos.X - PWB;
if AtEOL then
begin
SetLength(FLines[FCaretPos.Y], Length(FLines[FCaretPos.Y]) - Len);
FCaretPos.SetX(PWB);
if Len = 1 then
Changed(ctChar, FCaretPos.Y, FCaretPos.X)
else
Changed(ctLineFrom, FCaretPos.Y, FCaretPos.X);
end
else
begin
System.Delete(FLines[FCaretPos.Y], PWB + 1, Len);
FCaretPos.SetX(PWB);
Changed(ctLineFrom, FCaretPos.Y, FCaretPos.X);
end;
PushBookmarks(FCaretPos.Y, FCaretPos.X + 1, -Len);
Modified;
end;
function TTextFile.GetLastLine: string;
begin
if LineCount > 0 then
Result := Lines[LineCount - 1]
else
Result := '';
end;
procedure TTextFile.SetLastLine(const AText: string);
begin
if LineCount > 0 then
Lines[LineCount - 1] := AText
else
AddLine(AText);
end;
procedure TTextFile.Left(Word: Boolean = False; Selection: Boolean = False;
Block: Boolean = False);
begin
if (EditMode = emConsole) and (FCaretPos.X = 0) and AtLastLine then
begin
IssueInputError;
Exit;
end;
if Selection and (not HasSelection) and BeyondEOL and (not Block) then
Selection := False;
if Selection and Block then
FCaretPos.SelectionType := stBlock;
if (FCaretPos.SelectionType = stBlock) and (FCaretPos.X = 0) then
begin
IssueInputError;
Exit;
end;
if FCaretPos.X > 0 then
if Word then
FCaretPos.SetX(PrevWordBoundary, Selection)
else
FCaretPos.SetX(FCaretPos.X - 1, Selection)
else if FCaretPos.Y > 0 then
FCaretPos.SetPoint(VirtualLineWidths[FCaretPos.Y - 1], FCaretPos.Y - 1, Selection)
else
IssueInputError;
end;
procedure TTextFile.Right(Word: Boolean = False; Selection: Boolean = False;
Block: Boolean = False);
begin
if Selection and (not HasSelection) and AtOrBeyondEOL and (not Block) then
Selection := False;
if Selection and Block then
FCaretPos.SelectionType := stBlock;
if (FCaretPos.X < VirtualLineWidths[FCaretPos.Y]) or (FCaretAfterEOL and not Word) then
if Word then
FCaretPos.SetX(NextWordBoundary, Selection)
else
FCaretPos.SetX(FCaretPos.X + 1, Selection)
else if (FCaretPos.Y < LineCount - 1) then
FCaretPos.SetPoint(0, FCaretPos.Y + 1, Selection)
else
IssueInputError;
end;
function TTextFile.RushBookmarks(const FirstPoint: TPoint): Boolean;
begin
Result := RushBookmarksInternal(FirstPoint);
if Result then BookmarksMoved;
end;
function TTextFile.RushBookmarksEx(const FirstPoint,
SecondPoint: TPoint): Boolean;
var
i: Integer;
Δy, Δx: Integer;
begin
Result := False;
Δy := SecondPoint.Y - FirstPoint.Y;
Δx := SecondPoint.X - FirstPoint.X;
for i := Low(FBookmarks) to High(FBookmarks) do
if (FBookmarks[i].Y = FirstPoint.Y) and (FBookmarks[i].X >= FirstPoint.X) then
begin
Result := True;
Inc(FBookmarks[i].Y, Δy);
Inc(FBookmarks[i].X, Δx);
end
else if (FBookmarks[i].Y > FirstPoint.Y) then
begin
Result := True;
Inc(FBookmarks[i].Y, Δy);
end;
if Result then BookmarksMoved;
end;
function TTextFile.RushBookmarksInternal(const FirstPoint: TPoint): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if (FBookmarks[i].Y = FirstPoint.Y) and (FBookmarks[i].X >= FirstPoint.X) then
begin
Result := True;
Inc(FBookmarks[i].Y, 1);
Dec(FBookmarks[i].X, FirstPoint.X);
end
else if (FBookmarks[i].Y > FirstPoint.Y) then
begin
Result := True;
Inc(FBookmarks[i].Y, 1);
end;
end;
function TTextFile.Undo: Boolean;
var
UndoData: TUndoDataItem;
begin
Result := FHistoryManager.Undo(UndoData);
if not Result then Exit;
ApplyUndoRecord(UndoData);
end;
function TTextFile.UnsafeGetChar(Y, X: Integer): Char;
begin
Result := FLines[Y][X+1];
end;
procedure TTextFile.Up(Selection: Boolean = False; Block: Boolean = False);
begin
if Selection and Block then
FCaretPos.SelectionType := stBlock;
if FCaretPos.Y > 0 then
if FCaretAfterEOL then
FCaretPos.SetY(FCaretPos.Y - 1, Selection)
else
begin
FPreserveDesiredCol := True;
try
FCaretPos.SetPoint(Min(IfThen(FDesiredCol <> 0, FDesiredCol, FCaretPos.X),
VirtualLineWidths[FCaretPos.Y - 1]), FCaretPos.Y - 1, Selection)
finally
FPreserveDesiredCol := False;
end;
end
else
IssueInputError;
end;
function TTextFile.ValidCaretPos(APoint: TPoint): Boolean;
begin
Result := InRange(APoint.Y, 0, LineCount - 1) and
(InRange(APoint.X, 0, VirtualLineWidths[APoint.Y]) or FCaretAfterEOL);
end;
procedure TTextFile.WordWrap(ALineLength: Integer; ANice: Boolean; AChr: Char);
var
NewFile: TTextFile;
y: Integer;
WrapList: TIntegerDynArray;
i: Integer;
SChr: string;
HasBookmarks, BMCh: Boolean;
BMLastWrap, BMc: Integer;
begin
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
HasBookmarks := Self.HasBookmarks;
BMCh := False;
if ALineLength <= 0 then Exit;
if AChr = #0 then
SChr := ''
else
SChr := AChr;
NewFile := TTextFile.Create;
try
BMc := 0;
for y := 0 to LineCount - 1 do
begin
if ANice then
FindWhereToWrap(y, ALineLength, WrapList)
else
begin
if VirtualLineWidths[y] = 0 then
SetLength(WrapList, 0)
else
SetLength(WrapList, ceil(VirtualLineWidths[y] / ALineLength) - 1);
for i := 0 to High(WrapList) do WrapList[i] := (i+1) * ALineLength;
end;
if Length(WrapList) > 0 then
begin
BMLastWrap := 0;
NewFile.AddLine(SysUtils.TrimRight(Copy(FLines[y], 1, WrapList[0])) + SChr, FClasses[y]);
for i := 0 to High(WrapList) - 1 do
begin
NewFile.AddLine(SysUtils.TrimRight(Copy(FLines[y], WrapList[i] + 1,
WrapList[i+1] - WrapList[i])) + SChr, FClasses[y]);
if HasBookmarks then
begin
BMCh := RushBookmarksInternal(Point(WrapList[i] - BMLastWrap, y + BMc)) or BMCh;
BMLastWrap := WrapList[i];
Inc(BMc);
end;
end;
NewFile.AddLine(Copy(FLines[y], WrapList[High(WrapList)] + 1), FClasses[y]);
if HasBookmarks then
begin
BMCh := RushBookmarksInternal(Point(WrapList[High(WrapList)] - BMLastWrap, y + BMc)) or BMCh;
Inc(BMc);
end;
end
else
NewFile.AddLine(FLines[y], FClasses[y]);
end;
SetLength(FLines, NewFile.LineCount - 1);
SetLength(FClasses, NewFile.LineCount - 1);
for y := 1 to NewFile.LineCount - 1 do
begin
FLines[y - 1] := NewFile.Lines[y];
FClasses[y - 1] := NewFile.Classes[y];
end;
finally
NewFile.Free;
end;
LineArrayChanged;
Changed(ctFile);
GotoSOF;
Modified;
if BMCh then BookmarksMoved;
end;
procedure TTextFile.Delete(Word: Boolean);
var
NWB: Integer;
Len: Integer;
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and not AtLastLine) then
begin
IssueReadOnlyError;
Exit;
end;
if HasSelection then
begin
ClearSelection;
Exit;
end;
if AtOrBeyondEOF then
begin
IssueInputError;
Exit;
end;
if FControlAware and IsControlLine then
begin
if FCaretPos.X = 0 then
begin
DeleteControlAtLine(FCaretPos.Y);
Changed(ctLine, FCaretPos.Y);
Modified;
end
else if FCaretPos.X = 1 then
begin
if (not AtLastLine) and LineIsEmpty(FCaretPos.Y + 1) then
begin
InternalDeleteLine(FCaretPos.Y + 1);
QushBookmarks(FCaretPos.Y, 1);
LineArrayChanged;
Changed(ctLineRange, FCaretPos.Y, LineCount - 1);
PostFileChanged(1);
Modified;
end
else
IssueInputError;
end
else
IssueInputError;
Exit;
end;
if AtOrBeyondEOL and not AtLastLine then
begin
if FControlAware and IsControlLine(FCaretPos.Y + 1) then
begin
if LineIsEmpty(FCaretPos.Y) then
FClasses[FCaretPos.Y] := LINE_CONTROL_CLASS
else
begin
IssueInputError;
Exit;
end;
end;
FLines[FCaretPos.Y] := FLines[FCaretPos.Y] + GetVirtualSpace + FLines[FCaretPos.Y + 1];
InternalDeleteLine(FCaretPos.Y + 1);
QushBookmarks(FCaretPos.Y, FCaretPos.X);
LineArrayChanged;
Changed(ctLineRange, FCaretPos.Y, LineCount - 1, 2);
PostFileChanged(1);
Modified;
Exit;
end;
if Word then
NWB := NextWordBoundary
else
NWB := FCaretPos.X + 1;
Len := NWB - FCaretPos.X;
System.Delete(FLines[FCaretPos.Y], FCaretPos.X + 1, Len);
PushBookmarks(FCaretPos.Y, FCaretPos.X, -Len);
Changed(ctLineFrom, FCaretPos.Y, FCaretPos.X);
Modified;
end;
function TTextFile.DeleteControlAtLine(const LineIndex: Integer): Boolean;
var
CID: Integer;
begin
Result := IsControlLine(LineIndex) and TryStrToInt(Copy(FLines[LineIndex],
Length(LINE_CONTROL_PREFIX) + 1), CID);
if Result then
begin
FLines[LineIndex] := '';
FClasses[LineIndex] := '';
if Assigned(FOnControlRemoved) then
FOnControlRemoved(Self, CID);
LineClassChanged(LineIndex);
end;
end;
destructor TTextFile.Destroy;
begin
FreeAndNil(FHistoryManager);
FreeAndNil(FCaretPos);
FreeAndNil(FEditorState);
inherited;
end;
procedure TTextFile.Down(Selection: Boolean = False; Block: Boolean = False);
begin
if Selection and Block then
FCaretPos.SelectionType := stBlock;
if FCaretPos.Y < LineCount - 1 then
if FCaretAfterEOL then
FCaretPos.SetY(FCaretPos.Y + 1, Selection)
else
begin
FPreserveDesiredCol := True;
try
FCaretPos.SetPoint(Min(IfThen(FDesiredCol <> 0, FDesiredCol, FCaretPos.X),
VirtualLineWidths[FCaretPos.Y + 1]), FCaretPos.Y + 1, Selection)
finally
FPreserveDesiredCol := False;
end;
end
else
IssueInputError;
end;
function TTextFile.Empty: Boolean;
begin
Result := (Length(FLines) = 0) or
(Length(FLines) = 1) and (Length(FLines[0]) = 0);
end;
procedure TTextFile.ApplyUndoRecord(const UndoData: TUndoDataItem);
begin
SetText(UndoData.Text, UndoData.Classes);
FBookmarks := UndoData.Bookmarks;
FCaretPos.CreateSelection(UndoData.SelStartPos, UndoData.CaretPos, UndoData.SelType);
end;
procedure TTextFile.EndAddFindData;
begin
SetLength(FFindData, FFindDataActualLength);
end;
procedure TTextFile.EndAddLine;
begin
Dec(FMultiAddLineMode);
if FMultiAddLineMode <= 0 then
begin
LineArrayChanged;
Changed(ctFile);
GotoEOF;
Modified;
end;
end;
function TTextFile.FillWithChar(const AChar: Char): Boolean;
begin
Result := ChrTransform(function(C: Char): Char begin Result := AChar end);
end;
function TTextFile.LineMatches(LineIndex: Integer; const ACriteria: TFilterOptions): Boolean;
begin
Result := True;
if ACriteria.MatchCase then
begin
if ACriteria.Contains <> '' then
Result := Result and ContainsStr(FLines[LineIndex], ACriteria.Contains);
if ACriteria.StartsWith <> '' then
Result := Result and StartsStr(ACriteria.StartsWith, FLines[LineIndex]);
if ACriteria.EndsWith <> '' then
Result := Result and EndsStr(ACriteria.EndsWith, FLines[LineIndex]);
end
else
begin
if ACriteria.Contains <> '' then
Result := Result and ContainsText(FLines[LineIndex], ACriteria.Contains);
if ACriteria.StartsWith <> '' then
Result := Result and StartsText(ACriteria.StartsWith, FLines[LineIndex]);
if ACriteria.EndsWith <> '' then
Result := Result and EndsText(ACriteria.EndsWith, FLines[LineIndex]);
end
end;
procedure TTextFile.Filter(const AFilterOptions: TFilterOptions);
var
SL: TStringList;
i: Integer;
HasBookmarks, BMCh: Boolean;
BMc: Integer;
begin
if EditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
if FControlAware then
begin
IssueInputError;
Exit;
end;
HasBookmarks := Self.HasBookmarks;
BMCh := False;
BMc := 0;
SL := TStringList.Create;
try
SL.Capacity := LineCount;
SL.BeginUpdate;
for i := 0 to LineCount - 1 do
if LineMatches(i, AFilterOptions) xor AFilterOptions.RemoveMatchingLines then
SL.Add(FLines[i])
else if HasBookmarks then
begin
BMCh := DeleteBookmarksOnLine(i - BMc) or BMCh;
BMCh := TushBookmarksInternal(i - BMc, -1) or BMCh;
Inc(BMc);
end;
SL.EndUpdate;
SetLength(FLines, SL.Count);
SetLength(FClasses, SL.Count);
for i := 0 to SL.Count - 1 do
begin
FLines[i] := SL.Strings[i];
FClasses[i] := '';
end;
if Length(FLines) = 0 then
InternalAddLine('', '');
LineArrayChanged;
Changed(ctFile);
GotoSOF;
Modified;
if BMCh then BookmarksMoved;
finally
SL.Free;
end;
end;
function IsNoncharacter(C: Char): Boolean;
begin
Result := InRange(Ord(C), $FDD0, $FDEF) or (Ord(C) = $FFFE) or (Ord(C) = $FFFF);
end;
function TTextFile.Find(AFindData: TFindQuery; AInternal: Boolean = False): Integer;
procedure CheckWordAndAddFindData(const A, B: TPoint);
begin
if
(not AFindData.MatchWord)
or
(
(
(A.X = 0) or not FLines[A.Y][A.X-1+1].IsLetterOrDigit
)
and
(
(B.X = VirtualLineWidths[B.Y]) or not FLines[B.Y][B.X+1].IsLetterOrDigit
)
)
then
AddFindData(A, B);
end;
var
WithinLines, NoMatch: Boolean;
len, i, j, p, y, x: Integer;
SearchLines: DynStringArray;
LowerCaseLines: array of string;
label
Finish;
begin
Result := 0;
if HasQueryResult(AFindData) then Exit(Length(FFindData));
FFindQuery := AFindData;
ClearFindData;
if AFindData.UCBlock <> FQ_NULL then
begin
if not InRange(AFindData.UCBlock, FQ_MIN, UCD.BlockCount - 1) then
Exit;
for y := 0 to Length(FLines) - 1 do
begin
if IsControlLine(y) then
Continue;
for x := 1 to Length(FLines[y]) do
case AFindData.UCBlock of
FQ_NONASCII:
if Ord(FLines[y][x]) > 127 then
AddFindData(Point(x - 1, y));
FQ_CONTROL:
if FLines[y][x].IsControl then
AddFindData(Point(x - 1, y));
FQ_NONCHAR:
if IsNoncharacter(FLines[y][x]) then
AddFindData(Point(x - 1, y));
else
with UCD.Blocks[AFindData.UCBlock - 1] do
if InRange(Ord(FLines[y][x]), BlockBegin, BlockEnd) then
AddFindData(Point(x - 1, y));
end;
end;
goto Finish;
end;
len := Length(AFindData.SearchString);
WithinLines := (not AFindData.Linebreak) or (Pos('\n', AFindData.SearchString) = 0);
if AFindData.MatchCase then
DynStringArray(LowerCaseLines) := DynStringArray(FLines)
else
begin
AFindData.SearchString := AnsiLowerCase(AFindData.SearchString);
SetLength(LowerCaseLines, LineCount);
for i := 0 to LineCount - 1 do
LowerCaseLines[i] := AnsiLowerCase(FLines[i]);
end;
if WithinLines then
begin
for i := 0 to GetLineCount - 1 do
begin
if FControlAware and IsControlLine(i) then Continue;
p := 1 - Length(AFindData.SearchString);
repeat
p := PosEx(AFindData.SearchString, LowerCaseLines[i], p + Length(AFindData.SearchString));
if p > 0 then
CheckWordAndAddFindData(Point(p-1, i), Point(p-1+len, i));
until p = 0;
end;
end
else
begin
SearchLines := Split(AFindData.SearchString, '\n');
for i := 0 to GetLineCount - 1 do
begin
p := PhysicalLineWidths[i] - Length(SearchLines[0]) + 1;
if SameStr(SearchLines[0], Copy(LowerCaseLines[i], p)) then
begin
if IsControlLine(i) then Continue;
NoMatch := False;
for j := 1 to High(SearchLines) do
if (i + j >= LineCount)
or
((j < High(SearchLines)) and not SameStr(SearchLines[j], LowerCaseLines[i + j]))
or
((j = High(SearchLines)) and not SameStr(SearchLines[j], Copy(LowerCaseLines[i + j], 1, Length(SearchLines[j]))))
or
IsControlLine(i + j) then
begin
NoMatch := True;
break;
end;
if not NoMatch then
CheckWordAndAddFindData(Point(p-1, i), Point(Length(SearchLines[High(SearchLines)]), i + High(SearchLines)));
end;
end;
end;
Finish:
EndAddFindData;
Result := Length(FFindData);
FFindResultValid := True;
end;
function TTextFile.IsWrappable(const AChar: Char): Boolean;
var
i: Integer;
begin
Result := False;
for i := 1 to Length(FWrapAt) do
if AChar = FWrapAt[i] then
Exit(True);
end;
procedure TTextFile.FindWhereToWrap(ALineIndex, MaxLength: Integer;
var AWrapList: TIntegerDynArray);
const
ALLOC_BY = 32;
var
ActualLength: Integer;
procedure Add(X: Integer);
begin
if ActualLength = Length(AWrapList) then
SetLength(AWrapList, Length(AWrapList) + ALLOC_BY);
AWrapList[ActualLength] := X;
Inc(ActualLength);
end;
procedure Trim;
begin
SetLength(AWrapList, ActualLength);
end;
function LastBreak: Integer;
begin
if ActualLength > 0 then
Result := AWrapList[ActualLength - 1]
else
Result := 0;
end;
var
OpportunityFound: Boolean;
x: Integer;
LineLength: Integer;
begin
SetLength(AWrapList, 0);
if MaxLength <= 0 then Exit;
ActualLength := 0;
LineLength := VirtualLineWidths[ALineIndex];
while LineLength > LastBreak + MaxLength do
begin
OpportunityFound := False;
for x := LastBreak + MaxLength downto LastBreak + 1 do
if IsWrappable(Character[ALineIndex, x]) then
begin
if (x = LastBreak + MaxLength) and (Character[ALineIndex, x] <> #32) then Continue;
Add(x + 1);
OpportunityFound := True;
break;
end;
if not OpportunityFound then
Add(LastBreak + MaxLength);
end;
Trim;
end;
function TTextFile.GetIndent(LineIndex: Integer): Integer;
var
i: Integer;
begin
if FCaretAfterEOL and LineIsEmpty(LineIndex) then
Exit(FCaretPos.X);
for i := 1 to VirtualLineWidths[LineIndex] do
if FLines[LineIndex][i] <> #32 then
Exit(i - 1);
Result := VirtualLineWidths[LineIndex];
end;
function TTextFile.LineIsEmpty(const LineIndex: Integer): Boolean;
begin
Result := Length(FLines[LineIndex]) = 0;
end;
function TTextFile.Redo: Boolean;
var
UndoData: TUndoDataItem;
begin
Result := FHistoryManager.Redo(UndoData);
if not Result then Exit;
ApplyUndoRecord(UndoData);
end;
procedure TrimLeftInplace(var S: string; out Len: Integer);
begin
Len := 0;
while (Len + 1 <= Length(S)) and (S[Len + 1] = #32) do Inc(Len);
if Len > 0 then Delete(S, 1, Len);
end;
procedure TTextFile.RemoveAllIndent;
var
FirstPoint, SecondPoint: TPoint;
i, len: Integer;
HasBookmarks, BMCh: Boolean;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FirstPoint.Y < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
HasBookmarks := Self.HasBookmarks;
BMCh := False;
for i := FirstPoint.Y to SecondPoint.Y do
begin
TrimLeftInplace(FLines[i], len);
if HasBookmarks and (len > 0) then
BMCh := PushBookmarksInternal(i, -len) or BMCh;
end;
FCaretPos.SetX(0);
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
Modified;
if BMCh then BookmarksMoved;
end;
procedure TTextFile.RemoveIndent;
var
FirstPoint, SecondPoint: TPoint;
i: Integer;
IndentStep: string;
LastLinePushed: Boolean;
HasBookmarks, BMCh: Boolean;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FirstPoint.Y < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
HasBookmarks := Self.HasBookmarks;
BMCh := False;
IndentStep := DupeString(#32, FIndentSize);
LastLinePushed := SameStr(Copy(FLines[SecondPoint.Y], 1, FIndentSize), IndentStep);
for i := FirstPoint.Y to SecondPoint.Y do
if not (FControlAware and IsControlLine(i)) then
if SameStr(Copy(FLines[i], 1, FIndentSize), IndentStep) then
begin
System.Delete(FLines[i], 1, FIndentSize);
if HasBookmarks then
BMCh := PushBookmarksInternal(i, -FIndentSize) or BMCh;
end;
FCaretPos.InternalPush(-FIndentSize, LastLinePushed);
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
Modified;
if BMCh then BookmarksMoved;
end;
procedure TTextFile.ReplaceInLineSameWidth(const ReplaceText: string);
var
i: Integer;
begin
for i := Low(FFindData) to High(FFindData) do
Move(ReplaceText[1], FLines[FFindData[i].A.Y][FFindData[i].A.X + 1],
Length(ReplaceText) * SizeOf(Char));
end;
procedure TTextFile.ReplaceInLineDiffWidth(const ReplaceText: string);
var
LineMatches: array of Integer;
diff, i: Integer;
PrevCurLine: Integer;
NewLine: string;
OriginalOffset, NewOffset: Integer;
begin
diff := Length(ReplaceText) - Length(FFindQuery.SearchString);
SetLength(LineMatches, LineCount);
for i := 0 to LineCount - 1 do
LineMatches[i] := 0;
for i := Low(FFindData) to High(FFindData) do
Inc(LineMatches[FFindData[i].A.Y]);
PrevCurLine := -1;
OriginalOffset := 0;
NewOffset := 0;
for i := Low(FFindData) to High(FFindData) do
begin
if PrevCurLine <> FFindData[i].A.Y then
begin
if PrevCurLine <> -1 then
begin
Move(FLines[PrevCurLine][OriginalOffset + 1], NewLine[NewOffset + 1], (VirtualLineWidths[PrevCurLine] - OriginalOffset) * SizeOf(Char));
FLines[PrevCurLine] := NewLine;
end;
SetLength(NewLine, Length(FLines[FFindData[i].A.Y]) + LineMatches[FFindData[i].A.Y] * diff);
NewOffset := 0;
Move(FLines[FFindData[i].A.Y][1], NewLine[NewOffset + 1], FFindData[i].A.X * SizeOf(Char));
NewOffset := FFindData[i].A.X;
Move(ReplaceText[1], NewLine[NewOffset + 1], Length(ReplaceText) * SizeOf(Char));
Inc(NewOffset, Length(ReplaceText));
OriginalOffset := FFindData[i].A.X + Length(FFindQuery.SearchString);
PrevCurLine := FFindData[i].A.Y;
end
else
begin
Move(FLines[FFindData[i].A.Y][OriginalOffset + 1], NewLine[NewOffset + 1], (FFindData[i].A.X - OriginalOffset) * SizeOf(Char));
Inc(NewOffset, FFindData[i].A.X - OriginalOffset);
Move(ReplaceText[1], NewLine[NewOffset + 1], Length(ReplaceText) * SizeOf(Char));
Inc(NewOffset, Length(ReplaceText));
OriginalOffset := FFindData[i].A.X + Length(FFindQuery.SearchString);
end;
end;
if Length(FFindData) > 0 then
begin
Move(FLines[PrevCurLine][OriginalOffset + 1], NewLine[NewOffset + 1], (VirtualLineWidths[PrevCurLine] - OriginalOffset) * SizeOf(Char));
FLines[PrevCurLine] := NewLine;
end;
end;
procedure TTextFile.ReplaceMultilineSameWidth(const ReplaceText: string);
var
S: string;
ParsedReplaceText: string;
i: Integer;
ALW: array of Integer;
LW: Integer;
begin
LW := 0;
SetLength(ALW, Length(FLines));
for i := 0 to Length(FLines) - 1 do
begin
ALW[i] := LW;
Inc(LW, Length(FLines[i]) + Length(#13#10));
end;
S := GetText;
ParsedReplaceText := StringReplace(ReplaceText, '\n', #13#10, [rfReplaceAll]);
for i := Low(FFindData) to High(FFindData) do
Move(ParsedReplaceText[1], S[ALW[FFindData[i].A.Y] + FFindData[i].A.X + 1],
Length(ParsedReplaceText) * SizeOf(Char));
SetText(S);
end;
procedure TTextFile.ReplaceMultilineDiffWidth(const ReplaceText: string);
var
S, S2: string;
ParsedReplaceText: string;
diff: Integer;
OriginalOffset, NewOffset: Integer;
i, index: Integer;
ALW: array of Integer;
LW: Integer;
begin
LW := 0;
SetLength(ALW, Length(FLines));
for i := 0 to Length(FLines) - 1 do
begin
ALW[i] := LW;
Inc(LW, Length(FLines[i]) + Length(#13#10));
end;
S := GetText;
ParsedReplaceText := StringReplace(ReplaceText, '\n', #13#10, [rfReplaceAll]);
diff := Length(ReplaceText) - Length(FFindQuery.SearchString);
SetLength(S2, Length(S) + Length(FFindData) * diff);
OriginalOffset := 0;
NewOffset := 0;
for i := Low(FFindData) to High(FFindData) do
begin
index := ALW[FFindData[i].A.Y] + FFindData[i].A.X;
Move(S[OriginalOffset + 1], S2[NewOffset + 1], (index - OriginalOffset) * SizeOf(Char));
Inc(NewOffset, index - OriginalOffset);
Move(ParsedReplaceText[1], S2[NewOffset + 1], Length(ParsedReplaceText) * SizeOf(Char));
Inc(NewOffset, Length(ParsedReplaceText));
OriginalOffset := index + Length(FFindQuery.SearchString);
end;
Move(S[OriginalOffset + 1], S2[NewOffset + 1], (ALW[High(ALW)] + Length(FLines[High(FLines)]) - OriginalOffset) * SizeOf(Char));
SetText(S2);
end;
procedure TTextFile.IntersectFindDataWithSelection;
var
i: Integer;
tmp: TFindData;
ActualLength: Integer;
FirstPoint, SecondPoint: TPoint;
function IsSel(const AChr: TPoint): Boolean;
begin
Result := IsCharInRgn(AChr, FCaretPos.SelectionType, FirstPoint, SecondPoint)
end;
begin
SetLength(tmp, Length(FFindData));
ActualLength := 0;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
for i := Low(FFindData) to High(FFindData) do
if IsSel(FFindData[i].A) and IsSel(PrevChar(FFindData[i].B)) then
begin
tmp[ActualLength] := FFindData[i];
Inc(ActualLength);
end;
SetLength(FFindData, ActualLength);
Move(tmp[0], FFindData[0], ActualLength * sizeof(TTextSpan));
end;
function TTextFile.ReplaceAll(const ReplaceText: string; SelOnly: Boolean = False): Integer;
var
FirstPoint, SecondPoint: TPoint;
begin
Result := -1;
if FEditMode = emReadOnly then
begin
IssueReadOnlyError;
Exit;
end;
if FSingleLine and FFindQuery.Linebreak then
begin
IssueInputError;
Exit;
end;
if SelOnly then
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
IntersectFindDataWithSelection;
end;
Result := Length(FFindData);
if not FFindQuery.Linebreak then
begin
if Length(FFindQuery.SearchString) = Length(ReplaceText) then
ReplaceInLineSameWidth(ReplaceText)
else
ReplaceInLineDiffWidth(ReplaceText);
end
else
begin
if Length(FFindQuery.SearchString) = Length(ReplaceText) then
ReplaceMultilineSameWidth(ReplaceText)
else
ReplaceMultilineDiffWidth(ReplaceText);
end;
InternalClearFindData;
if Result > 0 then
begin
if FFindQuery.Linebreak then LineArrayChanged;
if SelOnly then
begin
FCaretPos.SetPoint(FirstPoint);
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
end
else
begin
Changed(ctFile);
GotoSOF;
end;
Modified;
end;
end;
function TTextFile.ReplaceCodepoint: Boolean;
var
PWB: Integer;
S: string;
V: Integer;
begin
Result := False;
if (EditMode = emReadOnly) or ((EditMode = emConsole) and not AtLastLine) then
begin
IssueReadOnlyError;
Exit;
end;
PWB := PrevWordBoundary;
S := Copy(FLines[FCaretPos.Y], PWB + 1, FCaretPos.X - PWB);
if TryStrToInt('$' + S, V) then
begin
System.Delete(FLines[FCaretPos.Y], PWB + 1, Length(S));
Insert(Chr(V), FLines[FCaretPos.Y], PWB + 1);
FCaretPos.SetX(FCaretPos.X - Length(S) + 1);
Changed(ctLineFrom, FCaretPos.Y, FCaretPos.X - 1);
Modified;
Result := True;
end
else
IssueInputError;
end;
function TTextFile.GetCurrentClass: string;
begin
Result := FClasses[FCaretPos.Y];
end;
function TTextFile.GetDecoratedControlText(LineIndex: Integer): string;
begin
Result := '[' + GetControlText(LineIndex) + ']';
end;
function TTextFile.GetEmptyBookmarkIndex: Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to High(FBookmarks) do
if SamePoint(FBookmarks[i], EMPTY_BOOKMARK) then
Exit(i);
end;
procedure TTextFile.Return;
var
indentLength: Integer;
begin
if EditMode = emReadOnly then
begin
IssueReadOnlyError;
Exit;
end;
if FSingleLine or (EditMode = emReadOnly) or ((EditMode = emConsole) and not AtLastLine) then
begin
IssueInputError;
Exit;
end;
if HasSelection then
ClearSelection;
if FControlAware and IsControlLine then
begin
if FCaretPos.X = 0 then
begin
InternalInsertLine(FCaretPos.Y, '', '');
RushBookmarks(FCaretPos.Data);
LineArrayChanged;
FCaretPos.SetPoint(0, FCaretPos.Y + 1);
Changed(ctLineRange, FCaretPos.Y - 1, LineCount - 1);
end
else
begin
InternalInsertLine(FCaretPos.Y + 1, '', '');
RushBookmarks(FCaretPos.Data);
LineArrayChanged;
FCaretPos.SetPoint(0, FCaretPos.Y + 1);
Changed(ctLineRange, FCaretPos.Y - 1, LineCount - 1);
end;
Modified;
Exit;
end;
if AtEOF then
begin
InternalAddLine(GetIndentOnReturn(indentLength), GetCurrentClass);
RushBookmarks(FCaretPos.Data);
LineArrayChanged;
FCaretPos.SetPoint(indentLength, FCaretPos.Y + 1);
Changed(ctLine, LineCount - 1, 0);
end
else if AtLastLine then
begin
InternalAddLine(GetIndentOnReturn(indentLength) + LineToRight, GetCurrentClass);
FLines[FCaretPos.Y] := Copy(FLines[FCaretPos.Y], 1, FCaretPos.X);
RushBookmarks(FCaretPos.Data);
LineArrayChanged;
FCaretPos.SetPoint(indentLength, FCaretPos.Y + 1);
Changed(ctLineRange, FCaretPos.Y - 1, FCaretPos.Y);
end
else
begin
InternalInsertLine(FCaretPos.Y + 1, GetIndentOnReturn(indentLength) + Copy(FLines[FCaretPos.Y], FCaretPos.X + 1), FClasses[FCaretPos.Y]);
FLines[FCaretPos.Y] := Copy(FLines[FCaretPos.Y], 1, FCaretPos.X);
RushBookmarks(FCaretPos.Data);
LineArrayChanged;
FCaretPos.SetPoint(indentLength, FCaretPos.Y + 1);
Changed(ctLineRange, FCaretPos.Y - 1, LineCount - 1, 1);
end;
Modified;
end;
procedure TTextFile.InternalAddLine(const ALine: string; const AClassName: string);
begin
SetLength(FLines, Length(FLines) + 1);
SetLength(FClasses, Length(FClasses) + 1);
FLines[High(FLines)] := ALine;
FClasses[High(FClasses)] := AClassName;
end;
procedure TTextFile.InternalAddLines(const NumLines: Integer);
var
i: Integer;
begin
SetLength(FLines, Length(FLines) + NumLines);
SetLength(FClasses, Length(FClasses) + NumLines);
for i := LineCount - NumLines to LineCount - 1 do
begin
FLines[i] := '';
FClasses[i] := '';
end;
end;
procedure TTextFile.InternalDeleteLine(const LineIndex: Integer);
begin
InternalDeleteLines(LineIndex, 1);
end;
procedure TTextFile.InternalDeleteLines(const LineIndex, NumLines: Integer);
var
i: Integer;
begin
for i := LineIndex to LineCount - NumLines - 1 do
begin
FLines[i] := FLines[i + NumLines];
FClasses[i] := FClasses[i + NumLines];
end;
SetLength(FLines, Length(FLines) - NumLines);
SetLength(FClasses, Length(FClasses) - NumLines);
end;
procedure TTextFile.InternalInsertLine(const LineIndex: Integer;
const ALine: string; const AClassName: string);
var
i: Integer;
begin
InternalAddLine('', '');
for i := LineCount - 1 downto LineIndex + 1 do
begin
FLines[i] := FLines[i - 1];
FClasses[i] := FClasses[i - 1];
end;
FLines[LineIndex] := ALine;
FClasses[LineIndex] := AClassName;
end;
procedure TTextFile.InternalInsertLines(const LineIndex, NumLines: Integer);
var
i: Integer;
begin
InternalAddLines(NumLines);
for i := LineCount - 1 downto LineIndex + NumLines do
begin
FLines[i] := FLines[i - NumLines];
FClasses[i] := FClasses[i - NumLines];
end;
for i := LineIndex to LineIndex + NumLines - 1 do
begin
FLines[i] := '';
FClasses[i] := '';
end;
end;
procedure TTextFile.InternalSwapLines(FirstLine, SecondLine: Integer;
BookmarkAware: Boolean = True);
var
tmpLine: string;
tmpClass: string;
begin
tmpLine := FLines[FirstLine];
tmpClass := FClasses[FirstLine];
FLines[FirstLine] := FLines[SecondLine];
FClasses[FirstLine] := FClasses[SecondLine];
FLines[SecondLine] := tmpLine;
FClasses[SecondLine] := tmpClass;
if BookmarkAware then
SushBookmarks(FirstLine, SecondLine, True);
end;
function TTextFile.IsCharInRgn(X, Y: Integer; SelectionType: TSelectionType; const FirstPoint, SecondPoint: TPoint): Boolean;
begin
case SelectionType of
stLineBased:
Result := ((FirstPoint.Y = SecondPoint.Y) and (Y = FirstPoint.Y) and
InRange(X, FirstPoint.X, SecondPoint.X - 1))
or
((FirstPoint.Y < SecondPoint.Y) and (
InRange(Y, FirstPoint.Y + 1, SecondPoint.Y - 1) or
((Y = FirstPoint.Y) and (X >= FirstPoint.X)) or
((Y = SecondPoint.Y) and (X < SecondPoint.X))
)
);
stBlock:
Result := InRange(X, FirstPoint.X, SecondPoint.X - 1) and InRange(Y, FirstPoint.Y, SecondPoint.Y);
else
Result := False;
end;
end;
function TTextFile.IsCharSel(const X, Y: Integer): Boolean;
var
FirstPoint, SecondPoint: TPoint;
begin
if not CharacterExistsEx(Y, X) then Exit(False);
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
Result := IsCharInRgn(X, Y, FCaretPos.SelectionType, FirstPoint, SecondPoint);
end;
function TTextFile.IsCharFound(const X, Y: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to Length(FFindData) - 1 do
if ((FFindData[i].A.Y = FFindData[i].B.Y) and (Y = FFindData[i].A.Y) and
InRange(X, FFindData[i].A.X, FFindData[i].B.X - 1))
or
((FFindData[i].A.Y < FFindData[i].B.Y) and (
InRange(Y, FFindData[i].A.Y + 1, FFindData[i].B.Y - 1) or
((Y = FFindData[i].A.Y) and (X >= FFindData[i].A.X)) or
((Y = FFindData[i].B.Y) and (X < FFindData[i].B.X))
)
) then
Exit(True);
end;
function TTextFile.IsCharInRgn(const Point: TPoint; SelectionType: TSelectionType;
const FirstPoint, SecondPoint: TPoint): Boolean;
begin
Result := IsCharInRgn(Point.X, Point.Y, SelectionType, FirstPoint, SecondPoint);
end;
function TTextFile.IsCharSel(const Point: TPoint): Boolean;
begin
Result := IsCharSel(Point.X, Point.Y);
end;
function TTextFile.IsControlLine(LineIndex: Integer): Boolean;
begin
Result := SameStr(FClasses[LineIndex], LINE_CONTROL_CLASS);
end;
function TTextFile.IsControlLine: Boolean;
begin
Result := SameStr(FClasses[FCaretPos.Y], LINE_CONTROL_CLASS);
end;
procedure TTextFile.IssueInputError;
begin
if Assigned(FOnInputError) then
FOnInputError(Self);
Abort;
end;
procedure TTextFile.IssueReadOnlyError;
begin
if Assigned(FOnReadOnlyError) then
FOnReadOnlyError(Self);
Abort;
end;
function TTextFile.CurrentLine: string;
begin
if LineExists(FCaretPos.Y) then
Result := FLines[FCaretPos.Y]
else
Result := '';
end;
procedure TTextFile.CutToClipboard;
begin
Clipboard.AsText := GetSelText;
ClearSelection;
end;
function TTextFile.LineToLeft: string;
begin
Result := Copy(FLines[FCaretPos.Y], 1, FCaretPos.X);
end;
function TTextFile.LineToRight: string;
begin
Result := Copy(FLines[FCaretPos.Y], FCaretPos.X + 1);
end;
procedure TTextFile.InternalZero;
begin
SetLength(FLines, 0);
SetLength(FClasses, 0);
ClearBookmarks;
FHistoryManager.Clear;
end;
procedure TTextFile.LoadFromFile(const FileName: TFileName;
Encoding: TEncoding; ClassAware: Boolean = False);
var
FS: TFileStream;
SR: TStreamReader;
ActualLength: Integer;
L: string;
p: Integer;
LineHasClass: Boolean;
hresult: Boolean;
PositiveEncoding: TTextEncoding;
PossibleEncodings, MagicWordsFound: TTextEncodings;
const
ALLOC_BY = 2048;
begin
try
p := 0;
ClearFindData;
InternalZero;
ActualLength := 0;
if Encoding = nil then
begin
hresult := GuessEncodingOfFile(FileName, PositiveEncoding, PossibleEncodings, MagicWordsFound);
if not hresult then
PositiveEncoding := teWindows8bitCodepage;
end;
FS := TFileStream.Create(FileName, fmOpenRead);
try
if Assigned(Encoding) then
SR := TStreamReader.Create(FS, Encoding)
else
SR := TStreamReader.Create(FS, GetVCLEncoding(PositiveEncoding));
try
while not SR.EndOfStream do
begin
if Length(FLines) = ActualLength then
begin
SetLength(FLines, Length(FLines) + ALLOC_BY);
SetLength(FClasses, Length(FClasses) + ALLOC_BY);
end;
if ClassAware then
begin
L := SR.ReadLine;
LineHasClass := False;
if (Length(L) > 0) and (L[1] = LINE_CLASS_INDICATOR) then
begin
p := PosEx(LINE_CLASS_INDICATOR, L, 2);
if p > 0 then
LineHasClass := True;
end;
if LineHasClass then
begin
FLines[ActualLength] := Copy(L, p + 1);
FClasses[ActualLength] := Copy(L, 2, p - 2);
end
else
begin
FLines[ActualLength] := L;
FClasses[ActualLength] := '';
end;
end
else
begin
FLines[ActualLength] := SR.ReadLine;
FClasses[ActualLength] := '';
end;
Inc(ActualLength);
end;
SetLength(FLines, ActualLength);
SetLength(FClasses, ActualLength);
finally
SR.Free;
end;
finally
FS.Free;
end;
if Length(FLines) = 0 then
InternalAddLine('', '');
FFileName := FileName;
FModified := False;
FControlAware := False;
FEncoding := DEFAULT_TEXT_FILE_FORMAT_INFO;
if Assigned(Encoding) then
FEncoding.TextEncoding := GetEncodingFromVCL(Encoding)
else
begin
FEncoding.TextEncoding := PositiveEncoding;
FEncoding.SetHasMagicWord(MagicWordsFound);
end;
FRecentlyOpened := True;
FCaretPos.SetPoint(0, 0);
Changed(ctFile);
except
NewFileAndInitUndo;
raise;
end;
end;
procedure TTextFile.LoadFromFileAndInitUndo(const FileName: TFileName;
Encoding: TEncoding);
begin
LoadFromFile(FileName, Encoding);
AddUndoRecord(SUndoDocumentLoaded, UID_UNKNOWN);
end;
procedure TTextFile.LoadFromStream(AStream: TStream);
var
Header: TStreamHeader;
Counts: array of packed record
LineText, LineClass: Integer;
end;
i: Integer;
data_dword: DWORD;
data_char: Char;
begin
FillChar(Header, sizeof(Header), 0);
AStream.ReadBuffer(Header, sizeof(Header));
if Header.Signature <> TEXTFILE_SIGNATURE then
raise Exception.Create('TTextFile.LoadFromStream: Invalid text file stream.');
NewFileAndInitUndo;
try
SetLength(FLines, Header.LineCount);
SetLength(FClasses, Header.LineCount);
SetLength(Counts, Header.LineCount);
if Length(Counts) > 0 then
AStream.ReadBuffer(Counts[0], Length(Counts) * sizeof(Counts[0]));
for i := 0 to Header.LineCount - 1 do
begin
SetLength(FLines[i], Counts[i].LineText);
SetLength(FClasses[i], Counts[i].LineClass);
end;
for i := 0 to Header.LineCount - 1 do
begin
if not FLines[i].IsEmpty then
AStream.ReadBuffer(FLines[i][1], FLines[i].Length * sizeof(Char));
if not FClasses[i].IsEmpty then
AStream.ReadBuffer(FClasses[i][1], FClasses[i].Length * sizeof(Char));
end;
AStream.ReadData(data_dword);
if data_dword <> TEXTFILE_SIGNATURE_FPCACHE then
raise Exception.Create('TTextFile.LoadFromStream: Invalid text file stream.');
AStream.ReadData(FEditorState.FFPCacheLen);
GetMem(FEditorState.FFPCache, FEditorState.FFPCacheLen);
try
AStream.ReadBuffer(FEditorState.FPCache^, FEditorState.FPCacheLen);
except
FreeMem(FEditorState.FFPCache);
FEditorState.FFPCacheLen := 0;
FEditorState.FFPCache := nil;
raise;
end;
FHistoryManager.LoadFromStream(AStream);
AStream.ReadData(data_dword);
AStream.ReadData(data_char);
if (data_dword <> TEXTFILE_SIGNATURE) or (data_char <> #0) then
raise Exception.Create('TTextFile.LoadFromStream: Invalid text file stream.');
FEditMode := Header.EditMode;
FModified := Header.Modified;
FFileName := Header.FileName;
FBookmarks := Header.Bookmarks;
FEditorState.ScrollPos := Header.ScrollPos;
FEditorState.MultiSize := Header.MultiSize;
FEditorState.Overwrite := Header.Overwrite;
FEditorState.HiddenChrs := Header.HiddenChars;
FEditorState.RulerVisible := Header.RulerVisible;
FEditorState.ZoomLevel := Header.ZoomLevel;
FEditorState.FormattingProcessor := Header.FPClassName;
FEditorState.Valid := True;
FEncoding := Header.Encoding;
FRecentlyOpened := Header.RecentlyOpened;
FStrictReadOnly := Header.StrictReadOnly;
FUseLineClasses := Header.UseLineClasses;
FCaretPos.CreateSelection(Header.CaretPos, Header.SelEndPos, Header.SelectionType);
Changed(ctFile);
BookmarksMoved;
except
NewFileAndInitUndo;
raise;
end;
end;
procedure TTextFile.LoadFromBuffer(const Data: pointer; const Len: UInt64);
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.WriteBuffer(Data^, Len);
MS.Position := 0;
LoadFromStream(MS);
finally
MS.Free;
end;
end;
function TTextFile.MakeLinesUnique: Boolean;
var
LC: Integer;
y: Integer;
i: Integer;
RemoveList: array of Boolean;
LinesRemoved: Integer;
NextExistingLine: Integer;
HasBookmarks: Boolean;
j: Integer;
label
Done;
begin
Result := False;
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
LC := LineCount;
HasBookmarks := Self.HasBookmarks;
SetLength(RemoveList, LC);
FillChar(RemoveList[0], Length(RemoveList) * Sizeof(Boolean), 0);
LinesRemoved := 0;
for y := 0 to LC - 1 do
if not RemoveList[y] then
for i := y + 1 to LC - 1 do
if not RemoveList[i] and SameStr(FLines[y], FLines[i]) then
begin
RemoveList[i] := True;
Inc(LinesRemoved);
if HasBookmarks then
for j := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[j].Y = i then
FBookmarks[j].Y := y;
end;
NextExistingLine := 0;
for y := 0 to LC - 1 do
if RemoveList[y] then
for i := Max(y + 1, NextExistingLine) to LC - 1 do
begin
if not RemoveList[i] then
begin
FLines[y] := FLines[i];
FClasses[y] := FClasses[i];
if HasBookmarks then
for j := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[j].Y = i then
FBookmarks[j].Y := y;
RemoveList[i] := True;
NextExistingLine := i + 1;
Break;
end;
if i = LC - 1 then
goto Done;
end;
Done:
Result := LinesRemoved > 0;
if not Result then Exit;
SetLength(FLines, LC - LinesRemoved);
SetLength(FClasses, LC - LinesRemoved);
LineArrayChanged;
Changed(ctFile);
CaretPos.SetPoint(0, 0);
LineClassChanged(0);
Modified;
if HasBookmarks then BookmarksMoved;
end;
function TTextFile.MatchBracket(const BracketPoint: TPoint): TPoint;
const
LeftBrackets: array[0..3] of Char = ('(', '[', '{', '❨');
RightBrackets: array[0..3] of Char = (')', ']', '}', '❩');
var
bracket: Char;
i, BracketType, direction, depth: Integer;
begin
bracket := GetChar(BracketPoint);
BracketType := -1;
direction := 0;
for i := Low(LeftBrackets) to High(LeftBrackets) do
if LeftBrackets[i] = bracket then
begin
direction := 1;
BracketType := i;
Break;
end
else if RightBrackets[i] = bracket then
begin
direction := -1;
BracketType := i;
Break;
end;
if BracketType = -1 then Exit(Point(0, -1));
depth := 0;
case direction of
+1:
begin
Result := NextChar(BracketPoint);
while CharacterExistsEx(Result) do
begin
if GetChar(Result) = LeftBrackets[BracketType] then
Inc(depth)
else if GetChar(Result) = RightBrackets[BracketType] then
begin
Dec(depth);
if depth < 0 then
Exit(Result);
end;
Result := NextChar(Result);
end;
end;
-1:
begin
Result := PrevChar(BracketPoint);
while CharacterExistsEx(Result) do
begin
if GetChar(Result) = RightBrackets[BracketType] then
Inc(depth)
else if GetChar(Result) = LeftBrackets[BracketType] then
begin
Dec(depth);
if depth < 0 then
Exit(Result);
end;
Result := PrevChar(Result);
end;
end;
end;
Exit(Point(0, -1));
end;
procedure TTextFile.Modified;
var
OldModified: Boolean;
begin
OldModified := FModified;
FModified := True;
FRecentlyOpened := False;
ClearFindData;
if Assigned(FOnModified) and not OldModified then
FOnModified(Self);
end;
procedure TTextFile.MultiBackspace(var ACarets: TPointArray);
var
i: Integer;
minln, maxln: Integer;
begin
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
minln := LineCount - 1;
maxln := 0;
for i := Low(ACarets) to High(ACarets) do
begin
if not InRange(ACarets[i].Y, 0, Length(FLines) - 1) then
Continue;
if ACarets[i].X > 0 then
begin
System.Delete(FLines[ACarets[i].Y], ACarets[i].X, 1);
PushBookmarks(ACarets[i].Y, ACarets[i].X, -1);
PushMultiCarets(ACarets, ACarets[i].Y, ACarets[i].X, -1);
minln := min(minln, ACarets[i].Y);
maxln := max(maxln, ACarets[i].Y);
end;
end;
Changed(ctLineRange, minln, maxln);
Modified;
end;
procedure TTextFile.MultiInsertChar(var ACarets: TPointArray;
const AChar: Char; const Overwrite: Boolean);
var
i: Integer;
minln, maxln: Integer;
begin
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
minln := LineCount - 1;
maxln := 0;
for i := Low(ACarets) to High(ACarets) do
begin
if not InRange(ACarets[i].Y, 0, Length(FLines) - 1) then
Continue;
if ACarets[i].X < PhysicalLineWidths[ACarets[i].Y] then
if Overwrite then
FLines[ACarets[i].Y][ACarets[i].X + 1] := AChar
else
Insert(AChar, FLines[ACarets[i].Y], ACarets[i].X + 1)
else
FLines[ACarets[i].Y] := FLines[ACarets[i].Y] + GetVirtualSpace(ACarets[i].Y, ACarets[i].X) + AChar;
if not Overwrite then
begin
PushBookmarks(ACarets[i].Y, ACarets[i].X);
PushMultiCarets(ACarets, ACarets[i].Y, ACarets[i].X);
end;
minln := min(minln, ACarets[i].Y);
maxln := max(maxln, ACarets[i].Y);
end;
Changed(ctLineRange, minln, maxln);
Modified;
end;
procedure TTextFile.MultiInsertText(var ACarets: TPointArray;
const AText: string);
var
i, minln, maxln: Integer;
begin
if TextIsMultiline(AText) then
begin
IssueInputError;
Exit;
end;
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
minln := LineCount - 1;
maxln := 0;
for i := Low(ACarets) to High(ACarets) do
begin
if not InRange(ACarets[i].Y, 0, Length(FLines) - 1) then
Continue;
if ACarets[i].X < PhysicalLineWidths[ACarets[i].Y] then
Insert(AText, FLines[ACarets[i].Y], ACarets[i].X + 1)
else
FLines[ACarets[i].Y] := FLines[ACarets[i].Y] + GetVirtualSpace(ACarets[i].Y, ACarets[i].X) + AText;
PushBookmarks(ACarets[i].Y, ACarets[i].X, Length(AText));
PushMultiCarets(ACarets, ACarets[i].Y, ACarets[i].X, Length(AText));
minln := min(minln, ACarets[i].Y);
maxln := max(maxln, ACarets[i].Y);
end;
Changed(ctLineRange, minln, maxln);
Modified;
end;
procedure TTextFile.NewFile;
begin
ClearFindData;
InternalZero;
FModified := False;
FRecentlyOpened := False;
FControlAware := False;
FFileName := Format(SNewFileName, [GlobalFileNumber]);
FEncoding := DEFAULT_TEXT_FILE_FORMAT_INFO;
if GlobalFileNumber = GlobalFileNumber.MaxValue then
GlobalFileNumber := 1
else
Inc(GlobalFileNumber);
InternalAddLine('', '');
FCaretPos.Reset;
LineArrayChanged;
Changed(ctFile);
GotoEOF;
end;
procedure TTextFile.NewFileAndInitUndo;
begin
NewFile;
AddUndoRecord(SUndoNewFile, UID_UNKNOWN);
end;
function TTextFile.NextChar(const APoint: TPoint): TPoint;
var
i: Integer;
begin
if APoint.X < VirtualLineWidths[APoint.Y] - 1 then
Exit(Point(APoint.X + 1, APoint.Y))
else
for i := APoint.Y + 1 to LineCount - 1 do
if VirtualLineWidths[i] > 0 then
Exit(Point(0, i));
Exit(Point(0, -1));
end;
function TTextFile.NextWordBoundary: Integer;
begin
Result := NextWordBoundary(FCaretPos.Y, FCaretPos.X);
end;
function TTextFile.NextWordBoundary(Point: TPoint): Integer;
begin
Result := NextWordBoundary(Point.Y, Point.X);
end;
function TTextFile.NextWordBoundary(Y, X: Integer): Integer;
var
i: Integer;
begin
Result := VirtualLineWidths[FCaretPos.Y];
for i := FCaretPos.X + 1 to Result do
if not FLines[FCaretPos.Y][i+1].IsLetterOrDigit then
Exit(i);
end;
function TTextFile.PasteFromClipboard: Boolean;
begin
Result := False;
if Clipboard.HasFormat(CF_TEXT) then
begin
InsertText(Clipboard.AsText);
Result := True;
end
else
IssueInputError;
end;
function TTextFile.PasteFromClipboardAsBlock: Boolean;
begin
Result := False;
if Clipboard.HasFormat(CF_TEXT) then
begin
InsertTextAsBlock(Clipboard.AsText);
Result := True;
end
else
IssueInputError;
end;
procedure TTextFile.PostFileChanged(const NumLines: Integer);
begin
if Assigned(FOnChange) then
FOnChange(Self, ctPostFile, NumLines, 0, 0, 0);
end;
function TTextFile.PrevWordBoundary(Point: TPoint): Integer;
begin
Result := PrevWordBoundary(Point.Y, Point.X);
end;
function TTextFile.PrevChar(const APoint: TPoint): TPoint;
var
i: Integer;
begin
if APoint.X > 0 then
Exit(Point(APoint.X - 1, APoint.Y))
else
for i := APoint.Y - 1 downto 0 do
if VirtualLineWidths[i] > 0 then
Exit(Point(VirtualLineWidths[i] - 1, i));
Exit(Point(0, -1));
end;
function TTextFile.PrevWordBoundary: Integer;
begin
Result := PrevWordBoundary(FCaretPos.Y, FCaretPos.X);
end;
function TTextFile.PushBookmarks(LineIndex, ColIndex: Integer; NumChars: Integer = 1): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if (FBookmarks[i].Y = LineIndex) and (FBookmarks[i].X >= ColIndex) then
begin
Result := True;
Inc(FBookmarks[i].X, NumChars);
end;
if Result then BookmarksMoved;
end;
function TTextFile.PushMultiCarets(var ACarets: TPointArray;
LineIndex, ColIndex: Integer; NumChars: Integer = 1): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(ACarets) to High(ACarets) do
if (ACarets[i].Y = LineIndex) and (ACarets[i].X >= ColIndex) then
begin
Result := True;
Inc(ACarets[i].X, NumChars);
end;
end;
function TTextFile.PushBookmarksEx(FirstLine, LastLine,
NumChars: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if InRange(FBookmarks[i].Y, FirstLine, LastLine) then
begin
Result := True;
Inc(FBookmarks[i].X, NumChars);
end;
if Result then BookmarksMoved;
end;
function TTextFile.PushBookmarksInternal(LineIndex, NumChars: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[i].Y = LineIndex then
begin
Result := True;
Inc(FBookmarks[i].X, NumChars);
if FBookmarks[i].X < 0 then
FBookmarks[i] := EMPTY_BOOKMARK;
end;
end;
function TTextFile.QushBookmarks(LineIndex, ColIndex: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[i].Y > LineIndex then
begin
Result := True;
if FBookmarks[i].Y = LineIndex + 1 then
Inc(FBookmarks[i].X, ColIndex);
Dec(FBookmarks[i].Y);
end;
if Result then BookmarksMoved;
end;
function TTextFile.QushBookmarksEx(SelectionType: TSelectionType;
const FirstPoint, SecondPoint: TPoint): Boolean;
var
i: Integer;
Δx, Δy: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if IsCharInRgn(FBookmarks[i], SelectionType, FirstPoint, SecondPoint) then
begin
Result := True;
FBookmarks[i] := EMPTY_BOOKMARK;
end;
Δx := SecondPoint.X - FirstPoint.X;
Δy := SecondPoint.Y - FirstPoint.Y;
case SelectionType of
stLineBased:
for i := Low(FBookmarks) to High(FBookmarks) do
if (FBookmarks[i].Y = SecondPoint.Y) and (FBookmarks[i].X >= SecondPoint.X) then
begin
Result := True;
Dec(FBookmarks[i].Y, Δy);
Dec(FBookmarks[i].X, ΔX);
end
else if FBookmarks[i].Y > SecondPoint.Y then
begin
Result := True;
Dec(FBookmarks[i].Y, Δy);
end;
stBlock:
for i := Low(FBookmarks) to High(FBookmarks) do
if InRange(FBookmarks[i].Y, FirstPoint.Y, SecondPoint.Y) and (FBookmarks[i].X >= SecondPoint.X) then
begin
Result := True;
Dec(FBookmarks[i].X, Δx);
end;
end;
if Result then BookmarksMoved;
end;
function TTextFile.PrevWordBoundary(Y, X: Integer): Integer;
var
i: Integer;
begin
Result := 0;
if X > VirtualLineWidths[Y] then
Result := VirtualLineWidths[Y]
else
for i := FCaretPos.X - 1 downto 1 do
if not FLines[FCaretPos.Y][(i - 1) + 1].IsLetterOrDigit then
Exit(i);
end;
procedure TTextFile.Clear;
begin
if EditMode <> emText then
begin
IssueInputError;
Exit;
end;
ClearFindData;
SetLength(FLines, 0);
SetLength(FClasses, 0);
ClearBookmarks;
AddLine('');
Changed(ctPostFile);
Modified;
end;
procedure TTextFile.ClearFindData;
var
OldLength: Integer;
begin
OldLength := Length(FFindData);
InternalClearFindData;
if OldLength > 0 then
begin
if Assigned(FOnFindDataClear) then
FOnFindDataClear(Self);
end;
end;
procedure TTextFile.InternalClearFindData;
begin
SetLength(FFindData, 0);
FFindDataActualLength := 0;
FFindResultValid := False;
end;
procedure TTextFile.ClearBookmarks;
var
i: Integer;
begin
for i := Low(FBookmarks) to High(FBookmarks) do
FBookmarks[i] := EMPTY_BOOKMARK;
end;
procedure TTextFile.ClearLine(LineIndex: Integer);
begin
if not InRange(LineIndex, 0, LineCount - 1) then
Exit;
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (LineIndex < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
if IsControlLine(LineIndex) then
begin
DeleteControlAtLine(LineIndex);
FCaretPos.SetPoint(0, LineIndex);
Changed(ctLine, LineIndex);
Modified;
Exit;
end;
if (VirtualLineWidths[LineIndex] = 0) and (LineIndex < LineCount - 1) then
begin
if EditMode = emConsole then
begin
IssueInputError;
Exit;
end;
InternalDeleteLine(LineIndex);
LineArrayChanged;
FCaretPos.SetPoint(0, LineIndex);
Changed(ctLineRange, LineIndex, LineCount);
end
else
begin
FLines[LineIndex] := '';
FCaretPos.SetPoint(0, LineIndex);
Changed(ctLine, LineIndex);
end;
Modified;
end;
procedure TTextFile.ClearLine;
begin
ClearLine(FCaretPos.Y);
end;
procedure TTextFile.ClearSelection;
var
FirstPoint, SecondPoint: TPoint;
SelectionType: TSelectionType;
i: Integer;
xmin, xmax, wmax: Integer;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
SelectionType := FCaretPos.SelectionType;
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FirstPoint.Y < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
if FirstPoint.Y = SecondPoint.Y then
begin
if FControlAware and IsControlLine then
begin
if (FirstPoint.X = 0) and (SecondPoint.X >= 1) then
DeleteControlAtLine(FCaretPos.Y)
else
Exit ;
end;
System.Delete(FLines[FirstPoint.Y], FirstPoint.X + 1, SecondPoint.X - FirstPoint.X);
FCaretPos.SetPoint(FirstPoint);
Changed(ctLineFrom, FirstPoint.Y, FirstPoint.X);
end
else
begin
case FCaretPos.SelectionType of
stLineBased:
begin
if FControlAware then
begin
if (IsControlLine(FirstPoint.Y) and (FirstPoint.X > 0)) or (IsControlLine(SecondPoint.Y) and (SecondPoint.X = 0)) then
begin
IssueInputError;
Exit;
end;
if IsControlLine(FirstPoint.Y) and (FirstPoint.X = 0) then
DeleteControlAtLine(FirstPoint.Y);
for i := FirstPoint.Y + 1 to SecondPoint.Y - 1 do
DeleteControlAtLine(i);
if IsControlLine(SecondPoint.Y) and (SecondPoint.X >= 1) then
DeleteControlAtLine(SecondPoint.Y);
end;
FLines[FirstPoint.Y] := Copy(FLines[FirstPoint.Y], 1, FirstPoint.X) +
GetVirtualSpace(FirstPoint.Y, FirstPoint.X) +
Copy(FLines[SecondPoint.Y], SecondPoint.X + 1);
InternalDeleteLines(FirstPoint.Y + 1, SecondPoint.Y - FirstPoint.Y);
LineArrayChanged;
FCaretPos.SetPoint(FirstPoint);
Changed(ctLineRange, FirstPoint.Y, LineCount - 1);
PostFileChanged(SecondPoint.Y - FirstPoint.Y);
end;
stBlock:
begin
xmin := min(FirstPoint.X, SecondPoint.X);
xmax := max(FirstPoint.X, SecondPoint.X);
wmax := 0;
for i := FirstPoint.Y to SecondPoint.Y do
begin
wmax := max(wmax, VirtualLineWidths[i]);
if FControlAware and IsControlLine(i) then
if FirstPoint.X = 0 then
DeleteControlAtLine(i)
else
else
System.Delete(FLines[i], xmin + 1, xmax - xmin);
end;
LineArrayChanged;
FCaretPos.SetPoint(xmin, FirstPoint.Y);
Changed(ctBlock, FirstPoint.Y, SecondPoint.Y, xmin, wmax);
end;
end;
end;
Modified;
QushBookmarksEx(SelectionType, FirstPoint, SecondPoint);
end;
procedure TTextFile.ClearUndoHistory;
begin
FHistoryManager.Clear;
end;
function TTextFile.CompareFindQuery(const AFindQuery: TFindQuery): Boolean;
begin
Result := (AFindQuery.MatchCase = FFindQuery.MatchCase) and
(AFindQuery.MatchWord = FFindQuery.MatchWord) and
(AFindQuery.Linebreak = FFindQuery.Linebreak) and
SameStr(AFindQuery.SearchString, FFindQuery.SearchString) and
(AFindQuery.UCBlock = FFindQuery.UCBlock);
end;
procedure TTextFile.CopyToClipboard;
begin
Clipboard.AsText := GetSelText;
end;
procedure TTextFile.LoadAutoReplaceItems;
var
ARFileName: TFileName;
i, p: Integer;
begin
if FAutoReplaceLoaded then
Exit;
ARFileName := GetAutoReplaceDataFileName;
if (Length(ARFileName) = 0) or not FileExists(ARFileName) then Exit;
with TStringList.Create do
try
LoadFromFile(ARFileName, TEncoding.UTF8);
SetLength(FAutoReplaceItems, Count);
for i := 0 to Count - 1 do
begin
p := Pos(#32, Strings[i]);
if p > 0 then
begin
FAutoReplaceItems[i].Token := Copy(Strings[i], 1, p - 1);
FAutoReplaceItems[i].ReplacedValue := Copy(Strings[i], p + 1);
end;
end;
finally
Free;
end;
FAutoReplaceLoaded := True;
end;
constructor TTextFile.Create;
begin
FUseLineClasses := False;
FStrictReadOnly := False;
FIndentSize := 2;
SetLength(FLines, 0);
SetLength(FClasses, 0);
FRecentlyOpened := False;
FEncoding := DEFAULT_TEXT_FILE_FORMAT_INFO;
FPreserveDesiredCol := False;
FSortReverseOrder := False;
FLineComparer := AnsiCompareText;
FEditorState := TEditorState.Create;
FWrapAt := DEFAULT_WRAP_AT;
FControlAware := False;
FSingleLine := False;
ClearFindData;
ClearBookmarks;
FHistoryManager := THistoryManager.Create;
FCaretPos := TCaretPos.Create;
FCaretPos.OnChange := CaretPosChange;
FCaretPos.OnSelChange := CaretPosSelChange;
FEditMode := emText;
FModified := False;
FCaretAfterEOL := True;
LoadAutoReplaceItems;
AddLine('');
end;
function TTextFile.CanRedo: Boolean;
begin
Result := FHistoryManager.CanRedo;
end;
function TTextFile.CanUndo: Boolean;
begin
Result := FHistoryManager.CanUndo;
end;
procedure TTextFile.CaretPosChange(Sender: TObject);
begin
if not FPreserveDesiredCol then
FDesiredCol := FCaretPos.X;
if Assigned(FOnCaretPosChange) then
FOnCaretPosChange(Self);
end;
procedure TTextFile.CaretPosSelChange(Sender: TObject; ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer);
begin
if Assigned(FOnCaretPosSelChange) then
FOnCaretPosSelChange(Sender, ChangeType, Data1, Data2, Data3, Data4);
end;
procedure TTextFile.Changed(ChangeType: TChangeType; Data1: Integer = 0;
Data2: Integer = 0; Data3: Integer = 0; Data4: Integer = 0);
begin
if Assigned(FOnChange) then
FOnChange(Self, ChangeType, Data1, Data2, Data3, Data4);
end;
function TTextFile.CharacterExists(APoint: TPoint): Boolean;
begin
Result := InRange(APoint.Y, 0, LineCount - 1) and
InRange(APoint.X, 0, VirtualLineWidths[APoint.Y] - 1) and
not IsControlLine(APoint.Y);
end;
function TTextFile.CharacterExistsEx(Y, X: Integer): Boolean;
begin
Result := InRange(Y, 0, LineCount - 1) and InRange(X, 0, VirtualLineWidths[Y] - 1);
end;
function TTextFile.CharacterExistsEx(APoint: TPoint): Boolean;
begin
Result := InRange(APoint.Y, 0, LineCount - 1) and
InRange(APoint.X, 0, VirtualLineWidths[APoint.Y] - 1);
end;
function TTextFile.ChrTransform(Transformation: TChrTransformFunc): Boolean;
var
FirstPoint, SecondPoint: TPoint;
i: Integer;
j: Integer;
begin
Result := HasSelection;
if Result then
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FirstPoint.Y < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
case FCaretPos.SelectionType of
stLineBased:
if FirstPoint.Y = SecondPoint.Y then
begin
for i := FirstPoint.X to SecondPoint.X - 1 do
FLines[FirstPoint.Y][i + 1] := Transformation(FLines[FirstPoint.Y][i + 1]);
Changed(ctBlock, FirstPoint.Y, SecondPoint.Y, FirstPoint.X, SecondPoint.X);
end
else
begin
for i := FirstPoint.X to GetVirtualLineWidth(FirstPoint.Y) - 1 do
FLines[FirstPoint.Y][i + 1] := Transformation(FLines[FirstPoint.Y][i + 1]);
for j := FirstPoint.Y + 1 to SecondPoint.Y - 1 do
for i := 0 to GetVirtualLineWidth(j) - 1 do
FLines[j][i + 1] := Transformation(FLines[j][i + 1]);
for i := 0 to SecondPoint.X - 1 do
FLines[SecondPoint.Y][i + 1] := Transformation(FLines[SecondPoint.Y][i + 1]);
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
end;
stBlock:
begin
for j := FirstPoint.Y to SecondPoint.Y do
for i := FirstPoint.X to SecondPoint.X - 1 do
if CharacterExists(j, i) then
FLines[j][i + 1] := Transformation(FLines[j][i + 1]);
Changed(ctBlock, FirstPoint.Y, SecondPoint.Y, FirstPoint.X, SecondPoint.X);
end;
end;
Modified;
end;
end;
procedure TTextFile.ChrTransformText(Transformation: TChrTransformFunc);
var
j: Integer;
i: Integer;
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (LineCount > 1)) then
begin
IssueReadOnlyError;
Exit;
end;
for j := 0 to Length(FLines) - 1 do
begin
if IsControlLine(j) then
Continue;
for i := 0 to GetPhysicalLineWidth(j) - 1 do
FLines[j][i + 1] := Transformation(FLines[j][i + 1]);
end;
Changed(ctFile);
Modified;
end;
function TTextFile.CharacterExists(Y, X: Integer): Boolean;
begin
Result := InRange(Y, 0, LineCount - 1) and InRange(X, 0, VirtualLineWidths[Y] - 1)
and not IsControlLine(Y);
end;
function TTextFile.GetChar(Y, X: Integer): Char;
begin
if CharacterExists(Y, X) then
Result := FLines[Y][X+1]
else
Result := #32;
end;
function TTextFile.GetAutoReplaceItem(Index: Integer): TAutoReplaceItem;
begin
Result := FAutoReplaceItems[Index];
end;
function TTextFile.GetAutoReplaceItemCount: Integer;
begin
Result := Length(FAutoReplaceItems);
end;
function TTextFile.GetBookmark(Index: Integer): TPoint;
begin
Assert(InRange(Index, Low(FBookmarks), High(FBookmarks)));
Result := FBookmarks[Index];
end;
function TTextFile.GetBookmarkCount: Integer;
begin
Result := High(FBookmarks) + 1;
end;
function TTextFile.GetChar(APoint: TPoint): Char;
begin
Result := GetChar(APoint.Y, APoint.X);
end;
function TTextFile.NumCharsOfType(CharTestFunction: TCharTestFunction): Integer;
var
i: Integer;
j: Integer;
begin
Result := 0;
for i := 0 to High(FLines) do
for j := 1 to Length(FLines[i]) do
if CharTestFunction(FLines[i][j]) then
Inc(Result);
end;
function TTextFile.GetFileStatistics(AFileStatisticsFlags: TFileStatisticsFlags;
AWordFreqs: TWordFreqDict): TFileStatistics;
var
i: Integer;
j: Integer;
InProposedWord: Boolean;
start: Integer;
CurLineWidth: Integer;
c: Char;
procedure ConsiderPossibleWord(AStart, AEnd: Integer);
var
WordLength: Integer;
Word, WordKey: string;
WordFreqItem: TWordFreqItem;
k: Integer;
HasLetter: Boolean;
begin
{$IFDEF DEBUG}
Assert(InRange(AStart, 1, FLines[i].Length));
Assert(InRange(AEnd, 1, FLines[i].Length));
Assert(AStart <= AEnd);
{$ENDIF}
while (AStart <= AEnd) and FLines[i][AStart].IsPunctuation do
Inc(AStart);
while (AEnd >= AStart) and FLines[i][AEnd].IsPunctuation do
Dec(AEnd);
HasLetter := False;
for k := AStart to AEnd do
if FLines[i][k].IsLetter then
begin
HasLetter := True;
Break;
end;
if not HasLetter then
Exit;
if AEnd >= AStart then
begin
WordLength := AEnd - AStart + 1;
if WordLength > Result.MaxWordLength then
Result.MaxWordLength := WordLength;
if WordLength >= Length(Result.WordLengthDistr) then
SetLength(Result.WordLengthDistr, WordLength + 1);
Inc(Result.WordLengthDistr[WordLength]);
Inc(Result.NumWords);
if Assigned(AWordFreqs) then
begin
Word := Copy(FLines[i], AStart, WordLength);
if fsCaseSensitive in AFileStatisticsFlags then
begin
if AWordFreqs.TryGetValue(Word, WordFreqItem) then
Inc(WordFreqItem.Count)
else
AWordFreqs.Add(Word, TWordFreqItem.Create(Word));
end
else
begin
WordKey := Word.ToLower;
if AWordFreqs.TryGetValue(WordKey, WordFreqItem) then
begin
Inc(WordFreqItem.Count);
if not WordFreqItem.IsLower and (Word = WordKey) then
begin
WordFreqItem.InNaturalCase := Word;
WordFreqItem.IsLower := True;
end;
end
else
AWordFreqs.Add(WordKey, TWordFreqItem.Create(Word, Word = WordKey));
end;
end;
end;
end;
function IsWordSep(const C: Char): Boolean;
const
SourceCodeWordSeps = ['.', ',', ';', ':', '-', '+', '*', '/', '=', '(', ')',
'[', ']', '{', '}', '<', '>', '|', '\', '%', '&', '@', '~', '!', '?'];
begin
Result := C.IsWhiteSpace or (C = '/') or (C = #$2014) or (C = '<') or (C = '>') or (C = '=');
if (fsSourceCode in AFileStatisticsFlags) and not Result then
Result := CharInSet(C, SourceCodeWordSeps) or (C.GetUnicodeCategory = TUnicodeCategory.ucMathSymbol);
end;
begin
Result.Flags := AFileStatisticsFlags;
Result.Clear;
if Assigned(AWordFreqs) then
AWordFreqs.Clear;
if fsfCharTypes in AFileStatisticsFlags then
begin
{$WARN SYMBOL_DEPRECATED OFF}
Result.NumChars := NumCharacters;
Result.NumLetters := NumCharsOfType(IsLetter);
Result.NumDigits := NumCharsOfType(IsDigit);
Result.NumWhitespace := NumCharsOfType(IsWhiteSpace);
Result.NumPunctuation := NumCharsOfType(IsPunctuation);
{$WARN SYMBOL_DEPRECATED DEFAULT}
end;
if fsfLines in AFileStatisticsFlags then
begin
Result.NumLines := LineCount;
Result.MaxLineLength := GetMaxLineWidth;
Result.AvgLineLength := 0;
SetLength(Result.LineLengthDistr, Result.MaxLineLength + 1);
for i := 0 to LineCount - 1 do
begin
Inc(Result.LineLengthDistr[Length(FLines[i])]);
Result.AvgLineLength := Result.AvgLineLength + Length(FLines[i]) / Result.NumLines;
end;
end;
if fsfWords in AFileStatisticsFlags then
begin
Result.NumWords := 0;
Result.MaxWordLength := 0;
SetLength(Result.WordLengthDistr, 1024);
for i := 0 to LineCount - 1 do
begin
InProposedWord := False;
start := 1;
CurLineWidth := VirtualLineWidths[i];
for j := 1 to CurLineWidth do
begin
c := FLines[i][j];
if InProposedWord then
begin
if IsWordSep(c) then
begin
InProposedWord := False;
ConsiderPossibleWord(start, j - 1);
end;
end
else
begin
if not IsWordSep(c) then
begin
start := j;
InProposedWord := True;
end
end
end;
if InProposedWord then
ConsiderPossibleWord(start, CurLineWidth);
end;
SetLength(Result.WordLengthDistr, Result.MaxWordLength + 1);
Result.AvgWordLength := 0;
if Result.NumWords > 0 then
for i := 0 to High(Result.WordLengthDistr) do
Result.AvgWordLength := Result.AvgWordLength + Result.WordLengthDistr[i] * i / Result.NumWords;
end;
end;
function TTextFile.GetFindCount: Integer;
begin
Result := Length(FFindData);
end;
function TTextFile.GetFindData(Index: Integer): TTextSpan;
begin
Result := FFindData[Index];
end;
function TTextFile.GetFirstLine(const AText: string): string;
begin
Result := Copy(AText, 1, Pos(#13#10, AText) - 1);
end;
function TTextFile.GetHasBookmarks: Boolean;
begin
Result := UsedBookmarkCount > 0;
end;
function TTextFile.GetClass(Index: Integer): string;
begin
Result := FClasses[Index];
end;
function TTextFile.GetClassesAsText: string;
var
i, p: Integer;
begin
SetLength(Result, GetClassLength);
p := 1;
for i := 0 to LineCount - 1 do
begin
if not FClasses[i].IsEmpty then
Move(FClasses[i][1], Result[p], Length(FClasses[i]) * SizeOf(Char));
if i < LineCount - 1 then
begin
Inc(p, Length(FClasses[i]) + 2);
Result[p-2] := #13;
Result[p-1] := #10;
end;
end;
end;
function TTextFile.GetClassLength: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to LineCount - 1 do
Inc(Result, Length(FClasses[i]) + Length(#13#10));
Dec(Result, Length(#13#10));
end;
function TTextFile.GetIndent: Integer;
begin
Result := GetIndent(FCaretPos.Y);
end;
function TTextFile.GetIndentOnReturn(out Len: Integer): string;
begin
Len := IfThen(FAutoIndent, Min(GetIndent, FCaretPos.X), 0);
if FCaretAfterEOL and AtOrBeyondEOL then
Result := ''
else
Result := DupeString(#32, Len);
end;
function TTextFile.GetIndexOfPoint(const APoint: TPoint): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to APoint.Y - 1 do
Inc(Result, VirtualLineWidths[i]);
Inc(Result, APoint.X);
end;
function TTextFile.GetLine(Index: Integer): string;
begin
Result := FLines[Index];
end;
function TTextFile.GetLineCount: Integer;
begin
Result := Length(FLines);
end;
function TTextFile.GetLogicalLineCount: Integer;
begin
if Empty then
Result := 0
else
Result := Length(FLines);
end;
function TTextFile.GetPhysicalLineWidth(Index: Integer): Integer;
begin
Result := Length(FLines[Index]);
end;
function TTextFile.GetPhysicalPhysicalIndexOfPoint(
const APoint: TPoint): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to APoint.Y - 1 do
Inc(Result, PhysicalLineWidths[i] + Length(#13#10));
Inc(Result, APoint.X);
end;
function TTextFile.GetVirtualLineWidth(Index: Integer): Integer;
begin
if SameStr(FClasses[Index], LINE_CONTROL_CLASS) then
Result := Min(1, Length(FLines[Index]))
else
Result := Length(FLines[Index]);
end;
function TTextFile.GetVirtualSpace(LineIndex, Col: Integer): string;
var
LW: Integer;
begin
LW := VirtualLineWidths[LineIndex];
if Col > LW then
Result := DupeString(' ', Col - LW)
else
Result := '';
end;
function TTextFile.GetMaxLineWidth: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to High(FLines) do
if Length(FLines[i]) > Result then
Result := Length(FLines[i]);
end;
function TTextFile.GetNoncharacterCount: Integer;
begin
Result := NumCharsOfType(IsNoncharacter)
end;
function TTextFile.GetNumCharacters: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to LineCount - 1 do
Inc(Result, VirtualLineWidths[i]);
end;
function TTextFile.GetPhysicalIndexOfPoint(const APoint: TPoint): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to APoint.Y - 1 do
Inc(Result, VirtualLineWidths[i] + Length(#13#10));
Inc(Result, APoint.X);
end;
function TTextFile.GetPointOfIndex(const Index: Integer): TPoint;
var
acc: Integer;
i: Integer;
begin
if Index < 0 then
raise Exception.CreateFmt(SInvalidOpMsgInvalidChrIndex, [Index]);
Result.Y := -1;
acc := 0;
for i := 0 to LineCount - 1 do
begin
Inc(acc, VirtualLineWidths[i]);
if acc > Index then
begin
Result.X := Index - acc + VirtualLineWidths[i];
Result.Y := i;
break;
end;
end;
end;
function TTextFile.GetSelLength: Integer;
var
FirstPoint, SecondPoint: TPoint;
i: Integer;
begin
Result := 0;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
case FCaretPos.SelectionType of
stLineBased:
if FirstPoint.Y = SecondPoint.Y then
Result := SecondPoint.X - FirstPoint.X
else
begin
Result := VirtualLineWidths[FirstPoint.Y] - FirstPoint.X;
for i := FirstPoint.Y + 1 to SecondPoint.Y - 1 do
Inc(Result, VirtualLineWidths[i]);
Inc(Result, SecondPoint.X);
end;
stBlock:
Result := (SecondPoint.Y - FirstPoint.Y + 1) * Abs(SecondPoint.X - FirstPoint.X);
end;
end;
function TTextFile.GetSelStart: Integer;
begin
Result := GetIndexOfPoint(FCaretPos.Data)
end;
function TTextFile.GetControlCharCount: Integer;
begin
{$WARN SYMBOL_DEPRECATED OFF}
Result := NumCharsOfType(IsControl)
{$WARN SYMBOL_DEPRECATED DEFAULT}
end;
function TTextFile.GetControlText(LineIndex: Integer): string;
begin
if Assigned(FOnGetControlText) then
FOnGetControlText(Self, LineIndex, Result)
else
Result := SControl;
end;
function TTextFile.GetSelText: string;
var
FirstPoint, SecondPoint: TPoint;
xmin, xmax: Integer;
i: Integer;
begin
Result := '';
if not HasSelection then Exit;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if FirstPoint.Y = SecondPoint.Y then
if FControlAware and IsControlLine(FirstPoint.Y) then
Result := IfThen((FirstPoint.X = 0) and (SecondPoint.X >= 1), GetDecoratedControlText(FirstPoint.Y))
else
Result := Copy(FLines[FirstPoint.Y], FirstPoint.X + 1, SecondPoint.X - FirstPoint.X)
else
case FCaretPos.SelectionType of
stLineBased:
begin
if FControlAware and IsControlLine(FirstPoint.Y) then
Result := IfThen(FirstPoint.X = 0, GetDecoratedControlText(FirstPoint.Y)) + #13#10
else
Result := Copy(FLines[FirstPoint.Y], FirstPoint.X + 1) + #13#10;
for i := FirstPoint.Y + 1 to SecondPoint.Y - 1 do
if FControlAware and IsControlLine(i) then
Result := Result + GetDecoratedControlText(i) + #13#10
else
Result := Result + FLines[i] + #13#10;
if FControlAware and IsControlLine(SecondPoint.Y) then
Result := Result + IfThen(SecondPoint.X >= 1, GetDecoratedControlText(SecondPoint.Y))
else
Result := Result + Copy(FLines[SecondPoint.Y], 1, SecondPoint.X);
end;
stBlock:
begin
xmin := min(FirstPoint.X, SecondPoint.X);
xmax := max(FirstPoint.X, SecondPoint.X);
for i := FirstPoint.Y to SecondPoint.Y do
Result := Result + Copy(FLines[i], xmin + 1, xmax - xmin) + IfThen(i < SecondPoint.Y, #13#10);
end;
end;
end;
function TTextFile.GetSingleLineText: string;
var
i, p: Integer;
begin
SetLength(Result, GetPhysicalTextLength);
p := 1;
for i := 0 to LineCount - 1 do
begin
Move(FLines[i][1], Result[p], PhysicalLineWidths[i] * SizeOf(Char));
if i < LineCount - 1 then
begin
Inc(p, PhysicalLineWidths[i] + 2);
Result[p-2] := '␍';
Result[p-1] := '␊';
end;
end;
end;
function TTextFile.GetVirtualTextLength: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to LineCount - 1 do
Inc(Result, VirtualLineWidths[i] + Length(#13#10));
Dec(Result, Length(#13#10));
end;
function TTextFile.GetPhysicalTextLength: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to LineCount - 1 do
Inc(Result, PhysicalLineWidths[i] + Length(#13#10));
Dec(Result, Length(#13#10));
end;
function TTextFile.AtEOL: Boolean;
begin
Result := FCaretPos.X = VirtualLineWidths[FCaretPos.Y]
end;
function TTextFile.AtOrBeyondEOF: Boolean;
begin
Result := (FCaretPos.Y = LineCount - 1) and (FCaretPos.X >= VirtualLineWidths[FCaretPos.Y]);
end;
function TTextFile.AtOrBeyondEOL: Boolean;
begin
Result := FCaretPos.X >= VirtualLineWidths[FCaretPos.Y]
end;
procedure TTextFile.BeginAddLine;
begin
Inc(FMultiAddLineMode);
end;
function TTextFile.BeyondEOL: Boolean;
begin
Result := FCaretPos.X > VirtualLineWidths[FCaretPos.Y]
end;
procedure TTextFile.BookmarksMoved;
begin
if Assigned(FOnBookmarksMoved) then
FOnBookmarksMoved(Self);
end;
function TTextFile.AtEOF: Boolean;
begin
Result := (FCaretPos.Y = LineCount - 1) and (FCaretPos.X = VirtualLineWidths[FCaretPos.Y]);
end;
function TTextFile.AtLastLine: Boolean;
begin
Result := FCaretPos.Y = LineCount - 1;
end;
function TTextFile.AtSOF: Boolean;
begin
Result := FCaretPos.X + FCaretPos.Y = 0;
end;
function TTextFile.CanAutoReplace(out StartPos, Index: Integer): Boolean;
var
i: Integer;
Token: string;
begin
Result := False;
if BeyondEOL then Exit;
StartPos := 1;
for i := FCaretPos.X downto 1 do
if FLines[FCaretPos.Y][i] = '\' then
begin
StartPos := i;
break;
end
else if FLines[FCaretPos.Y][i].IsWhiteSpace then
begin
StartPos := i + 1;
break;
end;
Token := Copy(FLines[FCaretPos.Y], StartPos, FCaretPos.X - StartPos + 1);
Index := -1;
for i := 0 to Length(FAutoReplaceItems) - 1 do
if SameStr(FAutoReplaceItems[i].Token, Token) then
begin
Index := i;
break;
end;
Result := (Index <> -1) and (Length(Token) > 0);
end;
procedure TTextFile.DoAutoReplace(const StartPos, Index: Integer);
begin
System.Delete(FLines[FCaretPos.Y], StartPos, FCaretPos.X - StartPos + 1);
System.Insert(FAutoReplaceItems[Index].ReplacedValue, FLines[FCaretPos.Y], StartPos);
FCaretPos.SetX(StartPos + Length(FAutoReplaceItems[Index].ReplacedValue) - 1);
Changed(ctLineFrom, FCaretPos.Y, StartPos - 1);
end;
function TTextFile.AutoReplace: Boolean;
var
StartPos: Integer;
Index: Integer;
begin
Result := CanAutoReplace(StartPos, Index);
if Result then
DoAutoReplace(StartPos, Index);
end;
function TTextFile.GetVirtualSpace: string;
begin
if FCaretPos.X > VirtualLineWidths[FCaretPos.Y] then
Result := DupeString(#32, FCaretPos.X - VirtualLineWidths[FCaretPos.Y])
else
Result := '';
end;
function TTextFile.GetWordBoundary(const Point: TPoint; out StartPos,
EndPos: Integer; PascalIdent: Boolean = False): Boolean;
var
i: Integer;
begin
Result := (CharacterExists(Point.Y, Point.X) and FLines[Point.Y][Point.X + 1].IsLetterOrDigit)
or
(CharacterExists(Point.Y, Point.X - 1) and FLines[Point.Y][Point.X - 1 + 1].IsLetterOrDigit);
if not Result then Exit;
StartPos := 0;
EndPos := VirtualLineWidths[Point.Y];
for i := Point.X - 1 downto 0 do
if not (FLines[Point.Y][i+1].IsLetterOrDigit or (PascalIdent and (FLines[Point.Y][i+1] = '_'))) then
begin
StartPos := i + 1;
break;
end;
for i := Point.X to VirtualLineWidths[Point.Y] - 1 do
if not (FLines[Point.Y][i+1].IsLetterOrDigit or (PascalIdent and (FLines[Point.Y][i+1] = '_'))) then
begin
EndPos := i;
break;
end;
end;
function TTextFile.GetWord(const Point: TPoint; PascalIdent: Boolean = False): string;
var
S, E: Integer;
begin
if GetWordBoundary(Point, S, E, PascalIdent) then
Result := Copy(FLines[Point.Y], S + 1, E - S);
end;
function TTextFile.GetWord(PascalIdent: Boolean = False): string;
begin
Result := GetWord(FCaretPos.Data, PascalIdent);
end;
function TTextFile.GetWordBoundary(out StartPos, EndPos: Integer; PascalIdent: Boolean = False): Boolean;
begin
Result := GetWordBoundary(FCaretPos.Data, StartPos, EndPos, PascalIdent);
end;
function TTextFile.IndexOf(const ALine: string): Integer;
var
i: Integer;
begin
for i := 0 to High(FLines) do
if FLines[i] = ALine then
Exit(i);
Result := -1;
end;
function TTextFile.IndexOfText(const ALine: string): Integer;
var
i: Integer;
begin
var LLine := ALine.ToLower;
for i := 0 to High(FLines) do
if FLines[i].ToLower = LLine then
Exit(i);
Result := -1;
end;
function TTextFile.IndexOfText2(const ALine: string): Integer;
begin
Result := IndexOf(ALine);
if Result = -1 then
Result := IndexOfText(ALine);
end;
procedure TTextFile.InsertChar(const AChar: Char; const Overwrite: Boolean = False);
var
PrevLineEnd: Integer;
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and not AtLastLine) then
begin
IssueReadOnlyError;
Exit;
end;
if HasSelection then
ClearSelection;
if FControlAware and IsControlLine then
begin
IssueInputError;
Exit;
end;
if AtEOL then
begin
FLines[FCaretPos.Y] := FLines[FCaretPos.Y] + AChar;
FCaretPos.SetX(FCaretPos.X + 1);
Changed(ctChar, FCaretPos.Y, FCaretPos.X - 1);
end
else
begin
PrevLineEnd := VirtualLineWidths[FCaretPos.Y];
FLines[FCaretPos.Y] := Copy(FLines[FCaretPos.Y], 1, FCaretPos.X) + GetVirtualSpace + AChar + Copy(FLines[FCaretPos.Y], FCaretPos.X + 1 + IfThen(Overwrite, 1));
FCaretPos.SetX(FCaretPos.X + 1);
Changed(ctLineFrom, FCaretPos.Y, Min(PrevLineEnd, FCaretPos.X - 1));
end;
PushBookmarks(FCaretPos.Y, FCaretPos.X - 1);
Modified;
end;
procedure TTextFile.InsertLine(const ALine, AClassName: string;
LineIndex: Integer);
begin
if (EditMode = emReadOnly) or (EditMode = emConsole) then
begin
IssueReadOnlyError;
Exit;
end;
if FSingleLine then
raise EInvalidOperation.Create(SInvalidOpMsgSingleLineModeInsertLine);
InternalInsertLine(LineIndex, ALine, AClassName);
TushBookmarks(LineIndex);
LineClassChanged(LineIndex);
FCaretPos.SetPoint(VirtualLineWidths[LineIndex], LineIndex);
Changed(ctLineRange, LineIndex, High(FLines));
Modified;
end;
procedure TTextFile.InsertLine(const ALine: string; LineIndex: Integer);
begin
InsertLine(ALine, '', LineIndex);
end;
procedure TTextFile.InsertText(const AText: string);
var
nlines, i: Integer;
indices: DynIntegerArray;
pre, post: string;
TML: Boolean;
PrevLineEnd: Integer;
OldCP, NewCP: TPoint;
HadSel, HadMultiLineSel: Boolean;
begin
TML := TextIsMultiline(AText);
if FSingleLine and TML then
begin
InsertText(GetFirstLine(AText));
Exit;
end;
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (TML or not AtLastLine)) then
begin
IssueReadOnlyError;
Exit;
end;
if FControlAware and IsControlLine then
begin
IssueInputError;
Exit;
end;
HadSel := HasSelection;
HadMultiLineSel := SelectionIsMultiline;
if not TML then
begin
LockVisualUpdates;
try
if HadSel then ClearSelection;
PushBookmarks(FCaretPos.Y, FCaretPos.X, Length(AText));
PrevLineEnd := VirtualLineWidths[FCaretPos.Y];
Insert(GetVirtualSpace + AText, FLines[FCaretPos.Y], FCaretPos.X + 1);
FCaretPos.SetX(FCaretPos.X + Length(AText));
finally
UnlockVisualUpdates;
end;
if not HadMultiLineSel then
Changed(ctLineFrom, FCaretPos.Y, Min(PrevLineEnd, FCaretPos.X - Length(AText)))
else
begin
Changed(ctLineRange, FCaretPos.Y, LineCount - 1);
PostFileChanged(100);
end;
end
else
begin
LockVisualUpdates;
try
if HadSel then ClearSelection;
nlines := Occurrences(AText, #13#10, indices) + 1;
OldCP := FCaretPos.Data;
InternalInsertLines(FCaretPos.Y + 1, nlines - 1);
pre := LineToLeft;
post := LineToRight;
FLines[FCaretPos.Y] := pre + GetVirtualSpace + Copy(AText, 1, indices[0] - 1);
FLines[FCaretPos.Y + nlines - 1] := Copy(AText, indices[High(indices)] + length(#13#10)) + post;
for i := 0 to High(indices) - 1 do
FLines[FCaretPos.Y + 1 + i] := Copy(AText, indices[i] + length(#13#10), indices[i+1] - indices[i] - length(#13#10));
NewCP := Point(Length(AText) - indices[High(indices)] - 1, FCaretPos.Y + nlines - 1);
LineArrayChanged;
FCaretPos.SetPoint(NewCP);
RushBookmarksEx(OldCP, FCaretPos.Data);
finally
UnlockVisualUpdates;
end;
Changed(ctLineRange, FCaretPos.Y - nlines + 1, LineCount - 1);
if HadMultiLineSel then
PostFileChanged(100);
end;
Modified;
end;
procedure TTextFile.LockVisualUpdates;
begin
if Assigned(FOnLockVisualUpdates) then
FOnLockVisualUpdates(Self);
end;
procedure TTextFile.UnlockVisualUpdates;
begin
if Assigned(FOnUnlockVisualUpdates) then
FOnUnlockVisualUpdates(Self);
end;
procedure TTextFile.InsertTextAsBlock(const AText: string);
var
Lines: DynStringArray;
nlines, i: Integer;
VirtualCP: TPoint;
oldlen, newlen: Integer;
j: Integer;
LAC: Boolean;
ML: Integer;
begin
if FSingleLine and (Pos(#13#10, AText) > 0) then
begin
IssueInputError;
Exit;
end;
if EditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
if HasSelection then
ClearSelection;
Lines := Split(AText, #13#10);
nlines := Length(Lines);
if FControlAware then
for i := FCaretPos.Y to min(LineCount - 1, FCaretPos.Y + nlines - 1) do
if IsControlLine(i) then
begin
IssueInputError;
Exit;
end;
LAC := False;
if CaretPos.Y + nlines - 1 >= Length(FLines) then
begin
InternalAddLines(CaretPos.Y + nlines - 1 + 1 - Length(FLines));
LAC := True;
end;
VirtualCP := CaretPos.Data;
ML := 0;
for i := 0 to nlines - 1 do
begin
oldlen := Length(FLines[VirtualCP.Y]);
SetLength(FLines[VirtualCP.Y],
Max(Length(FLines[VirtualCP.Y]), VirtualCP.X + Length(Lines[i])));
newlen := Length(FLines[VirtualCP.Y]);
if newlen > oldlen + Length(Lines[i]) then
for j := oldlen + 1 to VirtualCP.X do
FLines[VirtualCP.Y][j] := #$20;
Move(Lines[i][1], FLines[VirtualCP.Y][VirtualCP.X + 1], Length(Lines[i]) * sizeof(Char));
Inc(VirtualCP.Y);
ML := max(ML, Length(Lines[i]));
end;
if LAC then LineArrayChanged;
with CaretPos.Data do
Changed(ctBlock, Y, Y + nlines - 1, X, X + ML);
Modified;
end;
procedure TTextFile.SaveToFile(const FileName: TFileName; TrimRight: Boolean;
AExport: Boolean);
var
FS: TFileStream;
SW: TStreamWriter;
i: Integer;
begin
if FStrictReadOnly then Exit;
FS := TFileStream.Create(FileName, fmCreate);
try
SW := TStreamWriter.Create(FS, FEncoding.GetVCLEncoding);
try
if not FEncoding.MagicWord then
FS.Size := 0;
case FEncoding.LineBreakType of
lbtCRLF:
SW.NewLine := #13#10;
lbtCR:
SW.NewLine := #13;
lbtLF:
SW.NewLine := #10;
end;
if TrimRight then
for i := 0 to LineCount - 1 do
if FControlAware and IsControlLine(i) then
SW.WriteLine(GetDecoratedControlText(i))
else
SW.WriteLine(SysUtils.TrimRight(FLines[i]))
else
for i := 0 to LineCount - 1 do
if FControlAware and IsControlLine(i) then
SW.WriteLine(GetDecoratedControlText(i))
else
SW.WriteLine(FLines[i])
finally
SW.Free;
end;
finally
FS.Free;
end;
if not AExport then
begin
FFileName := FileName;
FModified := False;
FRecentlyOpened := False;
end;
end;
procedure TTextFile.SaveToStream(AStream: TStream);
var
Header: TStreamHeader;
i: Integer;
begin
if AStream = nil then
raise Exception.Create('TTextFile.SaveToStream: Stream is unassigned.');
FillChar(Header, sizeof(Header), 0);
Header.Signature := TEXTFILE_SIGNATURE;
Header.CaretPos := FCaretPos.Data;
Header.SelEndPos := FCaretPos.SelEnd;
Header.SelectionType := FCaretPos.SelectionType;
Header.EditMode := FEditMode;
Header.Modified := FModified;
Header.FileName := FFileName;
Header.LineCount := LineCount;
Header.Bookmarks := FBookmarks;
if FEditorState.Valid then
begin
Header.ScrollPos := FEditorState.ScrollPos;
Header.MultiSize := FEditorState.MultiSize;
Header.Overwrite := FEditorState.Overwrite;
Header.HiddenChars := FEditorState.HiddenChrs;
Header.RulerVisible := FEditorState.RulerVisible;
Header.ZoomLevel := FEditorState.ZoomLevel;
end;
Header.Encoding := FEncoding;
Header.RecentlyOpened := FRecentlyOpened;
Header.StrictReadOnly := FStrictReadOnly;
Header.UseLineClasses := FUseLineClasses;
Header.FPClassName := FEditorState.FormattingProcessor;
AStream.WriteBuffer(Header, sizeof(Header));
for i := 0 to Header.LineCount - 1 do
begin
AStream.WriteData(Integer(FLines[i].Length));
AStream.WriteData(Integer(FClasses[i].Length));
end;
for i := 0 to Header.LineCount - 1 do
begin
if not FLines[i].IsEmpty then
AStream.WriteBuffer(FLines[i][1], FLines[i].Length * sizeof(Char));
if not FClasses[i].IsEmpty then
AStream.WriteBuffer(FClasses[i][1], FClasses[i].Length * sizeof(Char));
end;
AStream.WriteData(TEXTFILE_SIGNATURE_FPCACHE);
AStream.WriteData(FEditorState.FPCacheLen);
if (FEditorState.FPCacheLen > 0) and Assigned(FEditorState.FPCache) then
AStream.WriteBuffer(FEditorState.FPCache^, FEditorState.FPCacheLen);
FHistoryManager.SaveToStream(AStream);
AStream.WriteData(TEXTFILE_SIGNATURE);
AStream.WriteData(#0);
end;
procedure TTextFile.CreateDataStream(out Data: pointer; out Len: UInt64);
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
Len := MS.Size;
GetMem(Data, Len);
try
CopyMemory(Data, MS.Memory, Len);
except
FreeMem(Data);
raise;
end;
finally
MS.Free;
end;
end;
procedure TTextFile.SelectAll;
begin
case FCaretPos.SelectionType of
stLineBased:
FCaretPos.CreateSelection(Point(VirtualLineWidths[LineCount - 1], LineCount - 1),
Point(0, 0),
stLineBased);
stBlock:
FCaretPos.CreateSelection(Point(GetMaxLineWidth, LineCount - 1),
Point(0, 0),
stBlock);
end;
end;
procedure TTextFile.SelectAllNone;
begin
if AllSelected then
SelectNone
else
SelectAll;
end;
function TTextFile.SelectionIsMultiline: Boolean;
begin
Result := FCaretPos.Data.Y <> FCaretPos.SelEnd.Y;
end;
procedure TTextFile.SelectLine(const ALineIndex: Integer);
begin
FCaretPos.CreateSelection(Point(VirtualLineWidths[ALineIndex], ALineIndex),
Point(0, ALineIndex));
end;
procedure TTextFile.SelectLine;
begin
FCaretPos.CreateSelection(Point(VirtualLineWidths[FCaretPos.Y], FCaretPos.Y),
Point(0, FCaretPos.Y));
end;
procedure TTextFile.SelectLines(const ALineA, ALineB: Integer);
begin
if ALineA < ALineB then
FCaretPos.CreateSelection(Point(0, ALineA),
Point(VirtualLineWidths[ALineB], ALineB))
else
FCaretPos.CreateSelection(Point(VirtualLineWidths[ALineA], ALineA),
Point(0, ALineB));
end;
procedure TTextFile.SelectNone;
begin
FCaretPos.RemoveSelection;
end;
function TTextFile.SelectWord: Boolean;
var
S, E: Integer;
begin
Result := GetWordBoundary(S, E);
if Result then
begin
FCaretPos.SetX(E);
FCaretPos.SetX(S, True);
end;
end;
procedure TTextFile.SetCaretAfterEOL(const Value: Boolean);
begin
if FSingleLine and Value then Exit;
if FCaretAfterEOL <> Value then
begin
FCaretAfterEOL := Value;
if not FCaretAfterEOL and (AtOrBeyondEOL and not AtEOL) then
FCaretPos.SetX(VirtualLineWidths[FCaretPos.Y]);
end;
end;
procedure TTextFile.SetChar(Y, X: Integer; const Value: Char);
begin
if CharacterExists(Y, X) then
begin
FLines[Y][X + 1] := Value;
Changed(ctChar, Y, X);
Modified;
end;
end;
procedure TTextFile.SetClass(Index: Integer; const Value: string);
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (Index < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
FClasses[Index] := Value;
end;
procedure TTextFile.SetLine(Index: Integer; const Value: string);
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (Index < LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
FLines[Index] := Value;
end;
procedure TTextFile.SetSelLength(const Value: Integer);
var
SelEndPos: TPoint;
FirstPoint, SecondPoint: TPoint;
begin
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
SelEndPos := GetPointOfIndex(GetIndexOfPoint(FirstPoint) + Value);
if SelEndPos.Y = -1 then
SelEndPos := Point(VirtualLineWidths[LineCount - 1], LineCount - 1);
FCaretPos.SetPoint(SelEndPos, True);
end;
procedure TTextFile.SetSelStart(const Value: Integer);
begin
FCaretPos.SetPoint(GetPointOfIndex(Value));
end;
procedure TTextFile.SetSingleLine(const Value: Boolean);
begin
if FSingleLine <> Value then
begin
FSingleLine := Value;
if FSingleLine and (Length(FLines) > 1) then
SetText(GetSingleLineText);
if FSingleLine then
SetCaretAfterEOL(False);
end;
end;
procedure TTextFile.SetText(const Value, Classes: string);
var
i, nlines, prevsep: Integer;
indices: DynIntegerArray;
begin
nlines := Occurrences(Value, #13#10, indices) + 1;
SetLength(FLines, nlines);
SetLength(indices, Length(indices) + 1);
indices[High(indices)] := length(Value) + 1;
prevsep := 1 - length(#13#10);
for i := 0 to High(indices) do
begin
FLines[i] := Copy(Value, prevsep + length(#13#10), indices[i] - prevsep - length(#13#10));
prevsep := indices[i];
end;
nlines := Occurrences(Classes, #13#10, indices) + 1;
SetLength(FClasses, nlines);
SetLength(indices, Length(indices) + 1);
indices[High(indices)] := length(Classes) + 1;
prevsep := 1 - length(#13#10);
for i := 0 to High(indices) do
begin
FClasses[i] := Copy(Classes, prevsep + length(#13#10), indices[i] - prevsep - length(#13#10));
prevsep := indices[i];
end;
LineArrayChanged;
Changed(ctFile);
GotoEOF;
Modified;
end;
const
SortTestStrA = 'baJbnHrkM7';
SortTestStrB = 'jhn5V';
function TTextFile.Sort(AFirstLine, ALastLine: Integer;
BookmarkAware: Boolean): Boolean;
begin
Result := False;
if not Assigned(FLineComparer) then
raise EInvalidOperation.Create(SNoLineComparer);
if FLineComparer(SortTestStrA, SortTestStrB) * FLineComparer(SortTestStrB, SortTestStrA) > 0 then
raise EInvalidOperation.Create(SIllegalLineComparer);
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
if AFirstLine >= ALastLine then Exit;
Result := True;
SortRecursive(AFirstLine, ALastLine, BookmarkAware);
LineArrayChanged;
CaretPos.SetPoint(0, AFirstLine);
LineClassChanged(AFirstLine);
Changed(ctLineRange, AFirstLine, ALastLine);
Modified;
if BookmarkAware then
BookmarksMoved;
end;
procedure TTextFile.SortRecursive(AFirstLine, ALastLine: Integer;
BookmarkAware: Boolean = True);
function Partition(A, B: Integer): Integer;
var
pivot: string;
i, j: Integer;
Rv: Integer;
begin
Rv := IfThen(FSortReverseOrder, -1, 1);
pivot := FLines[A + (B - A) div 2];
i := A;
j := B;
repeat
while Rv * FLineComparer(FLines[i], pivot) < 0 do Inc(i);
while Rv * FLineComparer(FLines[j], pivot) > 0 do Dec(j);
if i <= j then
begin
InternalSwapLines(i, j, BookmarkAware);
Inc(i);
Dec(j);
end;
until i > j;
Result := i;
end;
var
p: Integer;
begin
if AFirstLine < ALastLine then
begin
p := Partition(AFirstLine, ALastLine);
SortRecursive(AFirstLine, p - 1);
SortRecursive(p, ALastLine);
end;
end;
function TTextFile.Sort(BookmarkAware: Boolean): Boolean;
begin
Result := Sort(0, LineCount - 1, BookmarkAware);
end;
function TTextFile.SortSelection(BookmarkAware: Boolean): Boolean;
var
FirstPoint, SecondPoint: TPoint;
begin
Result := False;
if not HasSelection then Exit;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
Result := Sort(FirstPoint.Y, SecondPoint.Y, BookmarkAware);
end;
procedure TTextFile.SurroundText(const APrefix, APostfix: string);
var
FirstPoint, SecondPoint: TPoint;
begin
if SelectionIsMultiline then
begin
if EditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
SanitizeSelection;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if IsControlLine(FirstPoint.Y) or IsControlLine(SecondPoint.Y) then
begin
IssueInputError;
Exit;
end;
Insert(APrefix, FLines[FirstPoint.Y], FirstPoint.X + 1);
Insert(APostfix, FLines[SecondPoint.Y], SecondPoint.X + 1);
PushBookmarks(FirstPoint.Y, FirstPoint.X, Length(APrefix));
PushBookmarks(SecondPoint.Y, SecondPoint.X, Length(APostfix));
Inc(FirstPoint.X, Length(APrefix));
LockVisualUpdates;
try
FCaretPos.CreateSelection(FirstPoint, SecondPoint);
finally
UnlockVisualUpdates;
Changed(ctLineRange, FirstPoint.Y, SecondPoint.Y);
end;
end
else if HasSelection then
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FCaretPos.Y <> LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
if IsControlLine(FCaretPos.Y) then
begin
IssueInputError;
Exit;
end;
SanitizeSelection;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
Insert(APrefix, FLines[FirstPoint.Y], FirstPoint.X + 1);
Insert(APostfix, FLines[SecondPoint.Y], SecondPoint.X + Length(APrefix) + 1);
PushBookmarks(FCaretPos.Y, FirstPoint.X, Length(APrefix));
PushBookmarks(FCaretPos.Y, SecondPoint.X + Length(APrefix), Length(APostfix));
Inc(FirstPoint.X, Length(APrefix));
Inc(SecondPoint.X, Length(APrefix));
LockVisualUpdates;
try
FCaretPos.CreateSelection(FirstPoint, SecondPoint);
finally
UnlockVisualUpdates;
Changed(ctLine, FirstPoint.Y);
end;
end
else
begin
if (EditMode = emReadOnly) or ((EditMode = emConsole) and (FCaretPos.Y <> LineCount - 1)) then
begin
IssueReadOnlyError;
Exit;
end;
if IsControlLine(FCaretPos.Y) then
begin
IssueInputError;
Exit;
end;
Insert(GetVirtualSpace(FCaretPos.Y, FCaretPos.X) + APrefix + APostfix, FLines[FCaretPos.Y], FCaretPos.X + 1);
PushBookmarks(FCaretPos.Y, FCaretPos.X, Length(APrefix) + Length(APostfix));
FCaretPos.SetX(FCaretPos.X + Length(APrefix));
Changed(ctLine, FCaretPos.Y);
end;
Modified;
end;
procedure TTextFile.SanitizeSelection;
var
FirstPoint, SecondPoint: TPoint;
begin
if not (HasSelection and (FCaretPos.SelectionType = stLineBased)) then Exit;
FCaretPos.GetSelBdry(FirstPoint, SecondPoint);
if SecondPoint.X > VirtualLineWidths[SecondPoint.Y] then
SecondPoint.X := VirtualLineWidths[SecondPoint.Y];
if FirstPoint.X > VirtualLineWidths[FirstPoint.Y] then
FirstPoint.X := VirtualLineWidths[FirstPoint.Y];
FCaretPos.CreateSelection(FirstPoint, SecondPoint);
end;
function TTextFile.SushBookmarks(FirstLine, SecondLine: Integer; Silent: Boolean = False): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[i].Y = FirstLine then
begin
Result := True;
FBookmarks[i].Y := SecondLine;
end
else if FBookmarks[i].Y = SecondLine then
begin
Result := True;
FBookmarks[i].Y := FirstLine;
end;
if Result and not Silent then BookmarksMoved;
end;
procedure TTextFile.SetText(const Value: string);
var
i, nlines, prevsep: Integer;
indices: DynIntegerArray;
begin
nlines := Occurrences(Value, #13#10, indices) + 1;
SetLength(FLines, nlines);
SetLength(FClasses, nlines);
SetLength(indices, Length(indices) + 1);
indices[High(indices)] := Length(Value) + 1;
prevsep := 1 - Length(#13#10);
for i := 0 to High(indices) do
begin
FLines[i] := Copy(Value, prevsep + Length(#13#10), indices[i] - prevsep - Length(#13#10));
prevsep := indices[i];
if FControlAware and SameStr(Copy(FLines[i], 1, Length(LINE_CONTROL_PREFIX)), LINE_CONTROL_PREFIX) then
FClasses[i] := LINE_CONTROL_CLASS
else
FClasses[i] := '';
end;
LineArrayChanged;
Changed(ctFile);
if SingleLine then
GotoSOF
else
GotoEOF;
Modified;
end;
function TTextFile.SwapLines(FirstLine, SecondLine: Integer): Boolean;
var
tmpLine: string;
tmpClass: string;
begin
Result := False;
if SingleLine then
Exit;
if EditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
if not (InRange(FirstLine, 0, LineCount - 1) and InRange(SecondLine, 0, LineCount - 1)) then
begin
IssueInputError;
Exit;
end;
if FirstLine = SecondLine then Exit;
tmpLine := FLines[FirstLine];
tmpClass := FClasses[FirstLine];
FLines[FirstLine] := FLines[SecondLine];
FClasses[FirstLine] := FClasses[SecondLine];
FLines[SecondLine] := tmpLine;
FClasses[SecondLine] := tmpClass;
SushBookmarks(FirstLine, SecondLine);
LineArrayChanged;
if FirstLine = FCaretPos.Y then
FCaretPos.SetPoint(FCaretPos.X, SecondLine)
else if SecondLine = FCaretPos.Y then
FCaretPos.SetPoint(FCaretPos.X, FirstLine);
Changed(ctLine, FirstLine);
Changed(ctLine, SecondLine);
Modified;
Result := True;
end;
function TTextFile.LineArray: TArray<string>;
begin
Result := TArray<string>(FLines);
end;
procedure TTextFile.LineArrayChanged;
begin
if Assigned(FOnLineChange) then
FOnLineChange(Self, lctAll, 0);
end;
procedure TTextFile.LineClassChanged(LineIndex: Integer);
begin
if Assigned(FOnLineClassChange) then
FOnLineClassChange(Self, LineIndex);
end;
function TTextFile.LineExists(LineIndex: Integer): Boolean;
begin
Result := InRange(LineIndex, 0, LineCount - 1);
end;
function TTextFile.SwapLinesAbove: Boolean;
begin
Result := SwapLines(FCaretPos.Y, FCaretPos.Y - 1);
end;
function TTextFile.SwapLinesBelow: Boolean;
begin
Result := SwapLines(FCaretPos.Y, FCaretPos.Y + 1);
end;
function TTextFile.TextIsMultiline(const AText: string): Boolean;
begin
Result := Pos(#13#10, AText) > 0;
end;
procedure TTextFile.TrimRight;
var
i: Integer;
begin
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
for i := 0 to Length(FLines) - 1 do
FLines[i] := SysUtils.TrimRight(FLines[i]);
if (not FCaretAfterEOL) and (FCaretPos.Data.X > VirtualLineWidths[FCaretPos.Data.Y]) then
FCaretPos.SetX(VirtualLineWidths[FCaretPos.Data.Y]);
Changed(ctFile);
Modified;
end;
procedure TTextFile.TruncateFileAt(Line, Col: Integer);
begin
if EditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
if (Line < 0) or (Line = 0) and (Col <= 0) then
begin
Clear;
Exit;
end;
if (Line > LineCount - 1) or (Line = LineCount - 1) and (Col >= FLines[Line].Length) then
Exit;
SetLength(FLines, Line + 1);
SetLength(FClasses, Line + 1);
if Col < FLines[Line].Length then
SetLength(FLines[Line], Col);
LineArrayChanged;
Changed(ctFile);
GotoEOF;
LineClassChanged(LineCount - 1);
Modified;
RemoveGhostBookmarks;
end;
procedure TTextFile.TruncateAt(AFirstLine, ALastLine, AIndex: Integer;
AChar: Char = #0; PreserveChar: Boolean = False; AReverse: Boolean = False);
function NthPos(BLineIndex: Integer; N: Integer): Integer;
var
i, c: Integer;
begin
Result := 0;
c := 0;
for i := 1 to Length(FLines[BLineIndex]) do
begin
if FLines[BLineIndex][i] = AChar then
Inc(c);
if c = N then
Exit(i);
end;
end;
function NthPosRev(BLineIndex: Integer; N: Integer): Integer;
var
i, c: Integer;
begin
Result := 0;
c := 0;
for i := Length(FLines[BLineIndex]) downto 1 do
begin
if FLines[BLineIndex][i] = AChar then
Inc(c);
if c = N then
Exit(i);
end;
end;
procedure DoTruncate(BLineIndex: Integer; N: Integer);
begin
if AReverse then
System.Delete(FLines[BLineIndex], 1, N - 1)
else
SetLength(FLines[BLineIndex], N);
end;
var
y, MLW: Integer;
p: Integer;
offset: Integer;
begin
if FEditMode <> emText then
begin
IssueReadOnlyError;
Exit;
end;
MLW := 0;
for y := AFirstLine to ALastLine do
if Length(FLines[y]) > MLW then
MLW := Length(FLines[y]);
offset := IfThen(PreserveChar, 1, 0);
if AReverse and not PreserveChar then Inc(offset, 2);
if AChar = #0 then
begin
for y := AFirstLine to ALastLine do
if (Length(FLines[y]) > AIndex) or AReverse then
DoTruncate(y, AIndex);
end
else if AIndex > 0 then
begin
for y := AFirstLine to ALastLine do
begin
p := NthPos(y, AIndex);
if p > 0 then
DoTruncate(y, p - 1 + Offset);
end;
end
else if AIndex < 0 then
begin
for y := AFirstLine to ALastLine do
begin
p := NthPosRev(y, -AIndex);
if p > 0 then
DoTruncate(y, p - 1 + Offset);
end;
end;
Changed(ctBlock, AFirstLine, ALastLine, AIndex, MLW);
Modified;
FCaretPos.SetPoint(0, AFirstLine);
RemoveGhostBookmarks;
end;
function TTextFile.RemoveGhostBookmarks: Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if not SamePoint(FBookmarks[i], EMPTY_BOOKMARK) then
if (FBookmarks[i].Y >= Length(FLines)) or (FBookmarks[i].X > VirtualLineWidths[FBookmarks[i].Y]) then
begin
FBookmarks[i] := EMPTY_BOOKMARK;
Result := True;
end;
if Result then
BookmarksMoved;
end;
function TTextFile.TushBookmarks(Line, NumLines: Integer): Boolean;
begin
Result := TushBookmarksInternal(Line, NumLines);
if Result then BookmarksMoved;
end;
function TTextFile.TushBookmarksInternal(Line, NumLines: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[i].Y >= Line then
begin
Result := True;
Inc(FBookmarks[i].Y, NumLines);
end;
end;
function TTextFile.DeleteBookmarksOnLine(Line: Integer): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(FBookmarks) to High(FBookmarks) do
if FBookmarks[i].Y = Line then
begin
Result := True;
FBookmarks[i] := EMPTY_BOOKMARK;
end;
end;
procedure TCaretPos.Changed;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
constructor TCaretPos.Create;
begin
FCaretPos := Point(0, 0);
FSelectionType := stLineBased;
end;
procedure TCaretPos.CreateSelection(const ASelStart, ASelEnd: TPoint;
const ASelectionType: TSelectionType);
var
CurFirstPoint, CurSecondPoint: TPoint;
NewFirstPoint, NewSecondPoint: TPoint;
begin
if (ASelectionType = FSelectionType) and (ASelectionType = stLineBased) then
begin
GetSelBdry(CurFirstPoint, CurSecondPoint);
GetSelBdry(ASelStart, ASelEnd, NewFirstPoint, NewSecondPoint);
SaveSelExtent;
FSelectionType := ASelectionType;
FCaretPos := ASelEnd;
FSelStartPos := ASelStart;
if SamePoint(CurFirstPoint, NewFirstPoint) then
if CurSecondPoint.Y = NewSecondPoint.Y then
SelChanged(ctBlock, CurFirstPoint.Y, CurFirstPoint.Y,
min(CurSecondPoint.X, NewSecondPoint.X),
max(CurSecondPoint.X, NewSecondPoint.X))
else
SelChanged(ctLineRange, min(CurSecondPoint.Y, NewSecondPoint.Y),
max(CurSecondPoint.Y, NewSecondPoint.Y), 0, 0)
else if SamePoint(CurSecondPoint, NewSecondPoint) then
if CurFirstPoint.Y = NewFirstPoint.Y then
SelChanged(ctBlock, CurFirstPoint.Y, CurFirstPoint.Y,
min(CurFirstPoint.X, NewFirstPoint.X),
max(CurFirstPoint.X, NewFirstPoint.X))
else
SelChanged(ctLineRange, min(CurFirstPoint.Y, NewFirstPoint.Y),
max(CurFirstPoint.Y, NewFirstPoint.Y), 0, 0)
else
begin
SelRemoved;
with GetSelExtent(FCaretPos, FSelStartPos, FSelectionType) do
SelChanged(ChangeType, Data1, Data2, Data3, Data4);
end;
Changed;
end
else
begin
SaveSelExtent;
FSelectionType := ASelectionType;
FCaretPos := ASelEnd;
FSelStartPos := ASelStart;
SelRemoved;
with GetSelExtent(FCaretPos, FSelStartPos, FSelectionType) do
SelChanged(ChangeType, Data1, Data2, Data3, Data4);
Changed;
end;
end;
procedure TCaretPos.SaveSelExtent;
begin
FSavedSelExtent := GetSelExtent(FCaretPos, FSelStartPos, FSelectionType);
end;
procedure TCaretPos.SelChanged(ChangeType: TChangeType; Data1, Data2, Data3,
Data4: Integer);
begin
if Assigned(FOnSelChange) then
FOnSelChange(Self, ChangeType, Data1, Data2, Data3, Data4);
end;
procedure TCaretPos.SelRemoved;
begin
if FSavedSelExtent.ChangeType = ctNone then Exit;
if Assigned(FOnSelChange) then
FOnSelChange(Self, FSavedSelExtent.ChangeType,
FSavedSelExtent.Data1, FSavedSelExtent.Data2, FSavedSelExtent.Data3,
FSavedSelExtent.Data4);
end;
procedure TCaretPos.SetPoint(Point: TPoint; SelEnd: Boolean);
begin
SetPoint(Point.X, Point.Y, SelEnd);
end;
procedure TCaretPos.SetPoint(X, Y: Integer; SelEnd: Boolean);
var
OldCaretPos: TPoint;
OldExtent, NewExtent: TChangeRecord;
begin
if FCaretPos.Y = Y then
SetX(X, SelEnd)
else if FCaretPos.X = X then
SetY(Y, SelEnd)
else
if SelEnd then
begin
case FSelectionType of
stLineBased:
OldCaretPos := FCaretPos;
stBlock:
OldExtent := GetSelExtent(FCaretPos, FSelStartPos, stBlock);
end;
SetSelEndPos(Point(X,Y));
case FSelectionType of
stLineBased:
SelChanged(ctLineRange, min(OldCaretPos.Y, Y), max(OldCaretPos.Y, Y), 0, 0);
stBlock:
begin
NewExtent := GetSelExtent(FCaretPos, FSelStartPos, stBlock);
if (NewExtent.Data1 = OldExtent.Data1) and (NewExtent.Data3 = OldExtent.Data3) then
begin
SelChanged(ctBlock, Min(NewExtent.Data2, OldExtent.Data2), Max(NewExtent.Data2, OldExtent.Data2), NewExtent.Data3, Max(NewExtent.Data4, OldExtent.Data4));
SelChanged(ctBlock, NewExtent.Data1, Min(NewExtent.Data2, OldExtent.Data2), Min(NewExtent.Data4, OldExtent.Data4), Max(NewExtent.Data4, OldExtent.Data4));
end
else if (NewExtent.Data1 = OldExtent.Data1) and (NewExtent.Data4 = OldExtent.Data4) then
begin
SelChanged(ctBlock, Min(NewExtent.Data2, OldExtent.Data2), Max(NewExtent.Data2, OldExtent.Data2), Min(NewExtent.Data3, OldExtent.Data3), NewExtent.Data4);
SelChanged(ctBlock, NewExtent.Data1, Min(NewExtent.Data2, OldExtent.Data2), Min(NewExtent.Data3, OldExtent.Data3), Max(NewExtent.Data3, OldExtent.Data3));
end
else if (NewExtent.Data2 = OldExtent.Data2) and (NewExtent.Data3 = OldExtent.Data3) then
begin
SelChanged(ctBlock, Min(NewExtent.Data1, OldExtent.Data1), Max(NewExtent.Data1, OldExtent.Data1), NewExtent.Data3, Max(NewExtent.Data4, OldExtent.Data4));
SelChanged(ctBlock, Max(NewExtent.Data1, OldExtent.Data1), NewExtent.Data2, Min(NewExtent.Data4, OldExtent.Data4), Max(NewExtent.Data4, OldExtent.Data4));
end
else if (NewExtent.Data2 = OldExtent.Data2) and (NewExtent.Data4 = OldExtent.Data4) then
begin
SelChanged(ctBlock, Min(NewExtent.Data1, OldExtent.Data1), Max(NewExtent.Data1, OldExtent.Data1), Min(NewExtent.Data3, OldExtent.Data3), NewExtent.Data4);
SelChanged(ctBlock, Max(NewExtent.Data1, OldExtent.Data1), NewExtent.Data2, Min(NewExtent.Data3, OldExtent.Data3), Max(NewExtent.Data3, OldExtent.Data3));
end
else
begin
with OldExtent do
SelChanged(ctBlock, Data1, Data2, Data3, Data4);
with NewExtent do
SelChanged(ctBlock, Data1, Data2, Data3, Data4);
end;
end;
end;
end
else
SetCaretPos(Point(X,Y));
end;
procedure TCaretPos.SetSelectionType(const Value: TSelectionType);
begin
if FSelectionType <> Value then
begin
if FCaretPos.Y <> FSelStartPos.Y then RemoveSelection;
FSelectionType := Value;
end;
end;
procedure TCaretPos.SetCaretPos(const Value: TPoint);
begin
SaveSelExtent;
FCaretPos := Value;
FSelStartPos := Value;
SelRemoved;
Changed;
SelectionType := stLineBased;
end;
procedure TCaretPos.SetSelEndPos(const Value: TPoint);
begin
if (FCaretPos.X <> Value.X) or (FCaretPos.Y <> Value.Y) then
begin
FCaretPos := Value;
Changed;
end;
end;
procedure TCaretPos.SetX(X: Integer; SelEnd: Boolean);
var
OldCaretPos: TPoint;
begin
if SelEnd then
begin
OldCaretPos := FCaretPos;
SetSelEndPos(Point(X, FCaretPos.Y));
case FSelectionType of
stLineBased:
SelChanged(ctBlock, FCaretPos.Y,
FCaretPos.Y,
min(OldCaretPos.X, X),
max(OldCaretPos.X, X));
stBlock:
SelChanged(ctBlock, min(OldCaretPos.Y, FSelStartPos.Y),
max(OldCaretPos.Y, FSelStartPos.Y),
min(OldCaretPos.X, X),
max(OldCaretPos.X, X));
end;
end
else
SetCaretPos(Point(X, FCaretPos.Y));
end;
procedure TCaretPos.SetY(Y: Integer; SelEnd: Boolean);
var
OldCaretPos: TPoint;
begin
if SelEnd then
begin
OldCaretPos := FCaretPos;
SetSelEndPos(Point(FCaretPos.X, Y));
case FSelectionType of
stLineBased:
SelChanged(ctLineRange, min(OldCaretPos.Y, Y), max(OldCaretPos.Y, Y), 0, 0);
stBlock:
SelChanged(ctBlock, min(OldCaretPos.Y, Y),
max(OldCaretPos.Y, Y),
min(FSelStartPos.X, FCaretPos.X),
max(FSelStartPos.X, FCaretPos.X));
end;
end
else
SetCaretPos(Point(FCaretPos.X, Y));
end;
function TCaretPos.GetFirstPoint: TPoint;
var
dummy: TPoint;
begin
GetSelBdry(Result, dummy);
end;
function TCaretPos.GetLastPoint: TPoint;
var
dummy: TPoint;
begin
GetSelBdry(dummy, Result);
end;
procedure TCaretPos.GetSelBdry(out FirstPoint, SecondPoint: TPoint);
begin
GetSelBdry(FCaretPos, FSelStartPos, FirstPoint, SecondPoint);
end;
procedure TCaretPos.GetSelBdry(const PointA, PointB: TPoint; out FirstPoint,
SecondPoint: TPoint);
begin
case FSelectionType of
stLineBased:
begin
if (PointA.Y < PointB.Y) or ((PointA.Y = PointB.Y) and (PointA.X <= PointB.X)) then
begin
FirstPoint := PointA;
SecondPoint := PointB;
end
else
begin
FirstPoint := PointB;
SecondPoint := PointA;
end;
end;
stBlock:
begin
FirstPoint.Y := min(PointA.Y, PointB.Y);
FirstPoint.X := min(PointA.X, PointB.X);
SecondPoint.Y := max(PointA.Y, PointB.Y);
SecondPoint.X := max(PointA.X, PointB.X);
end;
end;
end;
function TCaretPos.GetSelExtent(ACaretPos, ASelEndPos: TPoint;
ASelectionType: TSelectionType): TChangeRecord;
var
FirstPoint, SecondPoint: TPoint;
begin
if SamePoint(ACaretPos, ASelEndPos) then
Exit(NO_CHANGE_RECORD);
GetSelBdry(FirstPoint, SecondPoint);
case ASelectionType of
stLineBased:
begin
if FirstPoint.Y = SecondPoint.Y then
begin
Result.ChangeType := ctBlock;
Result.Data1 := FirstPoint.Y;
Result.Data2 := SecondPoint.Y;
Result.Data3 := FirstPoint.X;
Result.Data4 := SecondPoint.X;
end
else
begin
Result.ChangeType := ctLineRange;
Result.Data1 := FirstPoint.Y;
Result.Data2 := SecondPoint.Y;
end;
end;
stBlock:
begin
Result.ChangeType := ctBlock;
Result.Data1 := FirstPoint.Y;
Result.Data2 := SecondPoint.Y;
Result.Data3 := FirstPoint.X;
Result.Data4 := SecondPoint.X;
end;
end;
end;
procedure TCaretPos.InternalPush(Size: Integer; LastLine: Boolean = True);
begin
if LastLine or (FSelStartPos.Y < FCaretPos.Y) then
Inc(FSelStartPos.X, Size);
if LastLine or (FCaretPos.Y < FSelStartPos.Y) then
Inc(FCaretPos.X, Size);
if FSelStartPos.X < 0 then FSelStartPos.X := 0;
if FCaretPos.X < 0 then FCaretPos.X := 0;
Changed;
end;
procedure TCaretPos.RemoveSelection;
begin
SaveSelExtent;
FSelStartPos := FCaretPos;
SelRemoved;
Changed;
SelectionType := stLineBased;
end;
procedure TCaretPos.Reset;
begin
FCaretPos := Point(0, 0);
FSelStartPos := Point(0, 0);
FSelectionType := stLineBased;
FillChar(FSavedSelExtent, sizeof(FSavedSelExtent), 0);
end;
function TTextFile.GetText: string;
var
i, p: Integer;
begin
SetLength(Result, GetPhysicalTextLength);
p := 1;
for i := 0 to LineCount - 1 do
begin
if not FLines[i].IsEmpty then
Move(FLines[i][1], Result[p], PhysicalLineWidths[i] * SizeOf(Char));
if i < LineCount - 1 then
begin
Inc(p, PhysicalLineWidths[i] + 2);
Result[p-2] := #13;
Result[p-1] := #10;
end;
end;
end;
function TTextFile.GetUnicodeBlockStatistics: TIntegerArray;
var
y, x, i: Integer;
begin
SetLength(Result, UCD.BlockCount);
ZeroMemory(@Result[0], Length(Result) * sizeof(Result[0]));
for y := 0 to Length(FLines) - 1 do
begin
if IsControlLine(y) then Continue;
for x := 1 to Length(FLines[y]) do
for i := 0 to UCD.BlockCount - 1 do
if InRange(Ord(FLines[y][x]), UCD.Blocks[i].BlockBegin, UCD.Blocks[i].BlockEnd) then
begin
Inc(Result[i]);
Break;
end;
end;
end;
function TTextFile.GetURLAtCaret(out AURL: string): Boolean;
function IsURLChar(const C: Char): Boolean;
begin
Result := C.IsLetterOrDigit or
(C in ['!', '$', '&', '''', '(', ')', '*', '+', ',', '-', '.', '/', ':',
';', '=', '?', '@', '_', '~', '%', '#']);
end;
var
S, E: Integer;
x: Integer;
begin
S := 0;
E := PhysicalLineWidths[FCaretPos.Y] - 1;
if FCaretPos.X > PhysicalLineWidths[FCaretPos.Y] then Exit(False);
for x := FCaretPos.X - 1 downto 0 do
if not IsURLChar(FLines[FCaretPos.Y][x+1]) then
begin
S := x + 1;
Break;
end;
for x := FCaretPos.X to E do
if not IsURLChar(FLines[FCaretPos.Y][x+1]) then
begin
E := x - 1;
Break;
end;
AURL := Copy(FLines[FCaretPos.Y], S + 1, E - S + 1);
Result := StartsText('http://', AURL) or StartsText('https://', AURL) or
StartsText('ftp://', AURL) or StartsText('file:', AURL) or
StartsText('gopher://', AURL) or StartsText('ws://', AURL) or
StartsText('wss://', AURL) or StartsText('mailto:', AURL) or StartsText('www.', AURL);
end;
function TTextFile.GetUsedBookmarkCount: Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to High(FBookmarks) do
if not SamePoint(FBookmarks[i], EMPTY_BOOKMARK) then
Inc(Result);
end;
procedure THistoryManager.Add(const AText: string; const AClasses: string;
const ACaretPos, ASelStartPos: TPoint; ASelType: TSelectionType;
const ATime: TDateTime; const AComment: string;
const ABookmarks: TBookmarkList; AUID: Integer = 0);
var
UDA: TUndoDataItem;
begin
UDA.Text := AText;
UDA.Classes := AClasses;
UDA.CaretPos := ACaretPos;
UDA.SelStartPos := ASelStartPos;
UDA.SelType := ASelType;
UDA.Time := ATime;
UDA.Comment := AComment;
UDA.UID := AUID;
UDA.Bookmarks := ABookmarks;
Add(UDA);
end;
procedure THistoryManager.Add(AUndoDataItem: TUndoDataItem);
begin
if FHistoryIndex < FActualLength - 1 then
Revert;
if FActualLength = length(FUndoData) then
SetLength(FUndoData, Length(FUndoData) + HISTORY_ALLOC_BY);
FUndoData[FActualLength] := AUndoDataItem;
Inc(FSize, SizeOfItem(FActualLength));
Inc(FActualLength);
Inc(FHistoryIndex);
TrimLeft;
end;
function THistoryManager.CanRedo: Boolean;
begin
Result := FHistoryIndex < FActualLength - 1;
end;
function THistoryManager.CanUndo: Boolean;
begin
Result := FHistoryIndex > FFirstItem;
end;
procedure THistoryManager.Clear;
begin
SetLength(FUndoData, 0);
FActualLength := 0;
FSize := 0;
FFirstItem := 0;
FHistoryIndex := -1;
end;
procedure THistoryManager.ClearItem(ItemIndex: Integer);
begin
with FUndoData[ItemIndex] do
begin
Dec(FSize, (Length(Text) + Length(Classes) + Length(Comment)) * sizeof(Char));
Text := '';
Classes := '';
CaretPos := Point(0, 0);
SelStartPos := Point(0, 0);
Time := 0;
Comment := '';
end;
end;
constructor THistoryManager.Create;
begin
inherited;
FMaxSize := DEFAULT_MAX_UNDO_SIZE;
Clear;
end;
procedure THistoryManager.CreateDataStream(out Data: pointer; out Len: UInt64);
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
SaveToStream(MS);
Len := MS.Size;
GetMem(Data, Len);
try
CopyMemory(Data, MS.Memory, Len);
except
FreeMem(Data);
raise;
end;
finally
MS.Free;
end;
end;
destructor THistoryManager.Destroy;
begin
inherited;
Clear;
end;
function THistoryManager.GetLastItem: Integer;
begin
Result := FActualLength - 1;
end;
function THistoryManager.GetLength: Integer;
begin
Result := FActualLength - FFirstItem;
end;
function THistoryManager.GetUndoData(Index: Integer): TUndoDataItem;
begin
Result := FUndoData[Index];
end;
function THistoryManager.GotoVersion(Index: Integer;
out UndoData: TUndoDataItem): Boolean;
begin
Result := InRange(Index, FFirstItem, FActualLength - 1) and (Index <> FHistoryIndex);
if Result then
begin
UndoData := FUndoData[Index];
FHistoryIndex := Index;
end;
end;
procedure THistoryManager.LoadFromBuffer(const Data: pointer;
const Len: UInt64);
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MS.WriteBuffer(Data^, Len);
MS.Position := 0;
LoadFromStream(MS);
finally
MS.Free;
end;
end;
procedure THistoryManager.LoadFromStream(AStream: TStream);
procedure Inv;
begin
raise Exception.Create('THistoryManager.LoadFromStream: Invalid stream.');
end;
var
data_dword: DWORD;
data_char: Char;
len, size, idx, strlen: Integer;
i: Integer;
begin
if AStream = nil then
raise Exception.Create('THistoryManager.LoadFromStream: Stream is unassigned.');
AStream.ReadData(data_dword);
if data_dword <> UNDO_SIGNATURE then Inv;
AStream.ReadData(len);
if len < 0 then Inv;
AStream.ReadData(size);
if size < 0 then Inv;
AStream.ReadData(idx);
if (len > 0) and not InRange(idx, 0, len - 1) then Inv;
Clear;
try
SetLength(FUndoData, len);
for i := 0 to len - 1 do
begin
AStream.ReadData(data_dword);
if data_dword <> UNDO_SIGNATURE_ITEM then Inv;
AStream.ReadData(strlen);
if strlen < 0 then Inv;
SetLength(FUndoData[i].Text, strlen);
if strlen > 0 then
AStream.ReadBuffer(FUndoData[i].Text[1], strlen * sizeof(Char));
AStream.ReadData(strlen);
if strlen < 0 then Inv;
SetLength(FUndoData[i].Classes, strlen);
if strlen > 0 then
AStream.ReadBuffer(FUndoData[i].Classes[1], strlen * sizeof(Char));
AStream.ReadBuffer(FUndoData[i].CaretPos, sizeof(FUndoData[i].CaretPos));
AStream.ReadBuffer(FUndoData[i].SelStartPos, sizeof(FUndoData[i].SelStartPos));
AStream.ReadBuffer(FUndoData[i].SelType, sizeof(FUndoData[i].SelType));
AStream.ReadBuffer(FUndoData[i].Time, sizeof(FUndoData[i].Time));
AStream.ReadData(strlen);
if strlen < 0 then Inv;
SetLength(FUndoData[i].Comment, strlen);
if strlen > 0 then
AStream.ReadBuffer(FUndoData[i].Comment[1], strlen * sizeof(Char));
AStream.ReadBuffer(FUndoData[i].UID, sizeof(FUndoData[i].UID));
AStream.ReadBuffer(FUndoData[i].Bookmarks, sizeof(FUndoData[i].Bookmarks));
end;
AStream.ReadData(data_dword);
AStream.ReadData(data_char);
if (data_dword <> UNDO_SIGNATURE) or (data_char <> #0) then Inv;
FFirstItem := 0;
FActualLength := Length(FUndoData);
FHistoryIndex := idx;
FSize := size;
except
Clear;
raise;
end;
end;
function THistoryManager.Redo(out UndoData: TUndoDataItem): Boolean;
begin
Result := CanRedo;
if Result then
begin
UndoData := FUndoData[FHistoryIndex + 1];
Inc(FHistoryIndex);
end;
end;
function THistoryManager.RemoveFirstItem;
begin
Result := False;
if FFirstItem >= FActualLength then Exit;
ClearItem(FFirstItem);
Inc(FFirstItem);
Result := True;
end;
procedure THistoryManager.Revert;
var
OldHistoryIndex: Integer;
begin
OldHistoryIndex := FHistoryIndex;
FHistoryIndex := FActualLength - 1;
with FUndoData[OldHistoryIndex] do
Add(Text, Classes, CaretPos, SelStartPos, SelType, Now,
Format(SUndoReverted, [OldHistoryIndex + 1, DateTimeToStr(Time)]),
Bookmarks);
end;
procedure THistoryManager.SaveToStream(AStream: TStream);
var
i: Integer;
begin
if AStream = nil then
raise Exception.Create('THistoryManager.SaveToStream: Stream is unassigned.');
AStream.WriteData(UNDO_SIGNATURE);
AStream.WriteData(FActualLength - FFirstItem);
AStream.WriteData(FSize);
AStream.WriteData(FHistoryIndex - FFirstItem);
for i := FFirstItem to FActualLength - 1 do
begin
AStream.WriteData(UNDO_SIGNATURE_ITEM);
AStream.WriteData(Integer(FUndoData[i].Text.Length));
if not FUndoData[i].Text.IsEmpty then
AStream.WriteBuffer(FUndoData[i].Text[1], FUndoData[i].Text.Length * sizeof(Char));
AStream.WriteData(Integer(FUndoData[i].Classes.Length));
if not FUndoData[i].Classes.IsEmpty then
AStream.WriteBuffer(FUndoData[i].Classes[1], FUndoData[i].Classes.Length * sizeof(Char));
AStream.WriteBuffer(FUndoData[i].CaretPos, sizeof(FUndoData[i].CaretPos));
AStream.WriteBuffer(FUndoData[i].SelStartPos, sizeof(FUndoData[i].SelStartPos));
AStream.WriteBuffer(FUndoData[i].SelType, sizeof(FUndoData[i].SelType));
AStream.WriteBuffer(FUndoData[i].Time, sizeof(FUndoData[i].Time));
AStream.WriteData(Integer(FUndoData[i].Comment.Length));
if not FUndoData[i].Comment.IsEmpty then
AStream.WriteBuffer(FUndoData[i].Comment[1], FUndoData[i].Comment.Length * sizeof(Char));
AStream.WriteData(FUndoData[i].UID);
AStream.WriteBuffer(FUndoData[i].Bookmarks, sizeof(FUndoData[i].Bookmarks));
end;
AStream.WriteData(UNDO_SIGNATURE);
AStream.WriteData(#0);
end;
procedure THistoryManager.SetMaxSize(Value: Integer);
begin
if FMaxSize <> Value then
begin
FMaxSize := Value;
TrimLeft;
end;
end;
function THistoryManager.SizeOfItem(ItemIndex: Integer): Integer;
begin
with FUndoData[ItemIndex] do
Result := Length(Text) * Sizeof(Char) + Length(Classes) * Sizeof(Char) +
SizeOf(CaretPos) + SizeOf(SelStartPos) + SizeOf(Time) +
Length(Comment) * Sizeof(Char) + SizeOf(Bookmarks);
end;
procedure THistoryManager.TrimLeft;
begin
while (FSize > FMaxSize) and RemoveFirstItem do;
if FSize > FMaxSize then Clear;
end;
function THistoryManager.Undo(out UndoData: TUndoDataItem): Boolean;
begin
Result := CanUndo;
if Result then
begin
UndoData := FUndoData[FHistoryIndex - 1];
Dec(FHistoryIndex);
end;
end;
function MakeCSSDeclaration(const AProperty, AValue: string): TCSSDeclaration;
begin
Result.CSSProperty := AProperty;
Result.Value := AValue;
end;
function MakeCSSOptionalDeclaration(const AUse: Boolean;
const AProperty, AValue: string): TCSSDeclaration;
begin
if AUse then
Result := MakeCSSDeclaration(AProperty, AValue)
else
Result := MakeCSSDeclaration('', '');
end;
function MakeCSSRule(const ASelector: string;
const ADeclarations: array of TCSSDeclaration): TCSSRule;
var
i, n, j: Integer;
begin
Result.Selector := ASelector;
n := 0;
for i := Low(ADeclarations) to High(ADeclarations) do
if ADeclarations[i].CSSProperty <> '' then
Inc(n);
SetLength(Result.Declarations, n);
j := 0;
for i := Low(ADeclarations) to High(ADeclarations) do
if ADeclarations[i].CSSProperty <> '' then
begin
Result.Declarations[j] := ADeclarations[i];
Inc(j);
end;
end;
function CSSColor(const AColor: TColor): string;
begin
Result := '#' + IntToHex(GetRValue(AColor), 2) +
IntToHex(GetGValue(AColor), 2) +
IntToHex(GetBValue(AColor), 2);
end;
procedure TFormattingProcessor.BeginUpdate;
begin
Inc(FUpdateLevel);
end;
procedure TFormattingProcessor.Changed;
begin
if (FUpdateLevel = 0) and Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TFormattingProcessor.ClearCache;
begin
end;
constructor TFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FUpdateLevel := 0;
end;
procedure TFormattingProcessor.EndUpdate;
begin
Dec(FUpdateLevel);
if FUpdateLevel < 0 then
FUpdateLevel := 0;
if FUpdateLevel = 0 then
Changed;
end;
function TFormattingProcessor.FileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
FillChar(Result, sizeof(Result), 0);
end;
function TFormattingProcessor.GetCache(out ACache: PByte): Integer;
begin
ACache := nil;
Result := 0;
end;
function TFormattingProcessor.RestoreCache(ACache: PByte;
ASize: Integer): Boolean;
begin
Result := False;
end;
function TFormattingProcessor.TextChar(ALineIndex, ACol: Integer): Char;
begin
Result := FOnGetChar(ALineIndex, ACol);
end;
function TFormattingProcessor.TextGetWord(const APoint: TPoint;
APascalIdent: Boolean): string;
begin
Result := FOnGetWord(APoint, APascalIdent);
end;
function TFormattingProcessor.TextGetWordBoundary(const APoint: TPoint; out SP,
EP: Integer): Boolean;
begin
Result := FOnGetWordBoundary(APoint, SP, EP);
end;
function TFormattingProcessor.TextLineCount: Integer;
begin
Result := FOnGetLineCount;
end;
function TFormattingProcessor.TextLineWidth(ALineIndex: Integer): Integer;
begin
Result := FOnGetLineWidth(ALineIndex);
end;
procedure TVowelsAndConsonantsFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FVowelColor := AColorScheme.Accent3;
FConsonantColor := AColorScheme.Accent2;
Changed;
end;
procedure TVowelsAndConsonantsFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TVowelsAndConsonantsFormattingProcessor then
begin
FVowelColor := TVowelsAndConsonantsFormattingProcessor(Source).VowelColor;
FVowelsBold := TVowelsAndConsonantsFormattingProcessor(Source).VowelsBold;
FConsonantColor := TVowelsAndConsonantsFormattingProcessor(Source).ConsonantColor;
FConsonantsBold := TVowelsAndConsonantsFormattingProcessor(Source).ConsonantBold;
Changed;
end
else
inherited;
end;
constructor TVowelsAndConsonantsFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FVowelColor := DEFAULT_VOWEL_COLOR;
FConsonantColor := DEFAULT_CONSONANT_COLOR;
FVowelsBold := DEFAULT_VOWELS_BOLD;
FConsonantsBold := DEFAULT_CONSONANTS_BOLD;
end;
function TVowelsAndConsonantsFormattingProcessor.GetCharCSSClass(ALineIndex,
ACol: Integer; AChar: Char): Integer;
begin
if IsVowel(AChar) then
Result := CSS_CLASS_VOWEL
else
Result := CSS_CLASS_CONSONANT;
end;
procedure TVowelsAndConsonantsFormattingProcessor.GetCharFormat(ALineIndex,
ACol: Integer; AChar: Char; var AFontRecord: TFontRecord);
begin
if IsVowel(AChar) then
begin
AFontRecord.Color := FVowelColor;
if FVowelsBold then
Include(AFontRecord.Style, fsBold)
end
else
begin
AFontRecord.Color := FConsonantColor;
if FConsonantsBold then
Include(AFontRecord.Style, fsBold)
end;
end;
function TVowelsAndConsonantsFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_VOWEL] := MakeCSSRule('vowel',
[MakeCSSDeclaration('color', CSSColor(FVowelColor)),
MakeCSSOptionalDeclaration(FVowelsBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_CONSONANT] := MakeCSSRule('consonant',
[MakeCSSDeclaration('color', CSSColor(FConsonantColor)),
MakeCSSOptionalDeclaration(FConsonantsBold, 'font-weight', 'bold')]);
end;
function TVowelsAndConsonantsFormattingProcessor.IsVowel(
const AChar: Char): Boolean;
begin
Result := AChar in ['A', 'E', 'I', 'O', 'U', 'Y', 'Å', 'Ä', 'Ö',
'a', 'e', 'i', 'o', 'u', 'y', 'å', 'ä', 'ö'];
end;
procedure TVowelsAndConsonantsFormattingProcessor.SetConsonantColor(
const Value: TColor);
begin
if FConsonantColor <> Value then
begin
FConsonantColor := Value;
Changed;
end;
end;
procedure TVowelsAndConsonantsFormattingProcessor.SetConsonantsBold(
const Value: Boolean);
begin
if FConsonantsBold <> Value then
begin
FConsonantsBold := Value;
Changed;
end;
end;
procedure TVowelsAndConsonantsFormattingProcessor.SetVowelColor(
const Value: TColor);
begin
if FVowelColor <> Value then
begin
FVowelColor := Value;
Changed;
end;
end;
procedure TVowelsAndConsonantsFormattingProcessor.SetVowelsBold(
const Value: Boolean);
begin
if FVowelsBold <> Value then
begin
FVowelsBold := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FTagColor := AColorScheme.Accent1;
FTagNameColor := AColorScheme.Accent3;
FParamColor := AColorScheme.Accent1;
FValueColor := AColorScheme.Accent2;
FCommentColor := AColorScheme.Soft;
FCDATAMColor := AColorScheme.Soft;
FCDATAColor := AColorScheme.Soft;
Changed;
end;
procedure TXMLFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TXMLFormattingProcessor then
begin
FTagColor := TXMLFormattingProcessor(Source).TagColor;
FTagNameColor := TXMLFormattingProcessor(Source).TagNameColor;
FTagNameBold := TXMLFormattingProcessor(Source).TagNameBold;
FParamColor := TXMLFormattingProcessor(Source).ParamColor;
FValueColor := TXMLFormattingProcessor(Source).ValueColor;
FCommentColor := TXMLFormattingProcessor(Source).CommentColor;
FCDATAMColor := TXMLFormattingProcessor(Source).CDATAMarkerColor;
FCDATAMBold := TXMLFormattingProcessor(Source).CDATAMarkerBold;
FCDATAColor := TXMLFormattingProcessor(Source).CDATAColor;
Changed;
end
else
inherited;
end;
constructor TXMLFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FTagColor := DEFAULT_TAG_COLOR;
FTagNameColor := DEFAULT_TAG_NAME_COLOR;
FTagNameBold := DEFAULT_TAG_NAME_BOLD;
FParamColor := DEFAULT_PARAM_COLOR;
FValueColor := DEFAULT_VALUE_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
FCDATAMColor := DEFAULT_CDATAM_COLOR;
FCDATAMBold := DEFAULT_CDATAM_BOLD;
FCDATAColor := DEFAULT_CDATA_COLOR;
end;
function TXMLFormattingProcessor.FileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
inherited;
case ChangeType of
ctNone: ;
ctFile:
begin
ParseText;
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
if Data3 = 1 then
begin
PushTokensDownFrom(Data1);
ParseText(Data1, True, 2);
end
else if Data3 = 2 then
begin
PushTokensUpFrom(Data1);
ParseText(Data1, True, 2);
end
else
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctBlock:
begin
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLine:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctLineFrom:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctChar:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctTwoChars:
begin
ParseText(min(Data1, Data3));
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := TextLineCount - 1;
end;
ctPostFile: ;
end;
end;
function TXMLFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
begin
case GetChrKind(ALineIndex, ACol) of
ckXmlUndefined, ckXmlText:
Result := CSS_CLASS_TEXT;
ckXmlTag:
Result := CSS_CLASS_TAG;
ckXmlTagName:
Result := CSS_CLASS_TAG_NAME;
ckXmlParam:
Result := CSS_CLASS_PARAM;
ckXmlValue:
Result := CSS_CLASS_VALUE;
ckXmlComment:
Result := CSS_CLASS_COMMENT;
ckCDATAMarker:
Result := CSS_CLASS_CDATAMARKER;
ckCDATA:
Result := CSS_CLASS_CDATA;
else
raise Exception.Create('TXMLFormattingProcessor.GetCharCSSClass: Invalid character kind.');
end;
end;
procedure TXMLFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetChrKind(ALineIndex, ACol) of
ckXmlTag:
AFontRecord.Color := FTagColor;
ckXmlTagName:
begin
AFontRecord.Color := FTagNameColor;
if FTagNameBold then
Include(AFontRecord.Style, fsBold);
end;
ckXmlParam:
AFontRecord.Color := FParamColor;
ckXmlValue:
AFontRecord.Color := FValueColor;
ckXmlComment:
AFontRecord.Color := FCommentColor;
ckCDATAMarker:
begin
AFontRecord.Color := FCDATAMColor;
if FCDATAMBold then
Include(AFontRecord.Style, fsBold);
end;
ckCDATA:
AFontRecord.Color := FCDATAColor;
end;
end;
function TXMLFormattingProcessor.GetChrKind(ALineIndex,
ACol: Integer): TXMLChrKind;
var
i: Integer;
begin
i := 0;
Result := ckXmlUndefined;
if ALineIndex <= High(FTokens) then
while (i <= High(FTokens[ALineIndex])) and (FTokens[ALineIndex][i].x <= ACol) do
begin
Result := FTokens[ALineIndex][i].kind;
Inc(i);
end;
end;
function TXMLFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_TEXT] := MakeCSSRule('text', []);
Result[CSS_CLASS_TAG] := MakeCSSRule('tag',
[MakeCSSDeclaration('color', CSSColor(FTagColor))]);
Result[CSS_CLASS_TAG_NAME] := MakeCSSRule('tag-name',
[MakeCSSDeclaration('color', CSSColor(FTagNameColor)),
MakeCSSOptionalDeclaration(FTagNameBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_PARAM] := MakeCSSRule('param',
[MakeCSSDeclaration('color', CSSColor(FParamColor))]);
Result[CSS_CLASS_VALUE] := MakeCSSRule('value',
[MakeCSSDeclaration('color', CSSColor(FValueColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
Result[CSS_CLASS_CDATAMARKER] := MakeCSSRule('cdata-marker',
[MakeCSSDeclaration('color', CSSColor(FCDATAMColor)),
MakeCSSOptionalDeclaration(FCDATAMBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_CDATA] := MakeCSSRule('cdata',
[MakeCSSDeclaration('color', CSSColor(FCDATAColor))]);
end;
function TXMLFormattingProcessor.ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
const
ALLOC_BY = 16;
var
ToLine: Integer;
ActualLengths: array of Integer;
y, x: Integer;
InTag,
InAttrib,
InComment,
InCDATAMarker,
InCDATA,
EndingCDATA: Boolean;
InVal: Char;
Chr: Char;
_counter: Integer;
function GetSignature: Cardinal;
begin
Result := Byte(InTag) or (Byte(InComment) shl 1) or (Byte(InAttrib) shl 2)
or (Byte(InCDATAMarker) shl 3) or (Byte(InCDATA) shl 4) or (Byte(EndingCDATA) shl 5)
or (Ord(InVal) shl 16) or (1 shl 15);
end;
procedure AddToken(AKind: TXMLChrKind; Signature: Boolean = False);
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := AKind;
if Signature then
FTokens[y][ActualLengths[y]].signature := GetSignature
else
FTokens[y][ActualLengths[y]].signature := 0;
Inc(ActualLengths[y]);
end;
function GetLastKind: TXMLChrKind;
var
yp: Integer;
xp: Integer;
begin
for yp := y downto 0 do
for xp := ActualLengths[yp] - 1 downto 0 do
Exit(FTokens[yp][xp].kind);
Result := ckXmlText;
end;
procedure AddSignature;
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := GetLastKind;
FTokens[y][ActualLengths[y]].signature := GetSignature;
Inc(ActualLengths[y]);
end;
function Peek: TXMLChrKind;
var
yp: Integer;
begin
for yp := y downto 0 do
if ActualLengths[yp] > 0 then
Exit(FTokens[yp][ActualLengths[yp] - 1].kind);
Result := ckXmlUndefined;
end;
procedure ExtractSignature(ASignature: Cardinal; out AInTag,
AInComment, AInAttrib, AInCDATAMarker, AInCDATA, AEndingCDATA: Boolean; out AInVal: Char);
begin
AInTag := ASignature and 1 <> 0;
AInComment := ASignature and 2 <> 0;
AInAttrib := ASignature and 4 <> 0;
AInCDATAMarker := ASignature and 8 <> 0;
AInCDATA := ASignature and 16 <> 0;
AEndingCDATA := ASignature and 32 <> 0;
AInVal := Char(ASignature shr 16);
end;
function GetLastSignature: Cardinal;
var
yp: Integer;
begin
for yp := AFromLine - 1 downto 0 do
if Length(FTokens[yp]) > 0 then
begin
Assert(FTokens[yp][High(FTokens[yp])].signature and (1 shl 15) <> 0);
Exit(FTokens[yp][High(FTokens[yp])].signature);
end;
Result := 0;
end;
function PeekSignatureForward: Cardinal;
var
yp: Integer;
begin
for yp := y + 1 to High(FTokens) do
if Length(FTokens[yp]) > 0 then
Exit(FTokens[yp][0].signature);
Result := 0;
end;
function PeekIsComment: Boolean;
begin
Result := (TextLineWidth(y) >= x + 4) and
(TextChar(y, x + 1) = '!') and
(TextChar(y, x + 2) = '-') and
(TextChar(y, x + 3) = '-');
end;
function DoesEndComment: Boolean;
begin
Result := (x >= 2) and
(TextChar(y, x - 1) = '-') and
(TextChar(y, x - 2) = '-');
end;
function PeekIsCDATAMarker: Boolean;
begin
Result := (TextLineWidth(y) >= x + 9) and
(TextChar(y, x + 1) = '!') and
(TextChar(y, x + 2) = '[') and
(TextChar(y, x + 3) = 'C') and
(TextChar(y, x + 4) = 'D') and
(TextChar(y, x + 5) = 'A') and
(TextChar(y, x + 6) = 'T') and
(TextChar(y, x + 7) = 'A') and
(TextChar(y, x + 8) = '[');
end;
function PeekDoesEndCDATA: Boolean;
begin
Result := (TextLineWidth(y) >= x + 3) and
(TextChar(y, x + 1) = ']') and
(TextChar(y, x + 2) = '>');
end;
begin
_counter := 0;
if AFromLine = 0 then
begin
InTag := False;
InComment := False;
InAttrib := False;
InCDATAMarker := False;
InCDATA := False;
EndingCDATA := False;
InVal := #0;
end
else
begin
ExtractSignature(GetLastSignature, InTag, InComment, InAttrib,
InCDATAMarker, InCDATA, EndingCDATA, InVal);
end;
SetLength(FTokens, TextLineCount);
SetLength(ActualLengths, TextLineCount);
ToLine := TextLineCount - 1;
for y := 0 to AFromLine - 1 do
ActualLengths[y] := length(FTokens[y]);
for y := AFromLine to ToLine do
ActualLengths[y] := 0;
for y := AFromLine to ToLine do
begin
for x := 0 to TextLineWidth(y) - 1 do
begin
if x=0 then
AddToken(Peek, True);
Chr := TextChar(y, x);
if InCDATA then
begin
if (Chr = ']') and PeekDoesEndCDATA then
begin
InCDATA := False;
InCDATAMarker := True;
_counter := 1;
EndingCDATA := True;
AddToken(ckCDATAMarker);
end;
end
else if InCDATAMarker then
begin
Inc(_counter);
if EndingCDATA then
begin
if _counter = 4 - 1 then
begin
InCDATAMarker := False;
InCDATA := False;
EndingCDATA := False;
end
end
else
begin
if _counter = 10 then
begin
InCDATAMarker := False;
InCDATA := True;
AddToken(ckCDATA);
end;
end;
end
else if InComment then
begin
if (Chr = '>') and DoesEndComment then
InComment := False;
end
else if InTag then
begin
if InVal <> #0 then
begin
if Chr = InVal then
InVal := #0;
end
else
begin
if (x=0) or (Chr = #32) and (Peek <> ckXmlParam) then
begin
InAttrib := True;
AddToken(ckXmlParam);
end
else if (Chr = '''') or (Chr = '"') then
begin
InVal := Chr;
AddToken(ckXmlValue);
end
else if Chr = '/' then
begin
if Peek <> ckXmlTag then
AddToken(ckXmlTag);
end
else if Chr = '>' then
begin
InTag := False;
AddToken(ckXmlTag);
end
else
begin
if InAttrib and (Peek <> ckXmlParam) then
AddToken(ckXmlParam)
else if (not InAttrib) and (Peek <> ckXmlTagName) then
AddToken(ckXmlTagName);
end;
end;
end
else if (Chr = '<') then
begin
if PeekIsComment then
begin
InComment := True;
AddToken(ckXmlComment);
end
else if PeekIsCDATAMarker then
begin
InCDATAMarker := True;
EndingCDATA := False;
_counter := 1;
AddToken(ckCDATAMarker);
end
else
begin
InTag := True;
InAttrib := False;
AddToken(ckXmlTag);
end;
end
else if Peek <> ckXmlText then
AddToken(ckXmlText);
if x = TextLineWidth(y) - 1 then
AddSignature;
end;
if SingleLinePossibility and (y - AFromLine >= ANumLines - 1) and (GetSignature = PeekSignatureForward) then
begin
ToLine := y;
break;
end;
end;
for y := AFromLine to ToLine do
SetLength(FTokens[y], ActualLengths[y]);
Result := ToLine;
end;
procedure TXMLFormattingProcessor.PushTokensDownFrom(ALineIndex: Integer);
var
i: Integer;
begin
SetLength(FTokens, Length(FTokens) + 1);
for i := High(FTokens) downto ALineIndex + 1 do
FTokens[i] := Copy(FTokens[i - 1]);
end;
procedure TXMLFormattingProcessor.PushTokensUpFrom(ALineIndex: Integer);
var
i: Integer;
begin
for i := ALineIndex + 1 to High(FTokens) - 1 do
FTokens[i] := Copy(FTokens[i + 1]);
SetLength(FTokens, Length(FTokens) - 1);
end;
procedure TXMLFormattingProcessor.SetCDATAColor(const Value: TColor);
begin
if FCDATAColor <> Value then
begin
FCDATAColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetCDATAMBold(const Value: Boolean);
begin
if FCDATAMBold <> Value then
begin
FCDATAMBold := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetCDATAMColor(const Value: TColor);
begin
if FCDATAMColor <> Value then
begin
FCDATAMColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
FCommentColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetParamColor(const Value: TColor);
begin
if FParamColor <> Value then
begin
FParamColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetTagColor(const Value: TColor);
begin
if FTagColor <> Value then
begin
FTagColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetTagNameBold(const Value: Boolean);
begin
if FTagNameBold <> Value then
begin
FTagNameBold := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetTagNameColor(const Value: TColor);
begin
if FTagNameColor <> Value then
begin
FTagNameColor := Value;
Changed;
end;
end;
procedure TXMLFormattingProcessor.SetValueColor(const Value: TColor);
begin
if FValueColor <> Value then
begin
FValueColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FSelectorColor := AColorScheme.Accent3;
FPropertyColor := AColorScheme.Accent1;
FValueColor := AColorScheme.Default;
FCommentColor := AColorScheme.Soft;
FBlockDelimColor := AColorScheme.Accent3;
FImportantColor := AColorScheme.Intense;
Changed;
end;
procedure TCSSFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TCSSFormattingProcessor then
begin
FSelectorColor := TCSSFormattingProcessor(Source).SelectorColor;
FSelectorBold := TCSSFormattingProcessor(Source).SelectorBold;
FPropertyColor := TCSSFormattingProcessor(Source).PropertyColor;
FValueColor := TCSSFormattingProcessor(Source).ValueColor;
FCommentColor := TCSSFormattingProcessor(Source).CommentColor;
FBlockDelimColor := TCSSFormattingProcessor(Source).BlockDelimColor;
FBlockDelimBold := TCSSFormattingProcessor(Source).BlockDelimBold;
FImportantColor := TCSSFormattingProcessor(Source).ImportantColor;
FImportantBold := TCSSFormattingProcessor(Source).ImportantBold;
Changed;
end
else
inherited;
end;
constructor TCSSFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FSelectorColor := DEFAULT_SELECTOR_COLOR;
FSelectorBold := DEFAULT_SELECTOR_BOLD;
FPropertyColor := DEFAULT_PROPERTY_COLOR;
FValueColor := DEFAULT_VALUE_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
FBlockDelimColor := DEFAULT_BLOCK_DELIM_COLOR;
FBlockDelimBold := DEFAULT_BLOCK_DELIM_BOLD;
FImportantColor := DEFAULT_IMPORTANT_COLOR;
FImportantBold := DEFAULT_IMPORTANT_BOLD;
end;
function TCSSFormattingProcessor.FileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
inherited;
case ChangeType of
ctNone: ;
ctFile:
begin
ParseText;
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
if Data3 = 1 then
begin
PushTokensDownFrom(Data1);
ParseText(Data1, True, 2);
end
else if Data3 = 2 then
begin
PushTokensUpFrom(Data1);
ParseText(Data1, True, 2);
end
else
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctBlock:
begin
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLine:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctLineFrom:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctChar:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctTwoChars:
begin
ParseText(min(Data1, Data3));
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := TextLineCount - 1;
end;
ctPostFile: ;
end;
end;
function TCSSFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
begin
case GetChrKind(ALineIndex, ACol) of
ckCssSelector:
Result := CSS_CLASS_SELECTOR;
ckCssBlockDelim:
Result := CSS_CLASS_BLOCK_DELIM;
ckCssProperty:
Result := CSS_CLASS_PROPERTY;
ckCssValue:
Result := CSS_CLASS_VALUE;
ckCssImportant:
Result := CSS_CLASS_IMPORTANT;
ckCssComment:
Result := CSS_CLASS_COMMENT;
else
raise Exception.Create('TCSSFormattingProcessor.GetCharCSSClass: Invalid character kind.');
end;
end;
procedure TCSSFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetChrKind(ALineIndex, ACol) of
ckCssSelector:
begin
AFontRecord.Color := FSelectorColor;
if FSelectorBold then
Include(AFontRecord.Style, fsBold);
end;
ckCssBlockDelim:
begin
AFontRecord.Color := FBlockDelimColor;
if FBlockDelimBold then
Include(AFontRecord.Style, fsBold);
end;
ckCssProperty:
AFontRecord.Color := FPropertyColor;
ckCssValue:
AFontRecord.Color := FValueColor;
ckCssImportant:
begin
AFontRecord.Color := FImportantColor;
if FImportantBold then
Include(AFontRecord.Style, fsBold);
end;
ckCssComment:
AFontRecord.Color := FCommentColor;
end;
end;
function TCSSFormattingProcessor.GetChrKind(ALineIndex,
ACol: Integer): TCSSChrKind;
var
i: Integer;
begin
i := 0;
Result := ckCssSelector;
if ALineIndex <= High(FTokens) then
while (i <= High(FTokens[ALineIndex])) and (FTokens[ALineIndex][i].x <= ACol) do
begin
Result := FTokens[ALineIndex][i].kind;
Inc(i);
end;
end;
function TCSSFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_SELECTOR] := MakeCSSRule('selector',
[MakeCSSDeclaration('color', CSSColor(FSelectorColor)),
MakeCSSOptionalDeclaration(FSelectorBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_PROPERTY] := MakeCSSRule('property',
[MakeCSSDeclaration('color', CSSColor(FPropertyColor))]);
Result[CSS_CLASS_VALUE] := MakeCSSRule('value',
[MakeCSSDeclaration('color', CSSColor(FValueColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
Result[CSS_CLASS_BLOCK_DELIM] := MakeCSSRule('delim',
[MakeCSSDeclaration('color', CSSColor(FBlockDelimColor)),
MakeCSSOptionalDeclaration(FBlockDelimBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_IMPORTANT] := MakeCSSRule('important',
[MakeCSSDeclaration('color', CSSColor(FImportantColor)),
MakeCSSOptionalDeclaration(FImportantBold, 'font-weight', 'bold')]);
end;
function TCSSFormattingProcessor.ParseText(AFromLine: Integer = 0;
SingleLinePossibility: Boolean = False; ANumLines: Integer = 1): Integer;
type
TNibble = type Byte;
const
ALLOC_BY = 8;
var
ToLine: Integer;
ActualLengths: array of Integer;
InBlock: TNibble;
InValue,
InImportant,
InComment: Boolean;
InStr: Char;
y, x: Integer;
Chr: Char;
function GetSignature: Cardinal;
begin
Result := ((InBlock and $F) shl 4) or (Byte(InValue) shl 1) or (Byte(InImportant) shl 2) or
(Byte(InComment) shl 3) or (Ord(InStr) shl 16) or (1 shl 15);
end;
procedure AddToken(AKind: TCSSChrKind; Signature: Boolean = False);
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := AKind;
if Signature then
FTokens[y][ActualLengths[y]].signature := GetSignature
else
FTokens[y][ActualLengths[y]].signature := 0;
Inc(ActualLengths[y]);
end;
function GetLastKind: TCSSChrKind;
var
yp: Integer;
xp: Integer;
begin
for yp := y downto 0 do
for xp := ActualLengths[yp] - 1 downto 0 do
Exit(FTokens[yp][xp].kind);
Result := ckCssUndefined;
end;
procedure AddSignature;
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := GetLastKind;
FTokens[y][ActualLengths[y]].signature := GetSignature;
Inc(ActualLengths[y]);
end;
function Peek: TCSSChrKind;
var
yp: Integer;
begin
for yp := y downto 0 do
if ActualLengths[yp] > 0 then
Exit(FTokens[yp][ActualLengths[yp] - 1].kind);
Result := ckCssSelector;
end;
procedure ExtractSignature(ASignature: Cardinal; out AInValue,
AInImportant, AInComment: Boolean; out AInStr: Char; out AInBlock: TNibble);
begin
AInBlock := (ASignature shr 4) and $F;
AInValue := ASignature and 2 <> 0;
AInImportant := ASignature and 4 <> 0;
AInComment := ASignature and 8 <> 0;
AInStr := Char(ASignature shr 16);
end;
function GetLastSignature: Cardinal;
var
yp: Integer;
begin
for yp := AFromLine - 1 downto 0 do
if Length(FTokens[yp]) > 0 then
begin
Assert(FTokens[yp][High(FTokens[yp])].signature and (1 shl 15) <> 0);
Exit(FTokens[yp][High(FTokens[yp])].signature);
end;
Result := 0;
end;
function PeekSignatureForward: Cardinal;
var
yp: Integer;
begin
for yp := y + 1 to High(FTokens) do
if Length(FTokens[yp]) > 0 then
Exit(FTokens[yp][0].signature);
Result := 0;
end;
function PeekImportant: Boolean;
begin
Result := (TextLineWidth(y) >= x + 10) and
(TextChar(y, x + 1) = 'i') and
(TextChar(y, x + 2) = 'm') and
(TextChar(y, x + 3) = 'p') and
(TextChar(y, x + 4) = 'o') and
(TextChar(y, x + 5) = 'r') and
(TextChar(y, x + 6) = 't') and
(TextChar(y, x + 7) = 'a') and
(TextChar(y, x + 8) = 'n') and
(TextChar(y, x + 9) = 't');
end;
function PeekComment: Boolean;
begin
Result := (TextLineWidth(y) >= x + 2) and
(TextChar(y, x + 1) = '*');
end;
function EndsComment: Boolean;
begin
Result := (x >= 1) and (TextChar(y, x - 1) = '*');
end;
begin
if AFromLine = 0 then
begin
InBlock := 0;
InValue := False;
InImportant := False;
InComment := False;
InStr := #0;
end
else
begin
ExtractSignature(GetLastSignature, InValue, InImportant, InComment,
InStr, InBlock);
end;
SetLength(FTokens, TextLineCount);
SetLength(ActualLengths, TextLineCount);
ToLine := TextLineCount - 1;
for y := 0 to AFromLine - 1 do
ActualLengths[y] := length(FTokens[y]);
for y := AFromLine to ToLine do
ActualLengths[y] := 0;
for y := AFromLine to ToLine do
begin
for x := 0 to TextLineWidth(y) - 1 do
begin
if x=0 then
AddToken(Peek, True);
Chr := TextChar(y, x);
if InStr <> #0 then
begin
if Chr = InStr then
InStr := #0
end
else if (not InComment) and ((Chr = '"') or (Chr = '''')) then
begin
InStr := Chr;
if InValue and (Peek <> ckCssValue) then
AddToken(ckCssValue);
end
else if InComment then
begin
if (Chr = '/') and EndsComment then
InComment := False;
end
else if (Chr = '/') and PeekComment then
begin
AddToken(ckCssComment);
InComment := True;
end
else if InImportant then
begin
if Chr = ';' then
begin
AddToken(ckCssValue);
InImportant := False;
InValue := False;
end;
end
else if InValue then
begin
if (Chr = '!') and PeekImportant then
begin
AddToken(ckCssImportant);
InImportant := True;
end
else
begin
if Peek <> ckCssValue then
AddToken(ckCssValue);
if Chr = ';' then
begin
InValue := False;
end
else if Chr = '}' then
begin
AddToken(ckCssBlockDelim);
InValue := False;
Dec(InBlock);
end
end;
end
else if InBlock > 0 then
begin
if Chr = '{' then
begin
AddToken(ckCssBlockDelim);
Inc(InBlock);
end
else if Chr = '}' then
begin
AddToken(ckCssBlockDelim);
Dec(InBlock);
end
else if Peek <> ckCssProperty then
AddToken(ckCssProperty);
if Chr = ':' then
begin
InValue := True;
end;
end
else if Chr = '{' then
begin
AddToken(ckCssBlockDelim);
Inc(InBlock);
end
else if Peek <> ckCssSelector then
AddToken(ckCssSelector);
if x = TextLineWidth(y) - 1 then
AddSignature;
end;
if SingleLinePossibility and (y - AFromLine >= ANumLines - 1) and (GetSignature = PeekSignatureForward) then
begin
ToLine := y;
break;
end;
end;
for y := AFromLine to ToLine do
SetLength(FTokens[y], ActualLengths[y]);
Result := ToLine;
end;
procedure TCSSFormattingProcessor.PushTokensDownFrom(ALineIndex: Integer);
var
i: Integer;
begin
SetLength(FTokens, Length(FTokens) + 1);
for i := High(FTokens) downto ALineIndex + 1 do
FTokens[i] := Copy(FTokens[i - 1]);
end;
procedure TCSSFormattingProcessor.PushTokensUpFrom(ALineIndex: Integer);
var
i: Integer;
begin
for i := ALineIndex + 1 to High(FTokens) - 1 do
FTokens[i] := Copy(FTokens[i + 1]);
SetLength(FTokens, Length(FTokens) - 1);
end;
procedure TCSSFormattingProcessor.SetBlockDelimBold(const Value: Boolean);
begin
if FBlockDelimBold <> Value then
begin
FBlockDelimBold := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetBlockDelimColor(const Value: TColor);
begin
if FBlockDelimColor <> Value then
begin
FBlockDelimColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
FCommentColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetImportantBold(const Value: Boolean);
begin
if FImportantBold <> Value then
begin
FImportantBold := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetImportantColor(const Value: TColor);
begin
if FImportantColor <> Value then
begin
FImportantColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetPropertyColor(const Value: TColor);
begin
if FPropertyColor <> Value then
begin
FPropertyColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetSelectorBold(const Value: Boolean);
begin
if FSelectorBold <> Value then
begin
FSelectorBold := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetSelectorColor(const Value: TColor);
begin
if FSelectorColor <> Value then
begin
FSelectorColor := Value;
Changed;
end;
end;
procedure TCSSFormattingProcessor.SetValueColor(const Value: TColor);
begin
if FValueColor <> Value then
begin
FValueColor := Value;
Changed;
end;
end;
procedure TINIFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FSectionColor := AColorScheme.Accent3;
FNameColor := AColorScheme.Accent1;
FValueColor := AColorScheme.Default;
FCommentColor := AColorScheme.Soft;
Changed;
end;
procedure TINIFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TINIFormattingProcessor then
begin
FSectionColor := TINIFormattingProcessor(Source).SectionColor;
FSectionBold := TINIFormattingProcessor(Source).SectionBold;
FNameColor := TINIFormattingProcessor(Source).NameColor;
FValueColor := TINIFormattingProcessor(Source).ValueColor;
FCommentColor := TINIFormattingProcessor(Source).CommentColor;
Changed;
end
else
inherited;
end;
constructor TINIFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FSectionColor := DEFAULT_SECTION_COLOR;
FSectionBold := DEFAULT_SECTION_BOLD;
FNameColor := DEFAULT_NAME_COLOR;
FValueColor := DEFAULT_VALUE_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
end;
function TINIFormattingProcessor.FileChangeNotification(ChangeType: TChangeType;
Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
inherited;
case ChangeType of
ctNone: ;
ctFile:
Result.ChangeType := ctFile;
ctLineRange:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctBlock:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctLine:
begin
Result.ChangeType := ctLine;
Result.Data1 := Data1;
end;
ctLineFrom:
begin
Result.ChangeType := ctLineFrom;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctChar:
begin
Result.ChangeType := ctLineFrom;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctTwoChars:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := max(Data1, Data3);
end;
ctPostFile: ;
end;
end;
function TINIFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
function AfterEqualsSign: Boolean;
var
x: Integer;
begin
Result := False;
for x := 0 to ACol - 1 do
if TextChar(ALineIndex, x) = '=' then
Exit(True);
end;
var
FirstChar: Char;
begin
FirstChar := TextChar(ALineIndex, 0);
if FirstChar = '[' then
Result := CSS_CLASS_SECTION
else if FirstChar = ';' then
Result := CSS_CLASS_COMMENT
else if AChar = '=' then
Result := CSS_CLASS_EQUALS
else if AfterEqualsSign then
Result := CSS_CLASS_VALUE
else
Result := CSS_CLASS_NAME
end;
procedure TINIFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
function AfterEqualsSign: Boolean;
var
x: Integer;
begin
Result := False;
for x := 0 to ACol - 1 do
if TextChar(ALineIndex, x) = '=' then
Exit(True);
end;
var
FirstChar: Char;
begin
FirstChar := TextChar(ALineIndex, 0);
if FirstChar = '[' then
begin
AFontRecord.Color := FSectionColor;
if FSectionBold then
Include(AFontRecord.Style, fsBold);
end
else if FirstChar = ';' then
AFontRecord.Color := FCommentColor
else if AChar = '=' then
else if AfterEqualsSign then
AFontRecord.Color := FValueColor
else
AFontRecord.Color := FNameColor;
end;
function TINIFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_SECTION] := MakeCSSRule('section',
[MakeCSSDeclaration('color', CSSColor(FSectionColor)),
MakeCSSOptionalDeclaration(FSectionBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_NAME] := MakeCSSRule('name',
[MakeCSSDeclaration('color', CSSColor(FNameColor))]);
Result[CSS_CLASS_VALUE] := MakeCSSRule('value',
[MakeCSSDeclaration('color', CSSColor(FValueColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
Result[CSS_CLASS_EQUALS] := MakeCSSRule('equals', []);
end;
procedure TINIFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
FCommentColor := Value;
Changed;
end;
end;
procedure TINIFormattingProcessor.SetNameColor(const Value: TColor);
begin
if FNameColor <> Value then
begin
FNameColor := Value;
Changed;
end;
end;
procedure TINIFormattingProcessor.SetSectionBold(const Value: Boolean);
begin
if FSectionBold <> Value then
begin
FSectionBold := Value;
Changed;
end;
end;
procedure TINIFormattingProcessor.SetSectionColor(const Value: TColor);
begin
if FSectionColor <> Value then
begin
FSectionColor := Value;
Changed;
end;
end;
procedure TINIFormattingProcessor.SetValueColor(const Value: TColor);
begin
if FValueColor <> Value then
begin
FValueColor := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FKeywordColor := AColorScheme.Accent3;
FStringColor := AColorScheme.Accent1;
FNumberColor := AColorScheme.Accent1;
FCommentColor := AColorScheme.Accent2;
FCompilerDirectiveColor := AColorScheme.Accent3;
Changed;
end;
procedure TPascalFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TPascalFormattingProcessor then
begin
FKeywordColor := TPascalFormattingProcessor(Source).KeywordColor;
FKeywordBold := TPascalFormattingProcessor(Source).KeywordBold;
FStringColor := TPascalFormattingProcessor(Source).StringColor;
FNumberColor := TPascalFormattingProcessor(Source).NumberColor;
FCommentColor := TPascalFormattingProcessor(Source).CommentColor;
FCompilerDirectiveColor := TPascalFormattingProcessor(Source).CompilerDirectiveColor;
Changed;
end
else
inherited;
end;
procedure TPascalFormattingProcessor.ClearCache;
begin
SetLength(FTokens, 0);
end;
constructor TPascalFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FKeywordColor := DEFAULT_KEYWORD_COLOR;
FKeywordBold := DEFAULT_KEYWORD_BOLD;
FStringColor := DEFAULT_STRING_COLOR;
FNumberColor := DEFAULT_NUMBER_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
FCompilerDirectiveColor := DEFAULT_COMPILER_DIRECTIVE_COLOR;
end;
function TPascalFormattingProcessor.FileChangeNotification(
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
case ChangeType of
ctNone: ;
ctFile:
begin
ParseText;
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
if Data3 = 1 then
begin
PushTokensDownFrom(Data1);
ParseText(Data1, True, 2);
end
else if Data3 = 2 then
begin
PushTokensUpFrom(Data1);
ParseText(Data1, True, 2);
end
else
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctBlock:
begin
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLine:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctLineFrom:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctChar:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctTwoChars:
begin
ParseText(min(Data1, Data3));
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := TextLineCount - 1;
end;
ctPostFile: ;
end;
end;
function TPascalFormattingProcessor.GetCache(out ACache: PByte): Integer;
var
i: Integer;
p: PByte;
begin
Result := (1 + length(FTokens)) * sizeof(Integer);
for i := 0 to High(FTokens) do
Inc(Result, length(FTokens[i]) * sizeof(TFmtBreak));
try
GetMem(ACache, Result);
try
p := ACache;
PInteger(p)^ := length(FTokens);
Inc(p, sizeof(Integer));
for i := 0 to High(FTokens) do
begin
PInteger(p)^ := length(FTokens[i]);
Inc(p, sizeof(Integer));
Move(FTokens[i][0], p^, length(FTokens[i]) * sizeof(TFmtBreak));
Inc(p, length(FTokens[i]) * sizeof(TFmtBreak));
end;
except
FreeMem(ACache);
raise;
end;
except
ACache := nil;
Result := 0;
end;
end;
function TPascalFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
begin
case GetChrKind(ALineIndex, ACol) of
ckPasUndefined:
Result := CSS_CLASS_DEFAULT;
ckPasKeyword:
Result := CSS_CLASS_KEYWORD;
ckPasString:
Result := CSS_CLASS_STRING;
ckPasNumber:
Result := CSS_CLASS_NUMBER;
ckPasComment:
Result := CSS_CLASS_COMMENT;
ckPasCompilerDirective:
Result := CSS_CLASS_COMPILER_DIRECTIVE;
else
raise Exception.Create('TPascalFormattingProcessor.GetCharCSSClass: Invalid character kind.');
end;
end;
procedure TPascalFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetChrKind(ALineIndex, ACol) of
ckPasUndefined:
;
ckPasKeyword:
begin
AFontRecord.Color := FKeywordColor;
if FKeywordBold then
Include(AFontRecord.Style, fsBold);
end;
ckPasString:
AFontRecord.Color := FStringColor;
ckPasNumber:
AFontRecord.Color := FNumberColor;
ckPasComment:
AFontRecord.Color := FCommentColor;
ckPasCompilerDirective:
AFontRecord.Color := FCompilerDirectiveColor;
end;
end;
function TPascalFormattingProcessor.GetChrKind(ALineIndex,
ACol: Integer): TPascalChrKind;
var
i: Integer;
begin
Result := ckPasUndefined;
i := 0;
if ALineIndex <= High(FTokens) then
while (i <= High(FTokens[ALineIndex])) and (FTokens[ALineIndex][i].x <= ACol) do
begin
Result := FTokens[ALineIndex][i].kind;
Inc(i);
end;
end;
function TPascalFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_DEFAULT] := MakeCSSRule('default', []);
Result[CSS_CLASS_KEYWORD] := MakeCSSRule('keyword',
[MakeCSSDeclaration('color', CSSColor(FKeywordColor)),
MakeCSSOptionalDeclaration(FKeywordBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_STRING] := MakeCSSRule('string',
[MakeCSSDeclaration('color', CSSColor(FStringColor))]);
Result[CSS_CLASS_NUMBER] := MakeCSSRule('number',
[MakeCSSDeclaration('color', CSSColor(FNumberColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
Result[CSS_CLASS_COMPILER_DIRECTIVE] := MakeCSSRule('compiler-directive',
[MakeCSSDeclaration('color', CSSColor(FCompilerDirectiveColor))]);
end;
function TPascalFormattingProcessor.ParseText(AFromLine: Integer;
SingleLinePossibility: Boolean; ANumLines: Integer): Integer;
const
ALLOC_BY = 16;
var
ToLine: Integer;
ActualLengths: array of Integer;
y, x: Integer;
InComment: Char;
InDirective: Boolean;
InStr: Boolean;
InNumber: Boolean;
InKeyword: Boolean;
Chr: Char;
lasttoken: TPascalChrKind;
NumberEndsAt: Integer;
function GetSignature: Cardinal;
begin
Result := Byte(InKeyword) or (Byte(InStr) shl 1) or (Byte(InNumber) shl 2) or
(Byte(InDirective) shl 3) or (Ord(InComment) shl 16) or (1 shl 15);
end;
procedure AddToken(AKind: TPascalChrKind; Signature: Boolean = False);
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := AKind;
if Signature then
FTokens[y][ActualLengths[y]].signature := GetSignature
else
FTokens[y][ActualLengths[y]].signature := 0;
Inc(ActualLengths[y]);
end;
function GetLastKind: TPascalChrKind;
var
yp: Integer;
xp: Integer;
begin
for yp := y downto 0 do
for xp := ActualLengths[yp] - 1 downto 0 do
Exit(FTokens[yp][xp].kind);
Result := ckPasUndefined;
end;
procedure AddSignature;
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := GetLastKind;
FTokens[y][ActualLengths[y]].signature := GetSignature;
Inc(ActualLengths[y]);
end;
function Peek: TPascalChrKind;
var
yp: Integer;
begin
for yp := y downto 0 do
if ActualLengths[yp] > 0 then
Exit(FTokens[yp][ActualLengths[yp] - 1].kind);
Result := ckPasUndefined;
end;
procedure ExtractSignature(ASignature: Cardinal; out AInKeyword,
AInStr, AInNumber: Boolean; out AInComment: Char; out AInDirective: Boolean);
begin
AInKeyword := ASignature and 1 <> 0;
AInStr := ASignature and 2 <> 0;
AInNumber := ASignature and 4 <> 0;
AInComment := Char(ASignature shr 16);
AInDirective := ASignature and 8 <> 0;
end;
function GetLastSignature: Cardinal;
var
yp: Integer;
begin
for yp := AFromLine - 1 downto 0 do
if Length(FTokens[yp]) > 0 then
begin
Assert(FTokens[yp][High(FTokens[yp])].signature and (1 shl 15) <> 0);
Exit(FTokens[yp][High(FTokens[yp])].signature);
end;
Result := 0;
end;
function PeekSignatureForward: Cardinal;
var
yp: Integer;
begin
for yp := y + 1 to High(FTokens) do
if Length(FTokens[yp]) > 0 then
Exit(FTokens[yp][0].signature);
Result := 0;
end;
function PeekSolidusComment: Boolean;
begin
Result := (x < TextLineWidth(y) - 1) and
(TextChar(y, x + 1) = '/');
end;
function PeekSpecialComment: Boolean;
begin
Result := (x < TextLineWidth(y) - 1) and
(TextChar(y, x + 1) = '*');
end;
function PeekDirective: Boolean;
begin
Result := (x < TextLineWidth(y) - 1) and
(TextChar(y, x + 1) = '$');
end;
function WasClosingSpecialComment: Boolean;
begin
Result := (x > 0) and
(TextChar(y, x - 1) = '*');
end;
function IsInKeyword: Boolean;
var
wrd: string;
i: Integer;
begin
wrd := LowerCase(TextGetWord(Point(x, y), True));
Result := False;
for i := Low(PASCAL_IDENTS) to High(PASCAL_IDENTS) do
if SameStr(wrd, PASCAL_IDENTS[i]) then
Exit(True);
end;
function StartsNumber: Boolean;
var
i: Integer;
c: Char;
PeriodUsed: Boolean;
EPos: Integer;
begin
Result := True;
PeriodUsed := False;
EPos := -1;
NumberEndsAt := TextLineWidth(y) - 1;
for i := x to TextLineWidth(y) - 1 do
begin
c := TextChar(y, i);
if c in ['0'..'9'] then
Continue
else if (c = '.') and not PeriodUsed then
begin
PeriodUsed := True;
Continue;
end
else if (c in ['E', 'e']) and (EPos = -1) and (i > x) then
begin
EPos := i;
Continue;
end
else if (c in ['+', '-']) and (i = EPos + 1) then
Continue
else
begin
NumberEndsAt := i - 1;
break;
end;
end;
end;
function StartsHexNumber: Boolean;
var
i: Integer;
c: Char;
begin
Result := True;
NumberEndsAt := TextLineWidth(y) - 1;
for i := x to TextLineWidth(y) - 1 do
begin
c := TextChar(y, i);
if ((c='$') and (i=x)) or (c in ['0'..'9', 'a'..'f', 'A'..'F']) then
Continue
else
begin
NumberEndsAt := i - 1;
break;
end;
end;
end;
function IsValidIdent(const C: Char): Boolean;
begin
Result := C.IsLetterOrDigit or (C = '_');
end;
function StartNumLittPossible: Boolean;
begin
Result := (x = 0) or
((x > 0) and not IsValidIdent(TextChar(y, x - 1)));
end;
function LastChrOfKeyword: Boolean;
begin
Result := (x = TextLineWidth(y) - 1) or
not (TextChar(y, x + 1) in ['a'..'z', 'A'..'Z']);
end;
begin
if AFromLine = 0 then
begin
InKeyword := False;
InStr := False;
InNumber := False;
InComment := #0;
InDirective := False;
end
else
begin
ExtractSignature(GetLastSignature, InKeyword, InStr, InNumber, InComment,
InDirective);
end;
SetLength(FTokens, TextLineCount);
SetLength(ActualLengths, TextLineCount);
ToLine := TextLineCount - 1;
for y := 0 to AFromLine - 1 do
ActualLengths[y] := length(FTokens[y]);
for y := AFromLine to ToLine do
ActualLengths[y] := 0;
for y := AFromLine to ToLine do
begin
for x := 0 to TextLineWidth(y) - 1 do
begin
if x=0 then
begin
lasttoken := Peek;
if InComment = '/' then
begin
InComment := #0;
lasttoken := ckPasUndefined;
end;
if InKeyword then
begin
InKeyword := False;
lasttoken := ckPasUndefined;
end;
if InStr then
begin
InStr := False;
lasttoken := ckPasUndefined;
end;
AddToken(lasttoken, True);
end;
Chr := TextChar(y, x);
if InComment = '/' then
else if (InComment = '{') or InDirective then
begin
if Chr = '}' then
begin
InComment := #0;
InDirective := False;
end;
end
else if (InComment = '(') then
begin
if (Chr = ')') and WasClosingSpecialComment then
InComment := #0;
end
else if InStr then
begin
if Chr = '''' then
InStr := False;
end
else if Chr = '''' then
begin
InStr := True;
AddToken(ckPasString);
end
else if (Chr = '/') and PeekSolidusComment then
begin
InComment := '/';
AddToken(ckPasComment);
end
else if (Chr = '{') and PeekDirective then
begin
InDirective := True;
AddToken(ckPasCompilerDirective);
end
else if (Chr = '{') then
begin
InComment := '{';
AddToken(ckPasComment);
end
else if (Chr = '(') and PeekSpecialComment then
begin
InComment := '(';
AddToken(ckPasComment);
end
else if InKeyword then
begin
if LastChrOfKeyword then
InKeyword := False
end
else if InNumber then
begin
if x = NumberEndsAt then
InNumber := False
end
else if (Chr in ['a'..'z', 'A'..'Z']) and IsInKeyword then
begin
InKeyword := True;
AddToken(ckPasKeyword);
end
else if (Chr in ['0'..'9']) and StartNumLittPossible and StartsNumber then
begin
InNumber := True;
AddToken(ckPasNumber);
if x = NumberEndsAt then
InNumber := False
end
else if (Chr = '$') and StartsHexNumber then
begin
InNumber := True;
AddToken(ckPasNumber);
if x = NumberEndsAt then
InNumber := False
end
else if (Chr = '#') then
begin
AddToken(ckPasString)
end
else
if Peek <> ckPasUndefined then
AddToken(ckPasUndefined);
if x = TextLineWidth(y) - 1 then
AddSignature;
end;
if SingleLinePossibility and (y - AFromLine >= ANumLines - 1) and (GetSignature = PeekSignatureForward) then
begin
ToLine := y;
break;
end;
end;
for y := AFromLine to ToLine do
SetLength(FTokens[y], ActualLengths[y]);
Result := ToLine;
end;
procedure TPascalFormattingProcessor.PushTokensDownFrom(ALineIndex: Integer);
var
i: Integer;
begin
SetLength(FTokens, Length(FTokens) + 1);
for i := High(FTokens) downto ALineIndex + 1 do
FTokens[i] := Copy(FTokens[i - 1]);
end;
procedure TPascalFormattingProcessor.PushTokensUpFrom(ALineIndex: Integer);
var
i: Integer;
begin
for i := ALineIndex + 1 to High(FTokens) - 1 do
FTokens[i] := Copy(FTokens[i + 1]);
SetLength(FTokens, Length(FTokens) - 1);
end;
function TPascalFormattingProcessor.RestoreCache(ACache: PByte;
ASize: Integer): Boolean;
var
i: Integer;
begin
Result := False;
if (ACache = nil) or (ASize = 0) then Exit;
SetLength(FTokens, PInteger(ACache)^);
Inc(ACache, sizeof(Integer));
for i := 0 to High(FTokens) do
begin
SetLength(FTokens[i], PInteger(ACache)^);
Inc(ACache, sizeof(Integer));
Move(ACache^, FTokens[i][0], Length(FTokens[i]) * sizeof(TFmtBreak));
Inc(ACache, Length(FTokens[i]) * sizeof(TFmtBreak));
end;
Result := True;
end;
procedure TPascalFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
FCommentColor := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.SetCompilerDirectiveColor(
const Value: TColor);
begin
if FCompilerDirectiveColor <> Value then
begin
FCompilerDirectiveColor := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.SetKeywordBold(const Value: Boolean);
begin
if FKeywordBold <> Value then
begin
FKeywordBold := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.SetKeywordColor(const Value: TColor);
begin
if FKeywordColor <> Value then
begin
FKeywordColor := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.SetNumberColor(const Value: TColor);
begin
if FNumberColor <> Value then
begin
FNumberColor := Value;
Changed;
end;
end;
procedure TPascalFormattingProcessor.SetStringColor(const Value: TColor);
begin
if FStringColor <> Value then
begin
FStringColor := Value;
Changed;
end;
end;
procedure TAlgoSimFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FKeywordColor := AColorScheme.Accent3;
FStringColor := AColorScheme.Accent1;
FNumberColor := AColorScheme.Accent1;
FCommentColor := AColorScheme.Accent2;
Changed;
end;
procedure TAlgoSimFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TAlgoSimFormattingProcessor then
begin
FKeywordColor := TAlgoSimFormattingProcessor(Source).KeywordColor;
FKeywordBold := TAlgoSimFormattingProcessor(Source).KeywordBold;
FStringColor := TAlgoSimFormattingProcessor(Source).StringColor;
FNumberColor := TAlgoSimFormattingProcessor(Source).NumberColor;
FCommentColor := TAlgoSimFormattingProcessor(Source).CommentColor;
Changed;
end
else
inherited;
end;
constructor TAlgoSimFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FKeywordColor := DEFAULT_KEYWORD_COLOR;
FKeywordBold := DEFAULT_KEYWORD_BOLD;
FStringColor := DEFAULT_STRING_COLOR;
FNumberColor := DEFAULT_NUMBER_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
end;
function TAlgoSimFormattingProcessor.FileChangeNotification(
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
case ChangeType of
ctNone: ;
ctFile:
begin
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctBlock:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctLine:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data1;
end;
ctLineFrom:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data1;
end;
ctChar:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data1;
end;
ctTwoChars:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := max(Data1, Data3);
end;
ctPostFile: ;
end;
end;
function TAlgoSimFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
function BeforeSpace: Boolean;
var
i: Integer;
AfterSemicolon: Boolean;
begin
Result := True;
AfterSemicolon := False;
for i := 0 to ACol do
case TextChar(ALineIndex, i) of
';': AfterSemicolon := True;
' ': if AfterSemicolon then Exit(False);
end;
end;
function IsNumber: Boolean;
var
i: Integer;
BaseN: Boolean;
SP, EP: Integer;
begin
if (AChar = '#') or (AChar = '.') then
Exit(True)
else if not (AChar in ['0'..'9', 'A'..'Z', 'a'..'z']) then
Exit(False);
TextGetWordBoundary(Point(ACol, ALineIndex), SP, EP);
Dec(EP);
BaseN := (EP < TextLineWidth(ALineIndex) - 3) and (TextChar(ALineIndex, EP + 1) = '#');
Result := True;
if BaseN then
begin
for i := SP to EP do
if not (TextChar(ALineIndex, i) in ['0'..'9', 'A'..'Z', 'a'..'z']) then
Exit(False)
end
else
for i := SP to EP do
if not (TextChar(ALineIndex, i) in ['0'..'9']) then
Exit(False);
end;
var
InStr: Boolean;
i: Integer;
InIndent: Boolean;
SemicolonCount: Integer;
begin
InIndent := True;
SemicolonCount := 0;
for i := 0 to TextLineWidth(ALineIndex) - 1 do
if (TextChar(ALineIndex, i) = ' ') and InIndent then
Continue
else
begin
InIndent := False;
if TextChar(ALineIndex, i) = ';' then
begin
Inc(SemicolonCount);
if SemicolonCount = 2 then break;
end
else
break;
end;
Result := CSS_CLASS_DEFAULT;
if SemicolonCount = 2 then
Exit(CSS_CLASS_COMMENT);
if SemicolonCount = 1 then
Exit(CSS_CLASS_KEYWORD);
InStr := False;
for i := 0 to ACol do
begin
if InStr then
begin
if TextChar(ALineIndex, i) = '"' then
InStr := False
end
else
begin
if TextChar(ALineIndex, i) = '"' then
InStr := True
end;
end;
if InStr or (AChar = '"') then
Result := CSS_CLASS_STRING
else if IsNumber then
Result := CSS_CLASS_NUMBER;
end;
procedure TAlgoSimFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetCharCSSClass(ALineIndex, ACol, AChar) of
CSS_CLASS_KEYWORD:
begin
AFontRecord.Color := FKeywordColor;
if FKeywordBold then
Include(AFontRecord.Style, fsBold);
end;
CSS_CLASS_STRING:
AFontRecord.Color := FStringColor;
CSS_CLASS_NUMBER:
AFontRecord.Color := FNumberColor;
CSS_CLASS_COMMENT:
AFontRecord.Color := FCommentColor;
end;
end;
function TAlgoSimFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_DEFAULT] := MakeCSSRule('default', []);
Result[CSS_CLASS_KEYWORD] := MakeCSSRule('keyword',
[MakeCSSDeclaration('color', CSSColor(FKeywordColor)),
MakeCSSOptionalDeclaration(FKeywordBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_STRING] := MakeCSSRule('string',
[MakeCSSDeclaration('color', CSSColor(FStringColor))]);
Result[CSS_CLASS_NUMBER] := MakeCSSRule('number',
[MakeCSSDeclaration('color', CSSColor(FNumberColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
end;
procedure TAlgoSimFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
FCommentColor := Value;
Changed;
end;
end;
procedure TAlgoSimFormattingProcessor.SetKeywordBold(const Value: Boolean);
begin
if FKeywordBold <> Value then
begin
FKeywordBold := Value;
Changed;
end;
end;
procedure TAlgoSimFormattingProcessor.SetKeywordColor(const Value: TColor);
begin
if FKeywordColor <> Value then
begin
FKeywordColor := Value;
Changed;
end;
end;
procedure TAlgoSimFormattingProcessor.SetNumberColor(const Value: TColor);
begin
if FNumberColor <> Value then
begin
FNumberColor := Value;
Changed;
end;
end;
procedure TAlgoSimFormattingProcessor.SetStringColor(const Value: TColor);
begin
if FStringColor <> Value then
begin
FStringColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FTagColor := AColorScheme.Accent1;
FTagNameColor := AColorScheme.Accent3;
FParamColor := AColorScheme.Accent1;
FValueColor := AColorScheme.Accent2;
FCommentColor := AColorScheme.Soft;
FCssSelectorColor := AColorScheme.Accent3;
FCssPropertyColor := AColorScheme.Accent1;
FCssValueColor := AColorScheme.Accent2;
FCssCommentColor := AColorScheme.Soft;
FCssBlockDelimColor := AColorScheme.Accent3;
FCssImportantColor := AColorScheme.Intense;
FDoctypeColor := AColorScheme.Soft;
Changed;
end;
procedure THTMLFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is THTMLFormattingProcessor then
begin
FTagColor := THTMLFormattingProcessor(Source).TagColor;
FTagNameColor := THTMLFormattingProcessor(Source).TagNameColor;
FTagNameBold := THTMLFormattingProcessor(Source).TagNameBold;
FParamColor := THTMLFormattingProcessor(Source).ParamColor;
FValueColor := THTMLFormattingProcessor(Source).ValueColor;
FCommentColor := THTMLFormattingProcessor(Source).CommentColor;
FCssSelectorColor := THTMLFormattingProcessor(Source).CssSelectorColor;
FCssSelectorBold := THTMLFormattingProcessor(Source).CssSelectorBold;
FCssPropertyColor := THTMLFormattingProcessor(Source).CssPropertyColor;
FCssValueColor := THTMLFormattingProcessor(Source).CssValueColor;
FCssCommentColor := THTMLFormattingProcessor(Source).CssCommentColor;
FCssBlockDelimColor := THTMLFormattingProcessor(Source).CssBlockDelimColor;
FCssBlockDelimBold := THTMLFormattingProcessor(Source).CssBlockDelimBold;
FCssImportantColor := THTMLFormattingProcessor(Source).CssImportantColor;
FCssImportantBold := THTMLFormattingProcessor(Source).CssImportantBold;
FDoctypeColor := THTMLFormattingProcessor(Source).DoctypeColor;
FDoctypeBold := THTMLFormattingProcessor(Source).DoctypeBold;
FDoctypeItalics := THTMLFormattingProcessor(Source).DoctypeItalics;
Changed;
end
else if Source is TXMLFormattingProcessor then
begin
FTagColor := TXMLFormattingProcessor(Source).TagColor;
FTagNameColor := TXMLFormattingProcessor(Source).TagNameColor;
FTagNameBold := TXMLFormattingProcessor(Source).TagNameBold;
FParamColor := TXMLFormattingProcessor(Source).ParamColor;
FValueColor := TXMLFormattingProcessor(Source).ValueColor;
FCommentColor := TXMLFormattingProcessor(Source).CommentColor;
Changed;
end
else if Source is TCSSFormattingProcessor then
begin
FCssSelectorColor := TCSSFormattingProcessor(Source).SelectorColor;
FCssSelectorBold := TCSSFormattingProcessor(Source).SelectorBold;
FCssPropertyColor := TCSSFormattingProcessor(Source).PropertyColor;
FCssValueColor := TCSSFormattingProcessor(Source).ValueColor;
FCssCommentColor := TCSSFormattingProcessor(Source).CommentColor;
FCssBlockDelimColor := TCSSFormattingProcessor(Source).BlockDelimColor;
FCssBlockDelimBold := TCSSFormattingProcessor(Source).BlockDelimBold;
FCssImportantColor := TCSSFormattingProcessor(Source).ImportantColor;
FCssImportantBold := TCSSFormattingProcessor(Source).ImportantBold;
Changed;
end
else
inherited;
end;
constructor THTMLFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FTagColor := DEFAULT_TAG_COLOR;
FTagNameColor := DEFAULT_TAG_NAME_COLOR;
FTagNameBold := DEFAULT_TAG_NAME_BOLD;
FParamColor := DEFAULT_PARAM_COLOR;
FValueColor := DEFAULT_VALUE_COLOR;
FCommentColor := DEFAULT_COMMENT_COLOR;
FCssSelectorColor := DEFAULT_CSS_SELECTOR_COLOR;
FCssSelectorBold := DEFAULT_CSS_SELECTOR_BOLD;
FCssPropertyColor := DEFAULT_CSS_PROPERTY_COLOR;
FCssValueColor := DEFAULT_CSS_VALUE_COLOR;
FCssCommentColor := DEFAULT_CSS_COMMENT_COLOR;
FCssBlockDelimColor := DEFAULT_CSS_BLOCK_DELIM_COLOR;
FCssBlockDelimBold := DEFAULT_CSS_BLOCK_DELIM_BOLD;
FCssImportantColor := DEFAULT_CSS_IMPORTANT_COLOR;
FCssImportantBold := DEFAULT_CSS_IMPORTANT_BOLD;
FDoctypeColor := DEFAULT_DOCTYPE_COLOR;
FDoctypeBold := DEFAULT_DOCTYPE_BOLD;
FDoctypeItalics := DEFAULT_DOCTYPE_ITALICS;
end;
function THTMLFormattingProcessor.FileChangeNotification(
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
inherited;
case ChangeType of
ctNone: ;
ctFile:
begin
ParseText;
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
if Data3 = 1 then
begin
PushTokensDownFrom(Data1);
ParseText(Data1, True, 2);
end
else if Data3 = 2 then
begin
PushTokensUpFrom(Data1);
ParseText(Data1, True, 2);
end
else
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctBlock:
begin
ParseText(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLine:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctLineFrom:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctChar:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := ParseText(Data1, True);
end;
ctTwoChars:
begin
ParseText(min(Data1, Data3));
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := TextLineCount - 1;
end;
ctPostFile: ;
end;
end;
function THTMLFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
begin
case GetChrKind(ALineIndex, ACol) of
ckHtmlUndefined, ckHtmlText:
Result := CSS_CLASS_TEXT;
ckHtmlTag:
Result := CSS_CLASS_TAG;
ckHtmlTagName:
Result := CSS_CLASS_TAG_NAME;
ckHtmlParam:
Result := CSS_CLASS_PARAM;
ckHtmlValue:
Result := CSS_CLASS_VALUE;
ckHtmlComment:
Result := CSS_CLASS_COMMENT;
ckHtmlCssSelector:
Result := CSS_CLASS_CSS_SELECTOR;
ckHtmlCssBlockDelim:
Result := CSS_CLASS_CSS_BLOCK_DELIM;
ckHtmlCssProperty:
Result := CSS_CLASS_CSS_PROPERTY;
ckHtmlCssValue:
Result := CSS_CLASS_CSS_VALUE;
ckHtmlCssImportant:
Result := CSS_CLASS_CSS_IMPORTANT;
ckHtmlCssComment:
Result := CSS_CLASS_CSS_COMMENT;
ckHtmlDoctype:
Result := CSS_CLASS_DOCTYPE;
ckHtmlScript:
Result := CSS_CLASS_SCRIPT;
else
raise Exception.Create('THTMLFormattingProcessor.GetCharCSSClass: Invalid character kind.');
end;
end;
procedure THTMLFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetChrKind(ALineIndex, ACol) of
ckHtmlTag:
AFontRecord.Color := FTagColor;
ckHtmlTagName:
begin
AFontRecord.Color := FTagNameColor;
if FTagNameBold then
Include(AFontRecord.Style, fsBold);
end;
ckHtmlParam:
AFontRecord.Color := FParamColor;
ckHtmlValue:
AFontRecord.Color := FValueColor;
ckHtmlComment:
AFontRecord.Color := FCommentColor;
ckHtmlCssSelector:
begin
AFontRecord.Color := FCssSelectorColor;
if FCssSelectorBold then
Include(AFontRecord.Style, fsBold);
end;
ckHtmlCssBlockDelim:
begin
AFontRecord.Color := FCssBlockDelimColor;
if FCssBlockDelimBold then
Include(AFontRecord.Style, fsBold);
end;
ckHtmlCssProperty:
AFontRecord.Color := FCssPropertyColor;
ckHtmlCssValue:
AFontRecord.Color := FCssValueColor;
ckHtmlCssImportant:
begin
AFontRecord.Color := FCssImportantColor;
if FCssImportantBold then
Include(AFontRecord.Style, fsBold);
end;
ckHtmlCssComment:
AFontRecord.Color := FCssCommentColor;
ckHtmlDoctype:
begin
AFontRecord.Color := FDoctypeColor;
if FDoctypeBold then
Include(AFontRecord.Style, fsBold);
if FDoctypeItalics then
Include(AFontRecord.Style, fsItalic);
end;
end;
end;
function THTMLFormattingProcessor.GetChrKind(ALineIndex,
ACol: Integer): THtmlChrKind;
var
i: Integer;
begin
Result := ckHtmlUndefined;
i := 0;
if ALineIndex <= High(FTokens) then
while (i <= High(FTokens[ALineIndex])) and (FTokens[ALineIndex][i].x <= ACol) do
begin
Result := FTokens[ALineIndex][i].kind;
Inc(i);
end;
end;
function THTMLFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_TEXT] := MakeCSSRule('text', []);
Result[CSS_CLASS_TAG] := MakeCSSRule('tag',
[MakeCSSDeclaration('color', CSSColor(FTagColor))]);
Result[CSS_CLASS_TAG_NAME] := MakeCSSRule('tag-name',
[MakeCSSDeclaration('color', CSSColor(FTagNameColor)),
MakeCSSOptionalDeclaration(FTagNameBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_PARAM] := MakeCSSRule('param',
[MakeCSSDeclaration('color', CSSColor(FParamColor))]);
Result[CSS_CLASS_VALUE] := MakeCSSRule('value',
[MakeCSSDeclaration('color', CSSColor(FValueColor))]);
Result[CSS_CLASS_COMMENT] := MakeCSSRule('comment',
[MakeCSSDeclaration('color', CSSColor(FCommentColor))]);
Result[CSS_CLASS_CSS_SELECTOR] := MakeCSSRule('css-selector',
[MakeCSSDeclaration('color', CSSColor(FCssSelectorColor)),
MakeCSSOptionalDeclaration(FCssSelectorBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_CSS_PROPERTY] := MakeCSSRule('css-property',
[MakeCSSDeclaration('color', CSSColor(FCssPropertyColor))]);
Result[CSS_CLASS_CSS_VALUE] := MakeCSSRule('css-value',
[MakeCSSDeclaration('color', CSSColor(FCssValueColor))]);
Result[CSS_CLASS_CSS_COMMENT] := MakeCSSRule('css-comment',
[MakeCSSDeclaration('color', CSSColor(FCssCommentColor))]);
Result[CSS_CLASS_CSS_BLOCK_DELIM] := MakeCSSRule('css-delim',
[MakeCSSDeclaration('color', CSSColor(FCssBlockDelimColor)),
MakeCSSOptionalDeclaration(FCssBlockDelimBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_CSS_IMPORTANT] := MakeCSSRule('css-important',
[MakeCSSDeclaration('color', CSSColor(FCssImportantColor)),
MakeCSSOptionalDeclaration(FCssImportantBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_DOCTYPE] := MakeCSSRule('doctype',
[MakeCSSDeclaration('color', CSSColor(FDoctypeColor)),
MakeCSSOptionalDeclaration(FDoctypeBold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FDoctypeItalics, 'text-style', 'italics')]);
Result[CSS_CLASS_SCRIPT] := MakeCSSRule('script', []);
end;
function THTMLFormattingProcessor.ParseText(AFromLine: Integer;
SingleLinePossibility: Boolean; ANumLines: Integer): Integer;
type
TNibble = type Byte;
const
ALLOC_BY = 16;
var
ToLine: Integer;
ActualLengths: array of Integer;
y, x: Integer;
InTag,
InScript,
InComment: Boolean;
InVal: Char;
InCss: Boolean;
InCssBlock: TNibble;
InCssValue,
InCssImportant,
InCssComment: Boolean;
InCssStr: Char;
InDoctype: Boolean;
Chr: Char;
TagStart: TPoint;
TagName: string;
InAttrib: Boolean;
function GetSignature: Cardinal;
begin
Result := Byte(InTag) or (Byte(InComment) shl 1) or (Ord(InVal) shl 16) or (1 shl 15)
or (Byte(InCss) shl 2) or ((InCssBlock and $F) shl 9) or (Byte(InCssValue) shl 4)
or (Byte(InCssImportant) shl 5) or (Byte(InCssComment) shl 6) or (Byte(InDoctype) shl 7)
or (Byte(InAttrib) shl 8) or (Byte(InScript) shl 3);
end;
procedure ExtractSignature(ASignature: Cardinal; out AInTag,
AInComment, AInScript: Boolean; out AInVal: Char; out AInCss,
AInCssValue, AInCssImportant, AInCssComment: Boolean; out AInCSSStr: Char;
out AInDoctype, AInAttrib: Boolean; out AInCssBlock: TNibble);
begin
AInTag := ASignature and 1 <> 0;
AInComment := ASignature and 2 <> 0;
AInScript := ASignature and 8 <> 0;
AInVal := Char(ASignature shr 16);
AInCss := ASignature and 4 <> 0;
AInCssBlock := (ASignature shr 9) and $F;
AInCssValue := ASignature and 16 <> 0;
AInCssImportant := ASignature and 32 <> 0;
AInCssComment := ASignature and 64 <> 0;
AInCSSStr := Char(ASignature shr 16);
AInDoctype := ASignature and 128 <> 0;
AInAttrib := ASignature and 256 <> 0;
end;
procedure AddToken(AKind: THtmlChrKind; Signature: Boolean = False);
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := AKind;
if Signature then
FTokens[y][ActualLengths[y]].signature := GetSignature
else
FTokens[y][ActualLengths[y]].signature := 0;
Inc(ActualLengths[y]);
end;
function GetLastKind: THtmlChrKind;
var
yp: Integer;
xp: Integer;
begin
for yp := y downto 0 do
for xp := ActualLengths[yp] - 1 downto 0 do
Exit(FTokens[yp][xp].kind);
Result := ckHtmlText;
end;
procedure AddSignature;
begin
if Length(FTokens[y]) = ActualLengths[y] then
SetLength(FTokens[y], Length(FTokens[y]) + ALLOC_BY);
FTokens[y][ActualLengths[y]].x := x;
FTokens[y][ActualLengths[y]].kind := GetLastKind;
FTokens[y][ActualLengths[y]].signature := GetSignature;
Inc(ActualLengths[y]);
end;
function Peek: THtmlChrKind;
var
yp: Integer;
begin
for yp := y downto 0 do
if ActualLengths[yp] > 0 then
Exit(FTokens[yp][ActualLengths[yp] - 1].kind);
Result := ckHtmlUndefined;
end;
function GetLastSignature: Cardinal;
var
yp: Integer;
begin
for yp := AFromLine - 1 downto 0 do
if Length(FTokens[yp]) > 0 then
begin
Assert(FTokens[yp][High(FTokens[yp])].signature and (1 shl 15) <> 0);
Exit(FTokens[yp][High(FTokens[yp])].signature);
end;
Result := 0;
end;
function PeekSignatureForward: Cardinal;
var
yp: Integer;
begin
for yp := y + 1 to High(FTokens) do
if Length(FTokens[yp]) > 0 then
Exit(FTokens[yp][0].signature);
Result := 0;
end;
function PeekIsComment: Boolean;
begin
Result := (TextLineWidth(y) >= x + 4) and
(TextChar(y, x + 1) = '!') and
(TextChar(y, x + 2) = '-') and
(TextChar(y, x + 3) = '-');
end;
function DoesEndComment: Boolean;
begin
Result := (x >= 2) and
(TextChar(y, x - 1) = '-') and
(TextChar(y, x - 2) = '-');
end;
function PeekDoctype: Boolean;
begin
Result := (TextLineWidth(y) >= x + 9) and
(TextChar(y, x + 1) = '!') and
(LowerCase(TextChar(y, x + 2)) = 'd') and
(LowerCase(TextChar(y, x + 3)) = 'o') and
(LowerCase(TextChar(y, x + 4)) = 'c') and
(LowerCase(TextChar(y, x + 5)) = 't') and
(LowerCase(TextChar(y, x + 6)) = 'y') and
(LowerCase(TextChar(y, x + 7)) = 'p') and
(LowerCase(TextChar(y, x + 8)) = 'e');
end;
function CssPeekImportant: Boolean;
begin
Result := (TextLineWidth(y) >= x + 10) and
(TextChar(y, x + 1) = 'i') and
(TextChar(y, x + 2) = 'm') and
(TextChar(y, x + 3) = 'p') and
(TextChar(y, x + 4) = 'o') and
(TextChar(y, x + 5) = 'r') and
(TextChar(y, x + 6) = 't') and
(TextChar(y, x + 7) = 'a') and
(TextChar(y, x + 8) = 'n') and
(TextChar(y, x + 9) = 't');
end;
function PeekStartsTag: Boolean;
begin
Result := (TextLineWidth(y) >= x + 2) and
(TextChar(y, x + 1).IsLetter or (TextChar(y, x + 1) = '/'));
end;
function CssPeekComment: Boolean;
begin
Result := (TextLineWidth(y) >= x + 2) and
(TextChar(y, x + 1) = '*');
end;
function CssEndsComment: Boolean;
begin
Result := (x >= 1) and (TextChar(y, x - 1) = '*');
end;
function PeekStyleEnd: Boolean;
begin
Result := (TextLineWidth(y) >= x + 8) and
(TextChar(y, x + 1) = '/') and
(LowerCase(TextChar(y, x + 2)) = 's') and
(LowerCase(TextChar(y, x + 3)) = 't') and
(LowerCase(TextChar(y, x + 4)) = 'y') and
(LowerCase(TextChar(y, x + 5)) = 'l') and
(LowerCase(TextChar(y, x + 6)) = 'e') and
(TextChar(y, x + 7) = '>');
end;
function PeekScriptEnd: Boolean;
begin
Result := (TextLineWidth(y) >= x + 9) and
(TextChar(y, x + 1) = '/') and
(LowerCase(TextChar(y, x + 2)) = 's') and
(LowerCase(TextChar(y, x + 3)) = 'c') and
(LowerCase(TextChar(y, x + 4)) = 'r') and
(LowerCase(TextChar(y, x + 5)) = 'i') and
(LowerCase(TextChar(y, x + 6)) = 'p') and
(LowerCase(TextChar(y, x + 7)) = 't') and
(TextChar(y, x + 8) = '>');
end;
function GetTagName: string;
var
pnt: TPoint;
begin
pnt := TagStart;
Inc(pnt.X);
Result := TextGetWord(pnt);
end;
begin
if AFromLine = 0 then
begin
InTag := False;
InScript := False;
InComment := False;
InVal := #0;
InCss := False;
InCssBlock := 0;
InCssValue := False;
InCssImportant := False;
InCssComment := False;
InCssStr := #0;
InDoctype := False;
InAttrib := False;
end
else
begin
ExtractSignature(GetLastSignature, InTag, InComment, InScript, InVal, InCss,
InCssValue, InCssImportant, InCssComment, InCssStr, InDoctype,
InAttrib, InCssBlock);
end;
SetLength(FTokens, TextLineCount);
SetLength(ActualLengths, TextLineCount);
ToLine := TextLineCount - 1;
for y := 0 to AFromLine - 1 do
ActualLengths[y] := length(FTokens[y]);
for y := AFromLine to ToLine do
ActualLengths[y] := 0;
for y := AFromLine to ToLine do
begin
for x := 0 to TextLineWidth(y) - 1 do
begin
if x=0 then
AddToken(Peek, True);
Chr := TextChar(y, x);
if InCss then
begin
if InCssStr <> #0 then
begin
if Chr = InCssStr then
InCssStr := #0
end
else if (not InCssComment) and ((Chr = '"') or (Chr = '''')) then
begin
InCssStr := Chr;
if InCssValue and (Peek <> ckHtmlCssValue) then
AddToken(ckHtmlCssValue);
end
else if InCssComment then
begin
if (Chr = '/') and CssEndsComment then
InCssComment := False;
end
else if (Chr = '/') and CssPeekComment then
begin
AddToken(ckHtmlCssComment);
InCssComment := True;
end
else if InCssImportant then
begin
if Chr = ';' then
begin
AddToken(ckHtmlCssValue);
InCssImportant := False;
InCssValue := False;
end;
end
else if InCssValue then
begin
if (Chr = '!') and CssPeekImportant then
begin
AddToken(ckHtmlCssImportant);
InCssImportant := True;
end
else
begin
if Peek <> ckHtmlCssValue then
AddToken(ckHtmlCssValue);
if Chr = ';' then
begin
InCssValue := False;
end
else if Chr = '}' then
begin
AddToken(ckHtmlCssBlockDelim);
InCssValue := False;
Dec(InCssBlock);
end
end;
end
else if InCssBlock > 0 then
begin
if Chr = '{' then
begin
AddToken(ckHtmlCssBlockDelim);
Inc(InCssBlock);
end
else if Chr = '}' then
begin
AddToken(ckHtmlCssBlockDelim);
Dec(InCssBlock);
end
else if Peek <> ckHtmlCssProperty then
AddToken(ckHtmlCssProperty);
if Chr = ':' then
begin
InCssValue := True;
end;
end
else if Chr = '{' then
begin
AddToken(ckHtmlCssBlockDelim);
Inc(InCssBlock);
end
else if (Chr = '<') and PeekStyleEnd then
begin
InCSS := False;
InTag := True;
InAttrib := False;
InVal := #0;
InComment := False;
InDoctype := False;
AddToken(ckHtmlTag);
TagStart := Point(x, y);
end
else if Peek <> ckHtmlCssSelector then
AddToken(ckHtmlCssSelector);
end
else if InScript then
begin
if (Chr = '<') and PeekScriptEnd then
begin
InScript := False;
InTag := True;
InAttrib := False;
InVal := #0;
InComment := False;
InDoctype := False;
AddToken(ckHtmlTag);
TagStart := Point(x, y);
end else if Peek <> ckHtmlScript then
AddToken(ckHtmlScript);
end
else if InComment then
begin
if (Chr = '>') and DoesEndComment then
InComment := False;
end
else if InDoctype then
begin
if Chr = '>' then
InDoctype := False;
end
else if InTag then
begin
if InVal <> #0 then
begin
if Chr = InVal then
InVal := #0;
end
else
begin
if (x=0) or (Chr = #32) and (Peek <> ckHtmlParam) then
begin
InAttrib := True;
AddToken(ckHtmlParam);
end
else if (Chr = '''') or (Chr = '"') then
begin
InVal := Chr;
AddToken(ckHtmlValue);
end
else if Chr = '/' then
begin
if Peek <> ckHtmlTag then
AddToken(ckHtmlTag);
end
else if Chr = '>' then
begin
TagName := GetTagName;
InTag := False;
AddToken(ckHtmlTag);
if SameText(TagName, 'style') then
begin
InCss := True;
InCssBlock := 0;
InCssValue := False;
InCssImportant := False;
InCssComment := False;
InCssStr := #0;
end
else if SameText(TagName, 'script') then
begin
InScript := True;
end
end
else
begin
if InAttrib and (Peek <> ckHtmlParam) then
AddToken(ckHtmlParam)
else if (not InAttrib) and (Peek <> ckHtmlTagName) then
AddToken(ckHtmlTagName);
end;
end;
end
else if (Chr = '<') then
begin
if PeekIsComment then
begin
InComment := True;
AddToken(ckHtmlComment);
end
else if PeekDoctype then
begin
InDoctype := True;
AddToken(ckHtmlDoctype);
end
else if PeekStartsTag then
begin
InTag := True;
InAttrib := False;
AddToken(ckHtmlTag);
TagStart := Point(x, y);
end
end
else if Peek <> ckHtmlText then
AddToken(ckHtmlText);
if x = TextLineWidth(y) - 1 then
AddSignature;
end;
if SingleLinePossibility and (y - AFromLine >= ANumLines - 1) and (GetSignature = PeekSignatureForward) then
begin
ToLine := y;
break;
end;
end;
for y := AFromLine to ToLine do
SetLength(FTokens[y], ActualLengths[y]);
Result := ToLine;
end;
procedure THTMLFormattingProcessor.PushTokensDownFrom(ALineIndex: Integer);
var
i: Integer;
begin
SetLength(FTokens, Length(FTokens) + 1);
for i := High(FTokens) downto ALineIndex + 1 do
FTokens[i] := Copy(FTokens[i - 1]);
end;
procedure THTMLFormattingProcessor.PushTokensUpFrom(ALineIndex: Integer);
var
i: Integer;
begin
for i := ALineIndex + 1 to High(FTokens) - 1 do
FTokens[i] := Copy(FTokens[i + 1]);
SetLength(FTokens, Length(FTokens) - 1);
end;
procedure THTMLFormattingProcessor.SetCommentColor(const Value: TColor);
begin
if FCommentColor <> Value then
begin
CommentColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssBlockDelimBold(const Value: Boolean);
begin
if FCssBlockDelimBold <> Value then
begin
FCssBlockDelimBold := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssBlockDelimColor(const Value: TColor);
begin
if FCssBlockDelimColor <> Value then
begin
FCssBlockDelimColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssCommentColor(const Value: TColor);
begin
if FCssCommentColor <> Value then
begin
FCssCommentColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssImportantBold(const Value: Boolean);
begin
if FCssImportantBold <> Value then
begin
FCssImportantBold := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssImportantColor(const Value: TColor);
begin
if FCssImportantColor <> Value then
begin
FCssImportantColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssPropertyColor(const Value: TColor);
begin
if FCssPropertyColor <> Value then
begin
FCssPropertyColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssSelectorBold(const Value: Boolean);
begin
if FCssSelectorBold <> Value then
begin
FCssSelectorBold := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssSelectorColor(const Value: TColor);
begin
if FCssSelectorColor <> Value then
begin
FCssSelectorColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetCssValueColor(const Value: TColor);
begin
if FCssValueColor <> Value then
begin
FCssValueColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetDoctypeBold(const Value: Boolean);
begin
if FDoctypeBold <> Value then
begin
FDoctypeBold := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetDoctypeColor(const Value: TColor);
begin
if FDoctypeColor <> Value then
begin
FDoctypeColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetDoctypeItalics(const Value: Boolean);
begin
if FDoctypeItalics <> Value then
begin
FDoctypeItalics := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetParamColor(const Value: TColor);
begin
if FParamColor <> Value then
begin
FParamColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetTagColor(const Value: TColor);
begin
if FTagColor <> Value then
begin
FTagColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetTagNameBold(const Value: Boolean);
begin
if FTagNameBold <> Value then
begin
FTagNameBold := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetTagNameColor(const Value: TColor);
begin
if FTagNameColor <> Value then
begin
FTagNameColor := Value;
Changed;
end;
end;
procedure THTMLFormattingProcessor.SetValueColor(const Value: TColor);
begin
if FValueColor <> Value then
begin
FValueColor := Value;
Changed
end;
end;
procedure TMediaWikiFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FHeading1Color := AColorScheme.Accent1;
FHeading2Color := AColorScheme.Accent1;
FHeading3Color := AColorScheme.Accent1;
FHeading4Color := AColorScheme.Accent1;
FHeading5Color := AColorScheme.Soft;
FHeading6Color := AColorScheme.Soft;
FWikilinkColor := AColorScheme.Accent3;
FExtlinkColor := AColorScheme.Accent3;
FTemplateColor := AColorScheme.Accent2;
FIndentColor := AColorScheme.Soft;
Changed;
end;
procedure TMediaWikiFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TMediaWikiFormattingProcessor then
begin
FHeading1Color := TMediaWikiFormattingProcessor(Source).Heading1Color;
FHeading1Bold := TMediaWikiFormattingProcessor(Source).Heading1Bold;
FHeading1Italics := TMediaWikiFormattingProcessor(Source).Heading1Italics;
FHeading2Color := TMediaWikiFormattingProcessor(Source).Heading2Color;
FHeading2Bold := TMediaWikiFormattingProcessor(Source).Heading2Bold;
FHeading2Italics := TMediaWikiFormattingProcessor(Source).Heading2Italics;
FHeading3Color := TMediaWikiFormattingProcessor(Source).Heading3Color;
FHeading3Bold := TMediaWikiFormattingProcessor(Source).Heading3Bold;
FHeading3Italics := TMediaWikiFormattingProcessor(Source).Heading3Italics;
FHeading4Color := TMediaWikiFormattingProcessor(Source).Heading4Color;
FHeading4Bold := TMediaWikiFormattingProcessor(Source).Heading4Bold;
FHeading4Italics := TMediaWikiFormattingProcessor(Source).Heading4Italics;
FHeading5Color := TMediaWikiFormattingProcessor(Source).Heading5Color;
FHeading5Bold := TMediaWikiFormattingProcessor(Source).Heading5Bold;
FHeading5Italics := TMediaWikiFormattingProcessor(Source).Heading5Italics;
FHeading6Color := TMediaWikiFormattingProcessor(Source).Heading6Color;
FHeading6Bold := TMediaWikiFormattingProcessor(Source).Heading6Bold;
FHeading6Italics := TMediaWikiFormattingProcessor(Source).Heading6Italics;
FWikilinkColor := TMediaWikiFormattingProcessor(Source).WikilinkColor;
FExtlinkColor := TMediaWikiFormattingProcessor(Source).ExtlinkColor;
FTemplateColor := TMediaWikiFormattingProcessor(Source).TemplateColor;
FTemplateNameBold := TMediaWikiFormattingProcessor(Source).TemplateNameBold;
FBoldBold := TMediaWikiFormattingProcessor(Source).BoldBold;
FItalicsItalics := TMediaWikiFormattingProcessor(Source).ItalicsItalics;
FIndentColor := TMediaWikiFormattingProcessor(Source).IndentColor;
Changed;
end
else
inherited;
end;
constructor TMediaWikiFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FHeading1Color := DEFAULT_HEADING1_COLOR;
FHeading1Bold := DEFAULT_HEADING1_BOLD;
FHeading1Italics := DEFAULT_HEADING1_ITALICS;
FHeading2Color := DEFAULT_HEADING2_COLOR;
FHeading2Bold := DEFAULT_HEADING2_BOLD;
FHeading2Italics := DEFAULT_HEADING2_ITALICS;
FHeading3Color := DEFAULT_HEADING3_COLOR;
FHeading3Bold := DEFAULT_HEADING3_BOLD;
FHeading3Italics := DEFAULT_HEADING3_ITALICS;
FHeading4Color := DEFAULT_HEADING4_COLOR;
FHeading4Bold := DEFAULT_HEADING4_BOLD;
FHeading4Italics := DEFAULT_HEADING4_ITALICS;
FHeading5Color := DEFAULT_HEADING5_COLOR;
FHeading5Bold := DEFAULT_HEADING5_BOLD;
FHeading5Italics := DEFAULT_HEADING5_ITALICS;
FHeading6Color := DEFAULT_HEADING6_COLOR;
FHeading6Bold := DEFAULT_HEADING6_BOLD;
FHeading6Italics := DEFAULT_HEADING6_ITALICS;
FWikilinkColor := DEFAULT_WIKILINK_COLOR;
FExtlinkColor := DEFAULT_EXTLINK_COLOR;
FTemplateColor := DEFAULT_TEMPLATE_COLOR;
FTemplateNameBold := DEFAULT_TEMPLATE_NAME_BOLD;
FBoldBold := DEFAULT_BOLD_BOLD;
FItalicsItalics := DEFAULT_ITALICS_ITALICS;
FIndentColor := DEFAULT_INDENT_COLOR;
end;
function TMediaWikiFormattingProcessor.FileChangeNotification(
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
inherited;
case ChangeType of
ctNone: ;
ctFile:
Result.ChangeType := ctFile;
ctLineRange:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctBlock:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := Data2;
end;
ctLine:
begin
Result.ChangeType := ctLine;
Result.Data1 := Data1;
end;
ctLineFrom:
begin
Result.ChangeType := ctLine;
Result.Data1 := Data1;
end;
ctChar:
begin
Result.ChangeType := ctLine;
Result.Data1 := Data1;
end;
ctTwoChars:
begin
Result.ChangeType := ctLineRange;
Result.Data1 := min(Data1, Data3);
Result.Data2 := max(Data1, Data3);
end;
ctPostFile: ;
end;
end;
function TMediaWikiFormattingProcessor.GetCharCSSClass(ALineIndex,
ACol: Integer; AChar: Char): Integer;
var
i: Integer;
TLW: Integer;
InIndent: Boolean;
InTemplate,
InWikilink: Integer;
InName,
PastSep,
InExtLink,
InBold,
InItalics: Boolean;
RunDecTemplate,
RunDecWikilink: Boolean;
function PeekTemplateStart: Boolean;
begin
Result := (TextChar(ALineIndex, i) = '{') and (i < TLW - 1) and
(TextChar(ALineIndex, i + 1) = '{');
end;
function PeekTemplateEnd: Boolean;
begin
Result := (TextChar(ALineIndex, i) = '}') and (i < TLW - 1) and
(TextChar(ALineIndex, i + 1) = '}');
end;
function PeekWikilinkStart: Boolean;
begin
Result := (TextChar(ALineIndex, i) = '[') and (i < TLW - 1) and
(TextChar(ALineIndex, i + 1) = '[');
end;
function PeekWikilinkEnd: Boolean;
begin
Result := (TextChar(ALineIndex, i) = ']') and (i < TLW - 1) and
(TextChar(ALineIndex, i + 1) = ']');
end;
function ExtlinkEnded: Boolean;
begin
Result := (i >= 1) and (TextChar(ALineIndex, i - 1) = ']');
end;
function PeekBold: Boolean;
begin
Result := (TextChar(ALineIndex, i) = '''') and (i < TLW - 2) and
(TextChar(ALineIndex, i + 1) = '''') and (TextChar(ALineIndex, i + 2) = '''');
end;
function PeekItalics: Boolean;
begin
Result := (TextChar(ALineIndex, i) = '''') and (i < TLW - 1) and
(TextChar(ALineIndex, i + 1) = '''');
end;
function GetStyleHighBits: Cardinal;
begin
if InBold and InItalics then
Result := CSS_CLASS_BOLDITALICS shl 16
else if InBold then
Result := CSS_CLASS_BOLD shl 16
else if InItalics then
Result := CSS_CLASS_ITALICS shl 16
else
Result := 0;
end;
begin
TLW := TextLineWidth(ALineIndex);
if (TLW >= 1) and (TextChar(ALineIndex, 0) = ';') then
Exit(CSS_CLASS_BOLD);
if (TLW >= 1) and (TextChar(ALineIndex, 0) = '=') then
if (TLW >= 2) and (TextChar(ALineIndex, 1) = '=') then
if (TLW >= 3) and (TextChar(ALineIndex, 2) = '=') then
if (TLW >= 4) and (TextChar(ALineIndex, 3) = '=') then
if (TLW >= 5) and (TextChar(ALineIndex, 4) = '=') then
if (TLW >= 6) and (TextChar(ALineIndex, 5) = '=') then
Exit(CSS_CLASS_HEADING6)
else
Exit(CSS_CLASS_HEADING5)
else
Exit(CSS_CLASS_HEADING4)
else
Exit(CSS_CLASS_HEADING3)
else
Exit(CSS_CLASS_HEADING2)
else
Exit(CSS_CLASS_HEADING1);
if AChar = ':' then
begin
InIndent := True;
for i := 0 to ACol - 1 do
if TextChar(ALineIndex, i) <> ':' then
begin
InIndent := False;
break;
end;
if InIndent then
Exit(CSS_CLASS_INDENT);
end;
InTemplate := 0;
InName := False;
PastSep := False;
InWikiLink := 0;
InExtLink := False;
InBold := False;
InItalics := False;
RunDecTemplate := False;
RunDecWikilink := False;
i := 0;
while i <= ACol do
begin
if RunDecTemplate then
begin
Dec(InTemplate);
RunDecTemplate := False;
end;
if RunDecWikilink then
begin
Dec(InWikilink);
RunDecWikilink := False;
end;
if PeekTemplateStart then
begin
Inc(InTemplate);
Inc(i);
InName := False;
PastSep := False;
end
else
begin
if (InTemplate > 0) and PeekTemplateEnd then
begin
RunDecTemplate := True;
Inc(i);
end;
if InTemplate > 0 then
begin
if TextChar(ALineIndex, i) = '|' then
begin
InName := False;
PastSep := True;
end
else if (not PastSep) and (TextChar(ALineIndex, i) <> '{') then
InName := True;
if TextChar(ALineIndex, i) = '}' then
InName := False;
end
else
begin
if PeekWikilinkStart then
begin
Inc(InWikilink);
Inc(i);
end
else if (InWikilink > 0) and PeekWikilinkEnd then
begin
RunDecWikilink := True;
Inc(i);
end
else if InExtlink and ExtlinkEnded then
InExtlink := False
else if (TextChar(ALineIndex, i) = '[') then
InExtlink := True
else if PeekBold then
begin
InBold := not InBold;
Inc(i, 2);
end
else if PeekItalics then
begin
InItalics := not InItalics;
Inc(i);
end;
end;
end;
Inc(i);
end;
if (InTemplate > 0) and InName then
Result := CSS_CLASS_TEMPLATE_NAME
else if (InTemplate > 0) then
Result := CSS_CLASS_TEMPLATE
else if (InWikiLink > 0) then
Result := CSS_CLASS_WIKILINK or GetStyleHighBits
else if InExtLink then
Result := CSS_CLASS_EXTLINK
else if InBold and InItalics then
Result := CSS_CLASS_BOLDITALICS
else if InBold then
Result := CSS_CLASS_BOLD
else if InItalics then
Result := CSS_CLASS_ITALICS
else
Result := CSS_CLASS_TEXT;
end;
procedure TMediaWikiFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetCharCSSClass(ALineIndex, ACol, AChar) of
CSS_CLASS_TEXT: ;
CSS_CLASS_HEADING1:
begin
AFontRecord.Color := FHeading1Color;
if FHeading1Bold then
Include(AFontRecord.Style, fsBold);
if FHeading1Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_HEADING2:
begin
AFontRecord.Color := FHeading2Color;
if FHeading2Bold then
Include(AFontRecord.Style, fsBold);
if FHeading2Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_HEADING3:
begin
AFontRecord.Color := FHeading3Color;
if FHeading3Bold then
Include(AFontRecord.Style, fsBold);
if FHeading3Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_HEADING4:
begin
AFontRecord.Color := FHeading4Color;
if FHeading4Bold then
Include(AFontRecord.Style, fsBold);
if FHeading4Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_HEADING5:
begin
AFontRecord.Color := FHeading5Color;
if FHeading5Bold then
Include(AFontRecord.Style, fsBold);
if FHeading5Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_HEADING6:
begin
AFontRecord.Color := FHeading6Color;
if FHeading6Bold then
Include(AFontRecord.Style, fsBold);
if FHeading6Italics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_WIKILINK:
AFontRecord.Color := FWikilinkColor;
CSS_CLASS_WIKILINK or (CSS_CLASS_BOLD shl 16):
begin
AFontRecord.Color := FWikilinkColor;
if FBoldBold then
Include(AFontRecord.Style, fsBold);
end;
CSS_CLASS_WIKILINK or (CSS_CLASS_ITALICS shl 16):
begin
AFontRecord.Color := FWikilinkColor;
if FItalicsItalics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_WIKILINK or (CSS_CLASS_BOLDITALICS shl 16):
begin
AFontRecord.Color := FWikilinkColor;
if FBoldBold then
Include(AFontRecord.Style, fsBold);
if FItalicsItalics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_EXTLINK:
AFontRecord.Color := FExtlinkColor;
CSS_CLASS_TEMPLATE_NAME:
begin
AFontRecord.Color := FTemplateColor;
if FTemplateNameBold then
Include(AFontRecord.Style, fsBold);
end;
CSS_CLASS_TEMPLATE:
AFontRecord.Color := FTemplateColor;
CSS_CLASS_BOLD:
if FBoldBold then
Include(AFontRecord.Style, fsBold);
CSS_CLASS_ITALICS:
if FItalicsItalics then
Include(AFontRecord.Style, fsItalic);
CSS_CLASS_BOLDITALICS:
begin
if FBoldBold then
Include(AFontRecord.Style, fsBold);
if FItalicsItalics then
Include(AFontRecord.Style, fsItalic);
end;
CSS_CLASS_INDENT:
AFontRecord.Color := FIndentColor;
end;
end;
function TMediaWikiFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_TEXT] := MakeCSSRule('text', []);
Result[CSS_CLASS_HEADING1] := MakeCSSRule('heading1',
[MakeCSSDeclaration('color', CSSColor(FHeading1Color)),
MakeCSSOptionalDeclaration(FHeading1Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading1Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_HEADING2] := MakeCSSRule('heading2',
[MakeCSSDeclaration('color', CSSColor(FHeading2Color)),
MakeCSSOptionalDeclaration(FHeading2Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading2Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_HEADING3] := MakeCSSRule('heading3',
[MakeCSSDeclaration('color', CSSColor(FHeading3Color)),
MakeCSSOptionalDeclaration(FHeading3Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading3Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_HEADING4] := MakeCSSRule('heading4',
[MakeCSSDeclaration('color', CSSColor(FHeading4Color)),
MakeCSSOptionalDeclaration(FHeading4Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading4Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_HEADING5] := MakeCSSRule('heading5',
[MakeCSSDeclaration('color', CSSColor(FHeading5Color)),
MakeCSSOptionalDeclaration(FHeading5Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading5Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_HEADING6] := MakeCSSRule('heading6',
[MakeCSSDeclaration('color', CSSColor(FHeading6Color)),
MakeCSSOptionalDeclaration(FHeading6Bold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FHeading6Italics, 'font-style', 'italic')]);
Result[CSS_CLASS_WIKILINK] := MakeCSSRule('wikilink',
[MakeCSSDeclaration('color', CSSColor(FWikilinkColor))]);
Result[CSS_CLASS_EXTLINK] := MakeCSSRule('extlink',
[MakeCSSDeclaration('color', CSSColor(FExtlinkColor))]);
Result[CSS_CLASS_TEMPLATE_NAME] := MakeCSSRule('template-name',
[MakeCSSDeclaration('color', CSSColor(FTemplateColor)),
MakeCSSOptionalDeclaration(FTemplateNameBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_TEMPLATE] := MakeCSSRule('template',
[MakeCSSDeclaration('color', CSSColor(FTemplateColor))]);
Result[CSS_CLASS_BOLD] := MakeCSSRule('bold',
[MakeCSSOptionalDeclaration(FBoldBold, 'font-weight', 'bold')]);
Result[CSS_CLASS_ITALICS] := MakeCSSRule('italics',
[MakeCSSOptionalDeclaration(FItalicsItalics, 'font-style', 'italic')]);
Result[CSS_CLASS_BOLDITALICS] := MakeCSSRule('bold-italic',
[MakeCSSOptionalDeclaration(FBoldBold, 'font-weight', 'bold'),
MakeCSSOptionalDeclaration(FItalicsItalics, 'font-style', 'italic')]);
Result[CSS_CLASS_INDENT] := MakeCSSRule('indent',
[MakeCSSDeclaration('color', CSSColor(FIndentColor))]);
end;
procedure TMediaWikiFormattingProcessor.SetBoldBold(const Value: Boolean);
begin
if FBoldBold <> Value then
begin
FBoldBold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetExtlinkColor(const Value: TColor);
begin
if FExtlinkColor <> Value then
begin
FExtlinkColor := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading1Bold(const Value: Boolean);
begin
if FHeading1Bold <> Value then
begin
FHeading1Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading1Color(const Value: TColor);
begin
if FHeading1Color <> Value then
begin
FHeading1Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading1Italics(
const Value: Boolean);
begin
if FHeading1Italics <> Value then
begin
FHeading1Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading2Bold(const Value: Boolean);
begin
if FHeading2Bold <> Value then
begin
FHeading2Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading2Color(const Value: TColor);
begin
if FHeading2Color <> Value then
begin
FHeading2Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading2Italics(
const Value: Boolean);
begin
if FHeading2Italics <> Value then
begin
FHeading2Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading3Bold(const Value: Boolean);
begin
if FHeading3Bold <> Value then
begin
FHeading3Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading3Color(const Value: TColor);
begin
if FHeading3Color <> Value then
begin
FHeading3Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading3Italics(
const Value: Boolean);
begin
if FHeading3Italics <> Value then
begin
FHeading3Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading4Bold(const Value: Boolean);
begin
if FHeading4Bold <> Value then
begin
FHeading4Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading4Color(const Value: TColor);
begin
if FHeading4Color <> Value then
begin
FHeading4Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading4Italics(
const Value: Boolean);
begin
if FHeading4Italics <> Value then
begin
FHeading4Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading5Bold(const Value: Boolean);
begin
if FHeading5Bold <> Value then
begin
FHeading5Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading5Color(const Value: TColor);
begin
if FHeading5Color <> Value then
begin
FHeading5Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading5Italics(
const Value: Boolean);
begin
if FHeading5Italics <> Value then
begin
FHeading5Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading6Bold(const Value: Boolean);
begin
if FHeading6Bold <> Value then
begin
FHeading6Bold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading6Color(const Value: TColor);
begin
if FHeading6Color <> Value then
begin
FHeading6Color := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetHeading6Italics(
const Value: Boolean);
begin
if FHeading6Italics <> Value then
begin
FHeading6Italics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetIndentColor(const Value: TColor);
begin
if FIndentColor <> Value then
begin
FIndentColor := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetItalicsItalics(const Value: Boolean);
begin
if FItalicsItalics <> Value then
begin
FItalicsItalics := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetTemplateColor(const Value: TColor);
begin
if FTemplateColor <> Value then
begin
FTemplateColor := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetTemplateNameBold(
const Value: Boolean);
begin
if FTemplateNameBold <> Value then
begin
FTemplateNameBold := Value;
Changed;
end;
end;
procedure TMediaWikiFormattingProcessor.SetWikilinkColor(const Value: TColor);
begin
if FWikilinkColor <> Value then
begin
FWikilinkColor := Value;
Changed;
end;
end;
procedure TPrintSettings.Assign(Source: TPersistent);
begin
if Source is TPrintSettings then
begin
FVerticalMargin := TPrintSettings(Source).VerticalMargin;
FHorizontalMargin := TPrintSettings(Source).HorizontalMargin;
FWordWrap := TPrintSettings(Source).WordWrap;
FNiceWordWrap := TPrintSettings(Source).NiceWordWrap;
FWordWrapChar := TPrintSettings(Source).WordWrapIcon;
FShowWordWrapIcon := TPrintSettings(Source).ShowWordWrapIcon;
FWordWrapIconColor := TPrintSettings(Source).WordWrapIconColor;
end
else
inherited;
end;
constructor TPrintSettings.Create;
begin
FVerticalMargin := DEFAULT_VERTICAL_MARGIN;
FHorizontalMargin := DEFAULT_HORIZONTAL_MARGIN;
FWordWrap := DEFAULT_WORD_WRAP;
FNiceWordWrap := DEFAULT_NICE_WORD_WRAP;
FWordWrapChar := DEFAULT_WORD_WRAP_CHAR;
FShowWordWrapIcon := DEFAULT_SHOW_WORD_WRAP_ICON;
FWordWrapIconColor := DEFAULT_WORD_WRAP_ICON_COLOR;
end;
constructor TEditorState.Create;
begin
FRulerVisible := True;
FZoomLevel := 100;
end;
destructor TEditorState.Destroy;
begin
if Assigned(FFPCache) then
begin
FreeMem(FFPCache);
FFPCache := nil;
end;
inherited;
end;
function EnumFontFamExProc(LF: PLogFont; TM: PTextMetric; FontType: DWORD;
lParam: LPARAM): Integer; stdcall;
begin
if ((LF.lfPitchAndFamily and 3) = FIXED_PITCH) and (LF.lfFaceName[0] <> '@') then
if FixedWidthFonts.IndexOf(LF.lfFaceName) = -1 then
FixedWidthFonts.Add(LF.lfFaceName);
Result := 1;
end;
var
LF: TLogFont;
class constructor TTextEditorDataObject.ClassCreate;
begin
Formats := [FORMATETC_UNICODETEXT];
end;
constructor TTextEditorDataObject.Create(AEditor: TTextEditor);
begin
FTextEditor := AEditor;
FBuffer := FTextEditor.SelText;
end;
class function TTextEditorDataObject.CreateHGlobal(Data: pointer; Len: UInt64;
uFlags: DWORD; out hGlobal: HGLOBAL): HRESULT;
var
p: pointer;
begin
hGlobal := GlobalAlloc(uFlags, Len);
if hGlobal <> 0 then
begin
p := GlobalLock(hGlobal);
if Assigned(p) then
begin
CopyMemory(p, Data, Len);
GlobalUnlock(hGlobal);
end
else
begin
GlobalFree(hGlobal);
hGlobal := 0;
end;
end;
Result := IfThen(hGlobal <> 0, S_OK, E_OUTOFMEMORY);
end;
function TTextEditorDataObject.DAdvise(const formatetc: tagFORMATETC;
advf: Integer; const advSink: IAdviseSink;
out dwConnection: Integer): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TTextEditorDataObject.DUnadvise(dwConnection: Integer): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TTextEditorDataObject.EnumDAdvise(
out enumAdvise: IEnumSTATDATA): HRESULT;
begin
Result := OLE_E_ADVISENOTSUPPORTED;
end;
function TTextEditorDataObject.EnumFormatEtc(dwDirection: Integer;
out enumFormatEtc: IEnumFORMATETC): HRESULT;
begin
if dwDirection = DATADIR_GET then
begin
enumFormatEtc := TEnumFormatEtc.Create;
Result := S_OK;
end
else
begin
enumFormatEtc := nil;
Result := E_NOTIMPL;
end;
end;
function TTextEditorDataObject.GetCanonicalFormatEtc(
const formatetc: tagFORMATETC; out formatetcOut: tagFORMATETC): HRESULT;
begin
formatetcOut := formatetc;
formatetcOut.ptd := nil;
Result := DATA_S_SAMEFORMATETC;
end;
function TTextEditorDataObject.GetData(const formatetcIn: tagFORMATETC;
out medium: tagSTGMEDIUM): HRESULT;
const
nullchr: Char = #0;
begin
FillChar(medium, sizeof(medium), 0);
case GetMatchingFormatIdx(formatetcIn) of
FMT_UNICODETEXT:
begin
medium.tymed := TYMED_HGLOBAL;
if FBuffer.IsEmpty then
Result := CreateHGlobal(@nullchr, sizeof(nullchr),
GMEM_MOVEABLE, medium.hGlobal)
else
Result := CreateHGlobal(PChar(FBuffer), (FBuffer.Length + 1) * sizeof(Char),
GMEM_MOVEABLE, medium.hGlobal);
end;
else
Result := DV_E_FORMATETC;
end;
end;
function TTextEditorDataObject.GetDataHere(const formatetc: tagFORMATETC;
out medium: tagSTGMEDIUM): HRESULT;
begin
Result := E_NOTIMPL;
end;
function TTextEditorDataObject.GetMatchingFormatIdx(
const AFormatEtc: TFormatEtc): Integer;
var
i: Integer;
begin
for i := 0 to High(Formats) do
if
(Formats[i].cfFormat = AFormatEtc.cfFormat)
and
((Formats[i].tymed and AFormatEtc.tymed) <> 0)
and
(Formats[i].dwAspect = AFormatEtc.dwAspect)
and
(Formats[i].lindex = AFormatEtc.lindex)
then
Exit(i);
Result := -1;
end;
function TTextEditorDataObject.QueryGetData(
const formatetc: tagFORMATETC): HRESULT;
begin
Result := IfThen(GetMatchingFormatIdx(formatetc) <> -1, S_OK, S_FALSE);
end;
function TTextEditorDataObject.SetData(const formatetc: tagFORMATETC;
var medium: tagSTGMEDIUM; fRelease: LongBool): HRESULT;
begin
Result := E_NOTIMPL;
end;
class operator TTextFile.TFixedString.Implicit(const S: TFixedString): string;
begin
Result := string(S.Data);
end;
class operator TTextFile.TFixedString.Implicit(const S: string): TFixedString;
begin
if S.Length > MAXLEN then
raise Exception.Create('String too long for fixed string.');
FillChar(Result, sizeof(Result), 0);
if not S.IsEmpty then
Move(S[1], Result.Data[0], S.Length * sizeof(Char));
end;
function TTextEditorDataObject.TEnumFormatEtc.Clone(
out Enum: IEnumFormatEtc): HResult;
begin
try
Enum := TEnumFormatEtc.Create;
TEnumFormatEtc(Enum).FIndex := Self.FIndex;
Result := S_OK;
except
Result := E_UNEXPECTED;
end;
end;
function TTextEditorDataObject.TEnumFormatEtc.Next(celt: Longint; out elt;
pceltFetched: PLongint): HResult;
var
count: Integer;
p: PFormatEtc;
begin
if (celt <= 0) or ((celt > 1) and (pceltFetched = nil)) then
Exit(E_INVALIDARG);
count := 0;
p := @elt;
while (FIndex <= High(Formats)) and (count < celt) do
begin
p^ := Formats[FIndex];
Inc(p);
Inc(count);
Inc(FIndex);
end;
if Assigned(pceltFetched) then
pceltFetched^ := count;
Result := IfThen(count = celt, S_OK, S_FALSE);
end;
function TTextEditorDataObject.TEnumFormatEtc.Reset: HResult;
begin
FIndex := 0;
Result := S_OK;
end;
function TTextEditorDataObject.TEnumFormatEtc.Skip(celt: Longint): HResult;
begin
if FIndex + celt <= High(Formats) then
begin
Inc(FIndex, celt);
Result := S_OK;
end
else
Result := S_FALSE;
end;
procedure TFileStatistics.Clear;
begin
Flags := [];
NumLines := 0;
NumChars := 0;
NumLetters := 0;
NumDigits := 0;
NumWhitespace := 0;
NumPunctuation := 0;
MaxLineLength := 0;
AvgLineLength := 0;
LineLengthDistr := nil;
NumWords := 0;
MaxWordLength := 0;
AvgWordLength := 0;
WordLengthDistr := nil;
end;
constructor TWordFreqItem.Create(AInNaturalCase: string; AIsLower: Boolean;
ACount: Int64);
begin
Self.InNaturalCase := AInNaturalCase;
Self.Count := ACount;
Self.IsLower := AIsLower;
end;
procedure TBracketListFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FBracketColor := AColorScheme.Soft;
Changed;
end;
procedure TBracketListFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TBracketListFormattingProcessor then
begin
FBracketColor := TBracketListFormattingProcessor(Source).BracketColor;
Changed;
end
else
inherited;
end;
constructor TBracketListFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FBracketColor := DEFAULT_BRACKET_COLOR;
end;
function TBracketListFormattingProcessor.GetCharCSSClass(ALineIndex,
ACol: Integer; AChar: Char): Integer;
begin
if InBracket(ALineIndex, ACol) then
Result := CSS_CLASS_BRACKET
else
Result := CSS_CLASS_TEXT;
end;
procedure TBracketListFormattingProcessor.GetCharFormat(ALineIndex,
ACol: Integer; AChar: Char; var AFontRecord: TFontRecord);
begin
if InBracket(ALineIndex, ACol) then
AFontRecord.Color := FBracketColor;
end;
function TBracketListFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_BRACKET] := MakeCSSRule('bracket',
[MakeCSSDeclaration('color', CSSColor(FBracketColor))]);
end;
function TBracketListFormattingProcessor.InBracket(ALineIndex,
ACol: Integer): Boolean;
var
i, l: Integer;
begin
if TextChar(ALineIndex, ACol).IsInArray(['(', ')', '[', ']', '{', '}']) then
Exit(True);
l := 0;
for i := 0 to Min(ACol, TextLineWidth(ALineIndex) - 1) do
case TextChar(ALineIndex, i) of
'(', '[', '{': Inc(l);
')', ']', '}': Dec(l);
end;
Result := l > 0;
end;
procedure TBracketListFormattingProcessor.SetBracketColor(const Value: TColor);
begin
if FBracketColor <> Value then
begin
FBracketColor := Value;
Changed;
end;
end;
constructor THyperlink.Create(const ALocation: TPoint; AEndPos: Integer;
const ACaption, AURL: string);
begin
Location := ALocation;
EndPos := AEndPos;
Caption := ACaption;
ExplicitURL := AURL;
end;
function THyperlink.ToRecord: TLinkRec;
begin
Result.Location := Location;
Result.EndPos := EndPos;
Result.Caption := Caption;
Result.URL := URL;
end;
function THyperlink.URL: string;
begin
if not ExplicitURL.IsEmpty then
Result := ExplicitURL
else
Result := Caption;
end;
procedure TASRefFormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FHeadingColor := AColorScheme.Accent1;
FLinkColor := clBlue;
FCodeColor := AColorScheme.Soft;
Changed;
end;
procedure TASRefFormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TASRefFormattingProcessor then
begin
FHeadingColor := TASRefFormattingProcessor(Source).HeadingColor;
FLinkColor := TASRefFormattingProcessor(Source).LinkColor;
FCodeColor := TASRefFormattingProcessor(Source).CodeColor;
Changed;
end
else
inherited;
end;
constructor TASRefFormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FHeadingColor := DEFAULT_HEADING_COLOR;
FLinkColor := DEFAULT_LINK_COLOR;
FCodeColor := DEFAULT_CODE_COLOR;
end;
function TASRefFormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
var
w, i: Integer;
InCode, InLink: Boolean;
begin
w := TextLineWidth(ALineIndex);
Result := CSS_CLASS_TEXT;
if w = 0 then
Exit;
case TextChar(ALineIndex, 0) of
'§':
if (w > 1) and (TextChar(ALineIndex, 1) = '§') then
Exit(CSS_CLASS_HEADINGn)
else
Exit(CSS_CLASS_HEADING1);
'>':
if (w > 1) and (TextChar(ALineIndex, 1) = '>') then
Exit(CSS_CLASS_DELIMITER)
else
Exit(CSS_CLASS_INPUT);
'<':
if (w > 1) and (TextChar(ALineIndex, 1) = '<') then
Exit(CSS_CLASS_DELIMITER)
else
Exit(CSS_CLASS_OUTPUT);
'!':
Exit(CSS_CLASS_FAILURE);
end;
InCode := False;
InLink := False;
i := 0;
while i < Min(ACol, w) do
begin
case TextChar(ALineIndex, i) of
'`':
begin
if (Succ(i) < w) and (TextChar(ALineIndex, Succ(i)) = '`') then
begin
Inc(i, 2);
Continue;
end
else
InCode := not InCode;
end;
'‹':
InLink := True;
'›':
InLink := False;
end;
Inc(i);
end;
if (AChar = '`') or (AChar = '‹') or (AChar = '›') or (AChar = '|') and InLink then
Exit(CSS_CLASS_DELIMITER);
if InLink then
Exit(CSS_CLASS_LINK);
if InCode then
Exit(CSS_CLASS_CODE);
end;
procedure TASRefFormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetCharCSSClass(ALineIndex, ACol, AChar) of
CSS_CLASS_LINK:
AFontRecord.Color := FLinkColor;
CSS_CLASS_CODE:
AFontRecord.Color := FCodeColor;
CSS_CLASS_INPUT:
AFontRecord.Style := [fsBold];
CSS_CLASS_FAILURE:
AFontRecord.Color := clRed;
CSS_CLASS_HEADING1:
begin
AFontRecord.Color := FHeadingColor;
AFontRecord.Style := [fsBold];
end;
CSS_CLASS_HEADINGn:
AFontRecord.Color := FHeadingColor;
CSS_CLASS_DELIMITER:
AFontRecord.Color := FCodeColor;
end;
end;
function TASRefFormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_TEXT] := MakeCSSRule('text', []);
Result[CSS_CLASS_LINK] := MakeCSSRule('link',
[MakeCSSDeclaration('color', CSSColor(FLinkColor))]);
Result[CSS_CLASS_CODE] := MakeCSSRule('code',
[MakeCSSDeclaration('color', CSSColor(FCodeColor))]);
Result[CSS_CLASS_INPUT] := MakeCSSRule('input',
[MakeCSSDeclaration('font-weight', 'bold')]);
Result[CSS_CLASS_OUTPUT] := MakeCSSRule('output', []);
Result[CSS_CLASS_FAILURE] := MakeCSSRule('failure',
[MakeCSSDeclaration('color', 'red')]);
Result[CSS_CLASS_HEADING1] := MakeCSSRule('MainHeading',
[MakeCSSDeclaration('font-weight', 'bold'),
MakeCSSDeclaration('color', CSSColor(FHeadingColor))]);
Result[CSS_CLASS_HEADINGn] := MakeCSSRule('subheading',
[MakeCSSDeclaration('color', CSSColor(FHeadingColor))]);
end;
procedure TASRefFormattingProcessor.SetCodeColor(const Value: TColor);
begin
if FCodeColor <> Value then
begin
FCodeColor := Value;
Changed;
end;
end;
procedure TASRefFormattingProcessor.SetHeadingColor(const Value: TColor);
begin
if FHeadingColor <> Value then
begin
FHeadingColor := Value;
Changed;
end;
end;
procedure TASRefFormattingProcessor.SetLinkColor(const Value: TColor);
begin
if FLinkColor <> Value then
begin
FLinkColor := Value;
Changed;
end;
end;
procedure TAlgosim3FormattingProcessor.ApplyColorScheme(
const AColorScheme: TColorScheme);
begin
FNumberColor := AColorScheme.Accent1;
FStringColor := AColorScheme.Accent1;
Changed;
end;
procedure TAlgosim3FormattingProcessor.Assign(Source: TPersistent);
begin
if Source is TAlgosim3FormattingProcessor then
begin
FNumberColor := TAlgosim3FormattingProcessor(Source).NumberColor;
FStringColor := TAlgosim3FormattingProcessor(Source).StringColor;
Changed;
end
else
inherited;
end;
constructor TAlgosim3FormattingProcessor.Create(AOwner: TComponent);
begin
inherited;
FNumberColor := DEFAULT_NUMBER_COLOR;
FStringColor := DEFAULT_STRING_COLOR;
FChrEvents := TObjectList<TList<TPair<Integer, TChrEvent>>>.Create;
end;
destructor TAlgosim3FormattingProcessor.Destroy;
begin
FreeAndNil(FChrEvents);
inherited;
end;
function TAlgosim3FormattingProcessor.FileChangeNotification(
ChangeType: TChangeType; Data1, Data2, Data3, Data4: Integer): TChangeRecord;
begin
case ChangeType of
ctFile:
begin
Reparse;
Result.ChangeType := ctFile;
end;
ctLineRange:
begin
Reparse(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctBlock:
begin
Reparse(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLine:
begin
Reparse(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctLineFrom:
begin
Reparse(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctChar:
begin
Reparse(Data1);
Result.ChangeType := ctLineRange;
Result.Data1 := Data1;
Result.Data2 := TextLineCount - 1;
end;
ctTwoChars:
begin
Reparse(Min(Data1, Data3));
Result.ChangeType := ctLineRange;
Result.Data1 := Min(Data1, Data3);
Result.Data2 := TextLineCount - 1;
end;
else
Result := Default(TChangeRecord);
end;
end;
function TAlgosim3FormattingProcessor.GetCharCSSClass(ALineIndex, ACol: Integer;
AChar: Char): Integer;
begin
var LLineCount := TextLineCount;
if not InRange(ALineIndex, 0, LLineCount - 1) then
Exit(CSS_CLASS_DEFAULT);
if FChrEvents.Count < LLineCount then
begin
Reparse;
if FChrEvents.Count < LLineCount then
raise Exception.Create('Reparse failed.');
end;
var LInNumber := False;
var LInString := False;
for var i := 0 to FChrEvents[ALineIndex].Count - 1 do
begin
if FChrEvents[ALineIndex][i].Key > ACol then
Break;
case FChrEvents[ALineIndex][i].Value of
ceNumberBegin:
LInNumber := True;
ceNumberEnd:
LInNumber := False;
ceStringBegin:
LInString := True;
ceStringEnd:
LInString := False;
end;
end;
{$IFDEF DEBUG}
if LInString and LInNumber then
raise Exception.Create('Literal conflict.');
{$ENDIF}
if LInString then
Result := CSS_CLASS_STRING
else if LInNumber then
Result := CSS_CLASS_NUMBER
else
Result := CSS_CLASS_DEFAULT;
end;
procedure TAlgosim3FormattingProcessor.GetCharFormat(ALineIndex, ACol: Integer;
AChar: Char; var AFontRecord: TFontRecord);
begin
case GetCharCSSClass(ALineIndex, ACol, AChar) of
CSS_CLASS_NUMBER:
AFontRecord.Color := FNumberColor;
CSS_CLASS_STRING:
AFontRecord.Color := FStringColor;
end;
end;
function TAlgosim3FormattingProcessor.GetCSSRules: TCSSRules;
begin
SetLength(Result, CSS_CLASS_LENGTH);
Result[CSS_CLASS_DEFAULT] := MakeCSSRule('default', []);
Result[CSS_CLASS_NUMBER] := MakeCSSRule('number',
[MakeCSSDeclaration('color', CSSColor(FNumberColor))]);
Result[CSS_CLASS_STRING] := MakeCSSRule('string',
[MakeCSSDeclaration('color', CSSColor(FStringColor))]);
end;
procedure TAlgosim3FormattingProcessor.Reparse(AFromLine: Integer);
const
ASCIINumLitChrs = ['0'..'9', 'A'..'Z', 'a'..'z', '.', '+', '-', '#'];
AllDigits = ['0'..'9', 'A'..'Z', 'a'..'z'];
MinusSign = #$2212;
begin
var LFromLine := Max(0, Min(AFromLine, FChrEvents.Count - 1));
var LInNumber := False;
var LInString := False;
if LFromLine > 0 then
begin
if FChrEvents[LFromLine].Count = 0 then
raise Exception.Create('Invalid syntax cache.');
if FChrEvents[LFromLine][0].Key <> -1 then
raise Exception.Create('Invalid syntax cache.');
LInNumber := FChrEvents[LFromLine][0].Value = ceNumberBegin;
LInString := FChrEvents[LFromLine][0].Value = ceStringBegin;
end;
var LSkipNext := False;
var PrevC: Char := #0;
for var y := LFromLine to TextLineCount - 1 do
begin
if y >= FChrEvents.Count then
FChrEvents.Add(TList<TPair<Integer, TChrEvent>>.Create);
if y >= FChrEvents.Count then
raise Exception.Create('Invalid syntax cache.');
FChrEvents[y].Clear;
if LInString then
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(-1, ceStringBegin))
else if LInNumber then
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(-1, ceNumberBegin))
else
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(-1, ceDefault));
for var x := 0 to TextLineWidth(y) - 1 do
begin
if LSkipNext then
begin
LSkipNext := False;
Continue;
end;
var c := TextChar(y, x);
if LInString then
begin
if (c = '"') and ((Succ(x) < TextLineWidth(y)) and (TextChar(y, Succ(x)) = '"')) then
LSkipNext := True
else if c = '"' then
begin
LInString := False;
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(Succ(x), ceStringEnd));
end;
end
else if LInNumber then
begin
if
not CharInSet(c, ASCIINumLitChrs) and (c <> MinusSign)
or
(
c.IsInArray(['+', '-', MinusSign])
and
not PrevC.IsInArray(['e', 'E'])
)
or
(
(c = '#')
and
not ((Succ(x) < TextLineWidth(y)) and CharInSet(TextChar(y, Succ(x)), AllDigits))
)
then
begin
LInNumber := False;
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(x, ceNumberEnd));
end;
end
else
begin
if c = '"' then
begin
LInString := True;
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(x, ceStringBegin));
end
else if
(c in ['0'..'9']) and ((x = 0) or not TextChar(y, Pred(x)).IsLetterOrDigit)
or
(c = '.') and (Succ(x) < TextLineWidth(y)) and (TextChar(y, Succ(x)) in ['0'..'9'])
then
begin
LInNumber := True;
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(x, ceNumberBegin));
end
end;
PrevC := c;
end;
if LInNumber then
begin
LInNumber := False;
FChrEvents[y].Add(TPair<Integer, TChrEvent>.Create(TextLineWidth(y), ceNumberEnd));
end;
end;
end;
procedure TAlgosim3FormattingProcessor.SetNumberColor(const Value: TColor);
begin
if FNumberColor <> Value then
begin
FNumberColor := Value;
Changed;
end;
end;
procedure TAlgosim3FormattingProcessor.SetStringColor(const Value: TColor);
begin
if FStringColor <> Value then
begin
FStringColor := Value;
Changed;
end;
end;
initialization
CF_PNG := RegisterClipboardFormat('PNG');
FixedWidthFonts := TStringList.Create;
FixedWidthFonts.BeginUpdate;
LF.lfCharSet := DEFAULT_CHARSET;
LF.lfFaceName := '';
LF.lfPitchAndFamily := 0;
with TBitmap.Create do
try
EnumFontFamiliesEx(Canvas.Handle, LF, @EnumFontFamExProc, 0, 0);
finally
Free;
end;
FixedWidthFonts.EndUpdate;
finalization
FixedWidthFonts.Free;
if Assigned(Mouse.PanningWindow) then
Mouse.PanningWindow := nil;
end.