Show SynEdit.pas syntax highlighted
{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: SynEdit.pas, released 2000-04-07.
The Original Code is based on mwCustomEdit.pas by Martin Waldenburg, part of
the mwEdit component suite.
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
Unicode translation by Maël Hörz.
All Rights Reserved.
Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.
Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.
$Id: SynEdit.pas,v 1.386.2.54 2006/05/21 11:59:34 maelh Exp $
You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net
Known Issues:
- Undo is buggy when dealing with Hard Tabs (when inserting text after EOL and
when trimming).
-------------------------------------------------------------------------------}
//todo: remove SynEdit Clipboard Format?
//todo: in WordWrap mode, parse lines only once in PaintLines()
//todo: Remove checks for WordWrap. Must abstract the behaviour with the plugins instead.
//todo: Move WordWrap glyph to the WordWrap plugin.
//todo: remove fShowSpecChar variable
//todo: remove the several Undo block types?
{$IFNDEF QSYNEDIT}
unit SynEdit;
{$ENDIF}
{$I SynEdit.inc}
interface
uses
{$IFDEF SYN_CLX}
{$IFDEF SYN_LINUX}
Xlib,
{$ENDIF}
Qt,
Types,
QControls,
QGraphics,
QForms,
QStdCtrls,
QExtCtrls,
QSynUnicode,
{$ELSE}
Controls,
Contnrs,
Graphics,
Forms,
StdCtrls,
ExtCtrls,
Windows,
Messages,
{$IFDEF SYN_COMPILER_7}
Themes,
{$ENDIF}
SynUnicode,
{$ENDIF}
{$IFDEF SYN_CLX}
kTextDrawer,
QSynEditTypes,
QSynEditKeyConst,
QSynEditMiscProcs,
QSynEditMiscClasses,
QSynEditTextBuffer,
QSynEditKeyCmds,
QSynEditHighlighter,
QSynEditKbdHandler,
{$ELSE}
Imm,
SynTextDrawer,
SynEditTypes,
SynEditKeyConst,
SynEditMiscProcs,
SynEditMiscClasses,
SynEditTextBuffer,
SynEditKeyCmds,
SynEditHighlighter,
SynEditKbdHandler,
{$ENDIF}
Math,
SysUtils,
Classes;
const
{$IFNDEF SYN_COMPILER_3_UP}
// not defined in all Delphi versions
WM_MOUSEWHEEL = $020A;
{$ENDIF}
// maximum scroll range
MAX_SCROLL = 32767;
// Max number of book/gutter marks returned from GetEditMarksForLine - that
// really should be enough.
MAX_MARKS = 16;
SYNEDIT_CLIPBOARD_FORMAT = 'SynEdit Control Block Type';
var
SynEditClipboardFormat: UINT;
type
{$IFDEF SYN_CLX}
TSynBorderStyle = bsNone..bsSingle;
{$ELSE}
TSynBorderStyle = TBorderStyle;
{$ENDIF}
TSynReplaceAction = (raCancel, raSkip, raReplace, raReplaceAll);
ESynEditError = class(ESynError);
TDropFilesEvent = procedure(Sender: TObject; X, Y: Integer; AFiles: TWideStrings)
of object;
THookedCommandEvent = procedure(Sender: TObject; AfterProcessing: Boolean;
var Handled: Boolean; var Command: TSynEditorCommand; var AChar: WideChar;
Data: pointer; HandlerData: pointer) of object;
TPaintEvent = procedure(Sender: TObject; ACanvas: TCanvas) of object;
TProcessCommandEvent = procedure(Sender: TObject;
var Command: TSynEditorCommand; var AChar: WideChar; Data: pointer) of object;
TReplaceTextEvent = procedure(Sender: TObject; const ASearch, AReplace:
WideString; Line, Column: Integer; var Action: TSynReplaceAction) of object;
TSpecialLineColorsEvent = procedure(Sender: TObject; Line: Integer;
var Special: Boolean; var FG, BG: TColor) of object;
TTransientType = (ttBefore, ttAfter);
TPaintTransient = procedure(Sender: TObject; Canvas: TCanvas;
TransientType: TTransientType) of object;
TScrollEvent = procedure(Sender: TObject; ScrollBar: TScrollBarKind) of object;
TGutterGetTextEvent = procedure(Sender: TObject; aLine: Integer;
var aText: WideString) of object;
TGutterPaintEvent = procedure(Sender: TObject; aLine: Integer;
X, Y: Integer) of object;
TSynEditCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock);
TSynStateFlag = (sfCaretChanged, sfScrollbarChanged, sfLinesChanging,
sfIgnoreNextChar, sfCaretVisible, sfDblClicked, sfPossibleGutterClick,
sfWaitForDragging, sfInsideRedo, sfGutterDragging);
TSynStateFlags = set of TSynStateFlag;
TScrollHintFormat = (shfTopLineOnly, shfTopToBottom);
TSynEditorOption = (
eoAltSetsColumnMode, //Holding down the Alt Key will put the selection mode into columnar format
eoAutoIndent, //Will indent the caret on new lines with the same amount of leading white space as the preceding line
eoAutoSizeMaxScrollWidth, //Automatically resizes the MaxScrollWidth property when inserting text
eoDisableScrollArrows, //Disables the scroll bar arrow buttons when you can't scroll in that direction any more
eoDragDropEditing, //Allows you to select a block of text and drag it within the document to another location
eoDropFiles, //Allows the editor accept OLE file drops
eoEnhanceHomeKey, //enhances home key positioning, similar to visual studio
eoEnhanceEndKey, //enhances End key positioning, similar to JDeveloper
eoGroupUndo, //When undoing/redoing actions, handle all continous changes of the same kind in one call instead undoing/redoing each command separately
eoHalfPageScroll, //When scrolling with page-up and page-down commands, only scroll a half page at a time
eoHideShowScrollbars, //if enabled, then the scrollbars will only show when necessary. If you have ScrollPastEOL, then it the horizontal bar will always be there (it uses MaxLength instead)
eoKeepCaretX, //When moving through lines w/o Cursor Past EOL, keeps the X position of the cursor
eoNoCaret, //Makes it so the caret is never visible
eoNoSelection, //Disables selecting text
eoRightMouseMovesCursor, //When clicking with the right mouse for a popup menu, move the cursor to that location
eoScrollByOneLess, //Forces scrolling to be one less
eoScrollHintFollows, //The scroll hint follows the mouse when scrolling vertically
eoScrollPastEof, //Allows the cursor to go past the end of file marker
eoScrollPastEol, //Allows the cursor to go past the last character into the white space at the end of a line
eoShowScrollHint, //Shows a hint of the visible line numbers when scrolling vertically
eoShowSpecialChars, //Shows the special Characters
eoSmartTabDelete, //similar to Smart Tabs, but when you delete characters
eoSmartTabs, //When tabbing, the cursor will go to the next non-white space character of the previous line
eoSpecialLineDefaultFg, //disables the foreground text color override when using the OnSpecialLineColor event
eoTabIndent, //When active <Tab> and <Shift><Tab> act as block indent, unindent when text is selected
eoTabsToSpaces, //Converts a tab character to a specified number of space characters
eoTrimTrailingSpaces //Spaces at the end of lines will be trimmed and not saved
);
TSynEditorOptions = set of TSynEditorOption;
const
SYNEDIT_DEFAULT_OPTIONS = [eoAutoIndent, eoDragDropEditing, eoEnhanceEndKey,
eoScrollPastEol, eoShowScrollHint, eoSmartTabs, eoTabsToSpaces,
eoSmartTabDelete, eoGroupUndo];
{$IFNDEF SYN_CLX}
type
TCreateParamsW = record
Caption: PWideChar;
Style: DWORD;
ExStyle: DWORD;
X, Y: Integer;
Width, Height: Integer;
WndParent: HWnd;
Param: Pointer;
WindowClass: TWndClassW;
WinClassName: array[0..63] of WideChar;
InternalCaption: WideString;
end;
{$ENDIF}
type
// use scAll to update a statusbar when another TCustomSynEdit got the focus
TSynStatusChange = (scAll, scCaretX, scCaretY, scLeftChar, scTopLine,
scInsertMode, scModified, scSelection, scReadOnly);
TSynStatusChanges = set of TSynStatusChange;
TContextHelpEvent = procedure(Sender: TObject; word: WideString)
of object;
TStatusChangeEvent = procedure(Sender: TObject; Changes: TSynStatusChanges)
of object;
TMouseCursorEvent = procedure(Sender: TObject; const aLineCharPos: TBufferCoord;
var aCursor: TCursor) of object;
TCustomSynEdit = class;
TSynEditMark = class
protected
fLine, fChar, fImage: Integer;
fEdit: TCustomSynEdit;
fVisible: Boolean;
fInternalImage: Boolean;
fBookmarkNum: Integer;
function GetEdit: TCustomSynEdit; virtual;
procedure SetChar(const Value: Integer); virtual;
procedure SetImage(const Value: Integer); virtual;
procedure SetLine(const Value: Integer); virtual;
procedure SetVisible(const Value: Boolean);
procedure SetInternalImage(const Value: Boolean);
function GetIsBookmark: Boolean;
public
constructor Create(AOwner: TCustomSynEdit);
property Line: Integer read fLine write SetLine;
property Char: Integer read fChar write SetChar;
property Edit: TCustomSynEdit read fEdit;
property ImageIndex: Integer read fImage write SetImage;
property BookmarkNumber: Integer read fBookmarkNum write fBookmarkNum;
property Visible: Boolean read fVisible write SetVisible;
property InternalImage: Boolean read fInternalImage write SetInternalImage;
property IsBookmark: Boolean read GetIsBookmark;
end;
TPlaceMarkEvent = procedure(Sender: TObject; var Mark: TSynEditMark)
of object;
TSynEditMarks = array[1..MAX_MARKS] of TSynEditMark;
{ A list of mark objects. Each object cause a litle picture to be drawn in the gutter. }
TSynEditMarkList = class(TObjectList) // It makes more sence to derive from TObjectList,
protected // as it automatically frees its members
fEdit: TCustomSynEdit;
fOnChange: TNotifyEvent;
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
function GetItem(Index: Integer): TSynEditMark;
procedure SetItem(Index: Integer; Item: TSynEditMark);
property OwnsObjects; // This is to hide the inherited property,
public // because TSynEditMarkList always owns the marks
constructor Create(AOwner: TCustomSynEdit);
function First: TSynEditMark;
function Last: TSynEditMark;
function Extract(Item: TSynEditMark): TSynEditMark;
procedure ClearLine(line: Integer);
procedure GetMarksForLine(line: Integer; var Marks: TSynEditMarks);
procedure Place(mark: TSynEditMark);
public
property Items[Index: Integer]: TSynEditMark read GetItem write SetItem; default;
property Edit: TCustomSynEdit read fEdit;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TGutterClickEvent = procedure(Sender: TObject; Button: TMouseButton;
X, Y, Line: Integer; Mark: TSynEditMark) of object;
// aIndex parameters of Line notifications are 0-based.
// aRow parameter of GetRowLength() is 1-based.
ISynEditBufferPlugin = interface
// conversion methods
function BufferToDisplayPos(const aPos: TBufferCoord): TDisplayCoord;
function DisplayToBufferPos(const aPos: TDisplayCoord): TBufferCoord;
function RowCount: Integer;
function GetRowLength(aRow: Integer): Integer;
// plugin notifications
function LinesInserted(aIndex: Integer; aCount: Integer): Integer;
function LinesDeleted(aIndex: Integer; aCount: Integer): Integer;
function LinesPutted(aIndex: Integer; aCount: Integer): Integer;
// font or size change
procedure DisplayChanged;
// pretty clear, heh?
procedure Reset;
end;
TSynEditPlugin = class(TObject)
private
fOwner: TCustomSynEdit;
protected
procedure AfterPaint(ACanvas: TCanvas; const AClip: TRect;
FirstLine, LastLine: Integer); virtual; abstract;
procedure LinesInserted(FirstLine, Count: Integer); virtual; abstract;
procedure LinesDeleted(FirstLine, Count: Integer); virtual; abstract;
protected
property Editor: TCustomSynEdit read fOwner;
public
constructor Create(AOwner: TCustomSynEdit);
destructor Destroy; override;
end;
TCustomSynEdit = class(TCustomControl)
private
{$IFNDEF SYN_CLX}
procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
procedure WMCaptureChanged(var Msg: TMessage); message WM_CAPTURECHANGED;
procedure WMChar(var Msg: TWMChar); message WM_CHAR;
procedure WMClear(var Msg: TMessage); message WM_CLEAR;
procedure WMCopy(var Message: TMessage); message WM_COPY;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMGetText(var Msg: TWMGetText); message WM_GETTEXT;
procedure WMGetTextLength(var Msg: TWMGetTextLength); message WM_GETTEXTLENGTH;
procedure WMHScroll(var Msg: TWMScroll); message WM_HSCROLL;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
procedure WMImeChar(var Msg: TMessage); message WM_IME_CHAR;
procedure WMImeComposition(var Msg: TMessage); message WM_IME_COMPOSITION;
procedure WMImeNotify(var Msg: TMessage); message WM_IME_NOTIFY;
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMUndo(var Msg: TMessage); message WM_UNDO;
procedure WMVScroll(var Msg: TWMScroll); message WM_VSCROLL;
{$ENDIF}
private
fAlwaysShowCaret: Boolean;
fBlockBegin: TBufferCoord;
fBlockEnd: TBufferCoord;
fCaretX: Integer;
fLastCaretX: integer;
fCaretY: Integer;
fCharsInWindow: Integer;
fCharWidth: Integer;
fFontDummy: TFont;
fInserting: Boolean;
fLines: TWideStrings;
fOrigLines: TWideStrings;
fOrigUndoList: TSynEditUndoList;
fOrigRedoList: TSynEditUndoList;
fLinesInWindow: Integer;
fLeftChar: Integer;
fMaxScrollWidth: Integer;
fPaintLock: Integer;
fReadOnly: Boolean;
fRightEdge: Integer;
fRightEdgeColor: TColor;
fScrollHintColor: TColor;
fScrollHintFormat: TScrollHintFormat;
FScrollBars: TScrollStyle;
fTextHeight: Integer;
fTextOffset: Integer;
fTopLine: Integer;
fHighlighter: TSynCustomHighlighter;
fSelectedColor: TSynSelectedColor;
fActiveLineColor: TColor;
fUndoList: TSynEditUndoList;
fRedoList: TSynEditUndoList;
fBookMarks: array[0..9] of TSynEditMark; // these are just references, fMarkList is the owner
fMouseDownX: Integer;
fMouseDownY: Integer;
fBookMarkOpt: TSynBookMarkOpt;
fBorderStyle: TSynBorderStyle;
fHideSelection: Boolean;
fMouseWheelAccumulator: Integer;
fOverwriteCaret: TSynEditCaretType;
fInsertCaret: TSynEditCaretType;
fCaretOffset: TPoint;
fKeyStrokes: TSynEditKeyStrokes;
fModified: Boolean;
fMarkList: TSynEditMarkList;
fExtraLineSpacing: Integer;
fSelectionMode: TSynSelectionMode;
fActiveSelectionMode: TSynSelectionMode; //mode of the active selection
fWantReturns: Boolean;
fWantTabs: Boolean;
fWordWrapPlugin: ISynEditBufferPlugin;
fWordWrapGlyph: TSynGlyph;
fCaretAtEOL: Boolean; // used by wordwrap
fGutter: TSynGutter;
fTabWidth: Integer;
fTextDrawer: TheTextDrawer;
fInvalidateRect: TRect;
fStateFlags: TSynStateFlags;
fOptions: TSynEditorOptions;
fStatusChanges: TSynStatusChanges;
fLastKey: word;
fLastShiftState: TShiftState;
fSearchEngine: TSynEditSearchCustom;
fHookedCommandHandlers: TObjectList;
fKbdHandler: TSynEditKbdHandler;
fFocusList: TList;
fPlugins: TObjectList;
fScrollTimer: TTimer;
fScrollDeltaX, fScrollDeltaY: Integer;
// event handlers
fOnChange: TNotifyEvent;
fOnClearMark: TPlaceMarkEvent;
fOnCommandProcessed: TProcessCommandEvent;
fOnDropFiles: TDropFilesEvent;
fOnGutterClick: TGutterClickEvent;
FOnKeyPressW: TKeyPressWEvent;
fOnMouseCursor: TMouseCursorEvent;
fOnPaint: TPaintEvent;
fOnPlaceMark: TPlaceMarkEvent;
fOnProcessCommand: TProcessCommandEvent;
fOnProcessUserCommand: TProcessCommandEvent;
fOnReplaceText: TReplaceTextEvent;
fOnSpecialLineColors: TSpecialLineColorsEvent;
fOnContextHelp: TContextHelpEvent;
fOnPaintTransient: TPaintTransient;
fOnScroll: TScrollEvent;
fOnGutterGetText: TGutterGetTextEvent;
fOnGutterPaint: TGutterPaintEvent;
fOnStatusChange: TStatusChangeEvent;
fShowSpecChar: Boolean;
FPaintTransientLock: Integer;
FIsScrolling: Boolean;
fChainListCleared: TNotifyEvent;
fChainListDeleted: TStringListChangeEvent;
fChainListInserted: TStringListChangeEvent;
fChainListPutted: TStringListChangeEvent;
fChainLinesChanging: TNotifyEvent;
fChainLinesChanged: TNotifyEvent;
fChainedEditor: TCustomSynEdit;
fChainUndoAdded: TNotifyEvent;
fChainRedoAdded: TNotifyEvent;
{$IFNDEF SYN_CLX}
FWindowProducedMessage: Boolean;
{$ENDIF}
{$IFDEF SYN_LINUX}
FDeadKeysFixed: Boolean;
{$ENDIF}
{$IFDEF SYN_CLX}
FHScrollBar : TSynEditScrollBar;
FVScrollBar : TSynEditScrollBar;
procedure ScrollEvent(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
{$ENDIF}
procedure BookMarkOptionsChanged(Sender: TObject);
procedure ComputeCaret(X, Y: Integer);
procedure ComputeScroll(X, Y: Integer);
procedure DoBlockIndent;
procedure DoBlockUnindent;
procedure DoHomeKey(Selection:boolean);
procedure DoEndKey(Selection: Boolean);
procedure DoLinesDeleted(FirstLine, Count: integer);
procedure DoLinesInserted(FirstLine, Count: integer);
procedure DoShiftTabKey;
procedure DoTabKey;
procedure DoCaseChange(const Cmd : TSynEditorCommand);
function FindHookedCmdEvent(AHandlerProc: THookedCommandEvent): integer;
procedure SynFontChanged(Sender: TObject);
function GetBlockBegin: TBufferCoord;
function GetBlockEnd: TBufferCoord;
function GetCanPaste: Boolean;
function GetCanRedo: Boolean;
function GetCanUndo: Boolean;
function GetCaretXY: TBufferCoord;
function GetDisplayX: Integer;
function GetDisplayY: Integer;
function GetDisplayXY: TDisplayCoord;
function GetDisplayLineCount: Integer;
function GetFont: TFont;
function GetHookedCommandHandlersCount: Integer;
function GetLineText: WideString;
function GetMaxUndo: Integer;
function GetOptions: TSynEditorOptions;
function GetSelAvail: Boolean;
function GetSelTabBlock: Boolean;
function GetSelTabLine: Boolean;
function GetSelText: WideString;
function SynGetText: WideString;
function GetWordAtCursor: WideString;
function GetWordAtMouse: WideString;
function GetWordWrap: Boolean;
procedure GutterChanged(Sender: TObject);
procedure InsertBlock(const BB, BE: TBufferCoord; ChangeStr: PWideChar; AddToUndoList: Boolean);
function LeftSpaces(const Line: WideString): Integer;
function LeftSpacesEx(const Line: WideString; WantTabs: Boolean): Integer;
function GetLeftSpacing(CharCount: Integer; WantTabs: Boolean): WideString;
procedure LinesChanging(Sender: TObject);
procedure MoveCaretAndSelection(const ptBefore, ptAfter: TBufferCoord;
SelectionCommand: Boolean);
procedure MoveCaretHorz(DX: Integer; SelectionCommand: Boolean);
procedure MoveCaretVert(DY: Integer; SelectionCommand: Boolean);
procedure PluginsAfterPaint(ACanvas: TCanvas; const AClip: TRect;
FirstLine, LastLine: Integer);
procedure ReadAddedKeystrokes(Reader: TReader);
procedure ReadRemovedKeystrokes(Reader: TReader);
function ScanFrom(Index: Integer): Integer;
procedure ScrollTimerHandler(Sender: TObject);
procedure SelectedColorsChanged(Sender: TObject);
procedure SetBlockBegin(Value: TBufferCoord);
procedure SetBlockEnd(Value: TBufferCoord);
procedure SetBorderStyle(Value: TSynBorderStyle);
procedure SetCaretX(Value: Integer);
procedure SetCaretY(Value: Integer);
procedure InternalSetCaretX(Value: Integer);
procedure InternalSetCaretY(Value: Integer);
procedure SetInternalDisplayXY(const aPos: TDisplayCoord);
procedure SetActiveLineColor(Value: TColor);
procedure SetExtraLineSpacing(const Value: Integer);
procedure SetFont(const Value: TFont);
procedure SetGutter(const Value: TSynGutter);
procedure SetGutterWidth(Value: Integer);
procedure SetHideSelection(const Value: Boolean);
procedure SetHighlighter(const Value: TSynCustomHighlighter);
procedure SetInsertCaret(const Value: TSynEditCaretType);
procedure SetInsertMode(const Value: Boolean);
procedure SetKeystrokes(const Value: TSynEditKeyStrokes);
procedure SetLeftChar(Value: Integer);
procedure SetLines(Value: TWideStrings);
procedure SetLineText(Value: WideString);
procedure SetMaxScrollWidth(Value: Integer);
procedure SetMaxUndo(const Value: Integer);
procedure SetModified(Value: Boolean);
procedure SetOptions(Value: TSynEditorOptions);
procedure SetOverwriteCaret(const Value: TSynEditCaretType);
procedure SetRightEdge(Value: Integer);
procedure SetRightEdgeColor(Value: TColor);
procedure SetScrollBars(const Value: TScrollStyle);
procedure SetSearchEngine(Value: TSynEditSearchCustom);
procedure SetSelectionMode(const Value: TSynSelectionMode);
procedure SetActiveSelectionMode(const Value: TSynSelectionMode);
procedure SetSelTextExternal(const Value: WideString);
procedure SetTabWidth(Value: Integer);
procedure SynSetText(const Value: WideString);
procedure SetTopLine(Value: Integer);
procedure SetWordBlock(Value: TBufferCoord);
procedure SetWordWrap(const Value: Boolean);
procedure SetWordWrapGlyph(const Value: TSynGlyph);
procedure WordWrapGlyphChange(Sender: TObject);
procedure SizeOrFontChanged(bFont: boolean);
procedure ProperSetLine(ALine: Integer; const ALineText: WideString);
procedure UpdateModifiedStatus;
procedure UndoRedoAdded(Sender: TObject);
procedure UpdateLastCaretX;
procedure UpdateScrollBars;
procedure WriteAddedKeystrokes(Writer: TWriter);
procedure WriteRemovedKeystrokes(Writer: TWriter);
protected
FIgnoreNextChar: Boolean;
FCharCodeString: string;
{$IFDEF SYN_CLX}
procedure Resize; override;
function GetClientOrigin: TPoint; override;
function GetClientRect: TRect; override;
function WidgetFlags: Integer; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
const MousePos: TPoint): Boolean; override;
procedure KeyString(var S: WideString; var Handled: Boolean); override;
function NeedKey(Key: Integer; Shift: TShiftState;
const KeyText: WideString): Boolean; override;
{$ELSE}
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure InvalidateRect(const aRect: TRect; aErase: Boolean); virtual;
{$ENDIF}
procedure DblClick; override;
procedure DecPaintLock;
procedure DefineProperties(Filer: TFiler); override;
procedure DoChange; virtual;
{$IFDEF SYN_CLX}
procedure DoKeyPressW(var Key: WideChar);
{$ELSE}
procedure DoKeyPressW(var Message: TWMKey);
{$ENDIF}
procedure DragCanceled; override;
procedure DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); override;
function GetReadOnly: boolean; virtual;
procedure HighlighterAttrChanged(Sender: TObject);
procedure IncPaintLock;
procedure InitializeCaret;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure KeyPressW(var Key: WideChar); virtual;
procedure LinesChanged(Sender: TObject); virtual;
procedure ListCleared(Sender: TObject);
procedure ListDeleted(Sender: TObject; aIndex: Integer; aCount: Integer);
procedure ListInserted(Sender: TObject; Index: Integer; aCount: Integer);
procedure ListPutted(Sender: TObject; Index: Integer; aCount: Integer);
//helper procs to chain list commands
procedure ChainListCleared(Sender: TObject);
procedure ChainListDeleted(Sender: TObject; aIndex: Integer; aCount: Integer);
procedure ChainListInserted(Sender: TObject; aIndex: Integer; aCount: Integer);
procedure ChainListPutted(Sender: TObject; aIndex: Integer; aCount: Integer);
procedure ChainLinesChanging(Sender: TObject);
procedure ChainLinesChanged(Sender: TObject);
procedure ChainUndoRedoAdded(Sender: TObject);
procedure ScanRanges;
procedure Loaded; override;
procedure MarkListChange(Sender: TObject);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
procedure NotifyHookedCommandHandlers(AfterProcessing: Boolean;
var Command: TSynEditorCommand; var AChar: WideChar; Data: pointer); virtual;
procedure Paint; override;
procedure PaintGutter(const AClip: TRect; const aFirstRow,
aLastRow: Integer); virtual;
procedure PaintTextLines(AClip: TRect; const aFirstRow, aLastRow,
FirstCol, LastCol: Integer); virtual;
procedure RecalcCharExtent;
procedure RedoItem;
procedure InternalSetCaretXY(const Value: TBufferCoord); virtual;
procedure SetCaretXY(const Value: TBufferCoord); virtual;
procedure SetCaretXYEx(CallEnsureCursorPos: Boolean; Value: TBufferCoord); virtual;
procedure SetName(const Value: TComponentName); override;
procedure SetReadOnly(Value: boolean); virtual;
procedure SetWantReturns(Value: Boolean);
procedure SetSelTextPrimitive(const Value: WideString);
procedure SetSelTextPrimitiveEx(PasteMode: TSynSelectionMode; Value: PWideChar;
AddToUndoList: Boolean);
procedure SetWantTabs(Value: Boolean);
procedure StatusChanged(AChanges: TSynStatusChanges);
// If the translations requires Data, memory will be allocated for it via a
// GetMem call. The client must call FreeMem on Data if it is not NIL.
function TranslateKeyCode(Code: word; Shift: TShiftState;
var Data: pointer): TSynEditorCommand;
procedure UndoItem;
procedure UpdateMouseCursor; virtual;
protected
fGutterWidth: Integer;
fInternalImage: TSynInternalImage;
procedure HideCaret;
procedure ShowCaret;
procedure DoOnClearBookmark(var Mark: TSynEditMark); virtual;
procedure DoOnCommandProcessed(Command: TSynEditorCommand; AChar: WideChar;
Data: pointer); virtual;
// no method DoOnDropFiles, intercept the WM_DROPFILES instead
procedure DoOnGutterClick(Button: TMouseButton; X, Y: Integer); virtual;
procedure DoOnPaint; virtual;
procedure DoOnPaintTransientEx(TransientType: TTransientType; Lock: Boolean); virtual;
procedure DoOnPaintTransient(TransientType: TTransientType); virtual;
procedure DoOnPlaceMark(var Mark: TSynEditMark); virtual;
procedure DoOnProcessCommand(var Command: TSynEditorCommand;
var AChar: WideChar; Data: pointer); virtual;
function DoOnReplaceText(const ASearch, AReplace: WideString;
Line, Column: Integer): TSynReplaceAction; virtual;
function DoOnSpecialLineColors(Line: Integer;
var Foreground, Background: TColor): Boolean; virtual;
procedure DoOnStatusChange(Changes: TSynStatusChanges); virtual;
function GetSelEnd: integer;
function GetSelStart: integer;
function GetSelLength: integer;
procedure SetSelEnd(const Value: integer);
procedure SetSelStart(const Value: integer);
procedure SetSelLength(const Value: integer);
procedure SetAlwaysShowCaret(const Value: Boolean);
function ShrinkAtWideGlyphs(const S: WideString; First: Integer;
var CharCount: Integer): WideString;
procedure LinesHookChanged;
property InternalCaretX: Integer write InternalSetCaretX;
property InternalCaretY: Integer write InternalSetCaretY;
property InternalCaretXY: TBufferCoord write InternalSetCaretXY;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelEnd: Integer read GetSelEnd write SetSelEnd;
property AlwaysShowCaret: Boolean read FAlwaysShowCaret
write SetAlwaysShowCaret;
procedure UpdateCaret;
{$IFDEF SYN_COMPILER_4_UP}
procedure AddKey(Command: TSynEditorCommand; Key1: word; SS1: TShiftState;
Key2: word = 0; SS2: TShiftState = []);
{$ELSE}
procedure AddKey(Command: TSynEditorCommand; Key1: word; SS1: TShiftState;
Key2: word; SS2: TShiftState);
{$ENDIF}
procedure BeginUndoBlock;
procedure BeginUpdate;
function CaretInView: Boolean;
function CharIndexToRowCol(Index: Integer): TBufferCoord;
procedure Clear;
procedure ClearAll;
procedure ClearBookMark(BookMark: Integer);
procedure ClearSelection;
procedure CommandProcessor(Command: TSynEditorCommand; AChar: WideChar;
Data: pointer); virtual;
procedure ClearUndo;
procedure CopyToClipboard;
procedure CutToClipboard;
procedure DoCopyToClipboard(const SText: WideString);
procedure DragDrop(Source: TObject; X, Y: Integer); override;
procedure EndUndoBlock;
procedure EndUpdate;
procedure EnsureCursorPosVisible;
procedure EnsureCursorPosVisibleEx(ForceToMiddle: Boolean);
procedure FindMatchingBracket; virtual;
function GetMatchingBracket: TBufferCoord; virtual;
function GetMatchingBracketEx(const APoint: TBufferCoord): TBufferCoord; virtual;
{$IFDEF SYN_COMPILER_4_UP}
function ExecuteAction(Action: TBasicAction): Boolean; override;
{$ENDIF}
procedure ExecuteCommand(Command: TSynEditorCommand; AChar: WideChar;
Data: pointer); virtual;
function ExpandAtWideGlyphs(const S: WideString): WideString;
function GetBookMark(BookMark: Integer; var X, Y: Integer): Boolean;
function GetHighlighterAttriAtRowCol(const XY: TBufferCoord; var Token: WideString;
var Attri: TSynHighlighterAttributes): Boolean;
function GetHighlighterAttriAtRowColEx(const XY: TBufferCoord; var Token: WideString;
var TokenType, Start: Integer;
var Attri: TSynHighlighterAttributes): boolean;
function GetPositionOfMouse(out aPos: TBufferCoord): Boolean;
function GetWordAtRowCol(XY: TBufferCoord): WideString;
procedure GotoBookMark(BookMark: Integer); virtual;
procedure GotoLineAndCenter(ALine: Integer); virtual;
function IsIdentChar(AChar: WideChar): Boolean; virtual;
function IsWhiteChar(AChar: WideChar): Boolean; virtual;
function IsWordBreakChar(AChar: WideChar): Boolean; virtual;
procedure InvalidateGutter;
procedure InvalidateGutterLine(aLine: integer);
procedure InvalidateGutterLines(FirstLine, LastLine: integer);
procedure InvalidateLine(Line: integer);
procedure InvalidateLines(FirstLine, LastLine: integer);
procedure InvalidateSelection;
function IsBookmark(BookMark: Integer): Boolean;
function IsPointInSelection(const Value: TBufferCoord): Boolean;
procedure LockUndo;
function BufferToDisplayPos(const p: TBufferCoord): TDisplayCoord;
function DisplayToBufferPos(const p: TDisplayCoord): TBufferCoord;
function LineToRow(aLine: Integer): Integer;
function RowToLine(aRow: Integer): Integer;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure PasteFromClipboard;
function NextWordPos: TBufferCoord; virtual;
function NextWordPosEx(const XY: TBufferCoord): TBufferCoord; virtual;
function WordStart: TBufferCoord; virtual;
function WordStartEx(const XY: TBufferCoord): TBufferCoord; virtual;
function WordEnd: TBufferCoord; virtual;
function WordEndEx(const XY: TBufferCoord): TBufferCoord; virtual;
function PrevWordPos: TBufferCoord; virtual;
function PrevWordPosEx(const XY: TBufferCoord): TBufferCoord; virtual;
function PixelsToRowColumn(aX, aY: Integer): TDisplayCoord;
function PixelsToNearestRowColumn(aX, aY: Integer): TDisplayCoord;
procedure Redo;
procedure RegisterCommandHandler(const AHandlerProc: THookedCommandEvent;
AHandlerData: pointer);
function RowColumnToPixels(const RowCol: TDisplayCoord): TPoint;
function RowColToCharIndex(RowCol: TBufferCoord): Integer;
function SearchReplace(const ASearch, AReplace: WideString;
AOptions: TSynSearchOptions): Integer;
procedure SelectAll;
procedure SetBookMark(BookMark: Integer; X: Integer; Y: Integer);
procedure SetCaretAndSelection(const ptCaret, ptBefore, ptAfter: TBufferCoord);
procedure SetDefaultKeystrokes; virtual;
procedure SetSelWord;
procedure Undo;
procedure UnlockUndo;
procedure UnregisterCommandHandler(AHandlerProc: THookedCommandEvent);
{$IFDEF SYN_COMPILER_4_UP}
function UpdateAction(Action: TBasicAction): Boolean; override;
{$ENDIF}
procedure SetFocus; override;
procedure AddKeyUpHandler(aHandler: TKeyEvent);
procedure RemoveKeyUpHandler(aHandler: TKeyEvent);
procedure AddKeyDownHandler(aHandler: TKeyEvent);
procedure RemoveKeyDownHandler(aHandler: TKeyEvent);
procedure AddKeyPressHandler(aHandler: TKeyPressWEvent);
procedure RemoveKeyPressHandler(aHandler: TKeyPressWEvent);
procedure AddFocusControl(aControl: TWinControl);
procedure RemoveFocusControl(aControl: TWinControl);
procedure AddMouseDownHandler(aHandler: TMouseEvent);
procedure RemoveMouseDownHandler(aHandler: TMouseEvent);
procedure AddMouseUpHandler(aHandler: TMouseEvent);
procedure RemoveMouseUpHandler(aHandler: TMouseEvent);
procedure AddMouseCursorHandler(aHandler: TMouseCursorEvent);
procedure RemoveMouseCursorHandler(aHandler: TMouseCursorEvent);
{$IFDEF SYN_CLX}
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
{$ELSE}
procedure WndProc(var Msg: TMessage); override;
{$ENDIF}
procedure SetLinesPointer(ASynEdit: TCustomSynEdit);
procedure RemoveLinesPointer;
procedure HookTextBuffer(aBuffer: TSynEditStringList;
aUndo, aRedo: TSynEditUndoList);
procedure UnHookTextBuffer;
public
property BlockBegin: TBufferCoord read GetBlockBegin write SetBlockBegin;
property BlockEnd: TBufferCoord read GetBlockEnd write SetBlockEnd;
property CanPaste: Boolean read GetCanPaste;
property CanRedo: Boolean read GetCanRedo;
property CanUndo: Boolean read GetCanUndo;
property CaretX: Integer read fCaretX write SetCaretX;
property CaretY: Integer read fCaretY write SetCaretY;
property CaretXY: TBufferCoord read GetCaretXY write SetCaretXY;
property ActiveLineColor: TColor read fActiveLineColor
write SetActiveLineColor default clNone;
property DisplayX: Integer read GetDisplayX;
property DisplayY: Integer read GetDisplayY;
property DisplayXY: TDisplayCoord read GetDisplayXY;
property DisplayLineCount: Integer read GetDisplayLineCount;
property CharsInWindow: Integer read fCharsInWindow;
property CharWidth: Integer read fCharWidth;
property Color;
property Font: TFont read GetFont write SetFont;
property Highlighter: TSynCustomHighlighter
read fHighlighter write SetHighlighter;
property LeftChar: Integer read fLeftChar write SetLeftChar;
property LineHeight: Integer read fTextHeight;
property LinesInWindow: Integer read fLinesInWindow;
property LineText: WideString read GetLineText write SetLineText;
property Lines: TWideStrings read fLines write SetLines;
property Marks: TSynEditMarkList read fMarkList;
property MaxScrollWidth: Integer read fMaxScrollWidth write SetMaxScrollWidth
default 1024;
property Modified: Boolean read fModified write SetModified;
property PaintLock: Integer read fPaintLock;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property SearchEngine: TSynEditSearchCustom read fSearchEngine write SetSearchEngine;
property SelAvail: Boolean read GetSelAvail;
property SelLength: Integer read GetSelLength write SetSelLength;
property SelTabBlock: Boolean read GetSelTabBlock;
property SelTabLine: Boolean read GetSelTabLine;
property SelText: WideString read GetSelText write SetSelTextExternal;
property StateFlags: TSynStateFlags read fStateFlags;
property Text: WideString read SynGetText write SynSetText;
property TopLine: Integer read fTopLine write SetTopLine;
property WordAtCursor: WideString read GetWordAtCursor;
property WordAtMouse: WideString read GetWordAtMouse;
property UndoList: TSynEditUndoList read fUndoList;
property RedoList: TSynEditUndoList read fRedoList;
public
property OnProcessCommand: TProcessCommandEvent
read FOnProcessCommand write FOnProcessCommand;
property BookMarkOptions: TSynBookMarkOpt
read fBookMarkOpt write fBookMarkOpt;
property BorderStyle: TSynBorderStyle read FBorderStyle write SetBorderStyle
default bsSingle;
property ExtraLineSpacing: Integer
read fExtraLineSpacing write SetExtraLineSpacing default 0;
property Gutter: TSynGutter read fGutter write SetGutter;
property HideSelection: Boolean read fHideSelection write SetHideSelection
default False;
property InsertCaret: TSynEditCaretType read FInsertCaret
write SetInsertCaret default ctVerticalLine;
property InsertMode: boolean read fInserting write SetInsertMode
default true;
property IsScrolling : Boolean read FIsScrolling;
property Keystrokes: TSynEditKeyStrokes
read FKeystrokes write SetKeystrokes stored False;
property MaxUndo: Integer read GetMaxUndo write SetMaxUndo default 1024;
property Options: TSynEditorOptions read GetOptions write SetOptions
default SYNEDIT_DEFAULT_OPTIONS;
property OverwriteCaret: TSynEditCaretType read FOverwriteCaret
write SetOverwriteCaret default ctBlock;
property RightEdge: Integer read fRightEdge write SetRightEdge default 80;
property RightEdgeColor: TColor
read fRightEdgeColor write SetRightEdgeColor default clSilver;
property ScrollHintColor: TColor read fScrollHintColor
write fScrollHintColor default clInfoBk;
property ScrollHintFormat: TScrollHintFormat read fScrollHintFormat
write fScrollHintFormat default shfTopLineOnly;
property ScrollBars: TScrollStyle
read FScrollBars write SetScrollBars default ssBoth;
property SelectedColor: TSynSelectedColor
read FSelectedColor write FSelectedColor;
property SelectionMode: TSynSelectionMode
read FSelectionMode write SetSelectionMode default smNormal;
property ActiveSelectionMode: TSynSelectionMode read fActiveSelectionMode
write SetActiveSelectionMode stored False;
property TabWidth: integer read fTabWidth write SetTabWidth default 8;
property WantReturns: boolean read fWantReturns write SetWantReturns default True;
property WantTabs: boolean read fWantTabs write SetWantTabs default False;
property WordWrap: boolean read GetWordWrap write SetWordWrap default False;
property WordWrapGlyph: TSynGlyph read fWordWrapGlyph write SetWordWrapGlyph;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClearBookmark: TPlaceMarkEvent read fOnClearMark
write fOnClearMark;
property OnCommandProcessed: TProcessCommandEvent
read fOnCommandProcessed write fOnCommandProcessed;
property OnContextHelp: TContextHelpEvent
read fOnContextHelp write fOnContextHelp;
property OnDropFiles: TDropFilesEvent read fOnDropFiles write fOnDropFiles;
property OnGutterClick: TGutterClickEvent
read fOnGutterClick write fOnGutterClick;
property OnGutterGetText: TGutterGetTextEvent read fOnGutterGetText
write fOnGutterGetText;
property OnGutterPaint: TGutterPaintEvent read fOnGutterPaint
write fOnGutterPaint;
property OnMouseCursor: TMouseCursorEvent read fOnMouseCursor
write fOnMouseCursor;
property OnKeyPress: TKeyPressWEvent read FOnKeyPressW write FOnKeyPressW;
property OnPaint: TPaintEvent read fOnPaint write fOnPaint;
property OnPlaceBookmark: TPlaceMarkEvent
read FOnPlaceMark write FOnPlaceMark;
property OnProcessUserCommand: TProcessCommandEvent
read FOnProcessUserCommand write FOnProcessUserCommand;
property OnReplaceText: TReplaceTextEvent read fOnReplaceText
write fOnReplaceText;
property OnSpecialLineColors: TSpecialLineColorsEvent
read fOnSpecialLineColors write fOnSpecialLineColors;
property OnStatusChange: TStatusChangeEvent
read fOnStatusChange write fOnStatusChange;
property OnPaintTransient: TPaintTransient
read fOnPaintTransient write fOnPaintTransient;
property OnScroll: TScrollEvent
read fOnScroll write fOnScroll;
published
property Cursor default crIBeam;
end;
TSynEdit = class(TCustomSynEdit)
published
// inherited properties
property Align;
{$IFDEF SYN_COMPILER_4_UP}
property Anchors;
property Constraints;
{$ENDIF}
property Color;
property ActiveLineColor;
{$IFDEF SYN_CLX}
{$ELSE}
property Ctl3D;
property ParentCtl3D;
{$ENDIF}
property Enabled;
property Font;
property Height;
property Name;
property ParentColor default False;
property ParentFont default False;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property Width;
// inherited events
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
{$IFDEF SYN_CLX}
{$ELSE}
{$IFDEF SYN_COMPILER_4_UP}
property OnEndDock;
property OnStartDock;
{$ENDIF}
{$ENDIF}
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnStartDrag;
// TCustomSynEdit properties
property BookMarkOptions;
property BorderStyle;
property ExtraLineSpacing;
property Gutter;
property HideSelection;
property Highlighter;
{$IFNDEF SYN_CLX}
property ImeMode;
property ImeName;
{$ENDIF}
property InsertCaret;
property InsertMode;
property Keystrokes;
property Lines;
property MaxScrollWidth;
property MaxUndo;
property Options;
property OverwriteCaret;
property ReadOnly;
property RightEdge;
property RightEdgeColor;
property ScrollHintColor;
property ScrollHintFormat;
property ScrollBars;
property SearchEngine;
property SelectedColor;
property SelectionMode;
property TabWidth;
property WantReturns;
property WantTabs;
property WordWrap;
property WordWrapGlyph;
// TCustomSynEdit events
property OnChange;
property OnClearBookmark;
property OnCommandProcessed;
property OnContextHelp;
property OnDropFiles;
property OnGutterClick;
property OnGutterGetText;
property OnGutterPaint;
property OnMouseCursor;
property OnPaint;
property OnPlaceBookmark;
property OnProcessCommand;
property OnProcessUserCommand;
property OnReplaceText;
property OnScroll;
property OnSpecialLineColors;
property OnStatusChange;
property OnPaintTransient;
end;
implementation
{$R SynEdit.res}
uses
{$IFDEF SYN_CLX}
QStdActns,
QClipbrd,
QSynEditWordWrap,
QSynEditStrConst;
{$ELSE}
{$IFDEF SYN_COMPILER_4_UP}
StdActns,
{$ENDIF}
Clipbrd,
ShellAPI,
SynEditWordWrap,
SynEditStrConst;
{$ENDIF}
{$IFDEF SYN_CLX}
const
FrameWidth = 2; { the border width when BoderStyle = bsSingle (until we support TWidgetStyle...) }
{$ENDIF}
function CeilOfIntDiv(Dividend: Cardinal; Divisor: Word): Word;
Var
Remainder: Word;
begin
DivMod(Dividend, Divisor, Result, Remainder);
if Remainder > 0 then
Inc(Result);
end;
function TrimTrailingSpaces(const S: WideString): WideString;
var
I: Integer;
begin
I := Length(S);
while (I > 0) and ((S[I] = #32) or (S[I] = #9)) do
Dec(I);
Result := Copy(S, 1, I);
end;
{ THookedCommandHandlerEntry }
type
THookedCommandHandlerEntry = class(TObject)
private
fEvent: THookedCommandEvent;
fData: pointer;
constructor Create(AEvent: THookedCommandEvent; AData: pointer);
function Equals(AEvent: THookedCommandEvent): Boolean;
end;
constructor THookedCommandHandlerEntry.Create(AEvent: THookedCommandEvent;
AData: pointer);
begin
inherited Create;
fEvent := AEvent;
fData := AData;
end;
function THookedCommandHandlerEntry.Equals(AEvent: THookedCommandEvent): Boolean;
begin
with TMethod(fEvent) do
Result := (Code = TMethod(AEvent).Code) and (Data = TMethod(AEvent).Data);
end;
{ TCustomSynEdit }
function TCustomSynEdit.PixelsToNearestRowColumn(aX, aY: Integer): TDisplayCoord;
// Result is in display coordinates
var
f: Single;
begin
{$IFDEF SYN_CLX}
with ClientRect.TopLeft do
begin
Dec(aX, X);
Dec(aY, Y);
end;
{$ENDIF}
f := (aX - fGutterWidth - 2) / fCharWidth;
// don't return a partially visible last line
if aY >= fLinesInWindow * fTextHeight then
begin
aY := fLinesInWindow * fTextHeight - 1;
if aY < 0 then
aY := 0;
end;
Result.Column := Max(1, LeftChar + Round(f));
Result.Row := Max(1, TopLine + (aY div fTextHeight));
end;
function TCustomSynEdit.PixelsToRowColumn(aX, aY: Integer): TDisplayCoord;
begin
{$IFDEF SYN_CLX}
with ClientRect.TopLeft do
begin
Dec(aX, X);
Dec(aY, Y);
end;
{$ENDIF}
Result.Column := Max(1, LeftChar + ((aX - fGutterWidth - 2) div fCharWidth));
Result.Row := Max(1, TopLine + (aY div fTextHeight));
end;
function TCustomSynEdit.RowColumnToPixels(const RowCol: TDisplayCoord): TPoint;
begin
Result.X := (RowCol.Column-1) * fCharWidth + fTextOffset;
Result.Y := (RowCol.Row - fTopLine) * fTextHeight;
{$IFDEF SYN_CLX}
with ClientRect.TopLeft do
begin
Inc(Result.X, X);
Inc(Result.Y, Y);
end;
{$ENDIF}
end;
procedure TCustomSynEdit.ComputeCaret(X, Y: Integer);
//X,Y are pixel coordinates
var
vCaretNearestPos : TDisplayCoord;
begin
vCaretNearestPos := PixelsToNearestRowColumn(X, Y);
vCaretNearestPos.Row := MinMax(vCaretNearestPos.Row, 1, DisplayLineCount);
SetInternalDisplayXY(vCaretNearestPos);
end;
procedure TCustomSynEdit.ComputeScroll(X, Y: Integer);
//X,Y are pixel coordinates
var
iScrollBounds: TRect; { relative to the client area }
begin
{ don't scroll if dragging text from other control }
if (not MouseCapture) and (not Dragging) then
begin
fScrollTimer.Enabled := False;
Exit;
end;
iScrollBounds := Bounds(fGutterWidth, 0, fCharsInWindow * fCharWidth,
fLinesInWindow * fTextHeight);
if BorderStyle = bsNone then
InflateRect(iScrollBounds, -2, -2);
if X < iScrollBounds.Left then
fScrollDeltaX := (X - iScrollBounds.Left) div fCharWidth - 1
else if X >= iScrollBounds.Right then
fScrollDeltaX := (X - iScrollBounds.Right) div fCharWidth + 1
else
fScrollDeltaX := 0;
if Y < iScrollBounds.Top then
fScrollDeltaY := (Y - iScrollBounds.Top) div fTextHeight - 1
else if Y >= iScrollBounds.Bottom then
fScrollDeltaY := (Y - iScrollBounds.Bottom) div fTextHeight + 1
else
fScrollDeltaY := 0;
fScrollTimer.Enabled := (fScrollDeltaX <> 0) or (fScrollDeltaY <> 0);
end;
procedure TCustomSynEdit.DoCopyToClipboard(const SText: WideString);
{$IFNDEF SYN_CLX}
var
Mem: HGLOBAL;
P: PByte;
SLen: Integer;
{$ENDIF}
begin
if SText = '' then Exit;
SetClipboardText(SText);
{$IFDEF SYN_CLX}
end;
{$ELSE}
SLen := Length(SText);
// Open and Close are the only TClipboard methods we use because TClipboard
// is very hard (impossible) to work with if you want to put more than one
// format on it at a time.
Clipboard.Open;
try
// Copy it in our custom format so we know what kind of block it is.
// That effects how it is pasted in.
// This format is kept as ANSI to be compatible with programs using the
// ANSI version of Synedit.
Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
sizeof(TSynSelectionMode) + SLen + 1);
if Mem <> 0 then
begin
P := GlobalLock(Mem);
try
if P <> nil then
begin
// Our format: TSynSelectionMode value followed by Ansi-text.
PSynSelectionMode(P)^ := fActiveSelectionMode;
inc(P, SizeOf(TSynSelectionMode));
Move(PAnsiChar(string(SText))^, P^, SLen + 1);
SetClipboardData(SynEditClipboardFormat, Mem);
end;
finally
GlobalUnlock(Mem);
end;
end;
// Don't free Mem! It belongs to the clipboard now, and it will free it
// when it is done with it.
finally
Clipboard.Close;
end;
end;
{$ENDIF}
procedure TCustomSynEdit.CopyToClipboard;
var
SText: WideString;
ChangeTrim: Boolean;
begin
if SelAvail then
begin
ChangeTrim := (fActiveSelectionMode = smColumn) and (eoTrimTrailingSpaces in Options);
try
if ChangeTrim then
Exclude(fOptions, eoTrimTrailingSpaces);
SText := SelText;
finally
if ChangeTrim then
Include(fOptions, eoTrimTrailingSpaces);
end;
DoCopyToClipboard(SText);
end;
end;
procedure TCustomSynEdit.CutToClipboard;
begin
if not ReadOnly and SelAvail then
begin
BeginUndoBlock;
try
DoCopyToClipboard(SelText);
SelText := '';
finally
EndUndoBlock;
end;
end;
end;
constructor TCustomSynEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fLines := TSynEditStringList.Create(ExpandAtWideGlyphs);
fOrigLines := fLines;
with TSynEditStringList(fLines) do
begin
OnChange := LinesChanged;
OnChanging := LinesChanging;
OnCleared := ListCleared;
OnDeleted := ListDeleted;
OnInserted := ListInserted;
OnPutted := ListPutted;
end;
fFontDummy := TFont.Create;
fUndoList := TSynEditUndoList.Create;
fUndoList.OnAddedUndo := UndoRedoAdded;
fOrigUndoList := fUndoList;
fRedoList := TSynEditUndoList.Create;
fRedoList.OnAddedUndo := UndoRedoAdded;
fOrigRedoList := fRedoList;
{$IFDEF SYN_COMPILER_4_UP}
{$IFDEF SYN_CLX}
{$ELSE}
DoubleBuffered := False;
{$ENDIF}
{$ENDIF}
fActiveLineColor := clNone;
fSelectedColor := TSynSelectedColor.Create;
fSelectedColor.OnChange := SelectedColorsChanged;
fBookMarkOpt := TSynBookMarkOpt.Create(Self);
fBookMarkOpt.OnChange := BookMarkOptionsChanged;
// fRightEdge has to be set before FontChanged is called for the first time
fRightEdge := 80;
fGutter := TSynGutter.Create;
fGutter.OnChange := GutterChanged;
fGutterWidth := fGutter.Width;
fWordWrapGlyph := TSynGlyph.Create(HINSTANCE, 'SynEditWrapped', clLime);
fWordWrapGlyph.OnChange := WordWrapGlyphChange;
fTextOffset := fGutterWidth + 2;
ControlStyle := ControlStyle + [csOpaque, csSetCaption];
{$IFDEF SYN_COMPILER_7_UP}
{$IFNDEF SYN_CLX}
ControlStyle := ControlStyle + [csNeedsBorderPaint];
{$ENDIF}
{$ENDIF}
Height := 150;
Width := 200;
Cursor := crIBeam;
Color := clWindow;
{$IFDEF SYN_WIN32}
fFontDummy.Name := 'Courier New';
fFontDummy.Size := 10;
{$ENDIF}
{$IFDEF SYN_KYLIX}
fFontDummy.Name := 'adobe-courier';
if fFontDummy.Name = 'adobe-courier' then
fFontDummy.Size := 12
else begin
fFontDummy.Name := 'terminal';
fFontDummy.Size := 14;
end;
{$ENDIF}
{$IFDEF SYN_COMPILER_3_UP}
fFontDummy.CharSet := DEFAULT_CHARSET;
{$ENDIF}
fTextDrawer := TheTextDrawer.Create([fsBold], fFontDummy);
Font.Assign(fFontDummy);
Font.OnChange := SynFontChanged;
ParentFont := False;
ParentColor := False;
TabStop := True;
fInserting := True;
fMaxScrollWidth := 1024;
fScrollBars := ssBoth;
fBorderStyle := bsSingle;
fInsertCaret := ctVerticalLine;
fOverwriteCaret := ctBlock;
FSelectionMode := smNormal;
fActiveSelectionMode := smNormal;
fFocusList := TList.Create;
fKbdHandler := TSynEditKbdHandler.Create;
fKeystrokes := TSynEditKeyStrokes.Create(Self);
fMarkList := TSynEditMarkList.Create(self);
fMarkList.OnChange := MarkListChange;
SetDefaultKeystrokes;
fRightEdgeColor := clSilver;
fWantReturns := True;
fWantTabs := False;
fTabWidth := 8;
fLeftChar := 1;
fTopLine := 1;
fCaretX := 1;
fLastCaretX := 1;
fCaretY := 1;
fBlockBegin.Char := 1;
fBlockBegin.Line := 1;
fBlockEnd := fBlockBegin;
fOptions := SYNEDIT_DEFAULT_OPTIONS;
fScrollTimer := TTimer.Create(Self);
fScrollTimer.Enabled := False;
fScrollTimer.Interval := 100;
fScrollTimer.OnTimer := ScrollTimerHandler;
{$IFDEF SYN_CLX}
InputKeys := [ikArrows, ikChars, ikReturns, ikEdit, ikNav, ikEsc];
FHScrollBar := TSynEditScrollbar.Create(self);
FHScrollBar.Kind := sbHorizontal;
FHScrollBar.Height := CYHSCROLL;
FHScrollBar.OnScroll := ScrollEvent;
FVScrollBar := TSynEditScrollbar.Create(self);
FVScrollBar.Kind := sbVertical;
FVScrollBar.Width := CXVSCROLL;
FVScrollBar.OnScroll := ScrollEvent;
// Set parent after BOTH scrollbars are created.
FHScrollBar.Parent := Self;
FHScrollBar.Color := clScrollBar;
FVScrollBar.Parent := Self;
FVScrollBar.Color := clScrollBar;
{$ENDIF}
fScrollHintColor := clInfoBk;
fScrollHintFormat := shfTopLineOnly;
SynFontChanged(nil);
end;
{$IFNDEF SYN_CLX}
procedure TCustomSynEdit.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
begin
// Clear WindowText to avoid it being used as Caption, or else window creation will
// fail if it's bigger than 64KB. It's useless to set the Caption anyway.
StrDispose(WindowText);
WindowText := nil;
inherited CreateParams(Params);
with Params do
begin
WindowClass.Style := WindowClass.Style and not ClassStylesOff;
Style := Style or BorderStyles[fBorderStyle] or WS_CLIPCHILDREN;
if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
if not (csDesigning in ComponentState) then
begin
// Necessary for unicode support, especially IME won't work else
if Win32PlatformIsUnicode then
WindowClass.lpfnWndProc := @DefWindowProcW;
end;
end;
end;
{$ENDIF}
procedure TCustomSynEdit.DecPaintLock;
var
vAuxPos: TDisplayCoord;
begin
Assert(fPaintLock > 0);
Dec(fPaintLock);
if (fPaintLock = 0) and HandleAllocated then
begin
if sfScrollbarChanged in fStateFlags then
UpdateScrollbars;
// Locks the caret inside the visible area
if WordWrap and ([scCaretX,scCaretY] * fStatusChanges <> []) then
begin
vAuxPos := DisplayXY;
// This may happen in the last row of a line or in rows which length is
// greater than CharsInWindow (Tabs and Spaces are allowed beyond
// CharsInWindow while wrapping the lines)
if (vAuxPos.Column > CharsInWindow +1) and (CharsInWindow > 0) then
begin
if fCaretAtEOL then
fCaretAtEOL := False
else
begin
if scCaretY in fStatusChanges then
begin
vAuxPos.Column := CharsInWindow + 1;
fCaretX := DisplayToBufferPos(vAuxPos).Char;
Include(fStatusChanges,scCaretX);
UpdateLastCaretX;
end;
end;
Include(fStateFlags, sfCaretChanged);
end;
end;
if sfCaretChanged in fStateFlags then
UpdateCaret;
if fStatusChanges <> [] then
DoOnStatusChange(fStatusChanges);
end;
end;
destructor TCustomSynEdit.Destroy;
begin
Highlighter := nil;
if (fChainedEditor <> nil) or (fLines <> fOrigLines) then
RemoveLinesPointer;
inherited Destroy;
// free listeners while other fields are still valid
// do not use FreeAndNil, it first nils and then freey causing problems with
// code accessing fHookedCommandHandlers while destruction
fHookedCommandHandlers.Free;
fHookedCommandHandlers := nil;
// do not use FreeAndNil, it first nils and then frees causing problems with
// code accessing fPlugins while destruction
fPlugins.Free;
fPlugins := nil;
fMarkList.Free;
fBookMarkOpt.Free;
fKeyStrokes.Free;
fKbdHandler.Free;
fFocusList.Free;
fSelectedColor.Free;
fOrigUndoList.Free;
fOrigRedoList.Free;
fGutter.Free;
fWordWrapGlyph.Free;
fTextDrawer.Free;
fInternalImage.Free;
fFontDummy.Free;
fOrigLines.Free;
end;
function TCustomSynEdit.GetBlockBegin: TBufferCoord;
begin
if (fBlockEnd.Line < fBlockBegin.Line)
or ((fBlockEnd.Line = fBlockBegin.Line) and (fBlockEnd.Char < fBlockBegin.Char))
then
Result := fBlockEnd
else
Result := fBlockBegin;
end;
function TCustomSynEdit.GetBlockEnd: TBufferCoord;
begin
if (fBlockEnd.Line < fBlockBegin.Line)
or ((fBlockEnd.Line = fBlockBegin.Line) and (fBlockEnd.Char < fBlockBegin.Char))
then
Result := fBlockBegin
else
Result := fBlockEnd;
end;
procedure TCustomSynEdit.SynFontChanged(Sender: TObject);
begin
RecalcCharExtent;
SizeOrFontChanged(True);
end;
function TCustomSynEdit.GetFont: TFont;
begin
Result := inherited Font;
end;
function TCustomSynEdit.GetLineText: WideString;
begin
if (CaretY >= 1) and (CaretY <= Lines.Count) then
Result := Lines[CaretY - 1]
else
Result := '';
end;
function TCustomSynEdit.GetSelAvail: Boolean;
begin
Result := (fBlockBegin.Char <> fBlockEnd.Char) or
((fBlockBegin.Line <> fBlockEnd.Line) and (fActiveSelectionMode <> smColumn));
end;
function TCustomSynEdit.GetSelTabBlock: Boolean;
begin
Result := (fBlockBegin.Line <> fBlockEnd.Line) and (fActiveSelectionMode <> smColumn);
end;
function TCustomSynEdit.GetSelTabLine: Boolean;
begin
Result := (BlockBegin.Char <= 1) and (BlockEnd.Char > length(Lines[CaretY - 1])) and SelAvail;
end;
function TCustomSynEdit.GetSelText: WideString;
function CopyPadded(const S: WideString; Index, Count: Integer): WideString;
var
SrcLen: Integer;
DstLen: Integer;
i: Integer;
P: PWideChar;
begin
SrcLen := Length(S);
DstLen := Index + Count;
if SrcLen >= DstLen then
Result := Copy(S, Index, Count)
else begin
SetLength(Result, DstLen);
P := PWideChar(Result);
StrCopyW(P, PWideChar(Copy(S, Index, Count)));
Inc(P, Length(S));
for i := 0 to DstLen - Srclen - 1 do
P[i] := #32;
end;
end;
procedure CopyAndForward(const S: WideString; Index, Count: Integer; var P:
PWideChar);
var
pSrc: PWideChar;
SrcLen: Integer;
DstLen: Integer;
begin
SrcLen := Length(S);
if (Index <= SrcLen) and (Count > 0) then
begin
Dec(Index);
pSrc := PWideChar(S) + Index;
DstLen := Min(SrcLen - Index, Count);
Move(pSrc^, P^, DstLen * sizeof(WideChar));
Inc(P, DstLen);
P^ := #0;
end;
end;
function CopyPaddedAndForward(const S: WideString; Index, Count: Integer;
var P: PWideChar): Integer;
var
OldP: PWideChar;
Len, i: Integer;
begin
Result := 0;
OldP := P;
CopyAndForward(S, Index, Count, P);
Len := Count - (P - OldP);
if not (eoTrimTrailingSpaces in Options) then
begin
for i := 0 to Len - 1 do
P[i] := #32;
Inc(P, Len);
end
else
Result:= Len;
end;
var
First, Last, TotalLen: Integer;
ColFrom, ColTo: Integer;
I: Integer;
l, r: Integer;
s: WideString;
P: PWideChar;
cRow: Integer;
vAuxLineChar: TBufferCoord;
vAuxRowCol: TDisplayCoord;
vTrimCount: Integer;
begin
if not SelAvail then
Result := ''
else begin
ColFrom := BlockBegin.Char;
First := BlockBegin.Line - 1;
//
ColTo := BlockEnd.Char;
Last := BlockEnd.Line - 1;
//
TotalLen := 0;
case fActiveSelectionMode of
smNormal:
if (First = Last) then
Result := Copy(Lines[First], ColFrom, ColTo - ColFrom)
else begin
// step1: calculate total length of result string
TotalLen := Max(0, Length(Lines[First]) - ColFrom + 1);
for i := First + 1 to Last - 1 do
Inc(TotalLen, Length(Lines[i]));
Inc(TotalLen, ColTo - 1);
Inc(TotalLen, Length(SLineBreak) * (Last - First));
// step2: build up result string
SetLength(Result, TotalLen);
P := PWideChar(Result);
CopyAndForward(Lines[First], ColFrom, MaxInt, P);
CopyAndForward(SLineBreak, 1, MaxInt, P);
for i := First + 1 to Last - 1 do
begin
CopyAndForward(Lines[i], 1, MaxInt, P);
CopyAndForward(SLineBreak, 1, MaxInt, P);
end;
CopyAndForward(Lines[Last], 1, ColTo - 1, P);
end;
smColumn:
begin
with BufferToDisplayPos(BlockBegin) do
begin
First := Row;
ColFrom := Column;
end;
with BufferToDisplayPos(BlockEnd) do
begin
Last := Row;
ColTo := Column;
end;
if ColFrom > ColTo then
SwapInt(ColFrom, ColTo);
// step1: pre-allocate string large enough for worst case
TotalLen := ((ColTo - ColFrom) + Length(sLineBreak)) *
(Last - First +1);
SetLength(Result, TotalLen);
P := PWideChar(Result);
// step2: copy chunks to the pre-allocated string
TotalLen := 0;
for cRow := First to Last do
begin
vAuxRowCol.Row := cRow;
vAuxRowCol.Column := ColFrom;
vAuxLineChar := DisplayToBufferPos(vAuxRowCol);
l := vAuxLineChar.Char;
s := Lines[vAuxLineChar.Line - 1];
vAuxRowCol.Column := ColTo;
r := DisplayToBufferPos(vAuxRowCol).Char;
vTrimCount := CopyPaddedAndForward(s, l, r - l, P);
TotalLen := TotalLen + (r - l) - vTrimCount + Length(sLineBreak);
CopyAndForward(sLineBreak, 1, MaxInt, P);
end;
SetLength(Result, TotalLen - Length(sLineBreak));
end;
smLine:
begin
// If block selection includes LastLine,
// line break code(s) of the last line will not be added.
// step1: calculate total length of result string
for i := First to Last do
Inc(TotalLen, Length(Lines[i]) + Length(SLineBreak));
if Last = Lines.Count then
Dec(TotalLen, Length(SLineBreak));
// step2: build up result string
SetLength(Result, TotalLen);
P := PWideChar(Result);
for i := First to Last - 1 do
begin
CopyAndForward(Lines[i], 1, MaxInt, P);
CopyAndForward(SLineBreak, 1, MaxInt, P);
end;
CopyAndForward(Lines[Last], 1, MaxInt, P);
if (Last + 1) < Lines.Count then
CopyAndForward(SLineBreak, 1, MaxInt, P);
end;
end;
end;
end;
function TCustomSynEdit.SynGetText: WideString;
begin
Result := Lines.Text;
end;
function TCustomSynEdit.GetWordAtCursor: WideString;
var
bBegin: TBufferCoord;
bEnd: TBufferCoord;
begin
bBegin := GetBlockBegin;
bEnd := GetBlockEnd;
SetBlockBegin(WordStart);
SetBlockEnd(WordEnd);
Result := SelText;
SetBlockBegin(bBegin);
SetBlockEnd(bEnd);
end;
procedure TCustomSynEdit.HideCaret;
begin
if sfCaretVisible in fStateFlags then
{$IFDEF SYN_CLX}
kTextDrawer.HideCaret(Self);
{$ELSE}
if Windows.HideCaret(Handle) then
{$ENDIF}
Exclude(fStateFlags, sfCaretVisible);
end;
procedure TCustomSynEdit.IncPaintLock;
begin
inc(fPaintLock);
end;
procedure TCustomSynEdit.InvalidateGutter;
begin
InvalidateGutterLines(-1, -1);
end;
procedure TCustomSynEdit.InvalidateGutterLine(aLine: Integer);
begin
if (aLine < 1) or (aLine > Lines.Count) then
Exit;
InvalidateGutterLines(aLine, aLine);
end;
procedure TCustomSynEdit.InvalidateGutterLines(FirstLine, LastLine: integer);
// note: FirstLine and LastLine don't need to be in correct order
var
rcInval: TRect;
begin
if Visible and HandleAllocated then
if (FirstLine = -1) and (LastLine = -1) then
begin
rcInval := Rect(0, 0, fGutterWidth, ClientHeight);
{$IFDEF SYN_CLX}
with GetClientRect do
OffsetRect(rcInval, Left, Top);
{$ENDIF}
if sfLinesChanging in fStateFlags then
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
else
InvalidateRect(rcInval, False);
end
else begin
{ find the visible lines first }
if (LastLine < FirstLine) then
SwapInt(LastLine, FirstLine);
if WordWrap then
begin
FirstLine := LineToRow(FirstLine);
if LastLine <= Lines.Count then
LastLine := LineToRow(LastLine)
else
LastLine := MaxInt;
end;
FirstLine := Max(FirstLine, TopLine);
LastLine := Min(LastLine, TopLine + LinesInWindow);
{ any line visible? }
if (LastLine >= FirstLine) then
begin
rcInval := Rect(0, fTextHeight * (FirstLine - TopLine),
fGutterWidth, fTextHeight * (LastLine - TopLine + 1));
{$IFDEF SYN_CLX}
with GetClientRect do
OffsetRect(rcInval, Left, Top);
{$ENDIF}
if sfLinesChanging in fStateFlags then
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
else
InvalidateRect(rcInval, False);
end;
end;
end;
procedure TCustomSynEdit.InvalidateLines(FirstLine, LastLine: integer);
// note: FirstLine and LastLine don't need to be in correct order
var
rcInval: TRect;
begin
if Visible and HandleAllocated then
if (FirstLine = -1) and (LastLine = -1) then
begin
rcInval := ClientRect;
Inc(rcInval.Left, fGutterWidth);
if sfLinesChanging in fStateFlags then
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
else
InvalidateRect(rcInval, False);
end
else begin
FirstLine := Max(FirstLine,1);
LastLine := Max(LastLine,1);
{ find the visible lines first }
if (LastLine < FirstLine) then
SwapInt(LastLine, FirstLine);
if LastLine >= Lines.Count then
LastLine := MaxInt; // paint empty space beyond last line
if WordWrap then
begin
FirstLine := LineToRow(FirstLine);
// Could avoid this conversion if (First = Last) and
// (Length < CharsInWindow) but the dependency isn't worth IMO.
if LastLine < Lines.Count then
LastLine := LineToRow(LastLine + 1) - 1;
end;
// TopLine is in display coordinates, so FirstLine and LastLine must be
// converted previously.
FirstLine := Max(FirstLine, TopLine);
LastLine := Min(LastLine, TopLine + LinesInWindow);
{ any line visible? }
if (LastLine >= FirstLine) then
begin
rcInval := Rect(fGutterWidth, fTextHeight * (FirstLine - TopLine),
ClientWidth, fTextHeight * (LastLine - TopLine + 1));
{$IFDEF SYN_CLX}
with GetClientRect do
OffsetRect(rcInval, Left, Top);
{$ENDIF}
if sfLinesChanging in fStateFlags then
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
else
InvalidateRect(rcInval, False);
end;
end;
end;
procedure TCustomSynEdit.InvalidateSelection;
begin
InvalidateLines(BlockBegin.Line, BlockEnd.Line);
end;
{$IFDEF SYN_COMPILER_5}
function TryStrToInt(const S: string; out Value: Integer): Boolean;
var
E: Integer;
begin
Val(S, Value, E);
Result := E = 0;
end;
{$ENDIF}
procedure TCustomSynEdit.KeyUp(var Key: Word; Shift: TShiftState);
{$IFDEF SYN_LINUX}
var
Code: Byte;
{$ENDIF}
{$IFNDEF SYN_CLX}
var
CharCode: Integer;
KeyMsg: TWMKey;
{$ENDIF}
begin
{$IFDEF SYN_LINUX}
// uniform Keycode: key has the same value wether Shift is pressed or not
if Key <= 255 then
begin
Code := XKeysymToKeycode(Xlib.PDisplay(QtDisplay), Key);
Key := XKeycodeToKeysym(Xlib.PDisplay(QtDisplay), Code, 0);
if AnsiChar(Key) in ['a'..'z'] then Key := Ord(UpCase(AnsiChar(Key)));
end;
{$ENDIF}
{$IFNDEF SYN_CLX}
if (ssAlt in Shift) and (Key >= VK_NUMPAD0) and (Key <= VK_NUMPAD9) then
FCharCodeString := FCharCodeString + IntToStr(Key - VK_NUMPAD0);
if Key = VK_MENU then
begin
if (FCharCodeString <> '') and TryStrToInt(FCharCodeString, CharCode) and
(CharCode >= 256) and (CharCode <= 65535) then
begin
KeyMsg.Msg := WM_CHAR;
KeyMsg.CharCode := CharCode;
KeyMsg.Unused := 0;
KeyMsg.KeyData := 0;
DoKeyPressW(KeyMsg);
FIgnoreNextChar := True;
end;
FCharCodeString := '';
end;
{$ENDIF}
inherited;
fKbdHandler.ExecuteKeyUp(Self, Key, Shift);
end;
procedure TCustomSynEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
Data: pointer;
C: WideChar;
Cmd: TSynEditorCommand;
{$IFDEF SYN_LINUX}
Code: Byte;
{$ENDIF}
begin
{$IFDEF SYN_LINUX}
// uniform Keycode: key has the same value wether Shift is pressed or not
if Key <= 255 then
begin
Code := XKeysymToKeycode(Xlib.PDisplay(QtDisplay), Key);
Key := XKeycodeToKeysym(Xlib.PDisplay(QtDisplay), Code, 0);
if AnsiChar(Key) in ['a'..'z'] then Key := Ord(UpCase(AnsiChar(Key)));
end;
{$ENDIF}
inherited;
fKbdHandler.ExecuteKeyDown(Self, Key, Shift);
Data := nil;
C := #0;
try
Cmd := TranslateKeyCode(Key, Shift, Data);
if Cmd <> ecNone then begin
Key := 0; // eat it.
Include(fStateFlags, sfIgnoreNextChar);
CommandProcessor(Cmd, C, Data);
end
else
Exclude(fStateFlags, sfIgnoreNextChar);
finally
if Data <> nil then
FreeMem(Data);
end;
end;
procedure TCustomSynEdit.Loaded;
begin
inherited Loaded;
GutterChanged(Self);
UpdateScrollBars;
end;
procedure TCustomSynEdit.KeyPress(var Key: Char);
{$IFDEF SYN_CLX}
var
KeyW: WideChar;
{$ENDIF}
begin
{$IFDEF SYN_CLX}
KeyW := WideChar(Key);
DoKeyPressW(KeyW);
if KeyW > High(AnsiChar) then
Key := #0
else
Key := AnsiChar(KeyW);
{$ELSE}
// for Windows, don't do anything here
{$ENDIF}
end;
{$IFDEF SYN_CLX}
procedure TCustomSynEdit.DoKeyPressW(var Key: WideChar);
begin
if (csNoStdEvents in ControlStyle) then Exit;
if (Key <> #0) and Assigned(FOnKeyPressW) then
FOnKeyPressW(Self, Key);
if WideChar(Key) <> #0 then
KeyPressW(Key);
end;
{$ELSE}
type
TAccessWinControl = class(TWinControl);
procedure TCustomSynEdit.DoKeyPressW(var Message: TWMKey);
var
Form: TCustomForm;
Key: WideChar;
begin
if FIgnoreNextChar then
begin
FIgnoreNextChar := False;
Exit;
end;
Key := WideChar(Message.CharCode);
Form := GetParentForm(Self);
if (Form <> nil) and (Form <> TWinControl(Self)) and Form.KeyPreview and
(Key <= High(AnsiChar)) and TAccessWinControl(Form).DoKeyPress(Message)
then
Exit;
Key := WideChar(Message.CharCode);
if (csNoStdEvents in ControlStyle) then Exit;
if Assigned(FOnKeyPressW) then
FOnKeyPressW(Self, Key);
if WideChar(Key) <> #0 then
KeyPressW(Key);
end;
{$ENDIF}
procedure TCustomSynEdit.KeyPressW(var Key: WideChar);
begin
// don't fire the event if key is to be ignored
if not (sfIgnoreNextChar in fStateFlags) then
begin
fKbdHandler.ExecuteKeyPress(Self, Key);
CommandProcessor(ecChar, Key, nil);
end
else
// don't ignore further keys
Exclude(fStateFlags, sfIgnoreNextChar);
end;
function TCustomSynEdit.LeftSpaces(const Line: WideString): Integer;
begin
Result := LeftSpacesEx(Line, False);
end;
function TCustomSynEdit.LeftSpacesEx(const Line: WideString; WantTabs: Boolean): Integer;
var
p: PWideChar;
begin
p := PWideChar(Line);
if Assigned(p) and (eoAutoIndent in fOptions) then
begin
Result := 0;
while (p^ >= #1) and (p^ <= #32) do
begin
if (p^ = #9) and WantTabs then
Inc(Result, TabWidth)
else
Inc(Result);
Inc(p);
end;
end
else
Result := 0;
end;
function TCustomSynEdit.GetLeftSpacing(CharCount: Integer; WantTabs: Boolean): WideString;
begin
if WantTabs and not(eoTabsToSpaces in Options) and (CharCount >= TabWidth) then
Result := WideStringOfChar(#9, CharCount div TabWidth) +
WideStringOfChar(#32, CharCount mod TabWidth)
else
Result := WideStringOfChar(#32, CharCount);
end;
procedure TCustomSynEdit.LinesChanging(Sender: TObject);
begin
Include(fStateFlags, sfLinesChanging);
end;
procedure TCustomSynEdit.LinesChanged(Sender: TObject);
var
vOldMode: TSynSelectionMode;
begin
Exclude(fStateFlags, sfLinesChanging);
if HandleAllocated then
begin
UpdateScrollBars;
vOldMode := fActiveSelectionMode;
SetBlockBegin(CaretXY);
fActiveSelectionMode := vOldMode;
InvalidateRect(fInvalidateRect, False);
FillChar(fInvalidateRect, SizeOf(TRect), 0);
if fGutter.ShowLineNumbers and fGutter.AutoSize then
fGutter.AutoSizeDigitCount(Lines.Count);
if not (eoScrollPastEof in Options) then
TopLine := TopLine;
end;
end;
procedure TCustomSynEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
bWasSel: Boolean;
bStartDrag: Boolean;
TmpBegin, TmpEnd: TBufferCoord;
begin
{$IFDEF SYN_CLX}
if not PtInRect(GetClientRect, Point(X,Y)) then
Exit;
{$ENDIF}
TmpBegin := FBlockBegin;
TmpEnd := FBlockEnd;
bWasSel := False;
bStartDrag := False;
if Button = mbLeft then
begin
if SelAvail then
begin
//remember selection state, as it will be cleared later
bWasSel := True;
fMouseDownX := X;
fMouseDownY := Y;
end;
end;
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and (ssDouble in Shift) then Exit;
fKbdHandler.ExecuteMouseDown(Self, Button, Shift, X, Y);
if (Button in [mbLeft, mbRight]) then
begin
if Button = mbRight then
begin
if (eoRightMouseMovesCursor in Options) and
(SelAvail and not IsPointInSelection(DisplayToBufferPos(PixelsToRowColumn(X, Y)))
or not SelAvail) then
begin
InvalidateSelection;
FBlockEnd := FBlockBegin;
ComputeCaret(X, Y);
end
else
Exit;
end
else
ComputeCaret(X, Y);
end;
if Button = mbLeft then
begin
//I couldn't track down why, but sometimes (and definately not all the time)
//the block positioning is lost. This makes sure that the block is
//maintained in case they started a drag operation on the block
FBlockBegin := TmpBegin;
FBlockEnd := TmpEnd;
MouseCapture := True;
//if mousedown occurred in selected block begin drag operation
Exclude(fStateFlags, sfWaitForDragging);
if bWasSel and (eoDragDropEditing in fOptions) and (X >= fGutterWidth + 2)
and (SelectionMode = smNormal) and IsPointInSelection(DisplayToBufferPos(PixelsToRowColumn(X, Y))) then
begin
bStartDrag := True
end;
end;
if (Button = mbLeft) and bStartDrag then
Include(fStateFlags, sfWaitForDragging)
else
begin
if not (sfDblClicked in fStateFlags) then
begin
if ssShift in Shift then
//BlockBegin and BlockEnd are restored to their original position in the
//code from above and SetBlockEnd will take care of proper invalidation
SetBlockEnd(CaretXY)
else
begin
if (eoAltSetsColumnMode in Options) and (fActiveSelectionMode <> smLine) then
begin
if ssAlt in Shift then
SelectionMode := smColumn
else
SelectionMode := smNormal;
end;
//Selection mode must be set before calling SetBlockBegin
SetBlockBegin(CaretXY);
end;
end;
end;
if (X < fGutterWidth) then
Include(fStateFlags, sfPossibleGutterClick);
if (sfPossibleGutterClick in fStateFlags) and (Button = mbRight) then
begin
DoOnGutterClick(Button, X, Y)
end;
SetFocus;
{$IFNDEF SYN_CLX}
Windows.SetFocus(Handle);
{$ENDIF}
end;
procedure TCustomSynEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
P: TDisplayCoord;
begin
{$IFDEF SYN_CLX}
if not InDragDropOperation then
UpdateMouseCursor;
{$ENDIF}
inherited MouseMove(Shift, x, y);
if MouseCapture and (sfWaitForDragging in fStateFlags) then
begin
if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG))
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG)) then
begin
Exclude(fStateFlags, sfWaitForDragging);
BeginDrag(False);
{$IFDEF SYN_CLX}
MouseCapture := False;
{$ENDIF}
end;
end
else if (ssLeft in Shift) and MouseCapture then
begin
// should we begin scrolling?
ComputeScroll(X, Y);
{ compute new caret }
P := PixelsToNearestRowColumn(X, Y);
P.Row := MinMax(P.Row, 1, DisplayLineCount);
if fScrollDeltaX <> 0 then
P.Column := DisplayX;
if fScrollDeltaY <> 0 then
P.Row := DisplayY;
InternalCaretXY := DisplayToBufferPos(P);
BlockEnd := CaretXY;
if (sfPossibleGutterClick in fStateFlags) and (FBlockBegin.Line <> CaretXY.Line) then
Include(fStateFlags, sfGutterDragging);
end;
end;
procedure TCustomSynEdit.ScrollTimerHandler(Sender: TObject);
var
iMousePos: TPoint;
C: TDisplayCoord;
X, Y: Integer;
vCaret: TBufferCoord;
begin
GetCursorPos( iMousePos );
iMousePos := ScreenToClient( iMousePos );
C := PixelsToRowColumn( iMousePos.X, iMousePos.Y );
C.Row := MinMax(C.Row, 1, DisplayLineCount);
if fScrollDeltaX <> 0 then
begin
LeftChar := LeftChar + fScrollDeltaX;
X := LeftChar;
if fScrollDeltaX > 0 then // scrolling right?
Inc(X, CharsInWindow);
C.Column := X;
end;
if fScrollDeltaY <> 0 then
begin
{$IFDEF SYN_CLX}
if ssShift in Application.KeyState then
{$ELSE}
if GetKeyState(SYNEDIT_SHIFT) < 0 then
{$ENDIF}
TopLine := TopLine + fScrollDeltaY * LinesInWindow
else
TopLine := TopLine + fScrollDeltaY;
Y := TopLine;
if fScrollDeltaY > 0 then // scrolling down?
Inc(Y, LinesInWindow - 1);
C.Row := MinMax(Y, 1, DisplayLineCount);
end;
vCaret := DisplayToBufferPos(C);
if (CaretX <> vCaret.Char) or (CaretY <> vCaret.Line) then
begin
// changes to line / column in one go
IncPaintLock;
try
InternalCaretXY := vCaret;
// if MouseCapture is True we're changing selection. otherwise we're dragging
if MouseCapture then
SetBlockEnd(CaretXY);
finally
DecPaintLock;
end;
end;
ComputeScroll(iMousePos.x, iMousePos.y);
end;
procedure TCustomSynEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
fKbdHandler.ExecuteMouseUp(Self, Button, Shift, X, Y);
fScrollTimer.Enabled := False;
if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then
exit;
MouseCapture := False;
if (sfPossibleGutterClick in fStateFlags) and (X < fGutterWidth) and (Button <> mbRight) then
begin
DoOnGutterClick(Button, X, Y)
end
else if fStateFlags * [sfDblClicked, sfWaitForDragging] = [sfWaitForDragging] then
begin
ComputeCaret(X, Y);
if not(ssShift in Shift) then
SetBlockBegin(CaretXY);
SetBlockEnd(CaretXY);
Exclude(fStateFlags, sfWaitForDragging);
end;
Exclude(fStateFlags, sfDblClicked);
Exclude(fStateFlags, sfPossibleGutterClick);
Exclude(fStateFlags, sfGutterDragging);
end;
procedure TCustomSynEdit.DoOnGutterClick(Button: TMouseButton; X, Y: Integer);
var
i : Integer;
offs : Integer;
line : Integer;
allmrk: TSynEditMarks;
mark : TSynEditMark;
begin
if Assigned(fOnGutterClick) then
begin
line := PixelsToRowColumn(X,Y).Row;
if line <= Lines.Count then
begin
Marks.GetMarksForLine(line, allmrk);
offs := 0;
mark := nil;
for i := 1 to MAX_MARKS do
begin
if assigned(allmrk[i]) then
begin
Inc(offs, BookMarkOptions.XOffset);
if X < offs then
begin
mark := allmrk[i];
break;
end;
end;
end; //for
fOnGutterClick(Self, Button, X, Y, line, mark);
end;
end;
end;
procedure TCustomSynEdit.Paint;
var
rcClip, rcDraw: TRect;
nL1, nL2, nC1, nC2: Integer;
{$IFDEF SYN_CLX}
iRestoreViewPort: Boolean;
iClientRect: TRect;
iClientRegion: QRegionH;
iClip: QRegionH;
{$ENDIF}
begin
{$IFDEF SYN_CLX}
{ draws the lower-right corner of the scrollbars }
if FHScrollBar.Visible and FVScrollBar.Visible then
begin
Canvas.Brush.Color := FHScrollBar.Color;
Canvas.FillRect(Bounds(FVScrollBar.Left, FHScrollBar.Top,
FVScrollBar.Width, FHScrollBar.Height));
end;
{ validates the NC area }
iClientRect := GetClientRect;
iClientRegion := QRegion_create(@iClientRect, QRegionRegionType_Rectangle);
iClip := QPainter_clipRegion(Canvas.Handle);
QRegion_intersect(iClip, iClip, iClientRegion);
QRegion_destroy(iClientRegion);
if BorderStyle <> bsNone then
begin
{ draws the border }
iClientRect := Rect( 0, 0, Width, Height );
QClxDrawUtil_DrawWinPanel(Canvas.Handle, @iClientRect,
Palette.ColorGroup(cgActive), True, QBrushH(0));
{ sets transformation to ignore NC area }
OffsetRect(iClientRect, FrameWidth, FrameWidth);
QPainter_setViewport(Canvas.Handle, @iClientRect);
iRestoreViewPort := True;
end
else
iRestoreViewPort := False;
{ Compute the invalidated rect. }
rcClip := Canvas.ClipRect;
OffsetRect(rcClip, - iClientRect.Left, - iClientRect.Top);
{$ELSE}
// Get the invalidated rect. Compute the invalid area in lines / columns.
rcClip := Canvas.ClipRect;
{$ENDIF}
// columns
nC1 := LeftChar;
if (rcClip.Left > fGutterWidth + 2) then
Inc(nC1, (rcClip.Left - fGutterWidth - 2) div CharWidth);
nC2 := LeftChar +
(rcClip.Right - fGutterWidth - 2 + CharWidth - 1) div CharWidth;
// lines
nL1 := Max(TopLine + rcClip.Top div fTextHeight, TopLine);
nL2 := MinMax(TopLine + (rcClip.Bottom + fTextHeight - 1) div fTextHeight,
1, DisplayLineCount);
// Now paint everything while the caret is hidden.
HideCaret;
try
// First paint the gutter area if it was (partly) invalidated.
if (rcClip.Left < fGutterWidth) then
begin
rcDraw := rcClip;
rcDraw.Right := fGutterWidth;
PaintGutter(rcDraw, nL1, nL2);
end;
// Then paint the text area if it was (partly) invalidated.
if (rcClip.Right > fGutterWidth) then
begin
rcDraw := rcClip;
rcDraw.Left := Max(rcDraw.Left, fGutterWidth);
PaintTextLines(rcDraw, nL1, nL2, nC1, nC2);
end;
PluginsAfterPaint(Canvas, rcClip, nL1, nL2);
{$IFDEF SYN_CLX}
if iRestoreViewPort then
QPainter_setViewport(Canvas.Handle, 0, 0, Width, Height);
{$ENDIF}
// If there is a custom paint handler call it.
DoOnPaint;
DoOnPaintTransient(ttAfter);
finally
UpdateCaret;
end;
end;
procedure TCustomSynEdit.PaintGutter(const AClip: TRect;
const aFirstRow, aLastRow: Integer);
procedure DrawMark(aMark: TSynEditMark; var aGutterOff: Integer;
aMarkRow: Integer);
begin
if (not aMark.InternalImage) and Assigned(fBookMarkOpt.BookmarkImages) then
begin
if aMark.ImageIndex <= fBookMarkOpt.BookmarkImages.Count then
begin
if aMark.IsBookmark = BookMarkOptions.DrawBookmarksFirst then
aGutterOff := 0
else if aGutterOff = 0 then
aGutterOff := fBookMarkOpt.XOffset;
with fBookMarkOpt do
BookmarkImages.Draw(Canvas, LeftMargin + aGutterOff,
(aMarkRow - TopLine) * fTextHeight, aMark.ImageIndex);
Inc(aGutterOff, fBookMarkOpt.XOffset);
end;
end
else begin
if aMark.ImageIndex in [0..9] then
begin
if not Assigned(fInternalImage) then
begin
fInternalImage := TSynInternalImage.Create(HINSTANCE,
'SynEditInternalImages', 10);
end;
if aGutterOff = 0 then
begin
fInternalImage.Draw(Canvas, aMark.ImageIndex,
fBookMarkOpt.LeftMargin + aGutterOff,
(aMarkRow - TopLine) * fTextHeight, fTextHeight);
end;
Inc(aGutterOff, fBookMarkOpt.XOffset);
end;
end;
end;
var
cLine: Integer;
cMark: Integer;
rcLine: TRect;
aGutterOffs: PIntArray;
bHasOtherMarks: Boolean;
s: WideString;
vFirstLine: Integer;
vLastLine: Integer;
vMarkRow: Integer;
vGutterRow: Integer;
vLineTop: Integer;
{$IFNDEF SYN_CLX}
dc: HDC;
TextSize: TSize;
{$ENDIF}
begin
vFirstLine := RowToLine(aFirstRow);
vLastLine := RowToLine(aLastRow);
//todo: Does the following comment still apply?
// Changed to use fTextDrawer.BeginDrawing and fTextDrawer.EndDrawing only
// when absolutely necessary. Note: Never change brush / pen / font of the
// canvas inside of this block (only through methods of fTextDrawer)!
// If we have to draw the line numbers then we don't want to erase
// the background first. Do it line by line with TextRect instead
// and fill only the area after the last visible line.
{$IFDEF SYN_CLX}
{$ELSE}
dc := Canvas.Handle;
{$ENDIF}
if fGutter.Gradient then
SynDrawGradient(Canvas, fGutter.GradientStartColor, fGutter.GradientEndColor,
fGutter.GradientSteps, Rect(0, 0, fGutterWidth, ClientHeight), True);
Canvas.Brush.Color := fGutter.Color;
if fGutter.ShowLineNumbers then
begin
if fGutter.UseFontStyle then
fTextDrawer.SetBaseFont(fGutter.Font)
else
fTextDrawer.Style := [];
{$IFDEF SYN_CLX}
fTextDrawer.BeginDrawing(canvas);
{$ELSE}
fTextDrawer.BeginDrawing(dc);
{$ENDIF}
try
if fGutter.UseFontStyle then
fTextDrawer.SetForeColor(fGutter.Font.Color)
else
fTextDrawer.SetForeColor(Self.Font.Color);
fTextDrawer.SetBackColor(fGutter.Color);
// prepare the rect initially
rcLine := AClip;
rcLine.Right := Max(rcLine.Right, fGutterWidth - 2);
rcLine.Bottom := rcLine.Top;
for cLine := vFirstLine to vLastLine do
begin
vLineTop := (LineToRow(cLine) - TopLine) * fTextHeight;
if WordWrap and not fGutter.Gradient then
begin
// erase space between wrapped lines (from previous line to current one)
rcLine.Top := rcLine.Bottom;
rcLine.Bottom := vLineTop;
with rcLine do
fTextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcLine, '', 0);
end;
// next line rect
rcLine.Top := vLineTop;
rcLine.Bottom := rcLine.Top + fTextHeight;
s := fGutter.FormatLineNumber(cLine);
if Assigned(OnGutterGetText) then
OnGutterGetText(Self, cLine, s);
{$IFDEF SYN_CLX}
if fGutter.Gradient then
Canvas.Brush.Style := bsClear
else
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(rcLine);
Canvas.TextRect(rcLine, fGutter.LeftOffset, rcLine.Top, s);
// restore brush
if fGutter.Gradient then
Canvas.Brush.Style := bsSolid;
{$ELSE}
TextSize := GetTextSize(DC, PWideChar(s), Length(s));
if fGutter.Gradient then
begin
SetBkMode(DC, TRANSPARENT);
Windows.ExtTextOutW(DC, (fGutterWidth - fGutter.RightOffset - 2) - TextSize.cx,
rcLine.Top + ((fTextHeight - Integer(TextSize.cy)) div 2), 0,
@rcLine, PWideChar(s), Length(s), nil);
SetBkMode(DC, OPAQUE);
end
else
Windows.ExtTextOutW(DC, (fGutterWidth - fGutter.RightOffset - 2) - TextSize.cx,
rcLine.Top + ((fTextHeight - Integer(TextSize.cy)) div 2), ETO_OPAQUE,
@rcLine, PWideChar(s), Length(s), nil);
{$ENDIF}
end;
// now erase the remaining area if any
if (AClip.Bottom > rcLine.Bottom) and not fGutter.Gradient then
begin
rcLine.Top := rcLine.Bottom;
rcLine.Bottom := AClip.Bottom;
with rcLine do
fTextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcLine, '', 0);
end;
finally
fTextDrawer.EndDrawing;
if fGutter.UseFontStyle then
fTextDrawer.SetBaseFont(Self.Font);
end;
end
else if not fGutter.Gradient then
Canvas.FillRect(AClip);
{$IFDEF SYN_WIN32}
// draw word wrap glyphs transparently over gradient
if fGutter.Gradient then
Canvas.Brush.Style := bsClear;
{$ENDIF}
// paint wrapped line glyphs
if WordWrap and fWordWrapGlyph.Visible then
for cLine := aFirstRow to aLastRow do
if LineToRow(RowToLine(cLine)) <> cLine then
fWordWrapGlyph.Draw(Canvas,
(fGutterWidth - fGutter.RightOffset - 2) - fWordWrapGlyph.Width,
(cLine - TopLine) * fTextHeight, fTextHeight);
{$IFDEF SYN_WIN32}
// restore brush
if fGutter.Gradient then
Canvas.Brush.Style := bsSolid;
{$ENDIF}
// the gutter separator if visible
if (fGutter.BorderStyle <> gbsNone) and (AClip.Right >= fGutterWidth - 2) then
with Canvas do
begin
Pen.Color := fGutter.BorderColor;
Pen.Width := 1;
with AClip do
begin
if fGutter.BorderStyle = gbsMiddle then
begin
MoveTo(fGutterWidth - 2, Top);
LineTo(fGutterWidth - 2, Bottom);
Pen.Color := fGutter.Color;
end;
MoveTo(fGutterWidth - 1, Top);
LineTo(fGutterWidth - 1, Bottom);
end;
end;
// now the gutter marks
if BookMarkOptions.GlyphsVisible and (Marks.Count > 0)
and (vLastLine >= vFirstLine) then
begin
aGutterOffs := AllocMem((aLastRow - aFirstRow + 1) * SizeOf(Integer));
try
// Instead of making a two pass loop we look while drawing the bookmarks
// whether there is any other mark to be drawn
bHasOtherMarks := False;
for cMark := 0 to Marks.Count - 1 do with Marks[cMark] do
if Visible and (Line >= vFirstLine) and (Line <= vLastLine) then
begin
if IsBookmark <> BookMarkOptions.DrawBookmarksFirst then
bHasOtherMarks := True
else begin
vMarkRow := LineToRow(Line);
if vMarkRow >= aFirstRow then
DrawMark(Marks[cMark], aGutterOffs[vMarkRow - aFirstRow], vMarkRow);
end
end;
if bHasOtherMarks then
for cMark := 0 to Marks.Count - 1 do with Marks[cMark] do
begin
if Visible and (IsBookmark <> BookMarkOptions.DrawBookmarksFirst)
and (Line >= vFirstLine) and (Line <= vLastLine) then
begin
vMarkRow := LineToRow(Line);
if vMarkRow >= aFirstRow then
DrawMark(Marks[cMark], aGutterOffs[vMarkRow - aFirstRow], vMarkRow);
end;
end;
if Assigned(OnGutterPaint) then
for cLine := vFirstLine to vLastLine do
begin
vGutterRow := LineToRow(cLine);
OnGutterPaint(Self, cLine, aGutterOffs[vGutterRow - aFirstRow],
(vGutterRow - TopLine) * LineHeight);
end;
finally
FreeMem(aGutterOffs);
end;
end
else if Assigned(OnGutterPaint) then
begin
for cLine := vFirstLine to vLastLine do
begin
vGutterRow := LineToRow(cLine);
OnGutterPaint(Self, cLine, 0, (vGutterRow - TopLine) * LineHeight);
end;
end;
end;
// Inserts filling chars into a string containing chars that display as glyphs
// wider than an average glyph. (This is often the case with Asian glyphs, which
// are usually wider than latin glpyhs)
// This is only to simplify paint-operations and has nothing to do with
// multi-byte chars.
function TCustomSynEdit.ExpandAtWideGlyphs(const S: WideString): WideString;
var
i, j, CountOfAvgGlyphs: Integer;
begin
Result := S;
j := 0;
SetLength(Result, Length(S) * 2); // speed improvement
for i := 1 to Length(S) do
begin
inc(j);
CountOfAvgGlyphs := CeilOfIntDiv(fTextDrawer.TextWidth(S[i]), fCharWidth);
if j + CountOfAvgGlyphs > Length(Result) then
SetLength(Result, Length(Result) + 128);
// insert CountOfAvgGlyphs filling chars
while CountOfAvgGlyphs > 1 do
begin
Result[j] := FillerChar;
inc(j);
dec(CountOfAvgGlyphs);
end;
Result[j] := S[i];
end;
SetLength(Result, j);
end;
// does the opposite of ExpandAtWideGlyphs
function TCustomSynEdit.ShrinkAtWideGlyphs(const S: WideString; First: Integer;
var CharCount: Integer): WideString;
var
i, j: Integer;
begin
SetLength(Result, Length(S));
i := First;
j := 0;
while i < First + CharCount do
begin
inc(j);
while S[i] = FillerChar do
inc(i);
Result[j] := S[i];
inc(i);
end;
SetLength(Result, j);
CharCount := j;
end;
procedure TCustomSynEdit.PaintTextLines(AClip: TRect; const aFirstRow, aLastRow,
FirstCol, LastCol: Integer);
var
bDoRightEdge: Boolean; // right edge
nRightEdge: Integer;
// selection info
bAnySelection: Boolean; // any selection visible?
vSelStart: TDisplayCoord; // start of selected area
vSelEnd: TDisplayCoord; // end of selected area
// info about normal and selected text and background colors
bSpecialLine, bLineSelected, bCurrentLine: Boolean;
colFG, colBG: TColor;
colSelFG, colSelBG: TColor;
// info about selection of the current line
nLineSelStart, nLineSelEnd: Integer;
bComplexLine: Boolean;
// painting the background and the text
rcLine, rcToken: TRect;
TokenAccu: record
// Note: s is not managed as a string, it will only grow!!!
// Never use AppendStr or "+", use Len and MaxLen instead and
// copy the string chars directly. This is for efficiency.
Len, MaxLen, CharsBefore: Integer;
s: WideString;
TabString: WideString;
FG, BG: TColor;
Style: TFontStyles;
end;
{$IFNDEF SYN_CLX}
dc: HDC;
{$ENDIF}
SynTabGlyphString: WideString;
vFirstLine: Integer;
vLastLine: Integer;
{ local procedures }
function colEditorBG: TColor;
var
iAttri: TSynHighlighterAttributes;
begin
if (ActiveLineColor <> clNone) and (bCurrentLine) then
Result := ActiveLineColor
else begin
Result := Color;
if Highlighter <> nil then
begin
iAttri := Highlighter.WhitespaceAttribute;
if (iAttri <> nil) and (iAttri.Background <> clNone) then
Result := iAttri.Background;
end;
end;
end;
procedure ComputeSelectionInfo;
var
vStart: TBufferCoord;
vEnd: TBufferCoord;
begin
bAnySelection := False;
// Only if selection is visible anyway.
if not HideSelection or Self.Focused then
begin
bAnySelection := True;
// Get the *real* start of the selected area.
if fBlockBegin.Line < fBlockEnd.Line then
begin
vStart := fBlockBegin;
vEnd := fBlockEnd;
end
else if fBlockBegin.Line > fBlockEnd.Line then
begin
vEnd := fBlockBegin;
vStart := fBlockEnd;
end
else if fBlockBegin.Char <> fBlockEnd.Char then
begin
// No selection at all, or it is only on this line.
vStart.Line := fBlockBegin.Line;
vEnd.Line := vStart.Line;
if fBlockBegin.Char < fBlockEnd.Char then
begin
vStart.Char := fBlockBegin.Char;
vEnd.Char := fBlockEnd.Char;
end
else
begin
vStart.Char := fBlockEnd.Char;
vEnd.Char := fBlockBegin.Char;
end;
end
else
bAnySelection := False;
// If there is any visible selection so far, then test if there is an
// intersection with the area to be painted.
if bAnySelection then
begin
// Don't care if the selection is not visible.
bAnySelection := (vEnd.Line >= vFirstLine) and (vStart.Line <= vLastLine);
if bAnySelection then
begin
// Transform the selection from text space into screen space
vSelStart := BufferToDisplayPos(vStart);
vSelEnd := BufferToDisplayPos(vEnd);
// In the column selection mode sort the begin and end of the selection,
// this makes the painting code simpler.
if (fActiveSelectionMode = smColumn) and (vSelStart.Column > vSelEnd.Column) then
SwapInt(vSelStart.Column, vSelEnd.Column);
end;
end;
end;
end;
procedure SetDrawingColors(Selected: Boolean);
begin
with fTextDrawer do
if Selected then
begin
SetBackColor(colSelBG);
SetForeColor(colSelFG);
Canvas.Brush.Color := colSelBG;
end
else begin
SetBackColor(colBG);
SetForeColor(colFG);
Canvas.Brush.Color := colBG;
end;
end;
function ColumnToXValue(Col: Integer): Integer;
begin
Result := fTextOffset + Pred(Col) * fCharWidth;
end;
//todo: Review SpecialChars and HardTabs painting. Token parameter of PaintToken procedure could very probably be passed by reference.
// Note: The PaintToken procedure will take care of invalid parameters
// like empty token rect or invalid indices into TokenLen.
// CharsBefore tells if Token starts at column one or not
procedure PaintToken(Token: WideString;
TokenLen, CharsBefore, First, Last: Integer);
var
Text: WideString;
Counter, nX, nCharsToPaint: Integer;
sTabbedToken: WideString;
DoTabPainting: Boolean;
i, TabStart, TabLen, CountOfAvgGlyphs, VisibleGlyphPart, FillerCount,
NonFillerPos: Integer;
rcTab: TRect;
const
ETOOptions = ETO_OPAQUE or ETO_CLIPPED;
begin
sTabbedToken := Token;
DoTabPainting := False;
Counter := Last - CharsBefore;
while Counter > First - CharsBefore - 1 do
begin
if Length(Token) >= Counter then
begin
if fShowSpecChar and (Token[Counter] = #32) then
Token[Counter] := SynSpaceGlyph
else if Token[Counter] = #9 then
begin
Token[Counter] := #32; //Tabs painted differently if necessary
DoTabPainting := fShowSpecChar;
end;
end;
Dec(Counter);
end;
if (Last >= First) and (rcToken.Right > rcToken.Left) then
begin
nX := ColumnToXValue(First);
Dec(First, CharsBefore);
Dec(Last, CharsBefore);
if (First > TokenLen) then
begin
nCharsToPaint := 0;
Text := '';
end
else
begin
FillerCount := 0;
NonFillerPos := First;
while Token[NonFillerPos] = FillerChar do
begin
inc(FillerCount);
inc(NonFillerPos);
end;
CountOfAvgGlyphs := CeilOfIntDiv(fTextDrawer.TextWidth(Token[NonFillerPos]) , fCharWidth);
// first visible part of the glyph (1-based)
// (the glyph is visually sectioned in parts of size fCharWidth)
VisibleGlyphPart := CountOfAvgGlyphs - FillerCount;
// clip off invisible parts
nX := nX - fCharWidth * (VisibleGlyphPart - 1);
nCharsToPaint := Min(Last - First + 1, TokenLen - First + 1);
// clip off partially visible glyphs at line end
if WordWrap then
while nX + fCharWidth * nCharsToPaint > ClientWidth do
begin
dec(nCharsToPaint);
while (nCharsToPaint > 0) and (Token[First + nCharsToPaint - 1] = FillerChar) do
dec(nCharsToPaint);
end;
// same as copy(Token, First, nCharsToPaint) and remove filler chars
Text := ShrinkAtWideGlyphs(Token, First, nCharsToPaint);
end;
fTextDrawer.ExtTextOut(nX, rcToken.Top, ETOOptions, rcToken,
Text, nCharsToPaint);
if DoTabPainting then
begin
// fix everything before the FirstChar
for i := 1 to First - 1 do // wipe the text out so we don't
if sTabbedToken[i] = #9 then // count it out of the range
sTabbedToken[i] := #32; // we're looking for
TabStart := pos(#9, sTabbedToken);
rcTab.Top := rcToken.Top;
rcTab.Bottom := rcToken.Bottom;
while (TabStart > 0) and (TabStart >= First) and (TabStart <= Last) do
begin
TabLen := 1;
while (TabStart + CharsBefore + TabLen - 1) mod FTabWidth <> 0 do inc(TabLen);
Text := SynTabGlyphString;
nX := ColumnToXValue(CharsBefore + TabStart + (TabLen div 2) - 1);
if TabLen mod 2 = 0 then
nX := nX + (fCharWidth div 2)
else nX := nX + fCharWidth;
rcTab.Left := nX;
rcTab.Right := nX + fTextDrawer.GetCharWidth;
fTextDrawer.ExtTextOut(nX, rcTab.Top, ETOOptions, rcTab,
Text, 1);
for i := 0 to TabLen - 1 do //wipe the text out so we don't
sTabbedToken[TabStart + i] := #32; //count it again
TabStart := pos(#9, sTabbedToken);
end;
end;
rcToken.Left := rcToken.Right;
end;
end;
{$IFNDEF SYN_CLX}
procedure AdjustEndRect;
// trick to avoid clipping the last pixels of text in italic,
// see also AdjustLastCharWidth() in TheTextDrawer.ExtTextOut()
var
LastChar: Cardinal;
NormalCharWidth, RealCharWidth: Integer;
CharInfo: TABC;
tm: TTextMetricA;
begin
LastChar := Ord(TokenAccu.s[TokenAccu.Len]);
NormalCharWidth := fTextDrawer.TextWidth(WideChar(LastChar));
RealCharWidth := NormalCharWidth;
if Win32PlatformIsUnicode then
begin
if GetCharABCWidthsW(Canvas.Handle, LastChar, LastChar, CharInfo) then
begin
RealCharWidth := CharInfo.abcA + Integer(CharInfo.abcB);
if CharInfo.abcC >= 0 then
Inc(RealCharWidth, CharInfo.abcC);
end
else if LastChar < Ord(High(AnsiChar)) then
begin
GetTextMetricsA(Canvas.Handle, tm);
RealCharWidth := tm.tmAveCharWidth + tm.tmOverhang;
end;
end
else if WideChar(LastChar) <= High(AnsiChar) then
begin
if GetCharABCWidths(Canvas.Handle, LastChar, LastChar, CharInfo) then
begin
RealCharWidth := CharInfo.abcA + Integer(CharInfo.abcB);
if CharInfo.abcC >= 0 then
Inc(RealCharWidth, CharInfo.abcC);
end
else if LastChar < Ord(High(AnsiChar)) then
begin
GetTextMetricsA(Canvas.Handle, tm);
RealCharWidth := tm.tmAveCharWidth + tm.tmOverhang;
end;
end;
if RealCharWidth > NormalCharWidth then
Inc(rcToken.Left, RealCharWidth - NormalCharWidth);
end;
{$ENDIF}
procedure PaintHighlightToken(bFillToEOL: Boolean);
var
bComplexToken: Boolean;
nC1, nC2, nC1Sel, nC2Sel: Integer;
bU1, bSel, bU2: Boolean;
nX1, nX2: Integer;
begin
// Compute some helper variables.
nC1 := Max(FirstCol, TokenAccu.CharsBefore + 1);
nC2 := Min(LastCol, TokenAccu.CharsBefore + TokenAccu.Len + 1);
if bComplexLine then
begin
bU1 := (nC1 < nLineSelStart);
bSel := (nC1 < nLineSelEnd) and (nC2 >= nLineSelStart);
bU2 := (nC2 >= nLineSelEnd);
bComplexToken := bSel and (bU1 or bU2);
end
else
begin
bU1 := False; // to shut up Compiler warning Delphi 2
bSel := bLineSelected;
bU2 := False; // to shut up Compiler warning Delphi 2
bComplexToken := False;
end;
// Any token chars accumulated?
if (TokenAccu.Len > 0) then
begin
// Initialize the colors and the font style.
if not bSpecialLine then
begin
colBG := TokenAccu.BG;
colFG := TokenAccu.FG;
end;
if bSpecialLine and (eoSpecialLineDefaultFg in fOptions) then
colFG := TokenAccu.FG;
fTextDrawer.SetStyle(TokenAccu.Style);
// Paint the chars
if bComplexToken then
begin
// first unselected part of the token
if bU1 then
begin
SetDrawingColors(False);
rcToken.Right := ColumnToXValue(nLineSelStart);
with TokenAccu do
PaintToken(s, Len, CharsBefore, nC1, nLineSelStart);
end;
// selected part of the token
SetDrawingColors(True);
nC1Sel := Max(nLineSelStart, nC1);
nC2Sel := Min(nLineSelEnd, nC2);
rcToken.Right := ColumnToXValue(nC2Sel);
with TokenAccu do
PaintToken(s, Len, CharsBefore, nC1Sel, nC2Sel);
// second unselected part of the token
if bU2 then
begin
SetDrawingColors(False);
rcToken.Right := ColumnToXValue(nC2);
with TokenAccu do
PaintToken(s, Len, CharsBefore, nLineSelEnd, nC2);
end;
end
else
begin
SetDrawingColors(bSel);
rcToken.Right := ColumnToXValue(nC2);
with TokenAccu do
PaintToken(s, Len, CharsBefore, nC1, nC2);
end;
end;
// Fill the background to the end of this line if necessary.
if bFillToEOL and (rcToken.Left < rcLine.Right) then
begin
if not bSpecialLine then colBG := colEditorBG;
if bComplexLine then
begin
nX1 := ColumnToXValue(nLineSelStart);
nX2 := ColumnToXValue(nLineSelEnd);
if (rcToken.Left < nX1) then
begin
SetDrawingColors(False);
rcToken.Right := nX1;
{$IFNDEF SYN_CLX}
if (TokenAccu.Len > 0) and (TokenAccu.Style <> []) then
AdjustEndRect;
{$ENDIF}
Canvas.FillRect(rcToken);
rcToken.Left := nX1;
end;
if (rcToken.Left < nX2) then
begin
SetDrawingColors(True);
rcToken.Right := nX2;
{$IFNDEF SYN_CLX}
if (TokenAccu.Len > 0) and (TokenAccu.Style <> []) then
AdjustEndRect;
{$ENDIF}
Canvas.FillRect(rcToken);
rcToken.Left := nX2;
end;
if (rcToken.Left < rcLine.Right) then
begin
SetDrawingColors(False);
rcToken.Right := rcLine.Right;
{$IFNDEF SYN_CLX}
if (TokenAccu.Len > 0) and (TokenAccu.Style <> []) then
AdjustEndRect;
{$ENDIF}
Canvas.FillRect(rcToken);
end;
end
else
begin
SetDrawingColors(bLineSelected);
rcToken.Right := rcLine.Right;
{$IFNDEF SYN_CLX}
if (TokenAccu.Len > 0) and (TokenAccu.Style <> []) then
AdjustEndRect;
{$ENDIF}
Canvas.FillRect(rcToken);
end;
end;
end;
// Store the token chars with the attributes in the TokenAccu
// record. This will paint any chars already stored if there is
// a (visible) change in the attributes.
procedure AddHighlightToken(const Token: WideString;
CharsBefore, TokenLen: Integer;
Foreground, Background: TColor;
Style: TFontStyles);
var
bCanAppend: Boolean;
bSpacesTest, bIsSpaces: Boolean;
i: Integer;
function TokenIsSpaces: Boolean;
var
pTok: PWideChar;
begin
if not bSpacesTest then
begin
bSpacesTest := True;
pTok := PWideChar(Token);
while pTok^ <> #0 do
begin
if pTok^ <> #32 then
break;
Inc(pTok);
end;
bIsSpaces := pTok^ = #0;
end;
Result := bIsSpaces;
end;
begin
if (Background = clNone) or
((ActiveLineColor <> clNone) and (bCurrentLine)) then
begin
Background := colEditorBG;
end;
if Foreground = clNone then Foreground := Font.Color;
// Do we have to paint the old chars first, or can we just append?
bCanAppend := False;
bSpacesTest := False;
if (TokenAccu.Len > 0) then
begin
// font style must be the same or token is only spaces
if (TokenAccu.Style = Style)
or (not (fsUnderline in Style) and not (fsUnderline in TokenAccu.Style)
and TokenIsSpaces) then
begin
// either special colors or same colors
if (bSpecialLine and not (eoSpecialLineDefaultFg in fOptions)) or bLineSelected or
// background color must be the same and
((TokenAccu.BG = Background) and
// foreground color must be the same or token is only spaces
((TokenAccu.FG = Foreground) or TokenIsSpaces)) then
begin
bCanAppend := True;
end;
end;
// If we can't append it, then we have to paint the old token chars first.
if not bCanAppend then
PaintHighlightToken(False);
end;
// Don't use AppendStr because it's more expensive.
if bCanAppend then
begin
if (TokenAccu.Len + TokenLen > TokenAccu.MaxLen) then
begin
TokenAccu.MaxLen := TokenAccu.Len + TokenLen + 32;
SetLength(TokenAccu.s, TokenAccu.MaxLen);
end;
for i := 1 to TokenLen do
TokenAccu.s[TokenAccu.Len + i] := Token[i];
Inc(TokenAccu.Len, TokenLen);
end
else
begin
TokenAccu.Len := TokenLen;
if (TokenAccu.Len > TokenAccu.MaxLen) then
begin
TokenAccu.MaxLen := TokenAccu.Len + 32;
SetLength(TokenAccu.s, TokenAccu.MaxLen);
end;
for i := 1 to TokenLen do
TokenAccu.s[i] := Token[i];
TokenAccu.CharsBefore := CharsBefore;
TokenAccu.FG := Foreground;
TokenAccu.BG := Background;
TokenAccu.Style := Style;
end;
end;
procedure PaintLines;
var
nLine: Integer; // line index for the loop
cRow: Integer;
sLine: WideString; // the current line (tab expanded)
sLineExpandedAtWideGlyhs: WideString;
sToken: WideString; // highlighter token info
nTokenPos, nTokenLen: Integer;
attr: TSynHighlighterAttributes;
vAuxPos: TDisplayCoord;
vFirstChar: Integer;
vLastChar: Integer;
vStartRow: Integer;
vEndRow: Integer;
begin
// Initialize rcLine for drawing. Note that Top and Bottom are updated
// inside the loop. Get only the starting point for this.
rcLine := AClip;
rcLine.Left := fGutterWidth + 2;
rcLine.Bottom := (aFirstRow - TopLine) * fTextHeight;
// Make sure the token accumulator string doesn't get reassigned to often.
if Assigned(fHighlighter) then
begin
TokenAccu.MaxLen := Max(128, fCharsInWindow);
SetLength(TokenAccu.s, TokenAccu.MaxLen);
end;
// Now loop through all the lines. The indices are valid for Lines.
for nLine := vFirstLine to vLastLine do
begin
sLine := TSynEditStringList(Lines).ExpandedStrings[nLine - 1];
sLineExpandedAtWideGlyhs := ExpandAtWideGlyphs(sLine);
// determine whether will be painted with ActiveLineColor
bCurrentLine := CaretY = nLine;
// Initialize the text and background colors, maybe the line should
// use special values for them.
colFG := Font.Color;
colBG := colEditorBG;
bSpecialLine := DoOnSpecialLineColors(nLine, colFG, colBG);
if bSpecialLine then
begin
// The selection colors are just swapped, like seen in Delphi.
colSelFG := colBG;
colSelBG := colFG;
end
else
begin
colSelFG := fSelectedColor.Foreground;
colSelBG := fSelectedColor.Background;
end;
vStartRow := Max(LineToRow(nLine), aFirstRow);
vEndRow := Min(LineToRow(nLine + 1) - 1, aLastRow);
for cRow := vStartRow to vEndRow do
begin
if WordWrap then
begin
vAuxPos.Row := cRow;
if Assigned(fHighlighter) then
vAuxPos.Column := FirstCol
else
// When no highlighter is assigned, we must always start from the
// first char in a row and PaintToken will do the actual clipping
vAuxPos.Column := 1;
vFirstChar := fWordWrapPlugin.DisplayToBufferPos(vAuxPos).Char;
vAuxPos.Column := LastCol;
vLastChar := fWordWrapPlugin.DisplayToBufferPos(vAuxPos).Char;
end
else
begin
vFirstChar := FirstCol;
vLastChar := LastCol;
end;
// Get the information about the line selection. Three different parts
// are possible (unselected before, selected, unselected after), only
// unselected or only selected means bComplexLine will be False. Start
// with no selection, compute based on the visible columns.
bComplexLine := False;
nLineSelStart := 0;
nLineSelEnd := 0;
// Does the selection intersect the visible area?
if bAnySelection and (cRow >= vSelStart.Row) and (cRow <= vSelEnd.Row) then
begin
// Default to a fully selected line. This is correct for the smLine
// selection mode and a good start for the smNormal mode.
nLineSelStart := FirstCol;
nLineSelEnd := LastCol + 1;
if (fActiveSelectionMode = smColumn) or
((fActiveSelectionMode = smNormal) and (cRow = vSelStart.Row)) then
begin
if (vSelStart.Column > LastCol) then
begin
nLineSelStart := 0;
nLineSelEnd := 0;
end
else if (vSelStart.Column > FirstCol) then
begin
nLineSelStart := vSelStart.Column;
bComplexLine := True;
end;
end;
if (fActiveSelectionMode = smColumn) or
((fActiveSelectionMode = smNormal) and (cRow = vSelEnd.Row)) then
begin
if (vSelEnd.Column < FirstCol) then
begin
nLineSelStart := 0;
nLineSelEnd := 0;
end
else if (vSelEnd.Column < LastCol) then
begin
nLineSelEnd := vSelEnd.Column;
bComplexLine := True;
end;
end;
end; //endif bAnySelection
// Update the rcLine rect to this line.
rcLine.Top := rcLine.Bottom;
Inc(rcLine.Bottom, fTextHeight);
bLineSelected := not bComplexLine and (nLineSelStart > 0);
rcToken := rcLine;
if not Assigned(fHighlighter) or not fHighlighter.Enabled then
begin
// Remove text already displayed (in previous rows)
if (vFirstChar <> FirstCol) or (vLastChar <> LastCol) then
sToken := Copy(sLineExpandedAtWideGlyhs, vFirstChar, vLastChar - vFirstChar)
else
sToken := Copy(sLineExpandedAtWideGlyhs, 1, vLastChar);
if fShowSpecChar and (Length(sLineExpandedAtWideGlyhs) < vLastChar) then
sToken := sToken + SynLineBreakGlyph;
nTokenLen := Length(sToken);
if bComplexLine then
begin
SetDrawingColors(False);
rcToken.Left := Max(rcLine.Left, ColumnToXValue(FirstCol));
rcToken.Right := Min(rcLine.Right, ColumnToXValue(nLineSelStart));
PaintToken(sToken, nTokenLen, 0, FirstCol, nLineSelStart);
rcToken.Left := Max(rcLine.Left, ColumnToXValue(nLineSelEnd));
rcToken.Right := Min(rcLine.Right, ColumnToXValue(LastCol));
PaintToken(sToken, nTokenLen, 0, nLineSelEnd, LastCol);
SetDrawingColors(True);
rcToken.Left := Max(rcLine.Left, ColumnToXValue(nLineSelStart));
rcToken.Right := Min(rcLine.Right, ColumnToXValue(nLineSelEnd));
PaintToken(sToken, nTokenLen, 0, nLineSelStart, nLineSelEnd - 1);
end
else
begin
SetDrawingColors(bLineSelected);
PaintToken(sToken, nTokenLen, 0, FirstCol, LastCol);
end;
end
else
begin
// Initialize highlighter with line text and range info. It is
// necessary because we probably did not scan to the end of the last
// line - the internal highlighter range might be wrong.
if nLine = 1 then
fHighlighter.ResetRange
else
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[nLine - 2]);
fHighlighter.SetLineExpandedAtWideGlyhs(sLine, sLineExpandedAtWideGlyhs,
nLine - 1);
// Try to concatenate as many tokens as possible to minimize the count
// of ExtTextOutW calls necessary. This depends on the selection state
// or the line having special colors. For spaces the foreground color
// is ignored as well.
TokenAccu.Len := 0;
nTokenPos := 0;
nTokenLen := 0;
attr := nil;
// Test first whether anything of this token is visible.
while not fHighlighter.GetEol do
begin
nTokenPos := fHighlighter.GetExpandedTokenPos;
sToken := fHighlighter.GetExpandedToken;
nTokenLen := Length(sToken);
if nTokenPos + nTokenLen >= vFirstChar then
begin
if nTokenPos + nTokenLen > vLastChar then
begin
if nTokenPos > vLastChar then
break;
if WordWrap then
nTokenLen := vLastChar - nTokenPos - 1
else
nTokenLen := vLastChar - nTokenPos;
end;
// Remove offset generated by tokens already displayed (in previous rows)
Dec(nTokenPos, vFirstChar - FirstCol);
// It's at least partially visible. Get the token attributes now.
attr := fHighlighter.GetTokenAttribute;
if Assigned(attr) then
AddHighlightToken(sToken, nTokenPos, nTokenLen, attr.Foreground,
attr.Background, attr.Style)
else
AddHighlightToken(sToken, nTokenPos, nTokenLen, colFG, colBG,
Font.Style);
end;
// Let the highlighter scan the next token.
fHighlighter.Next;
end;
// Draw anything that's left in the TokenAccu record. Fill to the end
// of the invalid area with the correct colors.
if fShowSpecChar and fHighlighter.GetEol then
begin
if (attr = nil) or (attr <> fHighlighter.CommentAttribute) then
attr := fHighlighter.WhitespaceAttribute;
AddHighlightToken(SynLineBreakGlyph, nTokenPos + nTokenLen, 1,
attr.Foreground, attr.Background, []);
end;
PaintHighlightToken(True);
end;
// Now paint the right edge if necessary. We do it line by line to reduce
// the flicker. Should not cost very much anyway, compared to the many
// calls to ExtTextOutW.
if bDoRightEdge then
begin
Canvas.MoveTo(nRightEdge, rcLine.Top);
Canvas.LineTo(nRightEdge, rcLine.Bottom + 1);
end;
end; //endfor cRow
bCurrentLine := False;
end; //endfor cLine
end;
{ end local procedures }
begin
vFirstLine := RowToLine(aFirstRow);
vLastLine := RowToLine(aLastRow);
bCurrentLine := False;
// If the right edge is visible and in the invalid area, prepare to paint it.
// Do this first to realize the pen when getting the dc variable.
SynTabGlyphString := SynTabGlyph;
bDoRightEdge := False;
if (fRightEdge > 0) then
begin // column value
nRightEdge := fTextOffset + fRightEdge * fCharWidth; // pixel value
if (nRightEdge >= AClip.Left) and (nRightEdge <= AClip.Right) then
begin
bDoRightEdge := True;
Canvas.Pen.Color := fRightEdgeColor;
Canvas.Pen.Width := 1;
end;
end;
{$IFDEF SYN_CLX}
{$ELSE}
// Do everything else with API calls. This (maybe) realizes the new pen color.
dc := Canvas.Handle;
{$ENDIF}
// If anything of the two pixel space before the text area is visible, then
// fill it with the component background color.
if (AClip.Left < fGutterWidth + 2) then
begin
rcToken := AClip;
rcToken.Left := Max(AClip.Left, fGutterWidth);
rcToken.Right := fGutterWidth + 2;
// Paint whole left edge of the text with same color.
// (value of WhiteAttribute can vary in e.g. MultiSyn)
if Highlighter <> nil then
Highlighter.ResetRange;
Canvas.Brush.Color := colEditorBG;
Canvas.FillRect(rcToken);
// Adjust the invalid area to not include this a