/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

  1. {-------------------------------------------------------------------------------
  2. The contents of this file are subject to the Mozilla Public License
  3. Version 1.1 (the "License"); you may not use this file except in compliance
  4. with the License. You may obtain a copy of the License at
  5. http://www.mozilla.org/MPL/
  6. Software distributed under the License is distributed on an "AS IS" basis,
  7. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  8. the specific language governing rights and limitations under the License.
  9. Alternatively, the contents of this file may be used under the terms of the
  10. GNU General Public License Version 2 or later (the "GPL"), in which case
  11. the provisions of the GPL are applicable instead of those above.
  12. If you wish to allow use of your version of this file only under the terms
  13. of the GPL and not to allow others to use your version of this file
  14. under the MPL, indicate your decision by deleting the provisions above and
  15. replace them with the notice and other provisions required by the GPL.
  16. If you do not delete the provisions above, a recipient may use your version
  17. of this file under either the MPL or the GPL.
  18. -------------------------------------------------------------------------------}
  19. (* Naming Conventions:
  20. Byte = Logical: Refers to the location any TextToken has in the String.
  21. In Utf8String some TextToken can have more than one byte
  22. Char = Physical: Refers to the (x-)location on the screen matrix.
  23. Some TextToken (like tab) can spawn multiply char locations
  24. *)
  25. unit SynEditPointClasses;
  26. {$I synedit.inc}
  27. {off $DEFINE SynCaretDebug}
  28. interface
  29. uses
  30. Classes, SysUtils, Controls, LCLProc, LCLType, LCLIntf, ExtCtrls, Graphics, Forms,
  31. {$IFDEF SYN_MBCSSUPPORT}
  32. Imm,
  33. {$ENDIF}
  34. LazSynEditText, SynEditTypes, SynEditMiscProcs;//, SynEditTextBuffer;
  35. type
  36. TInvalidateLines = procedure(FirstLine, LastLine: integer) of Object;
  37. TLinesCountChanged = procedure(FirstLine, Count: integer) of Object;
  38. TMaxLeftCharFunc = function: Integer of object;
  39. { TSynEditPointBase }
  40. TSynEditPointBase = class
  41. private
  42. function GetLocked: Boolean;
  43. protected
  44. FLines: TSynEditStrings;
  45. FOnChangeList: TMethodList;
  46. FLockCount: Integer;
  47. procedure SetLines(const AValue: TSynEditStrings); virtual;
  48. procedure DoLock; virtual;
  49. Procedure DoUnlock; virtual;
  50. public
  51. constructor Create;
  52. constructor Create(Lines: TSynEditStrings);
  53. destructor Destroy; override;
  54. procedure AddChangeHandler(AHandler: TNotifyEvent);
  55. procedure RemoveChangeHandler(AHandler: TNotifyEvent);
  56. procedure Lock;
  57. Procedure Unlock;
  58. property Lines: TSynEditStrings read FLines write SetLines;
  59. property Locked: Boolean read GetLocked;
  60. end;
  61. TSynEditBaseCaret = class;
  62. TSynEditCaret = class;
  63. TSynBlockPersistMode = (
  64. sbpDefault,
  65. sbpWeak, // selstart/end are treated as outside the block
  66. sbpStrong // selstart/end are treated as inside the block
  67. );
  68. TSynBeforeSetSelTextEvent = procedure(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar) of object;
  69. { TSynBeforeSetSelTextList }
  70. TSynBeforeSetSelTextList = Class(TMethodList)
  71. public
  72. procedure CallBeforeSetSelTextHandlers(Sender: TObject; AMode: TSynSelectionMode; ANewText: PChar);
  73. end;
  74. { TSynEditSelection }
  75. TSynEditSelection = class(TSynEditPointBase)
  76. private
  77. FOnBeforeSetSelText: TSynBeforeSetSelTextList;
  78. FAutoExtend: Boolean;
  79. FCaret: TSynEditCaret;
  80. FHide: Boolean;
  81. FInternalCaret: TSynEditBaseCaret;
  82. FInvalidateLinesMethod: TInvalidateLines;
  83. FEnabled: Boolean;
  84. FHookedLines: Boolean;
  85. FIsSettingText: Boolean;
  86. FForceSingleLineSelected: Boolean;
  87. FActiveSelectionMode: TSynSelectionMode;
  88. FSelectionMode: TSynSelectionMode;
  89. FStartLinePos: Integer; // 1 based
  90. FStartBytePos: Integer; // 1 based
  91. FAltStartLinePos, FAltStartBytePos: Integer; // 1 based // Alternate, for min selection
  92. FEndLinePos: Integer; // 1 based
  93. FEndBytePos: Integer; // 1 based
  94. FPersistent: Boolean;
  95. FPersistentLock, FWeakPersistentIdx, FStrongPersistentIdx: Integer;
  96. FIgnoreNextCaretMove: Boolean;
  97. (* On any modification, remember the position of the caret.
  98. If it gets moved from there to either end of the block, this should be ignored
  99. This happens, if Block and caret are adjusted directly
  100. *)
  101. FLastCarePos: TPoint;
  102. FStickyAutoExtend: Boolean;
  103. function AdjustBytePosToCharacterStart(Line: integer; BytePos: integer): integer;
  104. function GetFirstLineBytePos: TPoint;
  105. function GetLastLineBytePos: TPoint;
  106. function GetLastLineHasSelection: Boolean;
  107. procedure SetAutoExtend(AValue: Boolean);
  108. procedure SetCaret(const AValue: TSynEditCaret);
  109. procedure SetEnabled(const Value : Boolean);
  110. procedure SetActiveSelectionMode(const Value: TSynSelectionMode);
  111. procedure SetForceSingleLineSelected(AValue: Boolean);
  112. procedure SetHide(const AValue: Boolean);
  113. procedure SetPersistent(const AValue: Boolean);
  114. procedure SetSelectionMode (const AValue: TSynSelectionMode);
  115. function GetStartLineBytePos: TPoint;
  116. procedure ConstrainStartLineBytePos(var Value: TPoint);
  117. procedure SetStartLineBytePos(Value: TPoint);
  118. procedure AdjustStartLineBytePos(Value: TPoint);
  119. function GetEndLineBytePos: TPoint;
  120. procedure SetEndLineBytePos(Value: TPoint);
  121. function GetSelText: string;
  122. procedure SetSelText(const Value: string);
  123. procedure DoCaretChanged(Sender: TObject);
  124. procedure AdjustAfterTrimming; // TODO: Move into TrimView?
  125. protected
  126. procedure DoLock; override;
  127. procedure DoUnlock; override;
  128. Procedure LineChanged(Sender: TSynEditStrings; AIndex, ACount : Integer);
  129. procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
  130. aLineBrkCnt: Integer; aText: String);
  131. public
  132. constructor Create(ALines: TSynEditStrings; aActOnLineChanges: Boolean);
  133. destructor Destroy; override;
  134. procedure AssignFrom(Src: TSynEditSelection);
  135. procedure SetSelTextPrimitive(PasteMode: TSynSelectionMode; Value: PChar; AReplace: Boolean = False);
  136. function SelAvail: Boolean;
  137. function SelCanContinue(ACaret: TSynEditCaret): Boolean;
  138. function IsBackwardSel: Boolean; // SelStart < SelEnd ?
  139. procedure BeginMinimumSelection; // current selection will be minimum while follow caret (autoExtend) // until next setSelStart or end of follow
  140. procedure SortSelectionPoints;
  141. procedure IgnoreNextCaretMove;
  142. // Mode can NOT be changed in nested calls
  143. procedure IncPersistentLock(AMode: TSynBlockPersistMode = sbpDefault); // Weak: Do not extend (but rather move) block, if at start/end
  144. procedure DecPersistentLock;
  145. procedure Clear;
  146. procedure AddBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
  147. procedure RemoveBeforeSetSelTextHandler(AHandler: TSynBeforeSetSelTextEvent);
  148. property Enabled: Boolean read FEnabled write SetEnabled;
  149. property ForceSingleLineSelected: Boolean read FForceSingleLineSelected write SetForceSingleLineSelected;
  150. property ActiveSelectionMode: TSynSelectionMode
  151. read FActiveSelectionMode write SetActiveSelectionMode;
  152. property SelectionMode: TSynSelectionMode
  153. read FSelectionMode write SetSelectionMode;
  154. property SelText: String read GetSelText write SetSelText;
  155. // Start and End positions are in the order they where defined
  156. // This may mean Startpos is behind EndPos in the text
  157. property StartLineBytePos: TPoint
  158. read GetStartLineBytePos write SetStartLineBytePos;
  159. property StartLineBytePosAdjusted: TPoint
  160. write AdjustStartLineBytePos;
  161. property EndLineBytePos: TPoint
  162. read GetEndLineBytePos write SetEndLineBytePos;
  163. property StartLinePos: Integer read FStartLinePos;
  164. property EndLinePos: Integer read FEndLinePos;
  165. property StartBytePos: Integer read FStartBytePos;
  166. property EndBytePos: Integer read FEndBytePos;
  167. // First and Last Pos are ordered according to the text flow (LTR)
  168. property FirstLineBytePos: TPoint read GetFirstLineBytePos;
  169. property LastLineBytePos: TPoint read GetLastLineBytePos;
  170. property LastLineHasSelection: Boolean read GetLastLineHasSelection;
  171. property InvalidateLinesMethod : TInvalidateLines write FInvalidateLinesMethod;
  172. property Caret: TSynEditCaret read FCaret write SetCaret;
  173. property Persistent: Boolean read FPersistent write SetPersistent;
  174. // automatically Start/Extend selection if caret moves
  175. // (depends if caret was at block border or not)
  176. property AutoExtend: Boolean read FAutoExtend write SetAutoExtend;
  177. property StickyAutoExtend: Boolean read FStickyAutoExtend write FStickyAutoExtend;
  178. property Hide: Boolean read FHide write SetHide;
  179. end;
  180. { TSynEditCaret }
  181. TSynEditCaretFlag = (
  182. scCharPosValid, scBytePosValid
  183. );
  184. TSynEditCaretFlags = set of TSynEditCaretFlag;
  185. TSynEditCaretUpdateFlag = (
  186. scuForceSet, // Change even if equal to old
  187. scuChangedX, scuChangedY, //
  188. scuNoInvalidate // Keep the Char/Byte ValidFlags
  189. );
  190. TSynEditCaretUpdateFlags = set of TSynEditCaretUpdateFlag;
  191. { TSynEditBaseCaret
  192. No Checks at all.
  193. Caller MUST ensure at least not to set x to invalid pos (middle of char) (incl update x, after SetLine)
  194. }
  195. TSynEditBaseCaret = class(TSynEditPointBase)
  196. private
  197. FFlags: TSynEditCaretFlags;
  198. FLinePos: Integer; // 1 based
  199. FCharPos: Integer; // 1 based
  200. FBytePos, FBytePosOffset: Integer; // 1 based
  201. function GetBytePos: Integer;
  202. function GetBytePosOffset: Integer;
  203. function GetCharPos: Integer;
  204. function GetFullLogicalPos: TLogCaretPoint;
  205. function GetLineBytePos: TPoint;
  206. function GetLineCharPos: TPoint;
  207. procedure SetBytePos(AValue: Integer);
  208. procedure SetBytePosOffset(AValue: Integer);
  209. procedure SetCharPos(AValue: Integer);
  210. procedure SetFullLogicalPos(AValue: TLogCaretPoint);
  211. procedure SetLineBytePos(AValue: TPoint);
  212. procedure SetLineCharPos(AValue: TPoint);
  213. procedure SetLinePos(AValue: Integer);
  214. function GetLineText: string;
  215. procedure SetLineText(AValue: string);
  216. protected
  217. procedure ValidateBytePos;
  218. procedure ValidateCharPos;
  219. procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
  220. UpdFlags: TSynEditCaretUpdateFlags); virtual;
  221. procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
  222. UpdFlags: TSynEditCaretUpdateFlags); virtual;
  223. public
  224. constructor Create;
  225. procedure AssignFrom(Src: TSynEditBaseCaret);
  226. procedure Invalidate; // force to 1,1
  227. procedure InvalidateBytePos; // 1,1 IF no validCharPos
  228. procedure InvalidateCharPos;
  229. function IsAtLineChar(aPoint: TPoint): Boolean;
  230. function IsAtLineByte(aPoint: TPoint; aByteOffset: Integer = -1): Boolean;
  231. function IsAtPos(aCaret: TSynEditCaret): Boolean;
  232. property LinePos: Integer read FLinePos write SetLinePos;
  233. property CharPos: Integer read GetCharPos write SetCharPos;
  234. property LineCharPos: TPoint read GetLineCharPos write SetLineCharPos;
  235. property BytePos: Integer read GetBytePos write SetBytePos;
  236. property BytePosOffset: Integer read GetBytePosOffset write SetBytePosOffset;
  237. property LineBytePos: TPoint read GetLineBytePos write SetLineBytePos;
  238. property FullLogicalPos: TLogCaretPoint read GetFullLogicalPos write SetFullLogicalPos;
  239. property LineText: string read GetLineText write SetLineText;
  240. end;
  241. { TSynEditCaret }
  242. TSynEditCaret = class(TSynEditBaseCaret)
  243. private
  244. FLinesEditedRegistered: Boolean;
  245. FAllowPastEOL: Boolean;
  246. FAutoMoveOnEdit: Integer;
  247. FForcePastEOL: Integer;
  248. FForceAdjustToNextChar: Integer;
  249. FKeepCaretX: Boolean;
  250. FLastCharPos: Integer; // used by KeepCaretX
  251. FOldLinePos: Integer; // 1 based
  252. FOldCharPos: Integer; // 1 based
  253. FAdjustToNextChar: Boolean;
  254. FMaxLeftChar: TMaxLeftCharFunc;
  255. FChangeOnTouch: Boolean;
  256. FSkipTabs: Boolean;
  257. FTouched: Boolean;
  258. procedure AdjustToChar;
  259. function GetMaxLeftPastEOL: Integer;
  260. function GetOldLineCharPos: TPoint;
  261. function GetOldLineBytePos: TPoint;
  262. function GetOldFullLogicalPos: TLogCaretPoint;
  263. procedure SetAllowPastEOL(const AValue: Boolean);
  264. procedure SetSkipTabs(const AValue: Boolean);
  265. procedure SetKeepCaretX(const AValue: Boolean);
  266. procedure RegisterLinesEditedHandler;
  267. protected
  268. procedure InternalSetLineCharPos(NewLine, NewCharPos: Integer;
  269. UpdFlags: TSynEditCaretUpdateFlags); override;
  270. procedure InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
  271. UpdFlags: TSynEditCaretUpdateFlags); override;
  272. procedure DoLock; override;
  273. Procedure DoUnlock; override;
  274. procedure SetLines(const AValue: TSynEditStrings); override;
  275. procedure DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
  276. aLineBrkCnt: Integer; aText: String);
  277. public
  278. constructor Create;
  279. destructor Destroy; override;
  280. procedure AssignFrom(Src: TSynEditBaseCaret);
  281. procedure IncForcePastEOL;
  282. procedure DecForcePastEOL;
  283. procedure IncForceAdjustToNextChar;
  284. procedure DecForceAdjustToNextChar;
  285. procedure IncAutoMoveOnEdit;
  286. procedure DecAutoMoveOnEdit;
  287. procedure ChangeOnTouch;
  288. procedure Touch(aChangeOnTouch: Boolean = False);
  289. function WasAtLineChar(aPoint: TPoint): Boolean;
  290. function WasAtLineByte(aPoint: TPoint): Boolean;
  291. function MoveHoriz(ACount: Integer): Boolean; // Logical // False, if past EOL (not mowed)/BOl
  292. property OldLinePos: Integer read FOldLinePos;
  293. property OldCharPos: Integer read FOldCharPos;
  294. property OldLineCharPos: TPoint read GetOldLineCharPos;
  295. property OldLineBytePos: TPoint read GetOldLineBytePos;
  296. property OldFullLogicalPos: TLogCaretPoint read GetOldFullLogicalPos;
  297. property AdjustToNextChar: Boolean read FAdjustToNextChar write FAdjustToNextChar; deprecated;
  298. property SkipTabs: Boolean read FSkipTabs write SetSkipTabs;
  299. property AllowPastEOL: Boolean read FAllowPastEOL write SetAllowPastEOL;
  300. property KeepCaretX: Boolean read FKeepCaretX write SetKeepCaretX;
  301. property KeepCaretXPos: Integer read FLastCharPos write FLastCharPos;
  302. property MaxLeftChar: TMaxLeftCharFunc read FMaxLeftChar write FMaxLeftChar;
  303. end;
  304. TSynCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock, ctCostum);
  305. TSynCaretLockFlags = set of (sclfUpdateDisplay, sclfUpdateDisplayType);
  306. { TSynEditScreenCaretTimer
  307. Allow sync between carets which use an internal painter
  308. }
  309. TSynEditScreenCaretTimer = class
  310. private
  311. FDisplayCycle: Boolean;
  312. FTimer: TTimer;
  313. FTimerList: TMethodList;
  314. FAfterPaintList: TMethodList;
  315. FLocCount: Integer;
  316. FLocFlags: set of (lfTimer, lfRestart);
  317. procedure DoTimer(Sender: TObject);
  318. procedure DoAfterPaint(Data: PtrInt);
  319. public
  320. constructor Create;
  321. destructor Destroy; override;
  322. procedure AddAfterPaintHandler(AHandler: TNotifyEvent); // called once
  323. procedure AddHandler(AHandler: TNotifyEvent);
  324. procedure RemoveHandler(AHandler: TNotifyEvent);
  325. procedure RemoveHandler(AHandlerOwner: TObject);
  326. procedure IncLock;
  327. procedure DecLock;
  328. procedure AfterPaintEvent;
  329. procedure RestartCycle;
  330. property DisplayCycle: Boolean read FDisplayCycle;
  331. end;
  332. TSynEditScreenCaret = class;
  333. { TSynEditScreenCaretPainter }
  334. TSynEditScreenCaretPainter = class
  335. private
  336. FLeft, FTop, FHeight, FWidth: Integer;
  337. FCreated, FShowing: Boolean;
  338. FInPaint, FInScroll: Boolean;
  339. FPaintClip: TRect;
  340. FScrollX, FScrollY: Integer;
  341. FScrollRect, FScrollClip: TRect;
  342. function GetHandle: HWND;
  343. function GetHandleAllocated: Boolean;
  344. protected
  345. FHandleOwner: TWinControl;
  346. FOwner: TSynEditScreenCaret;
  347. FNeedPositionConfirmed: boolean;
  348. procedure Init; virtual;
  349. property Handle: HWND read GetHandle;
  350. property HandleAllocated: Boolean read GetHandleAllocated;
  351. procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); virtual;
  352. procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); virtual;
  353. procedure BeginPaint(rcClip: TRect); virtual;
  354. procedure FinishPaint(rcClip: TRect); virtual;
  355. public
  356. constructor Create(AHandleOwner: TWinControl; AOwner: TSynEditScreenCaret);
  357. function CreateCaret(w, h: Integer): Boolean; virtual;
  358. function DestroyCaret: Boolean; virtual;
  359. function HideCaret: Boolean; virtual;
  360. function ShowCaret: Boolean; virtual;
  361. function SetCaretPosEx(x, y: Integer): Boolean; virtual;
  362. property Left: Integer read FLeft;
  363. property Top: Integer read FTop;
  364. property Width: Integer read FWidth;
  365. property Height: Integer read FHeight;
  366. property Created: Boolean read FCreated;
  367. property Showing: Boolean read FShowing;
  368. property InPaint: Boolean read FInPaint;
  369. property InScroll: Boolean read FInScroll;
  370. property NeedPositionConfirmed: boolean read FNeedPositionConfirmed;
  371. end;
  372. TSynEditScreenCaretPainterClass = class of TSynEditScreenCaretPainter;
  373. { TSynEditScreenCaretPainterSystem }
  374. TSynEditScreenCaretPainterSystem = class(TSynEditScreenCaretPainter)
  375. protected
  376. //procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
  377. procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
  378. procedure BeginPaint(rcClip: TRect); override;
  379. //procedure FinishPaint(rcClip: TRect); override; // unhide, currently done by editor
  380. public
  381. function CreateCaret(w, h: Integer): Boolean; override;
  382. function DestroyCaret: Boolean; override;
  383. function HideCaret: Boolean; override;
  384. function ShowCaret: Boolean; override;
  385. function SetCaretPosEx(x, y: Integer): Boolean; override;
  386. end;
  387. { TSynEditScreenCaretPainterInternal }
  388. TSynEditScreenCaretPainterInternal = class(TSynEditScreenCaretPainter)
  389. private type
  390. TIsInRectState = (irInside, irPartInside, irOutside);
  391. TPainterState = (psAfterPaintAdded, psCleanOld, psRemoveTimer);
  392. TPainterStates = set of TPainterState;
  393. private
  394. FColor: TColor;
  395. FForcePaintEvents: Boolean;
  396. FIsDrawn: Boolean;
  397. FSavePen: TPen;
  398. FOldX, FOldY, FOldW, FOldH: Integer;
  399. FState: TPainterStates;
  400. FCanPaint: Boolean;
  401. procedure DoTimer(Sender: TObject);
  402. procedure DoPaint(ACanvas: TCanvas; X, Y, H, W: Integer);
  403. procedure Paint;
  404. procedure Invalidate;
  405. procedure AddAfterPaint(AStates: TPainterStates = []);
  406. procedure DoAfterPaint(Sender: TObject);
  407. procedure ExecAfterPaint;
  408. function CurrentCanvas: TCanvas;
  409. procedure SetColor(AValue: TColor);
  410. function IsInRect(ARect: TRect): TIsInRectState;
  411. function IsInRect(ARect: TRect; X, Y, W, H: Integer): TIsInRectState;
  412. protected
  413. procedure Init; override;
  414. procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect); override;
  415. procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean); override;
  416. procedure BeginPaint(rcClip: TRect); override;
  417. procedure FinishPaint(rcClip: TRect); override;
  418. public
  419. destructor Destroy; override;
  420. function CreateCaret(w, h: Integer): Boolean; override;
  421. function DestroyCaret: Boolean; override;
  422. function HideCaret: Boolean; override;
  423. function ShowCaret: Boolean; override;
  424. function SetCaretPosEx(x, y: Integer): Boolean; override;
  425. property Color: TColor read FColor write SetColor;
  426. property ForcePaintEvents: Boolean read FForcePaintEvents write FForcePaintEvents;
  427. end;
  428. // relative dimensions in percent from 0 to 1024 (=100%)
  429. TSynCustomCaretSizeFlag = (ccsRelativeLeft, ccsRelativeTop, ccsRelativeWidth, ccsRelativeHeight);
  430. TSynCustomCaretSizeFlags = set of TSynCustomCaretSizeFlag;
  431. { TSynEditScreenCaret }
  432. TSynEditScreenCaret = class
  433. private
  434. FCharHeight: Integer;
  435. FCharWidth: Integer;
  436. FClipRight: Integer;
  437. FClipBottom: Integer;
  438. FClipLeft: Integer;
  439. FClipTop: Integer;
  440. FDisplayPos: TPoint;
  441. FDisplayType: TSynCaretType;
  442. FExtraLinePixel, FExtraLineChars: Integer;
  443. FOnExtraLineCharsChanged: TNotifyEvent;
  444. FVisible: Boolean;
  445. FHandleOwner: TWinControl;
  446. FCaretPainter: TSynEditScreenCaretPainter;
  447. FPaintTimer: TSynEditScreenCaretTimer;
  448. FPaintTimerOwned: Boolean;
  449. function GetHandle: HWND;
  450. function GetHandleAllocated: Boolean;
  451. procedure SetCharHeight(const AValue: Integer);
  452. procedure SetCharWidth(const AValue: Integer);
  453. procedure SetClipRight(const AValue: Integer);
  454. procedure SetDisplayPos(const AValue: TPoint);
  455. procedure SetDisplayType(const AType: TSynCaretType);
  456. procedure SetVisible(const AValue: Boolean);
  457. private
  458. FClipExtraPixel: Integer;
  459. {$IFDeF SynCaretDebug}
  460. FDebugShowCount: Integer;
  461. {$ENDIF}
  462. FPixelWidth, FPixelHeight: Integer;
  463. FOffsetX, FOffsetY: Integer;
  464. FCustomPixelWidth, FCustomPixelHeight: Array [TSynCaretType] of Integer;
  465. FCustomOffsetX, FCustomOffsetY: Array [TSynCaretType] of Integer;
  466. FCustomFlags: Array [TSynCaretType] of TSynCustomCaretSizeFlags;
  467. FLockCount: Integer;
  468. FLockFlags: TSynCaretLockFlags;
  469. function GetHasPaintTimer: Boolean;
  470. function GetPaintTimer: TSynEditScreenCaretTimer;
  471. procedure SetClipBottom(const AValue: Integer);
  472. procedure SetClipExtraPixel(AValue: Integer);
  473. procedure SetClipLeft(const AValue: Integer);
  474. procedure SetClipRect(const AValue: TRect);
  475. procedure SetClipTop(const AValue: Integer);
  476. procedure CalcExtraLineChars;
  477. procedure SetPaintTimer(AValue: TSynEditScreenCaretTimer);
  478. procedure UpdateDisplayType;
  479. procedure UpdateDisplay;
  480. procedure ShowCaret;
  481. procedure HideCaret;
  482. property HandleAllocated: Boolean read GetHandleAllocated;
  483. protected
  484. property Handle: HWND read GetHandle;
  485. public
  486. constructor Create(AHandleOwner: TWinControl);
  487. constructor Create(AHandleOwner: TWinControl; APainterClass: TSynEditScreenCaretPainterClass);
  488. procedure ChangePainter(APainterClass: TSynEditScreenCaretPainterClass);
  489. destructor Destroy; override;
  490. procedure BeginScroll(dx, dy: Integer; const rcScroll, rcClip: TRect);
  491. procedure FinishScroll(dx, dy: Integer; const rcScroll, rcClip: TRect; Success: Boolean);
  492. procedure BeginPaint(rcClip: TRect);
  493. procedure FinishPaint(rcClip: TRect);
  494. procedure Lock;
  495. procedure UnLock;
  496. procedure AfterPaintEvent; // next async
  497. procedure Hide; // Keep visible = true
  498. procedure DestroyCaret(SkipHide: boolean = False);
  499. procedure ResetCaretTypeSizes;
  500. procedure SetCaretTypeSize(AType: TSynCaretType; AWidth, AHeight, AXOffs, AYOffs: Integer;
  501. AFlags: TSynCustomCaretSizeFlags = []);
  502. property HandleOwner: TWinControl read FHandleOwner;
  503. property PaintTimer: TSynEditScreenCaretTimer read GetPaintTimer write SetPaintTimer;
  504. property HasPaintTimer: Boolean read GetHasPaintTimer;
  505. property Painter: TSynEditScreenCaretPainter read FCaretPainter;
  506. property CharWidth: Integer read FCharWidth write SetCharWidth;
  507. property CharHeight: Integer read FCharHeight write SetCharHeight;
  508. property ClipLeft: Integer read FClipLeft write SetClipLeft;
  509. property ClipRight: Integer read FClipRight write SetClipRight; // First pixel outside the allowed area
  510. property ClipTop: Integer read FClipTop write SetClipTop;
  511. property ClipRect: TRect write SetClipRect;
  512. property ClipBottom: Integer read FClipBottom write SetClipBottom;
  513. property ClipExtraPixel: Integer read FClipExtraPixel write SetClipExtraPixel; // Amount of pixels, after the last full char (half visible char width)
  514. property Visible: Boolean read FVisible write SetVisible;
  515. property DisplayType: TSynCaretType read FDisplayType write SetDisplayType;
  516. property DisplayPos: TPoint read FDisplayPos write SetDisplayPos;
  517. property ExtraLineChars: Integer read FExtraLineChars; // Extend the longest line by x chars
  518. property OnExtraLineCharsChanged: TNotifyEvent
  519. read FOnExtraLineCharsChanged write FOnExtraLineCharsChanged;
  520. end;
  521. implementation
  522. { TSynBeforeSetSelTextList }
  523. procedure TSynBeforeSetSelTextList.CallBeforeSetSelTextHandlers(Sender: TObject;
  524. AMode: TSynSelectionMode; ANewText: PChar);
  525. var
  526. i: Integer;
  527. begin
  528. i:=Count;
  529. while NextDownIndex(i) do
  530. TSynBeforeSetSelTextEvent(Items[i])(Sender, AMode, ANewText);
  531. end;
  532. { TSynEditBaseCaret }
  533. function TSynEditBaseCaret.GetBytePos: Integer;
  534. begin
  535. ValidateBytePos;
  536. Result := FBytePos;
  537. end;
  538. function TSynEditBaseCaret.GetBytePosOffset: Integer;
  539. begin
  540. ValidateBytePos;
  541. Result := FBytePosOffset;
  542. end;
  543. function TSynEditBaseCaret.GetCharPos: Integer;
  544. begin
  545. ValidateCharPos;
  546. Result := FCharPos;
  547. end;
  548. function TSynEditBaseCaret.GetFullLogicalPos: TLogCaretPoint;
  549. begin
  550. ValidateBytePos;
  551. Result.Y := FLinePos;
  552. Result.X := FBytePos;
  553. Result.Offs := FBytePosOffset;
  554. end;
  555. function TSynEditBaseCaret.GetLineBytePos: TPoint;
  556. begin
  557. ValidateBytePos;
  558. Result := Point(FBytePos, FLinePos);
  559. end;
  560. function TSynEditBaseCaret.GetLineCharPos: TPoint;
  561. begin
  562. ValidateCharPos;
  563. Result := Point(FCharPos, FLinePos);
  564. end;
  565. procedure TSynEditBaseCaret.SetBytePos(AValue: Integer);
  566. begin
  567. InternalSetLineByterPos(FLinePos, AValue, 0, [scuChangedX]);
  568. end;
  569. procedure TSynEditBaseCaret.SetBytePosOffset(AValue: Integer);
  570. begin
  571. ValidateBytePos;
  572. InternalSetLineByterPos(FLinePos, FBytePos, AValue, [scuChangedX]);
  573. end;
  574. procedure TSynEditBaseCaret.SetCharPos(AValue: Integer);
  575. begin
  576. InternalSetLineCharPos(FLinePos, AValue, [scuChangedX]);
  577. end;
  578. procedure TSynEditBaseCaret.SetFullLogicalPos(AValue: TLogCaretPoint);
  579. begin
  580. InternalSetLineByterPos(AValue.y, AValue.x, AValue.Offs, [scuChangedX, scuChangedY]);
  581. end;
  582. procedure TSynEditBaseCaret.SetLineBytePos(AValue: TPoint);
  583. begin
  584. InternalSetLineByterPos(AValue.y, AValue.x, 0, [scuChangedX, scuChangedY]);
  585. end;
  586. procedure TSynEditBaseCaret.SetLineCharPos(AValue: TPoint);
  587. begin
  588. InternalSetLineCharPos(AValue.y, AValue.X, [scuChangedX, scuChangedY]);
  589. end;
  590. procedure TSynEditBaseCaret.SetLinePos(AValue: Integer);
  591. begin
  592. // TODO: may temporary lead to invalid x bytepos. Must be adjusted *before* calculating char
  593. //if scBytePosValid in FFlags then
  594. // InternalSetLineByterPos(AValue, FBytePos, FBytePosOffset, [scuChangedY])
  595. //else
  596. ValidateCharPos;
  597. InternalSetLineCharPos(AValue, FCharPos, [scuChangedY]);
  598. end;
  599. function TSynEditBaseCaret.GetLineText: string;
  600. begin
  601. if (LinePos >= 1) and (LinePos <= FLines.Count) then
  602. Result := FLines[LinePos - 1]
  603. else
  604. Result := '';
  605. end;
  606. procedure TSynEditBaseCaret.SetLineText(AValue: string);
  607. begin
  608. if (LinePos >= 1) and (LinePos <= Max(1, FLines.Count)) then
  609. FLines[LinePos - 1] := AValue;
  610. end;
  611. procedure TSynEditBaseCaret.ValidateBytePos;
  612. begin
  613. if scBytePosValid in FFlags then
  614. exit;
  615. assert(scCharPosValid in FFlags, 'ValidateBytePos: no charpos set');
  616. Include(FFlags, scBytePosValid);
  617. FBytePos := FLines.LogPhysConvertor.PhysicalToLogical(FLinePos-1, FCharPos, FBytePosOffset);
  618. end;
  619. procedure TSynEditBaseCaret.ValidateCharPos;
  620. begin
  621. if scCharPosValid in FFlags then
  622. exit;
  623. assert(scBytePosValid in FFlags, 'ValidateCharPos: no bytepos set');
  624. Include(FFlags, scCharPosValid);
  625. FCharPos := FLines.LogPhysConvertor.LogicalToPhysical(FLinePos-1, FBytePos, FBytePosOffset);
  626. end;
  627. procedure TSynEditBaseCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
  628. UpdFlags: TSynEditCaretUpdateFlags);
  629. begin
  630. if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
  631. (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
  632. then
  633. exit;
  634. if not (scuNoInvalidate in UpdFlags) then
  635. Exclude(FFlags, scBytePosValid);
  636. Include(FFlags, scCharPosValid);
  637. if NewLine < 1 then begin
  638. NewLine := 1;
  639. Exclude(FFlags, scBytePosValid);
  640. end;
  641. if NewCharPos < 1 then begin
  642. NewCharPos := 1;
  643. Exclude(FFlags, scBytePosValid);
  644. end;
  645. FCharPos := NewCharPos;
  646. FLinePos := NewLine;
  647. end;
  648. procedure TSynEditBaseCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
  649. UpdFlags: TSynEditCaretUpdateFlags);
  650. begin
  651. if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
  652. (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
  653. then
  654. exit;
  655. if not (scuNoInvalidate in UpdFlags) then
  656. Exclude(FFlags, scCharPosValid);
  657. Include(FFlags, scBytePosValid);
  658. if NewLine < 1 then begin
  659. NewLine := 1;
  660. Exclude(FFlags, scCharPosValid);
  661. end;
  662. if NewBytePos < 1 then begin
  663. NewBytePos := 1;
  664. Exclude(FFlags, scCharPosValid);
  665. end;
  666. FBytePos := NewBytePos;
  667. FBytePosOffset := NewByteOffs;
  668. FLinePos := NewLine;
  669. end;
  670. constructor TSynEditBaseCaret.Create;
  671. begin
  672. inherited Create;
  673. fLinePos := 1;
  674. fCharPos := 1;
  675. FBytePos := 1;
  676. FBytePosOffset := 0;
  677. FFlags := [scCharPosValid, scBytePosValid];
  678. end;
  679. procedure TSynEditBaseCaret.AssignFrom(Src: TSynEditBaseCaret);
  680. begin
  681. FLinePos := Src.FLinePos;
  682. FCharPos := Src.FCharPos;
  683. FBytePos := Src.FBytePos;
  684. FBytePosOffset := Src.FBytePosOffset;
  685. FFlags := Src.FFlags;
  686. SetLines(Src.FLines);
  687. end;
  688. procedure TSynEditBaseCaret.Invalidate;
  689. begin
  690. FLinePos := 1;
  691. FCharPos := 1;
  692. FBytePos := 1;
  693. FFlags := [];
  694. end;
  695. procedure TSynEditBaseCaret.InvalidateBytePos;
  696. begin
  697. if not (scCharPosValid in FFlags) then
  698. Invalidate
  699. else
  700. Exclude(FFlags, scBytePosValid);
  701. end;
  702. procedure TSynEditBaseCaret.InvalidateCharPos;
  703. begin
  704. if not (scBytePosValid in FFlags) then
  705. Invalidate
  706. else
  707. Exclude(FFlags, scCharPosValid);
  708. end;
  709. function TSynEditBaseCaret.IsAtLineChar(aPoint: TPoint): Boolean;
  710. begin
  711. ValidateCharPos;
  712. Result := (FLinePos = aPoint.y) and (FCharPos = aPoint.x);
  713. end;
  714. function TSynEditBaseCaret.IsAtLineByte(aPoint: TPoint; aByteOffset: Integer): Boolean;
  715. begin
  716. ValidateBytePos;
  717. Result := (FLinePos = aPoint.y) and (BytePos = aPoint.x) and
  718. ( (aByteOffset < 0) or (FBytePosOffset = aByteOffset) );
  719. end;
  720. function TSynEditBaseCaret.IsAtPos(aCaret: TSynEditCaret): Boolean;
  721. begin
  722. if (scBytePosValid in FFlags) or (scBytePosValid in aCaret.FFlags) then
  723. Result := IsAtLineByte(aCaret.LineBytePos, aCaret.BytePosOffset)
  724. else
  725. Result := IsAtLineChar(aCaret.LineCharPos);
  726. end;
  727. { TSynEditPointBase }
  728. function TSynEditPointBase.GetLocked: Boolean;
  729. begin
  730. Result := FLockCount > 0;
  731. end;
  732. procedure TSynEditPointBase.SetLines(const AValue: TSynEditStrings);
  733. begin
  734. FLines := AValue;
  735. end;
  736. procedure TSynEditPointBase.DoLock;
  737. begin
  738. end;
  739. procedure TSynEditPointBase.DoUnlock;
  740. begin
  741. end;
  742. constructor TSynEditPointBase.Create;
  743. begin
  744. FOnChangeList := TMethodList.Create;
  745. end;
  746. constructor TSynEditPointBase.Create(Lines : TSynEditStrings);
  747. begin
  748. Create;
  749. FLines := Lines;
  750. end;
  751. destructor TSynEditPointBase.Destroy;
  752. begin
  753. FreeAndNil(FOnChangeList);
  754. inherited Destroy;
  755. end;
  756. procedure TSynEditPointBase.AddChangeHandler(AHandler : TNotifyEvent);
  757. begin
  758. FOnChangeList.Add(TMethod(AHandler));
  759. end;
  760. procedure TSynEditPointBase.RemoveChangeHandler(AHandler : TNotifyEvent);
  761. begin
  762. FOnChangeList.Remove(TMethod(AHandler));
  763. end;
  764. procedure TSynEditPointBase.Lock;
  765. begin
  766. if FLockCount = 0 then
  767. DoLock;
  768. inc(FLockCount);
  769. end;
  770. procedure TSynEditPointBase.Unlock;
  771. begin
  772. dec(FLockCount);
  773. if FLockCount = 0 then
  774. DoUnLock;
  775. end;
  776. { TSynEditCaret }
  777. constructor TSynEditCaret.Create;
  778. begin
  779. inherited Create;
  780. FMaxLeftChar := nil;
  781. FAllowPastEOL := True;
  782. FForcePastEOL := 0;
  783. FAutoMoveOnEdit := 0;
  784. if FLines <> nil then
  785. FLines.AddEditHandler(@DoLinesEdited);
  786. end;
  787. destructor TSynEditCaret.Destroy;
  788. begin
  789. if FLines <> nil then
  790. FLines.RemoveEditHandler(@DoLinesEdited);
  791. inherited Destroy;
  792. end;
  793. procedure TSynEditCaret.AssignFrom(Src: TSynEditBaseCaret);
  794. begin
  795. FOldCharPos := FCharPos;
  796. FOldLinePos := FLinePos;
  797. inherited AssignFrom(Src);
  798. if Src is TSynEditCaret then begin
  799. FMaxLeftChar := TSynEditCaret(Src).FMaxLeftChar;
  800. FAllowPastEOL := TSynEditCaret(Src).FAllowPastEOL;
  801. FKeepCaretX := TSynEditCaret(Src).FKeepCaretX;
  802. FLastCharPos := TSynEditCaret(Src).FLastCharPos;
  803. end
  804. else begin
  805. AdjustToChar;
  806. FLastCharPos := FCharPos;
  807. end;
  808. end;
  809. procedure TSynEditCaret.DoLock;
  810. begin
  811. FTouched := False;
  812. ValidateCharPos;
  813. //ValidateBytePos;
  814. FOldCharPos := FCharPos;
  815. FOldLinePos := FLinePos;
  816. end;
  817. procedure TSynEditCaret.DoUnlock;
  818. begin
  819. if not FChangeOnTouch then
  820. FTouched := False;
  821. FChangeOnTouch := False;
  822. ValidateCharPos;
  823. //ValidateBytePos;
  824. if (FOldCharPos <> FCharPos) or (FOldLinePos <> FLinePos) or FTouched then
  825. fOnChangeList.CallNotifyEvents(self);
  826. // All notifications called, reset oldpos
  827. FTouched := False;
  828. FOldCharPos := FCharPos;
  829. FOldLinePos := FLinePos;
  830. end;
  831. procedure TSynEditCaret.SetLines(const AValue: TSynEditStrings);
  832. begin
  833. if FLines = AValue then exit;
  834. // Do not check flag. It will be cleared in Assign
  835. if (FLines <> nil) then
  836. FLines.RemoveEditHandler(@DoLinesEdited);
  837. FLinesEditedRegistered := False;
  838. inherited SetLines(AValue);
  839. if FAutoMoveOnEdit > 0 then
  840. RegisterLinesEditedHandler;
  841. end;
  842. procedure TSynEditCaret.RegisterLinesEditedHandler;
  843. begin
  844. if FLinesEditedRegistered or (FLines = nil) then
  845. exit;
  846. FLinesEditedRegistered := True;
  847. FLines.AddEditHandler(@DoLinesEdited);
  848. end;
  849. procedure TSynEditCaret.DoLinesEdited(Sender: TSynEditStrings; aLinePos, aBytePos, aCount,
  850. aLineBrkCnt: Integer; aText: String);
  851. // Todo: refactor / this is a copy from selection
  852. function AdjustPoint(aPoint: Tpoint): TPoint; inline;
  853. begin
  854. Result := aPoint;
  855. if aLineBrkCnt < 0 then begin
  856. (* Lines Deleted *)
  857. if aPoint.y > aLinePos then begin
  858. Result.y := Max(aLinePos, Result.y + aLineBrkCnt);
  859. if Result.y = aLinePos then
  860. Result.x := Result.x + aBytePos - 1;
  861. end;
  862. end
  863. else
  864. if aLineBrkCnt > 0 then begin
  865. (* Lines Inserted *)
  866. if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then begin
  867. Result.x := Result.x - aBytePos + 1;
  868. Result.y := Result.y + aLineBrkCnt;
  869. end;
  870. if aPoint.y > aLinePos then begin
  871. Result.y := Result.y + aLineBrkCnt;
  872. end;
  873. end
  874. else
  875. if aCount <> 0 then begin
  876. (* Chars Insert/Deleted *)
  877. if (aPoint.y = aLinePos) and (aPoint.x >= aBytePos) then
  878. Result.x := Max(aBytePos, Result.x + aCount);
  879. end;
  880. end;
  881. var
  882. p: TPoint;
  883. begin
  884. if (FAutoMoveOnEdit > 0) and
  885. ( (aLineBrkCnt <> 0) or (aLinePos = FLinePos) )
  886. then begin
  887. IncForcePastEOL;
  888. ValidateBytePos;
  889. p := AdjustPoint(Point(FBytePos, FLinePos));
  890. InternalSetLineByterPos(p.y, p.x, FBytePosOffset, [scuChangedX, scuChangedY, scuForceSet]);
  891. DecForcePastEOL;
  892. end;
  893. end;
  894. procedure TSynEditCaret.AdjustToChar;
  895. var
  896. CharWidthsArr: TPhysicalCharWidths;
  897. CharWidths: PPhysicalCharWidth;
  898. i, LogLen: Integer;
  899. ScreenPos: Integer;
  900. LogPos: Integer;
  901. L: String;
  902. begin
  903. ValidateCharPos;
  904. L := LineText;
  905. if FLines.LogPhysConvertor.CurrentLine = FLinePos then begin
  906. CharWidths := FLines.LogPhysConvertor.CurrentWidths;
  907. LogLen := FLines.LogPhysConvertor.CurrentWidthsCount;
  908. end
  909. else begin
  910. CharWidthsArr := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
  911. LogLen := Length(CharWidthsArr);
  912. if LogLen > 0 then
  913. CharWidths := @CharWidthsArr[0];
  914. end;
  915. ScreenPos := 1;
  916. LogPos := 0;
  917. while LogPos < LogLen do begin
  918. if ScreenPos = FCharPos then exit;
  919. if ScreenPos + (CharWidths[LogPos] and PCWMask) > FCharPos then begin
  920. if (L[LogPos+1] = #9) and (not FSkipTabs) then exit;
  921. i := FCharPos;
  922. if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
  923. FCharPos := ScreenPos + (CharWidths[LogPos] and PCWMask)
  924. else
  925. FCharPos := ScreenPos;
  926. if FCharPos <> i then
  927. Exclude(FFlags, scBytePosValid);
  928. exit;
  929. end;
  930. ScreenPos := ScreenPos + (CharWidths[LogPos] and PCWMask);
  931. inc(LogPos);
  932. end;
  933. end;
  934. function TSynEditCaret.GetMaxLeftPastEOL: Integer;
  935. begin
  936. if FMaxLeftChar <> nil then
  937. Result := FMaxLeftChar()
  938. else
  939. Result := MaxInt;
  940. end;
  941. procedure TSynEditCaret.InternalSetLineCharPos(NewLine, NewCharPos: Integer;
  942. UpdFlags: TSynEditCaretUpdateFlags);
  943. var
  944. LogEolPos, MaxPhysX, NewLogCharPos, Offs: Integer;
  945. L: String;
  946. begin
  947. if not (scuChangedX in UpdFlags) and FKeepCaretX then
  948. NewCharPos := FLastCharPos;
  949. Lock;
  950. FTouched := True;
  951. try
  952. if (fCharPos = NewCharPos) and (fLinePos = NewLine) and
  953. (scCharPosValid in FFlags) and not (scuForceSet in UpdFlags)
  954. then begin
  955. // Lines may have changed, so the other pos can be invalid
  956. if not (scuNoInvalidate in UpdFlags) then
  957. Exclude(FFlags, scBytePosValid);
  958. exit;
  959. end;
  960. if NewLine > FLines.Count then begin
  961. NewLine := FLines.Count;
  962. Exclude(UpdFlags, scuNoInvalidate);
  963. end;
  964. if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
  965. NewLine := 1;
  966. if (NewCharPos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
  967. then MaxPhysX := GetMaxLeftPastEOL
  968. else MaxPhysX := 1;
  969. if NewCharPos > MaxPhysX then
  970. NewCharPos := MaxPhysX;
  971. NewLogCharPos := NewCharPos;
  972. Offs := 0;
  973. Exclude(UpdFlags, scuNoInvalidate);
  974. end else begin
  975. if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
  976. NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToNextChar])
  977. else
  978. NewLogCharPos := Lines.LogPhysConvertor.PhysicalToLogical(NewLine-1, NewCharPos, Offs, cspDefault, [lpfAdjustToCharBegin]);
  979. Offs := Lines.LogPhysConvertor.UnAdjustedPhysToLogColOffs;
  980. L := Lines[NewLine - 1];
  981. if (Offs > 0) and (not FSkipTabs) and (L[NewLogCharPos] = #9) then begin
  982. // get the unadjusted result
  983. NewLogCharPos := Lines.LogPhysConvertor.UnAdjustedPhysToLogResult
  984. end
  985. else begin
  986. // get adjusted Result
  987. NewCharPos := Lines.LogPhysConvertor.AdjustedPhysToLogOrigin;
  988. Offs := 0;
  989. end;
  990. LogEolPos := length(L)+1;
  991. if NewLogCharPos > LogEolPos then begin
  992. if FAllowPastEOL or (FForcePastEOL > 0) then begin
  993. MaxPhysX := GetMaxLeftPastEOL;
  994. if NewCharPos > MaxPhysX then begin
  995. NewLogCharPos := NewLogCharPos - (NewCharPos - MaxPhysX);
  996. NewCharPos := MaxPhysX;
  997. Exclude(UpdFlags, scuNoInvalidate);
  998. end;
  999. end
  1000. else begin
  1001. NewCharPos := NewCharPos - (NewLogCharPos - LogEolPos);
  1002. NewLogCharPos := LogEolPos;
  1003. Exclude(UpdFlags, scuNoInvalidate);
  1004. end;
  1005. end;
  1006. end;
  1007. if NewCharPos < 1 then begin
  1008. NewCharPos := 1;
  1009. Exclude(UpdFlags, scuNoInvalidate);
  1010. end;
  1011. inherited InternalSetLineCharPos(NewLine, NewCharPos, UpdFlags);
  1012. inherited InternalSetLineByterPos(NewLine, NewLogCharPos, Offs, [scuNoInvalidate, scuChangedX]);
  1013. if (scuChangedX in UpdFlags) or (not FKeepCaretX) then
  1014. FLastCharPos := FCharPos;
  1015. finally
  1016. Unlock;
  1017. end;
  1018. end;
  1019. procedure TSynEditCaret.InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs: Integer;
  1020. UpdFlags: TSynEditCaretUpdateFlags);
  1021. var
  1022. MaxPhysX, NewCharPos, LogEolPos: Integer;
  1023. L: String;
  1024. begin
  1025. if not (scuChangedX in UpdFlags) and FKeepCaretX then begin
  1026. Exclude(UpdFlags, scuNoInvalidate);
  1027. InternalSetLineCharPos(NewLine, FLastCharPos, UpdFlags);
  1028. exit;
  1029. end;
  1030. Lock;
  1031. FTouched := True;
  1032. try
  1033. if (FBytePos = NewBytePos) and (FBytePosOffset = NewByteOffs) and
  1034. (FLinePos = NewLine) and (scBytePosValid in FFlags) and not (scuForceSet in UpdFlags)
  1035. then begin
  1036. // Lines may have changed, so the other pos can be invalid
  1037. if not (scuNoInvalidate in UpdFlags) then
  1038. Exclude(FFlags, scCharPosValid);
  1039. exit;
  1040. end;
  1041. if NewLine > FLines.Count then begin
  1042. NewLine := FLines.Count;
  1043. Exclude(UpdFlags, scuNoInvalidate);
  1044. end;
  1045. if NewLine < 1 then begin // Only allowed, if Lines.Count = 0
  1046. L := '';
  1047. NewLine := 1;
  1048. LogEolPos := 1;
  1049. if (NewBytePos > 1) and (FAllowPastEOL or (FForcePastEOL > 0))
  1050. then MaxPhysX := GetMaxLeftPastEOL
  1051. else MaxPhysX := 1;
  1052. if NewBytePos > MaxPhysX then
  1053. NewBytePos := MaxPhysX;
  1054. NewByteOffs := 0;
  1055. NewCharPos := NewBytePos;
  1056. Exclude(UpdFlags, scuNoInvalidate);
  1057. end else begin
  1058. L := Lines[NewLine - 1];
  1059. LogEolPos := length(L)+1;
  1060. if (NewBytePos > LogEolPos) then begin
  1061. if not(FAllowPastEOL or (FForcePastEOL > 0)) then
  1062. NewBytePos := LogEolPos;
  1063. NewByteOffs := 0;
  1064. end
  1065. else
  1066. if (NewByteOffs > 0) and ( (FSkipTabs) or (L[NewBytePos] <> #9) ) then
  1067. NewByteOffs := 0;
  1068. if FAdjustToNextChar or (FForceAdjustToNextChar > 0) then
  1069. NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToNextChar])
  1070. else
  1071. NewCharPos := Lines.LogPhysConvertor.LogicalToPhysical(NewLine-1, NewBytePos, NewByteOffs, cslDefault, [lpfAdjustToCharBegin]);
  1072. NewBytePos := Lines.LogPhysConvertor.AdjustedLogToPhysOrigin;
  1073. if (NewBytePos > LogEolPos) then begin
  1074. MaxPhysX := GetMaxLeftPastEOL;
  1075. if NewCharPos > MaxPhysX then begin
  1076. NewBytePos := NewBytePos - (NewCharPos - MaxPhysX);
  1077. NewCharPos := MaxPhysX;
  1078. Exclude(UpdFlags, scuNoInvalidate);
  1079. end;
  1080. end;
  1081. end;
  1082. if NewBytePos < 1 then begin
  1083. NewBytePos := 1;
  1084. Exclude(UpdFlags, scuNoInvalidate);
  1085. end;
  1086. inherited InternalSetLineByterPos(NewLine, NewBytePos, NewByteOffs, UpdFlags);
  1087. inherited InternalSetLineCharPos(NewLine, NewCharPos, [scuNoInvalidate, scuChangedX]);
  1088. if (scuChangedX in UpdFlags) and FKeepCaretX then
  1089. FLastCharPos := FCharPos;
  1090. finally
  1091. Unlock;
  1092. end;
  1093. end;
  1094. function TSynEditCaret.GetOldLineCharPos: TPoint;
  1095. begin
  1096. Result := Point(FOldCharPos, FOldLinePos);
  1097. end;
  1098. function TSynEditCaret.GetOldLineBytePos: TPoint;
  1099. begin
  1100. Result := FLines.PhysicalToLogicalPos(OldLineCharPos);
  1101. end;
  1102. function TSynEditCaret.GetOldFullLogicalPos: TLogCaretPoint;
  1103. begin
  1104. Result.Y := FOldLinePos;
  1105. Result.X := FLines.LogPhysConvertor.PhysicalToLogical(ToIdx(FOldLinePos), FOldCharPos, Result.Offs);
  1106. end;
  1107. procedure TSynEditCaret.SetAllowPastEOL(const AValue: Boolean);
  1108. begin
  1109. if FAllowPastEOL = AValue then exit;
  1110. FAllowPastEOL := AValue;
  1111. if not FAllowPastEOL then begin
  1112. // TODO: this would set x=LastX
  1113. //if scBytePosValid in FFlags then
  1114. // InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
  1115. //else
  1116. ValidateCharPos;
  1117. InternalSetLineCharPos(FLinePos, FCharPos, [scuForceSet]); // NO scuChangedX => FLastCharPos is kept
  1118. end;
  1119. end;
  1120. procedure TSynEditCaret.SetKeepCaretX(const AValue: Boolean);
  1121. begin
  1122. if FKeepCaretX = AValue then exit;
  1123. FKeepCaretX := AValue;
  1124. if FKeepCaretX then begin
  1125. ValidateCharPos;
  1126. FLastCharPos := FCharPos;
  1127. end;
  1128. end;
  1129. procedure TSynEditCaret.SetSkipTabs(const AValue: Boolean);
  1130. begin
  1131. if FSkipTabs = AValue then exit;
  1132. FSkipTabs := AValue;
  1133. if FSkipTabs then begin
  1134. Lock;
  1135. AdjustToChar;
  1136. Unlock;
  1137. end;
  1138. end;
  1139. procedure TSynEditCaret.IncForcePastEOL;
  1140. begin
  1141. inc(FForcePastEOL);
  1142. end;
  1143. procedure TSynEditCaret.DecForcePastEOL;
  1144. begin
  1145. dec(FForcePastEOL);
  1146. end;
  1147. procedure TSynEditCaret.IncForceAdjustToNextChar;
  1148. begin
  1149. Inc(FForceAdjustToNextChar);
  1150. end;
  1151. procedure TSynEditCaret.DecForceAdjustToNextChar;
  1152. begin
  1153. Dec(FForceAdjustToNextChar);
  1154. end;
  1155. procedure TSynEditCaret.IncAutoMoveOnEdit;
  1156. begin
  1157. if FAutoMoveOnEdit = 0 then begin
  1158. RegisterLinesEditedHandler;
  1159. ValidateBytePos;
  1160. end;
  1161. inc(FAutoMoveOnEdit);
  1162. end;
  1163. procedure TSynEditCaret.DecAutoMoveOnEdit;
  1164. begin
  1165. dec(FAutoMoveOnEdit);
  1166. end;
  1167. procedure TSynEditCaret.ChangeOnTouch;
  1168. begin
  1169. FChangeOnTouch := True;
  1170. if not Locked then
  1171. FTouched := False;
  1172. end;
  1173. procedure TSynEditCaret.Touch(aChangeOnTouch: Boolean);
  1174. begin
  1175. if aChangeOnTouch then
  1176. ChangeOnTouch;
  1177. FTouched := True;
  1178. end;
  1179. function TSynEditCaret.WasAtLineChar(aPoint: TPoint): Boolean;
  1180. begin
  1181. Result := (FOldLinePos = aPoint.y) and (FOldCharPos = aPoint.x);
  1182. end;
  1183. function TSynEditCaret.WasAtLineByte(aPoint: TPoint): Boolean;
  1184. begin
  1185. Result := (FOldLinePos = aPoint.y) and
  1186. (FLines.PhysicalToLogicalPos(Point(FOldCharPos, FOldLinePos)).X = aPoint.x);
  1187. end;
  1188. function TSynEditCaret.MoveHoriz(ACount: Integer): Boolean;
  1189. var
  1190. L: String;
  1191. CharWidths: TPhysicalCharWidths;
  1192. GotCharWidths: Boolean;
  1193. MaxOffs: Integer;
  1194. p: Integer;
  1195. NC: Boolean;
  1196. NF: Integer;
  1197. function GetMaxOffs(AlogPos: Integer): Integer;
  1198. begin
  1199. if not GotCharWidths then
  1200. CharWidths := FLines.GetPhysicalCharWidths(Pchar(L), length(L), FLinePos-1);
  1201. GotCharWidths := True;
  1202. Result := CharWidths[AlogPos-1];
  1203. end;
  1204. begin
  1205. GotCharWidths := False;
  1206. L := LineText;
  1207. ValidateBytePos;
  1208. If ACount > 0 then begin
  1209. if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
  1210. MaxOffs := GetMaxOffs(FBytePos) - 1
  1211. else
  1212. MaxOffs := 0;
  1213. while ACount > 0 do begin
  1214. if FBytePosOffset < MaxOffs then
  1215. inc(FBytePosOffset)
  1216. else begin
  1217. if (FBytePos > length(L)) and not (FAllowPastEOL or (FForcePastEOL > 0)) then
  1218. break;
  1219. FBytePos := FLines.LogicPosAddChars(L, FBytePos, 1, True);
  1220. FBytePosOffset := 0;
  1221. if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
  1222. MaxOffs := GetMaxOffs(FBytePos) - 1
  1223. else
  1224. MaxOffs := 0;
  1225. end;
  1226. dec(ACount);
  1227. end;
  1228. Result := ACount = 0;
  1229. p := FBytePos;
  1230. IncForceAdjustToNextChar;
  1231. InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
  1232. DecForceAdjustToNextChar;
  1233. if p > FBytePos then
  1234. Result := False; // MaxLeftChar
  1235. end
  1236. else begin
  1237. while ACount < 0 do begin
  1238. if FBytePosOffset > 0 then
  1239. dec(FBytePosOffset)
  1240. else begin
  1241. if FBytePos = 1 then
  1242. break;
  1243. FBytePos := FLines.LogicPosAddChars(L, FBytePos, -1, True);
  1244. if (FBytePos <= length(L)) and (L[FBytePos] = #9) and (not FSkipTabs) then
  1245. FBytePosOffset := GetMaxOffs(FBytePos) - 1
  1246. else
  1247. FBytePosOffset := 0;
  1248. end;
  1249. inc(ACount);
  1250. end;
  1251. Result := ACount = 0;
  1252. NC := FAdjustToNextChar;
  1253. NF := FForceAdjustToNextChar;
  1254. FAdjustToNextChar := False;
  1255. FForceAdjustToNextChar := 0;
  1256. InternalSetLineByterPos(FLinePos, FBytePos, FBytePosOffset, [scuChangedX, scuForceSet]);
  1257. FAdjustToNextChar := NC;
  1258. FForceAdjustToNextChar := NF;
  1259. end;
  1260. end;
  1261. { TSynEditSelection }
  1262. constructor TSynEditSelection.Create(ALines : TSynEditStrings; aActOnLineChanges: Boolean);
  1263. begin
  1264. Inherited Create(ALines);
  1265. FOnBeforeSetSelText := TSynBeforeSetSelTextList.Create;
  1266. FInternalCaret := TSynEditBaseCaret.Create;
  1267. FInternalCaret.Lines := FLines;
  1268. FActiveSelectionMode := smNormal;
  1269. FStartLinePos := 1;
  1270. FStartBytePos := 1;
  1271. FAltStartLinePos := -1;
  1272. FAltStartBytePos := -1;
  1273. FEndLinePos := 1;
  1274. FEndBytePos := 1;
  1275. FEnabled := True;
  1276. FHookedLines := aActOnLineChanges;
  1277. FIsSettingText := False;
  1278. if FHookedLines then begin
  1279. FLines.AddEditHandler(@DoLinesEdited);
  1280. FLines.AddChangeHandler(senrLineChange, @LineChanged);
  1281. end;
  1282. end;
  1283. destructor TSynEditSelection.Destroy;
  1284. begin
  1285. FreeAndNil(FOnBeforeSetSelText);
  1286. FreeAndNil(FInternalCaret);
  1287. if FHookedLines then begin
  1288. FLines.RemoveEditHandler(@DoLinesEdited);
  1289. FLines.RemoveChangeHandler(senrLineChange, @LineChanged);
  1290. end;
  1291. inherited Destroy;
  1292. end;
  1293. procedure TSynEditSelection.AssignFrom(Src: TSynEditSelection);
  1294. begin
  1295. //FEnabled := src.FEnabled;
  1296. FHide := src.FHide;
  1297. FActiveSelectionMode := src.FActiveSelectionMode;
  1298. FSelectionMode := src.FSelectionMode;
  1299. FStartLinePos := src.FStartLinePos; // 1 based
  1300. FStartBytePos := src.FStartBytePos; // 1 based
  1301. FEndLinePos := src.FEndLinePos; // 1 based
  1302. FEndBytePos := src.FEndBytePos; // 1 based
  1303. FPersistent := src.FPersistent;
  1304. end;
  1305. procedure TSynEditSelection.AdjustAfterTrimming;
  1306. begin
  1307. if FStartBytePos > Length(FLines[FStartLinePos-1]) + 1 then
  1308. FStartBytePos := Length(FLines[FStartLinePos-1]) + 1;
  1309. if FEndBytePos > Length(FLines[FEndLinePos-1]) + 1 then
  1310. FEndBytePos := Length(FLines[FEndLinePos-1]) + 1;
  1311. // Todo: Call ChangeNotification
  1312. end;
  1313. procedure TSynEditSelection.DoLock;
  1314. begin
  1315. inherited DoLock;
  1316. FLastCarePos := Point(-1, -1);
  1317. end;
  1318. procedure TSynEditSelection.DoUnlock;
  1319. begin
  1320. inherited DoUnlock;
  1321. FLastCarePos := Point(-1, -1);
  1322. end;
  1323. function TSynEditSelection.GetSelText : string;
  1324. function CopyPadded(const S: string; Index, Count: integer): string;
  1325. var
  1326. SrcLen: Integer;
  1327. DstLen: integer;
  1328. P: PChar;
  1329. begin
  1330. SrcLen := Length(S);
  1331. DstLen := Index + Count;
  1332. if SrcLen >= DstLen then
  1333. Result := Copy(S, Index, Count)
  1334. else begin
  1335. SetLength(Result, DstLen);
  1336. P := PChar(Pointer(Result));
  1337. StrPCopy(P, Copy(S, Index, Count));
  1338. Inc(P, SrcLen);
  1339. FillChar(P^, DstLen - Srclen, $20);
  1340. end;
  1341. end;
  1342. procedure CopyAndForward(const S: string; Index, Count: Integer; var P:
  1343. PChar);
  1344. var
  1345. pSrc: PChar;
  1346. SrcLen: Integer;
  1347. DstLen: Integer;
  1348. begin
  1349. SrcLen := Length(S);
  1350. if (Index <= SrcLen) and (Count > 0) then begin
  1351. Dec(In