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