/components/synedit/syneditpointclasses.pas
http://github.com/graemeg/lazarus · Pascal · 3487 lines · 2900 code · 399 blank · 188 comment · 379 complexity · c58c656596b082f0b7a7d16f58d7d30c MD5 · raw file
Large files are truncated click here to view the full file
- {-------------------------------------------------------------------------------
- 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.
- 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.
- -------------------------------------------------------------------------------}
- (* Naming Conventions:
- Byte = Logical: Refers to the location any TextToken has in the String.
- In Utf8String some TextToken can have more than one byte
- Char = Physical: Refers to the (x-)location on the screen matrix.
- Some TextToken (like tab) can spawn multiply char locations
- *)
- unit SynEditPointClasses;
- {$I synedit.inc}
- {off $DEFINE SynCaretDebug}
- interface
- uses
- Classes, SysUtils, Controls, LCLProc, LCLType, LCLIntf, ExtCtrls, Graphics, Forms,
- {$IFDEF SYN_MBCSSUPPORT}
- Imm,
- {$ENDIF}
- LazSynEditText, SynEditTypes, SynEditMiscProcs;//, SynEditTextBuffer;
- type
- TInvalidateLines = procedure(FirstLine, LastLine: integer) of Object;
- TLinesCountChanged = procedure(FirstLine, Count: integer) of Object;
- TMaxLeftCharFunc = function: Integer of object;
- { TSynEditPointBase }
- TSynEditPointBase = class
- private
- function GetLocked: Boolean;
- protected
- FLines: TSynEditStrings;
- FOnChangeList: TMethodList;
- FLockCount: Integer;
- procedure SetLines(const AValue: TSynEditStrings); virtual;
- procedure DoLock; virtual;
- Procedure DoUnlock; virtual;
- public
- constructor Create;
- constructor Create(Lines: TSynEditStrings);
- destructor Destroy; override;
- procedure AddChangeHandler(AHandler: TNotifyEvent);
- procedure RemoveChangeHandler(AHandler: TNotifyEvent);
- procedure Lock;
- Procedure Unlock;
- property Lines: TSynEditStrings read FLines write SetLines;
- property Locked: Boolean read GetLocked;
- end;
- TSynEditBaseCaret = class;
- TSynEditCaret = class;
- TSynBlockPersistMode = (
- sbpDefault,
- sbpWeak, // selstart/end are treated as outside the block
- sbpStrong // selstart/end are treated as inside the block
- );
- TSynBeforeSetSelTextEvent = procedure(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar) of object;
- { TSynBeforeSetSelTextList }
- TSynBeforeSetSelTextList = Class(TMethodList)
- public
- procedure CallBeforeSetSelTextHandlers(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar);
- end;
- { TSynEditSelection }
- TSynEditSelection = class(TSynEditPointBase)
- private
- FOnBeforeSetSelText: TSynBeforeSetSelTextList;
- FAutoExtend: Boolean;
- FCaret: TSynEditCaret;
- FHide: Boolean;
- FInternalCaret: TSynEditBaseCaret;
- FInvalidateLinesMethod: TInvalidateLines;
- FEnabled: Boolean;
- FHookedLines: Boolean;
- FIsSettingText: Boolean;
- FForceSingleLineSelected: Boolean;
- FActiveSelectionMode: TSynSelectionMode;
- FSelectionMode: TSynSelectionMode;
- FStartLinePos: Integer; // 1 based
- FStartBytePos: Integer; // 1 based
- FAltStartLinePos, FAltStartBytePos: Integer; // 1 based // Alternate, for min selection
- FEndLinePos: Integer; // 1 based
- FEndBytePos: Integer; // 1 based
- FPersistent: Boolean;
- FPersistentLock, FWeakPersistentIdx, FStrongPersistentIdx: Integer;
- FIgnoreNextCaretMove: Boolean;
- (* On any modification, remember the position of the caret.
- If it gets moved from there to either end of the block, this should be ignored
- This happens, if Block and caret are adjusted directly
- *)
- FLastCarePos: TPoint;
- FStickyAutoExtend: Boolean;
- function AdjustBytePosToCharacterStart(Line: integer; BytePos: integer): integer;
- function GetFirstLineBytePos: TPoint;
- function GetLastLineBytePos: TPoint;
- function GetLastLineHasSelection: Boolean;
- procedure SetAutoExtend(AValue: Boolean);
- procedure SetCaret(const AValue: TSynEditCaret);
- procedure SetEnabled(const Value : Boolean);
- procedure SetActiveSelectionMode(const Value: TSynSelectionMode);
- procedure SetForceSingleLineSelected(AValue: Boolean);
- procedure SetHide(const AValue: Boolean);
- procedure SetPersistent(const AValue: Boolean);
- procedure SetSelectionMode (const AValue: TSynSelectionMode);
- function GetStartLineBytePos: TPoint;
- procedure ConstrainStartLineBytePos(var Value: TPoint);
- procedure SetStartLineBytePos(Value: TPoint);
- procedure AdjustStartLineBytePos(Value: TPoint);
- function GetEndLineBytePos: TPoint;
- procedure SetEndLineBytePos(Value: TPoint);
- function GetSelText: string;
- procedure SetSelText(const Value: string);
- procedure DoCaretChanged(Sender: TObject);
- procedure AdjustAfterTrimming; // TODO: Move into TrimView?
- protected
- procedure DoLock; override;
- procedure DoUnlock; override;
- Procedure LineChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
- procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
- aLineBrkCnt: Integer; aText: String);
- public
- constructor Create(ALines: TSynEditStrings; aActOnLineChanges: Boolean);
- destructor Destroy; override;
- procedure AssignFrom(Src: TSynEditSelection);
- procedure SetSelTextPrimitive(PasteMode: TSynSelectionMode; Value: PChar; AReplace: Boolean = False);
- function SelAvail: Boolean;
- function SelCanContinue(ACaret: TSynEditCaret): Boolean;
- function IsBackwardSel: Boolean; // SelStart < SelEnd ?
- procedure BeginMinimumSelection; // current selection will be minimum while follow caret (autoExtend) // until next setSelStart or end of follow
- procedure SortSelectionPoints;
- procedure IgnoreNextCaretMove;
- // Mode can NOT be changed in nested calls
- procedure IncPersistentLock(AMode: TSynBlockPersistMode = sbpDefault); // Weak: Do not extend (but rather move) block, if at start/end
- procedure DecPersistentLock;
- procedure Clear;
- procedure AddBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
- procedure RemoveBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
- property Enabled: Boolean read FEnabled write SetEnabled;
- property ForceSingleLineSelected: Boolean read FForceSingleLineSelected write SetForceSingleLineSelected;
- property ActiveSelectionMode: TSynSelectionMode
- read FActiveSelectionMode write SetActiveSelectionMode;
- property SelectionMode: TSynSelectionMode
- read FSelectionMode write SetSelectionMode;
- property SelText: String read GetSelText write SetSelText;
- // Start and End positions are in the order they where defined
- // This may mean Startpos is behind EndPos in the text
- property StartLineBytePos: TPoint
- read GetStartLineBytePos write SetStartLineBytePos;
- property StartLineBytePosAdjusted: TPoint
- write AdjustStartLineBytePos;
- property EndLineBytePos: TPoint
- read GetEndLineBytePos write SetEndLineBytePos;
- property StartLinePos: Integer read FStartLinePos;
- property EndLinePos: Integer read FEndLinePos;
- property StartBytePos: Integer read FStartBytePos;
- property EndBytePos: Integer read FEndBytePos;
- // First and Last Pos are ordered according to the text flow (LTR)
- property FirstLineBytePos: TPoint read GetFirstLineBytePos;
- property LastLineBytePos: TPoint read GetLastLineBytePos;
- property LastLineHasSelection: Boolean read GetLastLineHasSelection;
- property InvalidateLinesMethod : TInvalidateLines write FInvalidateLinesMethod;
- property Caret: TSynEditCaret read FCaret write SetCaret;
- property Persistent: Boolean read FPersistent write SetPersistent;
- // automatically Start/Extend selection if caret moves
- // (depends if caret was at block border or not)
- property AutoExtend: Boolean read FAutoExtend write SetAutoExtend;
- property StickyAutoExtend: Boolean read FStickyAutoExtend write FStickyAutoExtend;
- property Hide: Boolean read FHide write SetHide;
- end;
- { TSynEditCaret }
- TSynEditCaretFlag = (
- scCharPosValid, scBytePosValid
- );
- TSynEditCaretFlags = set of TSynEditCaretFlag;
- TSynEditCaretUpdateFlag = (
- scuForceSet, // Change even if equal to old
- scuChangedX, scuChangedY, //
- scuNoInvalidate // Keep the Char/Byte ValidFlags
- );
- TSynEditCaretUpdateFlags = set of TSynEditCaretUpdateFlag;
- { TSynEditBaseCaret
- No Checks at all.
- Caller MUST ensure at least not to set x to invalid pos (middle of char) (incl update x, after SetLine)
- }
- TSynEditBaseCaret = class(TSynEditPointBase)
- private
- FFlags: TSynEditCaretFlags;
- FLinePos: Integer; // 1 based
- FCharPos: Integer; // 1 based
- FBytePos, FBytePosOffset: Integer; // 1 based
- function GetBytePos: Integer;
- function GetBytePosOffset: Integer;
- function GetCharPos: Integer;
- function GetFullLogicalPos: TLogCaretPoint;
- function GetLineBytePos: TPoint;
- function GetLineCharPos: TPoint;
- procedure SetBytePos(AValue: Integer);
- procedure SetBytePosOffset(AValue: Integer);
- procedure SetCharPos(AValue: Integer);
- procedure SetFullLogicalPos(AValue: TLogCaretPoint);
- procedure SetLineBytePos(AValue: TPoint);
- procedure SetLineCharPos(AValue: TPoint);
- procedure SetLinePos(AValue: Integer);
- function GetLineText: string;
- procedure SetLineText(AValue: string);
- protected
- procedure ValidateBytePos;
- procedure ValidateCharPos;
- procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
- UpdFlags: TSynEditCaretUpdateFlags); virtual;
- procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
- UpdFlags: TSynEditCaretUpdateFlags); virtual;
- public
- constructor Create;
- procedure AssignFrom(Src: TSynEditBaseCaret);
- procedure Invalidate; // force to 1,1
- procedure InvalidateBytePos; // 1,1 IF no validCharPos
- procedure InvalidateCharPos;
- function IsAtLineChar(aPoint: TPoint): Boolean;
- function IsAtLineByte(aPoint: TPoint; aByteOffset: Integer = -1): Boolean;
- function IsAtPos(aCaret: TSynEditCaret): Boolean;
- property LinePos: Integer read FLinePos write SetLinePos;
- property CharPos: Integer read GetCharPos write SetCharPos;
- property LineCharPos: TPoint read GetLineCharPos write SetLineCharPos;
- property BytePos: Integer read GetBytePos write SetBytePos;
- property BytePosOffset: Integer read GetBytePosOffset write SetBytePosOffset;
- property LineBytePos: TPoint read GetLineBytePos write SetLineBytePos;
- property FullLogicalPos: TLogCaretPoint read GetFullLogicalPos write SetFullLogicalPos;
- property LineText: string read GetLineText write SetLineText;
- end;
- { TSynEditCaret }
- TSynEditCaret = class(TSynEditBaseCaret)
- private
- FLinesEditedRegistered: Boolean;
- FAllowPastEOL: Boolean;
- FAutoMoveOnEdit: Integer;
- FForcePastEOL: Integer;
- FForceAdjustToNextChar: Integer;
- FKeepCaretX: Boolean;
- FLastCharPos: Integer; // used by KeepCaretX
- FOldLinePos: Integer; // 1 based
- FOldCharPos: Integer; // 1 based
- FAdjustToNextChar: Boolean;
- FMaxLeftChar: TMaxLeftCharFunc;
- FChangeOnTouch: Boolean;
- FSkipTabs: Boolean;
- FTouched: Boolean;
- procedure AdjustToChar;
- function GetMaxLeftPastEOL: Integer;
- function GetOldLineCharPos: TPoint;
- function GetOldLineBytePos: TPoint;
- function GetOldFullLogicalPos: TLogCaretPoint;
- procedure SetAllowPastEOL(const AValue: Boolean);
- procedure SetSkipTabs(const AValue: Boolean);
- procedure SetKeepCaretX(const AValue: Boolean);
- procedure RegisterLinesEditedHandler;
- protected
- procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
- UpdFlags: TSynEditCaretUpdateFlags); override;
- procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
- UpdFlags: TSynEditCaretUpdateFlags); override;
- procedure DoLock; override;
- Procedure DoUnlock; override;
- procedure SetLines(const AValue: TSynEditStrings); override;
- procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
- aLineBrkCnt: Integer; aText: String);
- public
- constructor Create;
- destructor Destroy; override;
- procedure AssignFrom(Src: TSynEditBaseCaret);
- procedure IncForcePastEOL;
- procedure DecForcePastEOL;
- procedure IncForceAdjustToNextChar;
- procedure DecForceAdjustToNextChar;
- procedure IncAutoMoveOnEdit;
- procedure DecAutoMoveOnEdit;
- procedure ChangeOnTouch;
- procedure Touch(aChangeOnTouch: Boolean = False);
- function WasAtLineChar(aPoint: TPoint): Boolean;
- function WasAtLineByte(aPoint: TPoint): Boolean;
- function MoveHoriz(ACount: Integer): Boolean; // Logical // False, if past EOL (not mowed)/BOl
- property OldLinePos: Integer read FOldLinePos;
- property OldCharPos: Integer read FOldCharPos;
- property OldLineCharPos: TPoint read GetOldLineCharPos;
- property OldLineBytePos: TPoint read GetOldLineBytePos;
- property OldFullLogicalPos: TLogCaretPoint read GetOldFullLogicalPos;
- property AdjustToNextChar: Boolean read FAdjustToNextChar write FAdjustToNextChar; deprecated;
- property SkipTabs: Boolean read FSkipTabs write SetSkipTabs;
- property AllowPastEOL: Boolean read FAllowPastEOL write SetAllowPastEOL;
- property KeepCaretX: Boolean read FKeepCaretX write SetKeepCaretX;
- property KeepCaretXPos: Integer read FLastCharPos write FLastCharPos;
- property MaxLeftChar: TMaxLeftCharFunc read FMaxLeftChar write FMaxLeftChar;
- end;
- TSynCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock, ctCostum);
- TSynCaretLockFlags = set of (sclfUpdateDisplay, sclfUpdateDisplayType);
- { TSynEditScreenCaretTimer
- Allow sync between carets which use an internal painter
- }
- TSynEditScreenCaretTimer = class
- private
- FDisplayCycle: Boolean;
- FTimer: TTimer;
- FTimerList: TMethodList;
- FAfterPaintList: TMethodList;
- FLocCount: Integer;
- FLocFlags: set of (lfTimer, lfRestart);
- procedure DoTimer(Sender: TObject);
- procedure DoAfterPaint(Data: PtrInt);
- public
- constructor Create;
- destructor Destroy; override;
- procedure AddAfterPaintHandler(AHandler: TNotifyEvent); // called once
- procedure AddHandler(AHandler: TNotifyEvent);
- procedure RemoveHandler(AHandler: TNotifyEvent);
- procedure RemoveHandler(AHandlerOwner: TObject);
- procedure IncLock;
- procedure DecLock;
- procedure AfterPaintEvent;
- procedure RestartCycle;
- property DisplayCycle: Boolean read FDisplayCycle;
- end;
- TSynEditScreenCaret = class;
- { TSynEditScreenCaretPainter }
- TSynEditScreenCaretPainter = class
- private
- FLeft, FTop, FHeight, FWidth: Integer;
- FCreated, FShowing: Boolean;
- FInPaint, FInScroll: Boolean;
- FPaintClip: TRect;
- FScrollX, FScrollY: Integer;
- FScrollRect, FScrollClip: TRect;
- function GetHandle: HWND;
- function GetHandleAllocated: Boolean;
- protected
- FHandleOwner: TWinControl;
- FOwner: TSynEditScreenCaret;
- FNeedPositionConfirmed: boolean;
- procedure Init; virtual;
- property Handle: HWND read GetHandle;
- property HandleAllocated: Boolean read GetHandleAllocated;
- procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); virtual;
- procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); virtual;
- procedure BeginPaint(rcClip: TRect); virtual;
- procedure FinishPaint(rcClip: TRect); virtual;
- public
- constructor Create(AHandleOwner: TWinControl; AOwner: TSynEditScreenCaret);
- function CreateCaret(w, h: Integer): Boolean; virtual;
- function DestroyCaret: Boolean; virtual;
- function HideCaret: Boolean; virtual;
- function ShowCaret: Boolean; virtual;
- function SetCaretPosEx(x, y: Integer): Boolean; virtual;
- property Left: Integer read FLeft;
- property Top: Integer read FTop;
- property Width: Integer read FWidth;
- property Height: Integer read FHeight;
- property Created: Boolean read FCreated;
- property Showing: Boolean read FShowing;
- property InPaint: Boolean read FInPaint;
- property InScroll: Boolean read FInScroll;
- property NeedPositionConfirmed: boolean read FNeedPositionConfirmed;
- end;
- TSynEditScreenCaretPainterClass = class of TSynEditScreenCaretPainter;
- { TSynEditScreenCaretPainterSystem }
- TSynEditScreenCaretPainterSystem = class(TSynEditScreenCaretPainter)
- protected
- //procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
- procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
- procedure BeginPaint(rcClip: TRect); override;
- //procedure FinishPaint(rcClip: TRect); override; // unhide, currently done by editor
- public
- function CreateCaret(w, h: Integer): Boolean; override;
- function DestroyCaret: Boolean; override;
- function HideCaret: Boolean; override;
- function ShowCaret: Boolean; override;
- function SetCaretPosEx(x, y: Integer): Boolean; override;
- end;
- { TSynEditScreenCaretPainterInternal }
- TSynEditScreenCaretPainterInternal = class(TSynEditScreenCaretPainter)
- private type
- TIsInRectState = (irInside, irPartInside, irOutside);
- TPainterState = (psAfterPaintAdded, psCleanOld, psRemoveTimer);
- TPainterStates = set of TPainterState;
- private
- FColor: TColor;
- FForcePaintEvents: Boolean;
- FIsDrawn: Boolean;
- FSavePen: TPen;
- FOldX, FOldY, FOldW, FOldH: Integer;
- FState: TPainterStates;
- FCanPaint: Boolean;
- procedure DoTimer(Sender: TObject);
- procedure DoPaint(ACanvas: TCanvas; X, Y, H, W: Integer);
- procedure Paint;
- procedure Invalidate;
- procedure AddAfterPaint(AStates: TPainterStates = []);
- procedure DoAfterPaint(Sender: TObject);
- procedure ExecAfterPaint;
- function CurrentCanvas: TCanvas;
- procedure SetColor(AValue: TColor);
- function IsInRect(ARect: TRect): TIsInRectState;
- function IsInRect(ARect: TRect; X, Y, W, H: Integer): TIsInRectState;
- protected
- procedure Init; override;
- procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
- procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
- procedure BeginPaint(rcClip: TRect); override;
- procedure FinishPaint(rcClip: TRect); override;
- public
- destructor Destroy; override;
- function CreateCaret(w, h: Integer): Boolean; override;
- function DestroyCaret: Boolean; override;
- function HideCaret: Boolean; override;
- function ShowCaret: Boolean; override;
- function SetCaretPosEx(x, y: Integer): Boolean; override;
- property Color: TColor read FColor write SetColor;
- property ForcePaintEvents: Boolean read FForcePaintEvents write FForcePaintEvents;
- end;
- // relative dimensions in percent from 0 to 1024 (=100%)
- TSynCustomCaretSizeFlag = (ccsRelativeLeft, ccsRelativeTop, ccsRelativeWidth, ccsRelativeHeight);
- TSynCustomCaretSizeFlags = set of TSynCustomCaretSizeFlag;
- { TSynEditScreenCaret }
- TSynEditScreenCaret = class
- private
- FCharHeight: Integer;
- FCharWidth: Integer;
- FClipRight: Integer;
- FClipBottom: Integer;
- FClipLeft: Integer;
- FClipTop: Integer;
- FDisplayPos: TPoint;
- FDisplayType: TSynCaretType;
- FExtraLinePixel, FExtraLineChars: Integer;
- FOnExtraLineCharsChanged: TNotifyEvent;
- FVisible: Boolean;
- FHandleOwner: TWinControl;
- FCaretPainter: TSynEditScreenCaretPainter;
- FPaintTimer: TSynEditScreenCaretTimer;
- FPaintTimerOwned: Boolean;
- function GetHandle: HWND;
- function GetHandleAllocated: Boolean;
- procedure SetCharHeight(const AValue: Integer);
- procedure SetCharWidth(const AValue: Integer);
- procedure SetClipRight(const AValue: Integer);
- procedure SetDisplayPos(const AValue: TPoint);
- procedure SetDisplayType(const AType: TSynCaretType);
- procedure SetVisible(const AValue: Boolean);
- private
- FClipExtraPixel: Integer;
- {$IFDeF SynCaretDebug}
- FDebugShowCount: Integer;
- {$ENDIF}
- FPixelWidth, FPixelHeight: Integer;
- FOffsetX, FOffsetY: Integer;
- FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer;
- FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer;
- FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags;
- FLockCount: Integer;
- FLockFlags: TSynCaretLockFlags;
- function GetHasPaintTimer: Boolean;
- function GetPaintTimer: TSynEditScreenCaretTimer;
- procedure SetClipBottom(const AValue: Integer);
- procedure SetClipExtraPixel(AValue: Integer);
- procedure SetClipLeft(const AValue: Integer);
- procedure SetClipRect(const AValue: TRect);
- procedure SetClipTop(const AValue: Integer);
- procedure CalcExtraLineChars;
- procedure SetPaintTimer(AValue: TSynEditScreenCaretTimer);
- procedure UpdateDisplayType;
- procedure UpdateDisplay;
- procedure ShowCaret;
- procedure HideCaret;
- property HandleAllocated: Boolean read GetHandleAllocated;
- protected
- property Handle: HWND read GetHandle;
- public
- constructor Create(AHandleOwner: TWinControl);
- constructor Create(AHandleOwner: TWinControl; APainterClass: TSynEditScreenCaretPainterClass);
- procedure ChangePainter(APainterClass: TSynEditScreenCaretPainterClass);
- destructor Destroy; override;
- procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect);
- procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean);
- procedure BeginPaint(rcClip: TRect);
- procedure FinishPaint(rcClip: TRect);
- procedure Lock;
- procedure UnLock;
- procedure AfterPaintEvent; // next async
- procedure Hide; // Keep visible = true
- procedure DestroyCaret(SkipHide: boolean = False);
- procedure ResetCaretTypeSizes;
- procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer;
- AFlags: TSynCustomCaretSizeFlags = []);
- property HandleOwner: TWinControl read FHandleOwner;
- property PaintTimer: TSynEditScreenCaretTimer read GetPaintTimer write SetPaintTimer;
- property HasPaintTimer: Boolean read GetHasPaintTimer;
- property Painter: TSynEditScreenCaretPainter read FCaretPainter;
- property CharWidth: Integer read FCharWidth write SetCharWidth;
- property CharHeight: Integer read FCharHeight write SetCharHeight;
- property ClipLeft: Integer read FClipLeft write SetClipLeft;
- property ClipRight: Integer read FClipRight write SetClipRight; // First pixel outside the allowed area
- property ClipTop: Integer read FClipTop write SetClipTop;
- property ClipRect: TRect write SetClipRect;
- property ClipBottom: Integer read FClipBottom write SetClipBottom;
- property ClipExtraPixel: Integer read FClipExtraPixel write SetClipExtraPixel; // Amount of pixels, after the last full char (half visible char width)
- property Visible: Boolean read FVisible write SetVisible;
- property DisplayType: TSynCaretType read FDisplayType write SetDisplayType;
- property DisplayPos: TPoint read FDisplayPos write SetDisplayPos;
- property ExtraLineChars: Integer read FExtraLineChars; // Extend the longest line by x chars
- property OnExtraLineCharsChanged: TNotifyEvent
- read FOnExtraLineCharsChanged write FOnExtraLineCharsChanged;
- end;
- implementation
- { TSynBeforeSetSelTextList }
- procedure TSynBeforeSetSelTextList.CallBeforeSetSelTextHandlers(Sender: TObject;
- AMode: TSynSelectionMode; ANewText: PChar);
- var
- i: Integer;
- begin
- i:=Count;
- while NextDownIndex(i) do
- TSynBeforeSetSelTextEvent(Items[i])(Sender, AMode, ANewText);
- end;
- { TSynEditBaseCaret }
- function TSynEditBaseCaret.GetBytePos: Integer;
- begin
- ValidateBytePos;
- Result := FBytePos;
- end;
- function TSynEditBaseCaret.GetBytePosOffset: Integer;
- begin
- ValidateBytePos;
- Result := FBytePosOffset;
- end;
- function TSynEditBaseCaret.GetCharPos: Integer;
- begin
- ValidateCharPos;
- Result := FCharPos;
- end;
- function TSynEditBaseCaret.GetFullLogicalPos: TLogCaretPoint;
- begin
- ValidateBytePos;
- Result.Y := FLinePos;
- Result.X := FBytePos;
- Result.Offs := FBytePosOffset;
- end;
- function TSynEditBaseCaret.GetLineBytePos: TPoint;
- begin
- ValidateBytePos;
- Result := Point(FBytePos, FLinePos);
- end;
- function TSynEditBaseCaret.GetLineCharPos: TPoint;
- begin
- ValidateCharPos;
- Result := Point(FCharPos, FLinePos);
- end;
- procedure TSynEditBaseCaret.SetBytePos(AValue: Integer);
- begin
- InternalSetLineByterPos(FLinePos, AValue, 0, [scuChangedX]);
- end;
- procedure TSynEditBaseCaret.SetBytePosOffset(AValue: Integer);
- begin
- ValidateBytePos;
- InternalSetLineByterPos(FLinePos, FBytePos, AValue, [scuChangedX]);
- end;
- procedure TSynEditBaseCaret.SetCharPos(AValue: Integer);
- begin
- InternalSetLineCharPos(FLinePos, AValue, [scuChangedX]);
- end;
- procedure TSynEditBaseCaret.SetFullLogicalPos(AValue: TLogCaretPoint);
- begin
- InternalSetLineByterPos(AValue.y, AValue.x, AValue.Offs, [scuChangedX, scuChangedY]);
- end;
- procedure TSynEditBaseCaret.SetLineBytePos(AValue: TPoint);
- begin
- InternalSetLineByterPos(AValue.y, AValue.x, 0, [scuChangedX, scuChangedY]);
- end;
- procedure TSynEditBaseCaret.SetLineCharPos(AValue: TPoint);
- begin
- InternalSetLineCharPos(AValue.y, AValue.X, [scuChangedX, scuChangedY]);
- end;
- procedure TSynEditBaseCaret.SetLinePos(AValue: Integer);
- begin
- // TODO: may temporary lead to invalid x bytepos. Must be adjusted *before* calculating char
- //if scBytePosValid in FFlags then
- // InternalSetLineByterPos(AValue, FBytePos, FBytePosOffset, [scuChangedY])
- //else
- ValidateCharPos;
- InternalSetLineCharPos(AValue, FCharPos, [scuChangedY]);
- end;
- function TSynEditBaseCaret.GetLineText: string;
- begin
- if (LinePos >= 1) and (LinePos <= FLines.Count) then
- Result := FLines[LinePos - 1]
- else
- Result := '';
- end;
- procedure TSynEditBaseCaret.SetLineText(AValue: string);
- begin
- if (LinePos >= 1) and (LinePos <= Max(1, FLines.Count)) then
- FLines[LinePos - 1] := AValue;
- end;
- procedure TSynEditBaseCaret.ValidateBytePos;
- begin
- if scBytePosValid in FFlags then
- exit;
- assert(scCharPosValid in FFlags, 'ValidateBytePos: no charpos set');
- Include(FFlags, scBytePosValid);
- FBytePos := FLines.LogPhysConvertor.PhysicalToLogical(FLinePos-1, FCharPos, FBytePosOffset);
- end;
- procedure TSynEditBaseCaret.ValidateCharPos;
- begin
- if scCharPosValid in FFlags then
- exit;
- assert(scBytePosValid in FFlags, 'ValidateCharPos: no bytepos set');
- Include(FFlags, scCharPosValid);
- FCharPos := FLines.LogPhysConvertor.LogicalToPhysical(FLinePos-1, FBytePos, FBytePosOffset);
- end;
- procedure TSynEditBaseCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
- UpdFlags: TSynEditCaretUpdateFlags);
- begin
- if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
- (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
- then
- exit;
- if not (scuNoInvalidate in UpdFlags) then
- Exclude(FFlags, scBytePosValid);
- Include(FFlags, scCharPosValid);
- if NewLine < 1 then begin
- NewLine := 1;
- Exclude(FFlags, scBytePosValid);
- end;
- if NewCharPos < 1 then begin
- NewCharPos := 1;
- Exclude(FFlags, scBytePosValid);
- end;
- FCharPos := NewCharPos;
- FLinePos := NewLine;
- end;
- procedure TSynEditBaseCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
- UpdFlags: TSynEditCaretUpdateFlags);
- begin
- if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
- (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
- then
- exit;
- if not (scuNoInvalidate in UpdFlags) then
- Exclude(FFlags, scCharPosValid);
- Include(FFlags, scBytePosValid);
- if NewLine < 1 then begin
- NewLine := 1;
- Exclude(FFlags, scCharPosValid);
- end;
- if NewBytePos < 1 then begin
- NewBytePos := 1;
- Exclude(FFlags, scCharPosValid);
- end;
- FBytePos := NewBytePos;
- FBytePosOffset := NewByteOffs;
- FLinePos := NewLine;
- end;
- constructor TSynEditBaseCaret.Create;
- begin
- inherited Create;
- fLinePos := 1;
- fCharPos := 1;
- FBytePos := 1;
- FBytePosOffset := 0;
- FFlags := [scCharPosValid, scBytePosValid];
- end;
- procedure TSynEditBaseCaret.AssignFrom(Src: TSynEditBaseCaret);
- begin
- FLinePos := Src.FLinePos;
- FCharPos := Src.FCharPos;
- FBytePos := Src.FBytePos;
- FBytePosOffset := Src.FBytePosOffset;
- FFlags := Src.FFlags;
- SetLines(Src.FLines);
- end;
- procedure TSynEditBaseCaret.Invalidate;
- begin
- FLinePos := 1;
- FCharPos := 1;
- FBytePos := 1;
- FFlags := [];
- end;
- procedure TSynEditBaseCaret.InvalidateBytePos;
- begin
- if not (scCharPosValid in FFlags) then
- Invalidate
- else
- Exclude(FFlags, scBytePosValid);
- end;
- procedure TSynEditBaseCaret.InvalidateCharPos;
- begin
- if not (scBytePosValid in FFlags) then
- Invalidate
- else
- Exclude(FFlags, scCharPosValid);
- end;
- function TSynEditBaseCaret.IsAtLineChar(aPoint: TPoint): Boolean;
- begin
- ValidateCharPos;
- Result := (FLinePos = aPoint.y) and (FCharPos = aPoint.x);
- end;
- function TSynEditBaseCaret.IsAtLineByte(aPoint: TPoint; aByteOffset: Integer): Boolean;
- begin
- ValidateBytePos;
- Result := (FLinePos = aPoint.y) and (BytePos = aPoint.x) and
- ( (aByteOffset < 0) or (FBytePosOffset = aByteOffset) );
- end;
- function TSynEditBaseCaret.IsAtPos(aCaret: TSynEditCaret): Boolean;
- begin
- if (scBytePosValid in FFlags) or (scBytePosValid in aCaret.FFlags) then
- Result := IsAtLineByte(aCaret.LineBytePos, aCaret.BytePosOffset)
- else
- Result := IsAtLineChar(aCaret.LineCharPos);
- end;
- { TSynEditPointBase }
- function TSynEditPointBase.GetLocked: Boolean;
- begin
- Result := FLockCount > 0;
- end;
- procedure TSynEditPointBase.SetLines(const AValue: TSynEditStrings);
- begin
- FLines := AValue;
- end;
- procedure TSynEditPointBase.DoLock;
- begin
- end;
- procedure TSynEditPointBase.DoUnlock;
- begin
- end;
- constructor TSynEditPointBase.Create;
- begin
- FOnChangeList := TMethodList.Create;
- end;
- constructor TSynEditPointBase.Create(Lines : TSynEditStrings);
- begin
- Create;
- FLines := Lines;
- end;
- destructor TSynEditPointBase.Destroy;
- begin
- FreeAndNil(FOnChangeList);
- inherited Destroy;
- end;
- procedure TSynEditPointBase.AddChangeHandler(AHandler : TNotifyEvent);
- begin
- FOnChangeList.Add(TMethod(AHandler));
- end;
- procedure TSynEditPointBase.RemoveChangeHandler(AHandler : TNotifyEvent);
- begin
- FOnChangeList.Remove(TMethod(AHandler));
- end;
- procedure TSynEditPointBase.Lock;
- begin
- if FLockCount = 0 then
- DoLock;
- inc(FLockCount);
- end;
- procedure TSynEditPointBase.Unlock;
- begin
- dec(FLockCount);
- if FLockCount = 0 then
- DoUnLock;
- end;
- { TSynEditCaret }
- constructor TSynEditCaret.Create;
- begin
- inherited Create;
- FMaxLeftChar := nil;
- FAllowPastEOL := True;
- FForcePastEOL := 0;
- FAutoMoveOnEdit := 0;
- if FLines <> nil then
- FLines.AddEditHandler(@DoLinesEdited);
- end;
- destructor TSynEditCaret.Destroy;
- begin
- if FLines <> nil then
- FLines.RemoveEditHandler(@DoLinesEdited);
- inherited Destroy;
- end;
- procedure TSynEditCaret.AssignFrom(Src: TSynEditBaseCaret);
- begin
- FOldCharPos := FCharPos;
- FOldLinePos := FLinePos;
- inherited AssignFrom(Src);
- if Src is TSynEditCaret then begin
- FMaxLeftChar := TSynEditCaret(Src).FMaxLeftChar;
- FAllowPastEOL := TSynEditCaret(Src).FAllowPastEOL;
- FKeepCaretX := TSynEditCaret(Src).FKeepCaretX;
- FLastCharPos := TSynEditCaret(Src).FLastCharPos;
- end
- else begin
- AdjustToChar;
- FLastCharPos := FCharPos;
- end;
- end;
- procedure TSynEditCaret.DoLock;
- begin
- FTouched := False;
- ValidateCharPos;
- //ValidateBytePos;
- FOldCharPos := FCharPos;
- FOldLinePos := FLinePos;
- end;
- procedure TSynEditCaret.DoUnlock;
- begin
- if not FChangeOnTouch then
- FTouched := False;
- FChangeOnTouch := False;
- ValidateCharPos;
- //ValidateBytePos;
- if (FOldCharPos <> FCharPos) or (FOldLinePos <> FLinePos) or FTouched then
- fOnChangeList.CallNotifyEvents(self);
- // All notifications called, reset oldpos
- FTouched := False;
- FOldCharPos := FCharPos;
- FOldLinePos := FLinePos;
- end;
- procedure TSynEditCaret.SetLines(const AValue: TSynEditStrings);
- begin
- if FLines = AValue then exit;
- // Do not check flag. It will be cleared in Assign
- if (FLines <> nil) then
- FLines.RemoveEditHandler(@DoLinesEdited);
- FLinesEditedRegistered := False;
- inherited SetLines(AValue);
- if FAutoMoveOnEdit > 0 then
- RegisterLinesEditedHandler;
- end;
- procedure TSynEditCaret.RegisterLinesEditedHandler;
- begin
- if FLinesEditedRegistered or (FLines = nil) then
- exit;
- FLinesEditedRegistered := True;
- FLines.AddEditHandler(@DoLinesEdited);
- end;
- procedure TSynEditCaret.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
- aLineBrkCnt: Integer; aText: String);
- // Todo: refactor / this is a copy from selection
- function AdjustPoint(aPoint: Tpoint): TPoint; inline;
- begin
- Result := aPoint;
- if aLineBrkCnt < 0 then begin
- (* Lines Deleted *)
- if aPoint.y > aLinePos then begin
- Result.y := Max(aLinePos, Result.y + aLineBrkCnt);
- if Result.y = aLinePos then
- Result.x := Result.x + aBytePos - 1;
- end;
- end
- else
- if aLineBrkCnt > 0 then begin
- (* Lines Inserted *)
- if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then begin
- Result.x := Result.x - aBytePos + 1;
- Result.y := Result.y + aLineBrkCnt;
- end;
- if aPoint.y > aLinePos then begin
- Result.y := Result.y + aLineBrkCnt;
- end;
- end
- else
- if aCount <> 0 then begin
- (* Chars Insert/Deleted *)
- if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then
- Result.x := Max(aBytePos, Result.x + aCount);
- end;
- end;
- var
- p: TPoint;
- begin
- if (FAutoMoveOnEdit > 0) and
- ( (aLineBrkCnt <> 0) or (aLinePos = FLinePos) )
- then begin
- IncForcePastEOL;
- ValidateBytePos;
- p := AdjustPoint(Point(FBytePos, FLinePos));
- InternalSetLineByterPos(p.y, p.x, FBytePosOffset, [scuChangedX, scuChangedY, scuForceSet]);
- DecForcePastEOL;
- end;
- end;
- procedure TSynEditCaret.AdjustToChar;
- var
- CharWidthsArr: TPhysicalCharWidths;
- CharWidths: PPhysicalCharWidth;
- i, LogLen: Integer;
- ScreenPos: Integer;
- LogPos: Integer;
- L: String;
- begin
- ValidateCharPos;
- L := LineText;
- if FLines.LogPhysConvertor.CurrentLine = FLinePos then begin
- CharWidths := FLines.LogPhysConvertor.CurrentWidths;
- LogLen := FLines.LogPhysConvertor.CurrentWidthsCount;
- end
- else begin
- CharWidthsArr := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
- LogLen := Length(CharWidthsArr);
- if LogLen > 0 then
- CharWidths := @CharWidthsArr[0];
- end;
- ScreenPos := 1;
- LogPos := 0;
- while LogPos < LogLen do begin
- if ScreenPos = FCharPos then exit;
- if ScreenPos + (CharWidths[LogPos] and PCWMask) > FCharPos then begin
- if (L[LogPos+1] = #9) and (not FSkipTabs) then exit;
- i := FCharPos;
- if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
- FCharPos := ScreenPos + (CharWidths[LogPos] and PCWMask)
- else
- FCharPos := ScreenPos;
- if FCharPos <> i then
- Exclude(FFlags, scBytePosValid);
- exit;
- end;
- ScreenPos := ScreenPos + (CharWidths[LogPos] and PCWMask);
- inc(LogPos);
- end;
- end;
- function TSynEditCaret.GetMaxLeftPastEOL: Integer;
- begin
- if FMaxLeftChar <> nil then
- Result := FMaxLeftChar()
- else
- Result := MaxInt;
- end;
- procedure TSynEditCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
- UpdFlags: TSynEditCaretUpdateFlags);
- var
- LogEolPos, MaxPhysX, NewLogCharPos, Offs: Integer;
- L: String;
- begin
- if not (scuChangedX in UpdFlags) and FKeepCaretX then
- NewCharPos := FLastCharPos;
- Lock;
- FTouched := True;
- try
- if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
- (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
- then begin
- // Lines may have changed, so the other pos can be invalid
- if not (scuNoInvalidate in UpdFlags) then
- Exclude(FFlags, scBytePosValid);
- exit;
- end;
- if NewLine > FLines.Count then begin
- NewLine := FLines.Count;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
- NewLine := 1;
- if (NewCharPos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
- then MaxPhysX := GetMaxLeftPastEOL
- else MaxPhysX := 1;
- if NewCharPos > MaxPhysX then
- NewCharPos := MaxPhysX;
- NewLogCharPos := NewCharPos;
- Offs := 0;
- Exclude(UpdFlags, scuNoInvalidate);
- end else begin
- if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
- NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToNextChar])
- else
- NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToCharBegin]);
- Offs := Lines.LogPhysConvertor.UnAdjustedPhysToLogColOffs;
- L := Lines[NewLine - 1];
- if (Offs > 0) and (not FSkipTabs) and (L[NewLogCharPos] = #9) then begin
- // get the unadjusted result
- NewLogCharPos := Lines.LogPhysConvertor.UnAdjustedPhysToLogResult
- end
- else begin
- // get adjusted Result
- NewCharPos := Lines.LogPhysConvertor.AdjustedPhysToLogOrigin;
- Offs := 0;
- end;
- LogEolPos := length(L)+1;
- if NewLogCharPos > LogEolPos then begin
- if FAllowPastEOL or (FForcePastEOL > 0) then begin
- MaxPhysX := GetMaxLeftPastEOL;
- if NewCharPos > MaxPhysX then begin
- NewLogCharPos := NewLogCharPos - (NewCharPos - MaxPhysX);
- NewCharPos := MaxPhysX;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- end
- else begin
- NewCharPos := NewCharPos - (NewLogCharPos - LogEolPos);
- NewLogCharPos := LogEolPos;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- end;
- end;
- if NewCharPos < 1 then begin
- NewCharPos := 1;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- inherited InternalSetLineCharPos(NewLine, NewCharPos, UpdFlags);
- inherited InternalSetLineByterPos(NewLine, NewLogCharPos, Offs, [scuNoInvalidate, scuChangedX]);
- if (scuChangedX in UpdFlags) or (not FKeepCaretX) then
- FLastCharPos := FCharPos;
- finally
- Unlock;
- end;
- end;
- procedure TSynEditCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
- UpdFlags: TSynEditCaretUpdateFlags);
- var
- MaxPhysX, NewCharPos, LogEolPos: Integer;
- L: String;
- begin
- if not (scuChangedX in UpdFlags) and FKeepCaretX then begin
- Exclude(UpdFlags, scuNoInvalidate);
- InternalSetLineCharPos(NewLine, FLastCharPos, UpdFlags);
- exit;
- end;
- Lock;
- FTouched := True;
- try
- if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
- (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
- then begin
- // Lines may have changed, so the other pos can be invalid
- if not (scuNoInvalidate in UpdFlags) then
- Exclude(FFlags, scCharPosValid);
- exit;
- end;
- if NewLine > FLines.Count then begin
- NewLine := FLines.Count;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
- L := '';
- NewLine := 1;
- LogEolPos := 1;
- if (NewBytePos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
- then MaxPhysX := GetMaxLeftPastEOL
- else MaxPhysX := 1;
- if NewBytePos > MaxPhysX then
- NewBytePos := MaxPhysX;
- NewByteOffs := 0;
- NewCharPos := NewBytePos;
- Exclude(UpdFlags, scuNoInvalidate);
- end else begin
- L := Lines[NewLine - 1];
- LogEolPos := length(L)+1;
- if (NewBytePos > LogEolPos) then begin
- if not(FAllowPastEOL or (FForcePastEOL > 0)) then
- NewBytePos := LogEolPos;
- NewByteOffs := 0;
- end
- else
- if (NewByteOffs > 0) and ( (FSkipTabs) or (L[NewBytePos] <> #9) ) then
- NewByteOffs := 0;
- if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
- NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToNextChar])
- else
- NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToCharBegin]);
- NewBytePos := Lines.LogPhysConvertor.AdjustedLogToPhysOrigin;
- if (NewBytePos > LogEolPos) then begin
- MaxPhysX := GetMaxLeftPastEOL;
- if NewCharPos > MaxPhysX then begin
- NewBytePos := NewBytePos - (NewCharPos - MaxPhysX);
- NewCharPos := MaxPhysX;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- end;
- end;
- if NewBytePos < 1 then begin
- NewBytePos := 1;
- Exclude(UpdFlags, scuNoInvalidate);
- end;
- inherited InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs, UpdFlags);
- inherited InternalSetLineCharPos(NewLine, NewCharPos, [scuNoInvalidate, scuChangedX]);
- if (scuChangedX in UpdFlags) and FKeepCaretX then
- FLastCharPos := FCharPos;
- finally
- Unlock;
- end;
- end;
- function TSynEditCaret.GetOldLineCharPos: TPoint;
- begin
- Result := Point(FOldCharPos, FOldLinePos);
- end;
- function TSynEditCaret.GetOldLineBytePos: TPoint;
- begin
- Result := FLines.PhysicalToLogicalPos(OldLineCharPos);
- end;
- function TSynEditCaret.GetOldFullLogicalPos: TLogCaretPoint;
- begin
- Result.Y := FOldLinePos;
- Result.X := FLines.LogPhysConvertor.PhysicalToLogical(ToIdx(FOldLinePos), FOldCharPos, Result.Offs);
- end;
- procedure TSynEditCaret.SetAllowPastEOL(const AValue: Boolean);
- begin
- if FAllowPastEOL = AValue then exit;
- FAllowPastEOL := AValue;
- if not FAllowPastEOL then begin
- // TODO: this would set x=LastX
- //if scBytePosValid in FFlags then
- // InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
- //else
- ValidateCharPos;
- InternalSetLineCharPos(FLinePos, FCharPos, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
- end;
- end;
- procedure TSynEditCaret.SetKeepCaretX(const AValue: Boolean);
- begin
- if FKeepCaretX = AValue then exit;
- FKeepCaretX := AValue;
- if FKeepCaretX then begin
- ValidateCharPos;
- FLastCharPos := FCharPos;
- end;
- end;
- procedure TSynEditCaret.SetSkipTabs(const AValue: Boolean);
- begin
- if FSkipTabs = AValue then exit;
- FSkipTabs := AValue;
- if FSkipTabs then begin
- Lock;
- AdjustToChar;
- Unlock;
- end;
- end;
- procedure TSynEditCaret.IncForcePastEOL;
- begin
- inc(FForcePastEOL);
- end;
- procedure TSynEditCaret.DecForcePastEOL;
- begin
- dec(FForcePastEOL);
- end;
- procedure TSynEditCaret.IncForceAdjustToNextChar;
- begin
- Inc(FForceAdjustToNextChar);
- end;
- procedure TSynEditCaret.DecForceAdjustToNextChar;
- begin
- Dec(FForceAdjustToNextChar);
- end;
- procedure TSynEditCaret.IncAutoMoveOnEdit;
- begin
- if FAutoMoveOnEdit = 0 then begin
- RegisterLinesEditedHandler;
- ValidateBytePos;
- end;
- inc(FAutoMoveOnEdit);
- end;
- procedure TSynEditCaret.DecAutoMoveOnEdit;
- begin
- dec(FAutoMoveOnEdit);
- end;
- procedure TSynEditCaret.ChangeOnTouch;
- begin
- FChangeOnTouch := True;
- if not Locked then
- FTouched := False;
- end;
- procedure TSynEditCaret.Touch(aChangeOnTouch: Boolean);
- begin
- if aChangeOnTouch then
- ChangeOnTouch;
- FTouched := True;
- end;
- function TSynEditCaret.WasAtLineChar(aPoint: TPoint): Boolean;
- begin
- Result := (FOldLinePos = aPoint.y) and (FOldCharPos = aPoint.x);
- end;
- function TSynEditCaret.WasAtLineByte(aPoint: TPoint): Boolean;
- begin
- Result := (FOldLinePos = aPoint.y) and
- (FLines.PhysicalToLogicalPos(Point(FOldCharPos, FOldLinePos)).X = aPoint.x);
- end;
- function TSynEditCaret.MoveHoriz(ACount: Integer): Boolean;
- var
- L: String;
- CharWidths: TPhysicalCharWidths;
- GotCharWidths: Boolean;
- MaxOffs: Integer;
- p: Integer;
- NC: Boolean;
- NF: Integer;
- function GetMaxOffs(AlogPos: Integer): Integer;
- begin
- if not GotCharWidths then
- CharWidths := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
- GotCharWidths := True;
- Result := CharWidths[AlogPos-1];
- end;
- begin
- GotCharWidths := False;
- L := LineText;
- ValidateBytePos;
- If ACount > 0 then begin
- if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
- MaxOffs := GetMaxOffs(FBytePos) - 1
- else
- MaxOffs := 0;
- while ACount > 0 do begin
- if FBytePosOffset < MaxOffs then
- inc(FBytePosOffset)
- else begin
- if (FBytePos > length(L)) and not (FAllowPastEOL or (FForcePastEOL > 0)) then
- break;
- FBytePos := FLines.LogicPosAddChars(L, FBytePos, 1, True);
- FBytePosOffset := 0;
- if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
- MaxOffs := GetMaxOffs(FBytePos) - 1
- else
- MaxOffs := 0;
- end;
- dec(ACount);
- end;
- Result := ACount = 0;
- p := FBytePos;
- IncForceAdjustToNextChar;
- InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
- DecForceAdjustToNextChar;
- if p > FBytePos then
- Result := False; // MaxLeftChar
- end
- else begin
- while ACount < 0 do begin
- if FBytePosOffset > 0 then
- dec(FBytePosOffset)
- else begin
- if FBytePos = 1 then
- break;
- FBytePos := FLines.LogicPosAddChars(L, FBytePos, -1, True);
- if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
- FBytePosOffset := GetMaxOffs(FBytePos) - 1
- else
- FBytePosOffset := 0;
- end;
- inc(ACount);
- end;
- Result := ACount = 0;
- NC := FAdjustToNextChar;
- NF := FForceAdjustToNextChar;
- FAdjustToNextChar := False;
- FForceAdjustToNextChar := 0;
- InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
- FAdjustToNextChar := NC;
- FForceAdjustToNextChar := NF;
- end;
- end;
- { TSynEditSelection }
- constructor TSynEditSelection.Create(ALines : TSynEditStrings; aActOnLineChanges: Boolean);
- begin
- Inherited Create(ALines);
- FOnBeforeSetSelText := TSynBeforeSetSelTextList.Create;
- FInternalCaret := TSynEditBaseCaret.Create;
- FInternalCaret.Lines := FLines;
- FActiveSelectionMode := smNormal;
- FStartLinePos := 1;
- FStartBytePos := 1;
- FAltStartLinePos := -1;
- FAltStartBytePos := -1;
- FEndLinePos := 1;
- FEndBytePos := 1;
- FEnabled := True;
- FHookedLines := aActOnLineChanges;
- FIsSettingText := False;
- if FHookedLines then begin
- FLines.AddEditHandler(@DoLinesEdited);
- FLines.AddChangeHandler(senrLineChange, @LineChanged);
- end;
- end;
- destructor TSynEditSelection.Destroy;
- begin
- FreeAndNil(FOnBeforeSetSelText);
- FreeAndNil(FInternalCaret);
- if FHookedLines then begin
- FLines.RemoveEditHandler(@DoLinesEdited);
- FLines.RemoveChangeHandler(senrLineChange, @LineChanged);
- end;
- inherited Destroy;
- end;
- procedure TSynEditSelection.AssignFrom(Src: TSynEditSelection);
- begin
- //FEnabled := src.FEnabled;
- FHide := src.FHide;
- FActiveSelectionMode := src.FActiveSelectionMode;
- FSelectionMode := src.FSelectionMode;
- FStartLinePos := src.FStartLinePos; // 1 based
- FStartBytePos := src.FStartBytePos; // 1 based
- FEndLinePos := src.FEndLinePos; // 1 based
- FEndBytePos := src.FEndBytePos; // 1 based
- FPersistent := src.FPersistent;
- end;
- procedure TSynEditSelection.AdjustAfterTrimming;
- begin
- if FStartBytePos > Length(FLines[FStartLinePos-1]) + 1 then
- FStartBytePos := Length(FLines[FStartLinePos-1]) + 1;
- if FEndBytePos > Length(FLines[FEndLinePos-1]) + 1 then
- FEndBytePos := Length(FLines[FEndLinePos-1]) + 1;
- // Todo: Call ChangeNotification
- end;
- procedure TSynEditSelection.DoLock;
- begin
- inherited DoLock;
- FLastCarePos := Point(-1, -1);
- end;
- procedure TSynEditSelection.DoUnlock;
- begin
- inherited DoUnlock;
- FLastCarePos := Point(-1, -1);
- end;
- function TSynEditSelection.GetSelText : string;
- function CopyPadded(const S: string; Index, Count: integer): string;
- var
- SrcLen: Integer;
- DstLen: integer;
- P: PChar;
- begin
- SrcLen := Length(S);
- DstLen := Index + Count;
- if SrcLen >= DstLen then
- Result := Copy(S, Index, Count)
- else begin
- SetLength(Result, DstLen);
- P := PChar(Pointer(Result));
- StrPCopy(P, Copy(S, Index, Count));
- Inc(P, SrcLen);
- FillChar(P^, DstLen - Srclen, $20);
- end;
- end;
- procedure CopyAndForward(const S: string; Index, Count: Integer; var P:
- PChar);
- var
- pSrc: PChar;
- SrcLen: Integer;
- DstLen: Integer;
- begin
- SrcLen := Length(S);
- if (Index <= SrcLen) and (Count > 0) then begin
- Dec(In…