1unit LazSynTextArea; 2 3{$mode objfpc}{$H+} 4{$INLINE OFF} 5 6interface 7 8uses 9 Classes, SysUtils, 10 // LCL 11 Graphics, Controls, LCLType, LCLIntf, LCLProc, 12 // LazUtils 13 LazMethodList, 14 // SynEdit 15 SynEditTypes, SynEditMiscProcs, SynEditMiscClasses, LazSynEditText, 16 SynEditMarkup, SynEditHighlighter, SynTextDrawer; 17 18 19type 20 TLazSynDisplayTokenInfoEx = record 21 Tk: TLazSynDisplayTokenInfo; 22 Attr: TSynSelectedColorMergeResult; 23 StartPos: TLazSynDisplayTokenBound; // Start according to Logical flow. Left for LTR, or Right for RTL 24 EndPos: TLazSynDisplayTokenBound; // End according to Logical flow. 25 // SreenRect Bounds. Ltr/RTL independent. Start is always left. End Always right 26 PhysicalCharStart: Integer; // 1 based - Full char bound (Before StartPos.Physical (PaintStart)) 27 PhysicalClipStart: Integer; // 1 based - PaintStart 28 PhysicalCharEnd: Integer; // 1 based - Full char bound (After EndPos.Physical (PaintEnd)) 29 PhysicalClipEnd: Integer; // 1 based - PaintEnd 30 RtlInfo: TLazSynDisplayRtlInfo; 31 RtlExpandedExtraBytes: Integer; // tab and space expansion 32 RtlHasTabs: Boolean; 33 RtlHasDoubleWidth: Boolean; 34 35 ExpandedExtraBytes: Integer; // tab and space expansion 36 HasTabs: Boolean; // ExtraWidth may still be 0 37 HasDoubleWidth: Boolean; 38 39 NextPos: TLazSynDisplayTokenBound; // Next toxen, may be BIDI 40 NextRtlInfo: TLazSynDisplayRtlInfo; 41 end; 42 43 { TLazSynPaintTokenBreaker } 44 45 TLazSynPaintTokenBreaker = class 46 private 47 FBackgroundColor: TColor; 48 FForegroundColor: TColor; 49 FSpaceExtraByteCount: Integer; 50 FTabExtraByteCount: Integer; 51 FFirstCol, FLastCol: integer; // Physical 52 53 FDisplayView: TLazSynDisplayView; 54 FLinesView: TSynEditStrings; 55 FMarkupManager: TSynEditMarkupManager; 56 57 FCharWidths: TPhysicalCharWidths; 58 FCharWidthsLen: Integer; 59 FCurTxtLineIdx : Integer; 60 FCurLineByteLen: Integer; 61 62 // Fields for GetNextHighlighterTokenFromView 63 // Info about the token (from highlighter) 64 FCurViewToken: TLazSynDisplayTokenInfo; 65 FCurViewCurTokenStartPos: TLazSynDisplayTokenBound; // Start bound of the HL token 66 FCurViewAttr: TSynSelectedColorMergeResult; 67 FWrapEndBound: TLazSynDisplayTokenBound; 68 // Scanner Pos 69 FCurViewScannerPos: TLazSynDisplayTokenBound; // Start according to Logical flow. Left for LTR, or Right for RTL 70 FCurViewScannerPhysCharPos: Integer; // 1 based - Full char bound (Before FCurViewScannerPos.Physical (PaintStart)) 71 // RTL Run 72 FCurViewinRTL: Boolean; 73 FCurViewRtlPhysStart, FCurViewRtlPhysEnd: integer; 74 FCurViewRtlLogStart, FCurViewRtlLogEnd: integer; 75 FCurViewRtlExpExtraBytes: Integer; // tab and space expansion for entire RTL run 76 FCurViewRtlHasTabs: Boolean; 77 FCurViewRtlHasDoubleWidth: Boolean; 78 79 FNextMarkupPhysPos, FNextMarkupLogPos: Integer; 80 FCurMarkupNextStart: TLazSynDisplayTokenBound; 81 FCurMarkupNextRtlInfo: TLazSynDisplayRtlInfo; 82 FCurMarkupState: (cmPreInit, cmLine, cmPastEOL, cmPastWrapEnd); 83 FMarkupTokenAttr: TSynSelectedColorMergeResult; 84 procedure InitCurMarkup; 85 public 86 constructor Create; 87 destructor Destroy; override; 88 procedure Prepare(ADisplayView: TLazSynDisplayView; ALinesView: TSynEditStrings; 89 AMarkupManager: TSynEditMarkupManager; 90 AFirstCol, ALastCol: integer 91 ); 92 procedure SetHighlighterTokensLine(ALine: TLineIdx; out ARealLine: TLineIdx); 93 function GetNextHighlighterTokenFromView(out ATokenInfo: TLazSynDisplayTokenInfoEx; 94 APhysEnd: Integer = -1; 95 ALogEnd: Integer = -1 96 ): Boolean; 97 function GetNextHighlighterTokenEx(out ATokenInfo: TLazSynDisplayTokenInfoEx): Boolean; 98 property CharWidths: TPhysicalCharWidths read FCharWidths; 99 property ForegroundColor: TColor read FForegroundColor write FForegroundColor; 100 property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor; 101 property SpaceExtraByteCount: Integer read FSpaceExtraByteCount write FSpaceExtraByteCount; 102 property TabExtraByteCount: Integer read FTabExtraByteCount write FTabExtraByteCount; 103 end; 104 105 { TLazSynTextArea } 106 107 TLazSynTextArea = class(TLazSynSurface) 108 private 109 FCharsInWindow: Integer; 110 FCharWidth: integer; 111 FLinesInWindow: Integer; 112 fOnStatusChange: TStatusChangeEvent; 113 FTextSizeChangeList: TMethodList; 114 FTextHeight: integer; 115 116 FCanvas: TCanvas; 117 FTextDrawer: TheTextDrawer; 118 FEtoBuf: TEtoBuffer; 119 FTheLinesView: TSynEditStrings; 120 FHighlighter: TSynCustomHighlighter; 121 FMarkupManager: TSynEditMarkupManager; 122 FTokenBreaker: TLazSynPaintTokenBreaker; 123 FPaintLineColor, FPaintLineColor2: TSynSelectedColor; 124 FForegroundColor: TColor; 125 FBackgroundColor: TColor; 126 FRightEdgeColor: TColor; 127 128 FTextBounds: TRect; 129 FPadding: array [TLazSynBorderSide] of Integer; 130 FExtraCharSpacing: integer; 131 FExtraLineSpacing, FCurrentExtraLineSpacing: integer; 132 FVisibleSpecialChars: TSynVisibleSpecialChars; 133 FRightEdgeColumn: integer; 134 FRightEdgeVisible: boolean; 135 136 FTopLine: TLinePos; 137 FLeftChar: Integer; 138 139 function GetExtraCharSpacing: integer; 140 function GetPadding(Side: TLazSynBorderSide): integer; 141 procedure SetExtraCharSpacing(AValue: integer); 142 procedure SetExtraLineSpacing(AValue: integer); 143 procedure SetLeftChar(AValue: Integer); 144 procedure SetPadding(Side: TLazSynBorderSide; AValue: integer); 145 procedure SetTopLine(AValue: TLinePos); 146 procedure DoDrawerFontChanged(Sender: TObject); 147 protected 148 procedure BoundsChanged; override; 149 procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override; 150 procedure PaintTextLines(AClip: TRect; FirstLine, LastLine, 151 FirstCol, LastCol: integer); virtual; 152 property Canvas: TCanvas read FCanvas; 153 public 154 constructor Create(AOwner: TWinControl; ATextDrawer: TheTextDrawer); 155 destructor Destroy; override; 156 procedure Assign(Src: TLazSynSurface); override; 157 procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override; 158 159 function ScreenColumnToXValue(Col: integer): integer; // map screen column to screen pixel 160 function RowColumnToPixels(const RowCol: TPoint): TPoint; 161 function PixelsToRowColumn(Pixels: TPoint; aFlags: TSynCoordinateMappingFlags): TPoint; // ignores scmLimitToLines 162 163 procedure FontChanged; 164 procedure AddTextSizeChangeHandler(AHandler: TNotifyEvent); 165 procedure RemoveTextSizeChangeHandler(AHandler: TNotifyEvent); 166 167 // Settings controlled by SynEdit 168 property Padding[Side: TLazSynBorderSide]: integer read GetPadding write SetPadding; 169 property ForegroundColor: TColor read FForegroundColor write FForegroundColor; 170 property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor; 171 property ExtraCharSpacing: integer read GetExtraCharSpacing write SetExtraCharSpacing; 172 property ExtraLineSpacing: integer read FCurrentExtraLineSpacing write SetExtraLineSpacing; 173 property VisibleSpecialChars: TSynVisibleSpecialChars read FVisibleSpecialChars write FVisibleSpecialChars; 174 property RightEdgeColumn: integer read FRightEdgeColumn write FRightEdgeColumn; 175 property RightEdgeVisible: boolean read FRightEdgeVisible write FRightEdgeVisible; 176 property RightEdgeColor: TColor read FRightEdgeColor write FRightEdgeColor; 177 178 property TopLine: TLinePos read FTopLine write SetTopLine; // TopView 179 property LeftChar: Integer read FLeftChar write SetLeftChar; 180 181 property TheLinesView: TSynEditStrings read FTheLinesView write FTheLinesView; 182 property Highlighter: TSynCustomHighlighter read FHighlighter write FHighlighter; 183 property MarkupManager: TSynEditMarkupManager read FMarkupManager write FMarkupManager; 184 property TextDrawer: TheTextDrawer read FTextDrawer; 185 public 186 property TextBounds: TRect read FTextBounds; 187 188 property LineHeight: integer read FTextHeight; 189 property CharWidth: integer read FCharWidth; 190 property LinesInWindow: Integer read FLinesInWindow; 191 property CharsInWindow: Integer read FCharsInWindow; 192 property OnStatusChange: TStatusChangeEvent read fOnStatusChange write fOnStatusChange; 193 end; 194 195 { TLazSynSurfaceWithText } 196 197 TLazSynSurfaceWithText = class(TLazSynSurface) 198 private 199 FTextArea: TLazSynTextArea; 200 protected 201 procedure SetTextArea(AValue: TLazSynTextArea); virtual; 202 function GetTextArea: TLazSynTextArea; virtual; 203 public 204 procedure Assign(Src: TLazSynSurface); override; 205 property TextArea: TLazSynTextArea read GetTextArea write SetTextArea; 206 end; 207 208 { TLazSynSurfaceManager } 209 210 TLazSynSurfaceManager = class(TLazSynSurfaceWithText) 211 private 212 FLeftGutterArea: TLazSynSurfaceWithText; 213 FLeftGutterWidth: integer; 214 FRightGutterArea: TLazSynSurfaceWithText; 215 FRightGutterWidth: integer; 216 procedure SetLeftGutterArea(AValue: TLazSynSurfaceWithText); 217 procedure SetLeftGutterWidth(AValue: integer); 218 procedure SetRightGutterArea(AValue: TLazSynSurfaceWithText); 219 procedure SetRightGutterWidth(AValue: integer); 220 protected 221 function GetLeftGutterArea: TLazSynSurfaceWithText; virtual; 222 function GetRightGutterArea: TLazSynSurfaceWithText; virtual; 223 procedure SetTextArea(AValue: TLazSynTextArea); override; 224 function GetTextArea: TLazSynTextArea; override; 225 protected 226 procedure SetBackgroundColor(AValue: TColor); virtual; 227 procedure SetExtraCharSpacing(AValue: integer); virtual; 228 procedure SetExtraLineSpacing(AValue: integer); virtual; 229 procedure SetForegroundColor(AValue: TColor); virtual; 230 procedure SetPadding(Side: TLazSynBorderSide; AValue: integer); virtual; 231 procedure SetRightEdgeColor(AValue: TColor); virtual; 232 procedure SetRightEdgeColumn(AValue: integer); virtual; 233 procedure SetRightEdgeVisible(AValue: boolean); virtual; 234 procedure SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars); virtual; 235 procedure SetHighlighter(AValue: TSynCustomHighlighter); virtual; 236 protected 237 procedure DoPaint(ACanvas: TCanvas; AClip: TRect); override; 238 procedure DoDisplayViewChanged; override; 239 procedure BoundsChanged; override; 240 public 241 constructor Create(AOwner: TWinControl); 242 procedure InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); override; 243 procedure InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); virtual; 244 procedure InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); virtual; 245 246 property LeftGutterArea: TLazSynSurfaceWithText read GetLeftGutterArea write SetLeftGutterArea; 247 property RightGutterArea: TLazSynSurfaceWithText read GetRightGutterArea write SetRightGutterArea; 248 property LeftGutterWidth: integer read FLeftGutterWidth write SetLeftGutterWidth; 249 property RightGutterWidth: integer read FRightGutterWidth write SetRightGutterWidth; 250 public 251 // Settings forwarded to textarea 252 property Padding[Side: TLazSynBorderSide]: integer write SetPadding; 253 property ForegroundColor: TColor write SetForegroundColor; 254 property BackgroundColor: TColor write SetBackgroundColor; 255 property ExtraCharSpacing: integer write SetExtraCharSpacing; 256 property ExtraLineSpacing: integer write SetExtraLineSpacing; 257 property VisibleSpecialChars: TSynVisibleSpecialChars write SetVisibleSpecialChars; 258 property RightEdgeColumn: integer write SetRightEdgeColumn; 259 property RightEdgeVisible: boolean write SetRightEdgeVisible; 260 property RightEdgeColor: TColor write SetRightEdgeColor; 261 property Highlighter: TSynCustomHighlighter write SetHighlighter; 262 end; 263 264 265implementation 266 267{ TLazSynPaintTokenBreaker } 268 269procedure TLazSynPaintTokenBreaker.InitCurMarkup; 270var 271 TmpTokenInfo: TLazSynDisplayTokenInfoEx; 272begin 273 FCurMarkupState := cmLine; 274 275 if GetNextHighlighterTokenFromView(TmpTokenInfo, -1, 1) then begin 276 FCurMarkupNextStart := TmpTokenInfo.NextPos; 277 FCurMarkupNextRtlInfo := TmpTokenInfo.NextRtlInfo; 278 end else begin 279 // past eol 280 FCurMarkupNextStart := TmpTokenInfo.StartPos; 281 FCurMarkupNextStart.Logical := FCurMarkupNextStart.Logical + (FFirstCol - FCurMarkupNextStart.Physical); 282 FCurMarkupNextStart.Physical := FFirstCol; 283 FCurMarkupNextRtlInfo.IsRtl := False; 284 end; 285end; 286 287constructor TLazSynPaintTokenBreaker.Create; 288begin 289 FCurViewAttr := TSynSelectedColorMergeResult.Create; 290 FMarkupTokenAttr := TSynSelectedColorMergeResult.Create; 291 FTabExtraByteCount := 0; 292 FSpaceExtraByteCount := 0; 293end; 294 295destructor TLazSynPaintTokenBreaker.Destroy; 296begin 297 FreeAndNil(FCurViewAttr); 298 FreeAndNil(FMarkupTokenAttr); 299 inherited Destroy; 300end; 301 302procedure TLazSynPaintTokenBreaker.Prepare(ADisplayView: TLazSynDisplayView; 303 ALinesView: TSynEditStrings; AMarkupManager: TSynEditMarkupManager; AFirstCol, 304 ALastCol: integer); 305begin 306 FDisplayView := ADisplayView; 307 FLinesView := ALinesView; 308 FMarkupManager := AMarkupManager; 309 FFirstCol := AFirstCol; 310 FLastCol := ALastCol; 311end; 312 313procedure TLazSynPaintTokenBreaker.SetHighlighterTokensLine(ALine: TLineIdx; out 314 ARealLine: TLineIdx); 315var 316 LogLeftPos: Integer; 317begin 318 FDisplayView.SetHighlighterTokensLine(ALine, ARealLine, LogLeftPos, FCurLineByteLen); 319 FCharWidths := FLinesView.GetPhysicalCharWidths(ARealLine); 320 FCharWidthsLen := Length(FCharWidths); 321 FCurLineByteLen := FCurLineByteLen + LogLeftPos - 1; 322 323 FCurViewToken.TokenLength := 0; 324 FCurViewScannerPos.Logical := LogLeftPos; 325 FCurViewScannerPos.Physical := 1; 326 FCurViewScannerPos.Offset := 0; 327 FCurViewScannerPhysCharPos := 1; 328 FCurViewinRTL := False; 329 330 FNextMarkupPhysPos := -1; 331 FNextMarkupLogPos := -1; 332 FCurMarkupState := cmPreInit; 333 FCurTxtLineIdx := ARealLine; 334end; 335 336function TLazSynPaintTokenBreaker.GetNextHighlighterTokenEx(out 337 ATokenInfo: TLazSynDisplayTokenInfoEx): Boolean; 338const 339 Space = ' '; 340begin 341 if FCurMarkupState = cmPreInit then 342 InitCurMarkup; 343 344 if (FCurLineByteLen < FCharWidthsLen) and (FCurViewScannerPos.Logical > FCurLineByteLen) 345 then begin 346 if FCurMarkupState <> cmPastWrapEnd then begin 347 assert(FCurViewScannerPos.Logical = FCurLineByteLen + 1, 'TLazSynPaintTokenBreaker.GetNextHighlighterTokenEx: FCurViewScannerPos.Logical = FCurLineByteLen + 1'); 348 FCurMarkupState := cmPastWrapEnd; 349 FWrapEndBound := FCurViewScannerPos; 350 end; 351 end; 352 353 if (FCurMarkupState = cmPastWrapEnd) then begin 354 FNextMarkupPhysPos := MaxInt; 355 FNextMarkupLogPos := MaxInt; 356 end 357 else 358 if (FNextMarkupPhysPos < 0) or 359 (FCurMarkupNextRtlInfo.IsRtl and (FNextMarkupPhysPos >= FCurMarkupNextStart.Physical)) or 360 ((not FCurMarkupNextRtlInfo.IsRtl) and (FNextMarkupPhysPos <= FCurMarkupNextStart.Physical)) or 361 (FNextMarkupLogPos < 0) or (FNextMarkupLogPos <= FCurMarkupNextStart.Logical) 362 then begin 363 FMarkupManager.GetNextMarkupColAfterRowCol(FCurTxtLineIdx+1, 364 FCurMarkupNextStart, FCurMarkupNextRtlInfo, FNextMarkupPhysPos, FNextMarkupLogPos); 365 366 if FNextMarkupPhysPos < 1 then 367 if FCurMarkupNextRtlInfo.IsRtl 368 then FNextMarkupPhysPos := 1 369 else FNextMarkupPhysPos := MaxInt; 370 if FNextMarkupLogPos < 1 then 371 FNextMarkupLogPos := MaxInt; 372 end; 373 374 if (FCurMarkupState <> cmPastWrapEnd) and (FCurLineByteLen < FCharWidthsLen) and 375 (FNextMarkupLogPos > FCurLineByteLen + 1) 376 then 377 FNextMarkupLogPos := FCurLineByteLen + 1; // stop at WrapEnd / EOL // tokens should have a bound there anyway 378 379 ATokenInfo.Attr := nil; 380 if FCurMarkupState in [cmPastEOL, cmPastWrapEnd] 381 then Result := False 382 else Result := GetNextHighlighterTokenFromView(ATokenInfo, FNextMarkupPhysPos, FNextMarkupLogPos); 383 384 if not Result then begin 385 // the first run StartPos is set by GetNextHighlighterTokenFromView 386 if FCurMarkupState in [cmPastEOL, cmPastWrapEnd] then begin 387 ATokenInfo.StartPos := FCurMarkupNextStart 388 end 389 else 390 if FFirstCol > ATokenInfo.StartPos.Physical then begin 391 ATokenInfo.StartPos.Logical := ATokenInfo.StartPos.Logical + (FFirstCol - ATokenInfo.StartPos.Physical); 392 ATokenInfo.StartPos.Physical := FFirstCol; 393 end; 394 395 if (FCurMarkupState <> cmPastWrapEnd) then 396 FCurMarkupState := cmPastEOL; 397 398 Result := (ATokenInfo.StartPos.Physical < FLastCol); 399 if not Result then 400 exit; 401 assert((FNextMarkupPhysPos <= 0) or (FNextMarkupPhysPos > ATokenInfo.StartPos.Physical), 'FNextMarkupPhysPos > ATokenInfo.StartPos.Physical'); 402 403 ATokenInfo.Tk.TokenStart := @Space[1]; 404 ATokenInfo.Tk.TokenLength := 1; 405 406 if FNextMarkupPhysPos > 0 407 then ATokenInfo.EndPos.Physical := Min(FNextMarkupPhysPos, FLastCol) 408 else ATokenInfo.EndPos.Physical := FLastCol; 409 ATokenInfo.EndPos.Offset := 0; 410 ATokenInfo.EndPos.Logical := ATokenInfo.StartPos.Logical + (ATokenInfo.EndPos.Physical - ATokenInfo.StartPos.Physical); 411 412 if (FNextMarkupLogPos > 0) and (FNextMarkupLogPos < ATokenInfo.EndPos.Logical) then begin 413 ATokenInfo.EndPos.Physical := ATokenInfo.EndPos.Physical - (ATokenInfo.EndPos.Logical - FNextMarkupLogPos); 414 ATokenInfo.EndPos.Logical := FNextMarkupLogPos; 415 end; 416 assert(ATokenInfo.EndPos.Physical > ATokenInfo.StartPos.Physical, 'ATokenInfo.EndPos.Physical > ATokenInfo.StartPos.Physical'); 417 assert(ATokenInfo.EndPos.Logical > ATokenInfo.StartPos.Logical, 'ATokenInfo.EndPos.Logical > ATokenInfo.StartPos.Logical'); 418 419 FCurMarkupNextStart := ATokenInfo.EndPos; 420 if FCurMarkupNextRtlInfo.IsRtl then begin 421 FNextMarkupPhysPos := -1; 422 FNextMarkupLogPos := -1; 423 end; 424 FCurMarkupNextRtlInfo.IsRtl := False; 425 426 ATokenInfo.PhysicalCharStart := ATokenInfo.StartPos.Physical; 427 ATokenInfo.PhysicalClipStart := ATokenInfo.StartPos.Physical; 428 ATokenInfo.PhysicalCharEnd := ATokenInfo.EndPos.Physical; 429 ATokenInfo.PhysicalClipEnd := ATokenInfo.EndPos.Physical; 430 ATokenInfo.RtlInfo.IsRtl := False; 431 FMarkupTokenAttr.Clear; 432 if ATokenInfo.Attr <> nil then begin 433 FMarkupTokenAttr.Assign(ATokenInfo.Attr); 434 end 435 else begin 436 FMarkupTokenAttr.Foreground := FForegroundColor; 437 FMarkupTokenAttr.Background := FBackgroundColor; 438 end; 439 440 ATokenInfo.ExpandedExtraBytes := 0; 441 ATokenInfo.HasTabs := False; 442 ATokenInfo.HasDoubleWidth := False; // TODO: True, but needs charwidth for painter 443 end 444 else begin 445 if ATokenInfo.NextRtlInfo.IsRtl <> FCurMarkupNextRtlInfo.IsRtl then begin 446 FNextMarkupPhysPos := -1; 447 FNextMarkupLogPos := -1; 448 end; 449 FCurMarkupNextStart := ATokenInfo.NextPos; 450 FCurMarkupNextRtlInfo := ATokenInfo.NextRtlInfo; 451 452 FMarkupTokenAttr.Assign(ATokenInfo.Attr); 453 FMarkupTokenAttr.CurrentStartX := ATokenInfo.StartPos; // current sub-token 454 FMarkupTokenAttr.CurrentEndX := ATokenInfo.EndPos; 455 end; 456 457 if FCurMarkupState = cmPastWrapEnd then 458 fMarkupManager.MergeMarkupAttributeAtWrapEnd(FCurTxtLineIdx + 1, 459 FWrapEndBound, FMarkupTokenAttr) 460 else 461 fMarkupManager.MergeMarkupAttributeAtRowCol(FCurTxtLineIdx + 1, 462 ATokenInfo.StartPos, ATokenInfo.EndPos, ATokenInfo.RtlInfo, FMarkupTokenAttr); 463 FMarkupTokenAttr.ProcessMergeInfo; 464 465 466 ATokenInfo.Attr := FMarkupTokenAttr; 467 // Deal with equal colors 468 // TODO: Map to RGB first 469 if (FMarkupTokenAttr.Background = FMarkupTokenAttr.Foreground) then begin // or if diff(gb,fg) < x 470 if FMarkupTokenAttr.Background = BackgroundColor then 471 FMarkupTokenAttr.Foreground := not(FMarkupTokenAttr.Background) and $00ffffff // or maybe ForegroundColor ? 472 else 473 FMarkupTokenAttr.Foreground := BackgroundColor; 474 end; 475 476 // Todo merge attribute 477 478end; 479 480function TLazSynPaintTokenBreaker.GetNextHighlighterTokenFromView(out 481 ATokenInfo: TLazSynDisplayTokenInfoEx; APhysEnd: Integer; ALogEnd: Integer): Boolean; 482 483 procedure InitSynAttr(var ATarget: TSynSelectedColorMergeResult; const ASource: TLazSynCustomTextAttributes; 484 const AnAttrStartX: TLazSynDisplayTokenBound); 485 const 486 NoEnd: TLazSynDisplayTokenBound = (Physical: -1; Logical: -1; Offset: 0); 487 begin 488 ATarget.Clear; 489 if Assigned(ASource) then begin 490 ATarget.Assign(ASource); 491 if ATarget.Foreground = clNone then 492 ATarget.Foreground := ForegroundColor; 493 if ATarget.Background = clNone then 494 ATarget.Background := BackgroundColor; 495 end else 496 begin 497 ATarget.Foreground := ForegroundColor; 498 ATarget.Background := BackgroundColor; 499 ATarget.Style := []; // Font.Style; // currently always cleared 500 end; 501// ATarget.MergeFinalStyle := True; 502 ATarget.StyleMask := []; 503 ATarget.StartX := AnAttrStartX; 504 ATarget.EndX := NoEnd; 505 end; 506 507 function MaybeFetchToken: Boolean; inline; 508 begin 509 Result := FCurViewToken.TokenLength > 0; 510 if Result or (FCurViewToken.TokenLength < 0) then exit; 511 FCurViewCurTokenStartPos := FCurViewScannerPos; 512 while FCurViewToken.TokenLength = 0 do begin // Todo: is SyncroEd-test a zero size token is returned 513 Result := FDisplayView.GetNextHighlighterToken(FCurViewToken); 514 if not Result then 515 FCurViewToken.TokenAttr := nil; 516 Result := Result and (FCurViewToken.TokenStart <> nil); // False for end of line token 517 if not Result then begin 518 FCurViewToken.TokenLength := -1; 519 exit; 520 end; 521 // Todo: concatenate with next token, if possible (only, if reaching token end) 522 end; 523 end; 524 525 function GetCharWidthData(AIdx: Integer): TPhysicalCharWidth; inline; 526 begin 527 if (AIdx >= FCharWidthsLen) or (AIdx >= FCurLineByteLen) 528 then Result := 1 529 else Result := FCharWidths[AIdx]; 530 end; 531 532 Procedure AdjustCurTokenLogStart(ANewLogStart: Integer); inline; 533 // ANewLogStart = 1 based 534 var 535 j: integer; 536 begin 537 j := (ANewLogStart - FCurViewScannerPos.Logical); 538 FCurViewToken.TokenLength := FCurViewToken.TokenLength - j; 539 FCurViewToken.TokenStart := FCurViewToken.TokenStart + j; 540 FCurViewScannerPos.Logical := ANewLogStart; 541 end; 542 543 procedure SkipLtrBeforeFirstCol(var ALogicIdx: integer; ALogicEnd: Integer); inline; 544 var 545 j: Integer; 546 pcw: TPhysicalCharWidth; 547 begin 548 if (FCurViewScannerPhysCharPos >= FFirstCol) then 549 exit; 550 551 pcw := GetCharWidthData(ALogicIdx); 552 if (pcw and PCWFlagRTL <> 0) then exit; 553 554 j := (pcw and PCWMask); 555 while (ALogicIdx < ALogicEnd) and (FCurViewScannerPhysCharPos + j <= FFirstCol) and 556 (pcw and PCWFlagRTL = 0) 557 do begin 558 inc(FCurViewScannerPhysCharPos, j); 559 repeat 560 inc(ALogicIdx); 561 until (ALogicIdx >= ALogicEnd) or 562 (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0); 563 564 pcw := GetCharWidthData(ALogicIdx); 565 j := pcw and PCWMask; 566 end; 567 568 if ALogicIdx <> FCurViewScannerPos.Logical - 1 then begin 569 AdjustCurTokenLogStart(ALogicIdx + 1); 570 assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength > 0'); 571 end; 572 573 if FCurViewScannerPhysCharPos > FCurViewScannerPos.Physical then 574 FCurViewScannerPos.Physical := FCurViewScannerPhysCharPos; 575 if (FCurViewScannerPos.Physical < FFirstCol) and 576 (FCurViewScannerPos.Physical + j > FFirstCol) 577 then 578 FCurViewScannerPos.Physical := FFirstCol; 579 end; 580 581 procedure SkipRtlOffScreen(var ALogicIdx: integer; ALogicEnd: Integer); inline; 582 var 583 j: Integer; 584 pcw: TPhysicalCharWidth; 585 begin 586 if (FCurViewScannerPhysCharPos <= FFirstCol) then begin 587// TODO: end, if FCurViewRtlPhysEnd >= FLastCol; 588 if ALogicIdx + FCurViewToken.TokenLength < FCurViewRtlLogEnd then begin 589 if FCurViewToken.TokenLength > 0 then begin 590 ALogicIdx := ALogicIdx + FCurViewToken.TokenLength; 591 FCurViewScannerPos.Logical := FCurViewScannerPos.Logical + FCurViewToken.TokenLength; 592 FCurViewToken.TokenLength := 0; 593 end; 594 end 595 else begin 596 j := FCurViewRtlLogEnd - ALogicIdx; 597 FCurViewScannerPos.Logical := FCurViewScannerPos.Logical + j; 598 FCurViewToken.TokenStart := FCurViewToken.TokenStart + j; 599 FCurViewToken.TokenLength := FCurViewToken.TokenLength - j; 600 ALogicIdx := ALogicIdx + j; 601 FCurViewScannerPhysCharPos := FCurViewRtlPhysEnd; 602 FCurViewScannerPos.Physical := FCurViewRtlPhysEnd; 603 assert(FCurViewScannerPos.Logical - 1 = FCurViewRtlLogEnd, 'SkipRtlOffScreen: FCurViewScannerPos.Logical = FCurViewRtlLogEnd'); 604 end; 605 exit; 606 end; 607 608 if (FCurViewScannerPhysCharPos <= FLastCol) then 609 exit; 610 611 pcw := GetCharWidthData(ALogicIdx); 612 if (pcw and PCWFlagRTL = 0) then exit; 613 614 j := (pcw and PCWMask); 615 while (ALogicIdx < ALogicEnd) and (FCurViewScannerPhysCharPos - j >= FLastCol) and 616 (pcw and PCWFlagRTL <> 0) 617 do begin 618 dec(FCurViewScannerPhysCharPos, j); 619 repeat 620 inc(ALogicIdx); 621 until (ALogicIdx >= ALogicEnd) or 622 (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0); 623 624 pcw := GetCharWidthData(ALogicIdx); 625 j := pcw and PCWMask; 626 end; 627 628 if ALogicIdx <> FCurViewScannerPos.Logical - 1 then begin 629 AdjustCurTokenLogStart(ALogicIdx + 1); 630 assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength > 0'); 631 end; 632 if FCurViewScannerPos.Physical > FLastCol then 633 FCurViewScannerPos.Physical := FLastCol; 634 end; 635 636 procedure ChangeToRtl(ALogicIdx, ALogicEnd: Integer); 637 var 638 RtlRunPhysWidth, TabExtra, i, j: Integer; 639 pcw: TPhysicalCharWidth; 640 HasTabs, HasDouble: Boolean; 641 c: Char; 642 begin 643 FCurViewRtlLogStart := ALogicIdx; 644 pcw := GetCharWidthData(ALogicIdx); 645 646 RtlRunPhysWidth := 0; 647 i := 0; 648 HasDouble := False; 649 HasTabs := False; 650 TabExtra := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot) 651 j := (pcw and PCWMask); 652 // must go over token bounds 653 //while (ALogicIdx < ALogicEnd) and (pcw and PCWFlagRTL <> 0) do begin 654 while (ALogicIdx < FCharWidthsLen) and (ALogicIdx < FCurLineByteLen) and (pcw and PCWFlagRTL <> 0) do begin 655 inc(RtlRunPhysWidth, j); 656 657 if (j <> 0) and (FCurViewToken.TokenStart <> nil) then begin 658 c := (FCurViewToken.TokenStart + i)^; 659 if c = #9 then begin 660 HasTabs := True; 661 inc(TabExtra, j-1 + FTabExtraByteCount); 662 end 663 else 664 if j > 1 then 665 HasDouble := True; 666 if c = ' ' then 667 inc(TabExtra, FSpaceExtraByteCount); 668 end; 669 670 repeat 671 inc(ALogicIdx); 672 inc(i); 673 until (ALogicIdx >= FCurLineByteLen) or 674 (ALogicIdx >= FCharWidthsLen) or ((FCharWidths[ALogicIdx] and PCWMask) <> 0); 675 676 pcw := GetCharWidthData(ALogicIdx); 677 j := pcw and PCWMask; 678 end; 679 680 FCurViewinRTL := True; 681 FCurViewRTLLogEnd := ALogicIdx; 682 FCurViewRtlPhysStart := FCurViewScannerPhysCharPos; 683 FCurViewRtlPhysEnd := FCurViewScannerPhysCharPos + RtlRunPhysWidth; 684 FCurViewScannerPhysCharPos := FCurViewRtlPhysEnd; 685 FCurViewScannerPos.Physical := FCurViewRtlPhysEnd; 686 FCurViewRtlExpExtraBytes := TabExtra; 687 FCurViewRtlHasTabs := HasTabs; 688 FCurViewRtlHasDoubleWidth := HasDouble; 689 end; 690 691 function MaybeChangeToRtl(ALogicIdx, ALogicEnd: Integer): boolean; inline; 692 begin 693 Result := (GetCharWidthData(ALogicIdx) and PCWFlagRTL) <> 0; 694 if Result then 695 ChangeToRtl(ALogicIdx, ALogicEnd); 696 end; 697 698 procedure ChangeToLtr(ALogicIdx, ALogicEnd: Integer); 699 begin 700 FCurViewinRTL := False; 701 FCurViewScannerPhysCharPos := FCurViewRtlPhysEnd; 702 FCurViewScannerPos.Physical := FCurViewRtlPhysEnd; 703 end; 704 705 function MaybeChangeToLtr(ALogicIdx, ALogicEnd: Integer): boolean; inline; 706 begin 707 Result := (GetCharWidthData(ALogicIdx) and PCWFlagRTL) = 0; 708 if Result then 709 ChangeToLtr(ALogicIdx, ALogicEnd); 710 end; 711 712var 713 i, j: Integer; 714 pcw: TPhysicalCharWidth; 715 c: Char; 716 LogicIdx, LogicEnd, PhysPos: Integer; 717 PrevLogicIdx, PrevPhysPos: Integer; 718 PhysTokenStop: Integer; 719 TabExtra: Integer; 720 HasTabs, HasDouble: Boolean; 721begin 722 ATokenInfo.Attr := nil; 723 while True do begin 724 Result := MaybeFetchToken; // Get token from View/Highlighter 725 if not Result then begin 726 ATokenInfo.StartPos := FCurViewScannerPos; 727 ATokenInfo.RtlInfo.IsRtl := False; 728 ATokenInfo.NextRtlInfo.IsRtl := False; 729 if FCurViewToken.TokenAttr <> nil then begin 730 InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos); 731 ATokenInfo.Attr := FCurViewAttr; 732 end 733 else 734 ATokenInfo.Attr := nil; 735 exit; 736 end; 737 738 LogicIdx := FCurViewScannerPos.Logical - 1; 739 LogicEnd := LogicIdx + FCurViewToken.TokenLength; 740 //assert(GetCharWidthData(LogicIdx)<>0, 'GetNextHighlighterTokenFromView: Token starts with char'); 741 742 case FCurViewinRTL of 743 False: // Left To Right 744 begin 745 SkipLtrBeforeFirstCol(LogicIdx, LogicEnd); // Skip out of screen 746 if FCurViewToken.TokenLength = 0 then 747 continue; // Get NEXT token 748 749 if MaybeChangeToRtl(LogicIdx, LogicEnd) then 750 continue; 751 752 if APhysEnd > 0 753 then PhysTokenStop := Min(FLastCol, APhysEnd) 754 else PhysTokenStop := FLastCol; 755 // TODO: APhysEnd should always allow some data. Compare with FLastCol? Assert for APhysEnd 756 Result := PhysTokenStop > FCurViewScannerPos.Physical; 757 if not Result then begin 758 ATokenInfo.StartPos := FCurViewScannerPos; 759 exit; 760 end; 761 762 // Find end according to PhysTokenStop 763 PhysPos := FCurViewScannerPhysCharPos; 764 PrevLogicIdx := LogicIdx; 765 PrevPhysPos := PhysPos; 766 HasDouble := False; 767 HasTabs := False; 768 TabExtra := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot) 769 i := 0; 770 771 if (ALogEnd > 0) and (LogicEnd >= ALogEnd) then 772 LogicEnd := ALogEnd - 1; 773 774 pcw := GetCharWidthData(LogicIdx); 775 while (LogicIdx < LogicEnd) and (PhysPos < PhysTokenStop) and 776 (pcw and PCWFlagRTL = 0) 777 do begin 778 j := pcw and PCWMask; 779 780 PrevLogicIdx := LogicIdx; 781 PrevPhysPos := PhysPos; 782 inc(PhysPos, j); 783 if j <> 0 then begin 784 c := (FCurViewToken.TokenStart + i)^; 785 if c = #9 then begin 786 HasTabs := True; 787 inc(TabExtra, j-1 + FTabExtraByteCount); 788 end 789 else 790 if j > 1 then 791 HasDouble := True; 792 if c = ' ' then 793 inc(TabExtra, FSpaceExtraByteCount); 794 end; 795 796 repeat 797 inc(LogicIdx); 798 inc(i); 799 until (LogicIdx >= FCharWidthsLen) or 800 (LogicIdx >= LogicEnd) or ((FCharWidths[LogicIdx] and PCWMask) <> 0); 801 pcw := GetCharWidthData(LogicIdx); 802 end; 803 Assert((PhysPos > FCurViewScannerPhysCharPos) or (ALogEnd > 0), 'PhysPos > FCurViewScannerPhysCharPos'); 804 805 ATokenInfo.Tk := FCurViewToken; 806 ATokenInfo.Tk.TokenLength := LogicIdx + 1 - FCurViewScannerPos.Logical; 807 808 ATokenInfo.StartPos := FCurViewScannerPos; 809 ATokenInfo.StartPos.Offset := ATokenInfo.StartPos.Physical - FCurViewScannerPhysCharPos; // >= 0 810 811 ATokenInfo.EndPos.Logical := LogicIdx + 1; 812 ATokenInfo.EndPos.Physical := Min(PhysPos, PhysTokenStop); 813 ATokenInfo.EndPos.Offset := ATokenInfo.EndPos.Physical - PhysPos; // Zero or Negative. Paint ends before Logical 814 815 ATokenInfo.PhysicalCharStart := FCurViewScannerPhysCharPos; 816 ATokenInfo.PhysicalClipStart := ATokenInfo.StartPos.Physical; 817 ATokenInfo.PhysicalCharEnd := PhysPos; 818 ATokenInfo.PhysicalClipEnd := ATokenInfo.EndPos.Physical; 819 ATokenInfo.RtlInfo.IsRtl := False; 820 //ATokenInfo.RtlInfo.PhysLeft := FCurViewRtlPhysStart; 821 //ATokenInfo.RtlInfo.PhysRight := FCurViewRtlPhysEnd; 822 //ATokenInfo.RtlInfo.LogFirst := FCurViewRtlLogStart + 1; 823 //ATokenInfo.RtlInfo.LogLast := FCurViewRtlLogEnd + 1; 824 //ATokenInfo.RtlExpandedExtraBytes := FCurViewRtlExpExtraBytes; 825 //ATokenInfo.RtlHasDoubleWidth := FCurViewRtlHasDoubleWidth; 826 ATokenInfo.Attr := FCurViewAttr; 827 828 ATokenInfo.ExpandedExtraBytes := TabExtra; 829 ATokenInfo.HasTabs := HasTabs; 830 ATokenInfo.HasDoubleWidth := HasDouble; 831 assert(ATokenInfo.StartPos.Offset >= 0, 'FCurViewScannerPos.Offset >= 0'); 832 assert(ATokenInfo.EndPos.Offset <= 0, 'FCurViewToken.EndPos.Offset <= 0'); 833 834 if PhysPos > PhysTokenStop then begin // Last char goes over paint boundary 835 LogicIdx := PrevLogicIdx; 836 PhysPos := PrevPhysPos; 837 end 838 else 839 PhysTokenStop := PhysPos; 840 AdjustCurTokenLogStart(LogicIdx + 1); 841 FCurViewScannerPhysCharPos := PhysPos; 842 if PhysTokenStop > FCurViewScannerPos.Physical then 843 FCurViewScannerPos.Physical := PhysTokenStop; 844 845 assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength >= 0'); 846 847 InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos); 848 if FCurViewToken.TokenLength = 0 then 849 ATokenInfo.Attr.EndX := ATokenInfo.EndPos; // PhysPos-1; 850 851 MaybeFetchToken; 852 if MaybeChangeToRtl(LogicIdx, LogicEnd) then begin // get NextTokenPhysStart 853 SkipRtlOffScreen(LogicIdx, LogicEnd); 854 while FCurViewToken.TokenLength = 0 do 855 if MaybeFetchToken then 856 SkipRtlOffScreen(LogicIdx, LogicEnd); 857 end; 858 859 ATokenInfo.NextPos.Physical := FCurViewScannerPos.Physical; 860 ATokenInfo.NextPos.Logical := FCurViewScannerPos.Logical; 861 ATokenInfo.NextPos.Offset := FCurViewScannerPos.Physical - FCurViewScannerPhysCharPos; 862 ATokenInfo.NextRtlInfo.IsRtl := FCurViewinRTL; 863 ATokenInfo.NextRtlInfo.PhysLeft := FCurViewRtlPhysStart; 864 ATokenInfo.NextRtlInfo.PhysRight := FCurViewRtlPhysEnd; 865 ATokenInfo.NextRtlInfo.LogFirst := FCurViewRtlLogStart + 1; 866 ATokenInfo.NextRtlInfo.LogLast := FCurViewRtlLogEnd + 1; 867 868 break; 869 end; // case FCurViewinRTL = False; 870 True: // Right To Left 871 begin 872 SkipRtlOffScreen(LogicIdx, LogicEnd); 873 if FCurViewToken.TokenLength = 0 then 874 continue; // Get NEXT token 875 876 if MaybeChangeToLtr(LogicIdx, LogicEnd) then 877 continue; 878 879 if APhysEnd >= FCurViewRtlPhysEnd 880 then PhysTokenStop := FFirstCol 881 else PhysTokenStop := Max(FFirstCol, APhysEnd); 882 // TODO: APhysEnd should always allow some data. Assert for APhysEnd 883 // FFirstCol must be less PPS. Otherwise it would have gone LTR 884// Result := PhysTokenStop < FCurViewScannerPos.Physical; 885// if not Result then exit; 886 887 // Find end according to PhysTokenStop 888 PhysPos := FCurViewScannerPhysCharPos; 889 PrevLogicIdx := LogicIdx; 890 PrevPhysPos := PhysPos; 891 HasDouble := False; 892 HasTabs := False; 893 TabExtra := 0; // Extra bytes needed for expanded Tab/Space(utf8 visible space/dot) 894 i := 0; 895 896 if (ALogEnd > 0) and (LogicEnd >= ALogEnd) then 897 LogicEnd := ALogEnd - 1; 898 899 pcw := GetCharWidthData(LogicIdx); 900 while (LogicIdx < LogicEnd) and (PhysPos > PhysTokenStop) and 901 (pcw and PCWFlagRTL <> 0) 902 do begin 903 j := pcw and PCWMask; 904 905 PrevLogicIdx := LogicIdx; 906 PrevPhysPos := PhysPos; 907 dec(PhysPos, j); 908 if j <> 0 then begin 909 c := (FCurViewToken.TokenStart + i)^; 910 if c = #9 then begin 911 HasTabs := True; 912 inc(TabExtra, j-1 + FTabExtraByteCount); 913 end 914 else 915 if j > 1 then 916 HasDouble := True; 917 if c = ' ' then 918 inc(TabExtra, FSpaceExtraByteCount); 919 end; 920 921 repeat 922 inc(LogicIdx); 923 inc(i); 924 until (LogicIdx >= FCharWidthsLen) or 925 (LogicIdx >= LogicEnd) or ((FCharWidths[LogicIdx] and PCWMask) <> 0); 926 pcw := GetCharWidthData(LogicIdx); 927 end; 928 Assert((PhysPos < FCurViewScannerPhysCharPos) or (ALogEnd > 0), 'PhysPos > FCurViewScannerPhysCharPos'); 929 930 ATokenInfo.Tk := FCurViewToken; 931 ATokenInfo.Tk.TokenLength := LogicIdx + 1 - FCurViewScannerPos.Logical; 932 933 ATokenInfo.StartPos := FCurViewScannerPos; 934 //ATokenInfo.StartPos.Logical := LogicIdx + 1; 935 //ATokenInfo.StartPos.Physical := ATokenInfo.StartPos.Physical; 936 ATokenInfo.StartPos.Offset := FCurViewScannerPhysCharPos - ATokenInfo.StartPos.Physical; // >= 0 937 938 ATokenInfo.EndPos.Logical := LogicIdx + 1; 939 ATokenInfo.EndPos.Physical := Max(PhysPos, PhysTokenStop); 940 ATokenInfo.EndPos.Offset := PhysPos - ATokenInfo.EndPos.Physical; // <= 0 941 942 ATokenInfo.PhysicalCharStart := PhysPos; 943 ATokenInfo.PhysicalClipStart := ATokenInfo.EndPos.Physical; 944 ATokenInfo.PhysicalCharEnd := FCurViewScannerPhysCharPos; 945 ATokenInfo.PhysicalClipEnd := ATokenInfo.StartPos.Physical; 946 ATokenInfo.RtlInfo.IsRtl := True; 947 ATokenInfo.RtlInfo.PhysLeft := FCurViewRtlPhysStart; 948 ATokenInfo.RtlInfo.PhysRight := FCurViewRtlPhysEnd; 949 ATokenInfo.RtlInfo.LogFirst := FCurViewRtlLogStart + 1; 950 ATokenInfo.RtlInfo.LogLast := FCurViewRtlLogEnd + 1; 951 ATokenInfo.RtlExpandedExtraBytes := FCurViewRtlExpExtraBytes; 952 ATokenInfo.RtlHasTabs := FCurViewRtlHasTabs; 953 ATokenInfo.RtlHasDoubleWidth := FCurViewRtlHasDoubleWidth; 954 ATokenInfo.Attr := FCurViewAttr; 955 956 ATokenInfo.ExpandedExtraBytes := TabExtra; 957 ATokenInfo.HasTabs := HasTabs; 958 ATokenInfo.HasDoubleWidth := HasDouble; 959 assert(ATokenInfo.StartPos.Offset >= 0, 'FCurViewScannerPos.Offset >= 0'); 960 assert(ATokenInfo.EndPos.Offset <= 0, 'FCurViewToken.EndPos.Offset <= 0'); 961 962 if (PhysPos < PhysTokenStop) and (PhysTokenStop > FFirstCol) then begin // Last char goes over paint boundary 963 LogicIdx := PrevLogicIdx; 964 PhysPos := PrevPhysPos; 965 end 966 else 967 PhysTokenStop := Max(PhysPos, PhysTokenStop); 968 969 AdjustCurTokenLogStart(LogicIdx + 1); 970 FCurViewScannerPhysCharPos := PhysPos; 971 if PhysTokenStop < FCurViewScannerPos.Physical then 972 FCurViewScannerPos.Physical := PhysTokenStop; 973 974 assert(FCurViewToken.TokenLength >= 0, 'FCurViewToken.TokenLength >= 0'); 975 976 InitSynAttr(FCurViewAttr, FCurViewToken.TokenAttr, FCurViewCurTokenStartPos); 977 if FCurViewToken.TokenLength = 0 then 978 ATokenInfo.Attr.EndX := ATokenInfo.EndPos; // PhysPos-1; 979 980 MaybeFetchToken; 981 SkipRtlOffScreen(LogicIdx, LogicEnd); 982 while FCurViewToken.TokenLength = 0 do 983 if MaybeFetchToken then 984 SkipRtlOffScreen(LogicIdx, LogicEnd); 985 MaybeChangeToLtr(LogicIdx, LogicEnd); // get NextTokenPhysStart 986 987 // If the next token is RTL, then NextPos is the next EndPos 988 ATokenInfo.NextPos.Physical := FCurViewScannerPos.Physical; 989 ATokenInfo.NextPos.Logical := FCurViewScannerPos.Logical; 990 ATokenInfo.NextPos.Offset := FCurViewScannerPhysCharPos - FCurViewScannerPos.Physical; 991 ATokenInfo.NextRtlInfo.IsRtl := FCurViewinRTL; 992 ATokenInfo.NextRtlInfo.PhysLeft := FCurViewRtlPhysStart; 993 ATokenInfo.NextRtlInfo.PhysRight := FCurViewRtlPhysEnd; 994 ATokenInfo.NextRtlInfo.LogFirst := FCurViewRtlLogStart + 1; 995 ATokenInfo.NextRtlInfo.LogLast := FCurViewRtlLogEnd + 1; 996 997 break; 998 end; // case FCurViewinRTL = True; 999 end; 1000 1001 1002 end; // while True 1003end; 1004 1005{ TLazSynSurfaceWithText } 1006 1007procedure TLazSynSurfaceWithText.SetTextArea(AValue: TLazSynTextArea); 1008begin 1009 FTextArea := AValue; 1010end; 1011 1012function TLazSynSurfaceWithText.GetTextArea: TLazSynTextArea; 1013begin 1014 Result := FTextArea; 1015end; 1016 1017procedure TLazSynSurfaceWithText.Assign(Src: TLazSynSurface); 1018begin 1019 inherited Assign(Src); 1020 FTextArea := TLazSynSurfaceWithText(Src).FTextArea; 1021end; 1022 1023{ TLazSynSurfaceManager } 1024 1025procedure TLazSynSurfaceManager.SetLeftGutterWidth(AValue: integer); 1026begin 1027 if FLeftGutterWidth = AValue then Exit; 1028 FLeftGutterWidth := AValue; 1029 BoundsChanged; 1030end; 1031 1032procedure TLazSynSurfaceManager.SetPadding(Side: TLazSynBorderSide; AValue: integer); 1033begin 1034 FTextArea.Padding[Side] := AValue; 1035end; 1036 1037procedure TLazSynSurfaceManager.SetRightEdgeColor(AValue: TColor); 1038begin 1039 FTextArea.RightEdgeColor := AValue; 1040end; 1041 1042procedure TLazSynSurfaceManager.SetRightEdgeColumn(AValue: integer); 1043begin 1044 FTextArea.RightEdgeColumn := AValue; 1045end; 1046 1047procedure TLazSynSurfaceManager.SetRightEdgeVisible(AValue: boolean); 1048begin 1049 FTextArea.RightEdgeVisible := AValue; 1050end; 1051 1052procedure TLazSynSurfaceManager.SetLeftGutterArea(AValue: TLazSynSurfaceWithText); 1053begin 1054 if FLeftGutterArea = AValue then Exit; 1055 FLeftGutterArea := AValue; 1056 FLeftGutterArea.DisplayView := DisplayView; 1057 FLeftGutterArea.TextArea := FTextArea; 1058end; 1059 1060function TLazSynSurfaceManager.GetLeftGutterArea: TLazSynSurfaceWithText; 1061begin 1062 Result := FLeftGutterArea; 1063end; 1064 1065function TLazSynSurfaceManager.GetRightGutterArea: TLazSynSurfaceWithText; 1066begin 1067 Result := FRightGutterArea; 1068end; 1069 1070function TLazSynSurfaceManager.GetTextArea: TLazSynTextArea; 1071begin 1072 Result := FTextArea; 1073end; 1074 1075procedure TLazSynSurfaceManager.SetBackgroundColor(AValue: TColor); 1076begin 1077 FTextArea.BackgroundColor := AValue; 1078end; 1079 1080procedure TLazSynSurfaceManager.SetExtraCharSpacing(AValue: integer); 1081begin 1082 FTextArea.ExtraCharSpacing := AValue; 1083end; 1084 1085procedure TLazSynSurfaceManager.SetExtraLineSpacing(AValue: integer); 1086begin 1087 FTextArea.ExtraLineSpacing := AValue; 1088end; 1089 1090procedure TLazSynSurfaceManager.SetForegroundColor(AValue: TColor); 1091begin 1092 FTextArea.ForegroundColor := AValue; 1093end; 1094 1095procedure TLazSynSurfaceManager.SetRightGutterArea(AValue: TLazSynSurfaceWithText); 1096begin 1097 if FRightGutterArea = AValue then Exit; 1098 FRightGutterArea := AValue; 1099 FRightGutterArea.DisplayView := DisplayView; 1100 FLeftGutterArea.TextArea := FTextArea; 1101end; 1102 1103procedure TLazSynSurfaceManager.SetRightGutterWidth(AValue: integer); 1104begin 1105 if FRightGutterWidth = AValue then Exit; 1106 FRightGutterWidth := AValue; 1107 BoundsChanged; 1108end; 1109 1110procedure TLazSynSurfaceManager.SetTextArea(AValue: TLazSynTextArea); 1111begin 1112 if FTextArea = AValue then Exit; 1113 FTextArea := AValue; 1114 FTextArea.DisplayView := DisplayView; 1115 if FLeftGutterArea <> nil then 1116 FLeftGutterArea.TextArea := FTextArea; 1117 if FRightGutterArea <> nil then 1118 FRightGutterArea.TextArea := FTextArea; 1119end; 1120 1121procedure TLazSynSurfaceManager.SetVisibleSpecialChars(AValue: TSynVisibleSpecialChars); 1122begin 1123 FTextArea.VisibleSpecialChars := AValue; 1124end; 1125 1126procedure TLazSynSurfaceManager.SetHighlighter(AValue: TSynCustomHighlighter); 1127begin 1128 FTextArea.Highlighter := AValue; 1129end; 1130 1131procedure TLazSynSurfaceManager.DoPaint(ACanvas: TCanvas; AClip: TRect); 1132begin 1133 FLeftGutterArea.Paint(ACanvas, AClip); 1134 FTextArea.Paint(ACanvas, AClip); 1135 FRightGutterArea.Paint(ACanvas, AClip); 1136end; 1137 1138procedure TLazSynSurfaceManager.DoDisplayViewChanged; 1139begin 1140 FLeftGutterArea.DisplayView := DisplayView; 1141 FRightGutterArea.DisplayView := DisplayView; 1142 FTextArea.DisplayView := DisplayView; 1143end; 1144 1145procedure TLazSynSurfaceManager.BoundsChanged; 1146var 1147 l, r: Integer; 1148begin 1149 r := Max(Left, Right - RightGutterWidth); 1150 l := Min(r, Left + LeftGutterWidth); 1151 FLeftGutterArea.SetBounds(Top, Left, Bottom, l); 1152 FTextArea.SetBounds(Top, l, Bottom, r); 1153 FRightGutterArea.SetBounds(Top, r, Bottom, Right); 1154end; 1155 1156constructor TLazSynSurfaceManager.Create(AOwner: TWinControl); 1157begin 1158 inherited Create(AOwner); 1159 FLeftGutterWidth := 0; 1160 FRightGutterWidth := 0; 1161end; 1162 1163procedure TLazSynSurfaceManager.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); 1164var 1165 rcInval: TRect; 1166 ViewedRange: TLineRange; 1167begin 1168 rcInval := Bounds; 1169 if (FirstTextLine >= 0) then begin 1170 ViewedRange := DisplayView.TextToViewIndex(FirstTextLine); 1171 rcInval.Top := Max(TextArea.TextBounds.Top, 1172 TextArea.TextBounds.Top + (ViewedRange.Top 1173 - TextArea.TopLine + 1) * TextArea.LineHeight); 1174 end; 1175 if (LastTextLine >= 0) then begin 1176 if LastTextLine <> FirstTextLine then 1177 ViewedRange := DisplayView.TextToViewIndex(LastTextLine); 1178 rcInval.Bottom := Min(TextArea.TextBounds.Bottom, 1179 TextArea.TextBounds.Top + (ViewedRange.Bottom 1180 - TextArea.TopLine + 2) * TextArea.LineHeight); 1181 end; 1182 1183 {$IFDEF VerboseSynEditInvalidate} 1184 DebugLn(['TCustomSynEdit.InvalidateGutterLines ',DbgSName(self), ' FirstLine=',FirstTextLine, ' LastLine=',LastTextLine, ' rect=',dbgs(rcInval)]); 1185 {$ENDIF} 1186 if (rcInval.Top < rcInval.Bottom) and (rcInval.Left < rcInval.Right) then 1187 InvalidateRect(Handle, @rcInval, FALSE); 1188end; 1189 1190procedure TLazSynSurfaceManager.InvalidateTextLines(FirstTextLine, LastTextLine: TLineIdx); 1191begin 1192 FTextArea.InvalidateLines(FirstTextLine, LastTextLine); 1193end; 1194 1195procedure TLazSynSurfaceManager.InvalidateGutterLines(FirstTextLine, LastTextLine: TLineIdx); 1196begin 1197 FLeftGutterArea.InvalidateLines(FirstTextLine, LastTextLine); 1198 FRightGutterArea.InvalidateLines(FirstTextLine, LastTextLine); 1199end; 1200 1201{ TLazSynTextArea } 1202 1203function TLazSynTextArea.GetPadding(Side: TLazSynBorderSide): integer; 1204begin 1205 Result := FPadding[Side]; 1206end; 1207 1208function TLazSynTextArea.GetExtraCharSpacing: integer; 1209begin 1210 Result := Max(FExtraCharSpacing, -CharWidth+1); 1211end; 1212 1213procedure TLazSynTextArea.SetExtraCharSpacing(AValue: integer); 1214begin 1215 if FExtraCharSpacing = AValue then Exit; 1216 FExtraCharSpacing := AValue; 1217 FontChanged; 1218end; 1219 1220procedure TLazSynTextArea.SetExtraLineSpacing(AValue: integer); 1221begin 1222 if FExtraLineSpacing = AValue then Exit; 1223 FExtraLineSpacing := AValue; 1224 FCurrentExtraLineSpacing := Max(AValue, -FTextDrawer.CharHeight+1); 1225 FTextHeight := FTextDrawer.CharHeight + FCurrentExtraLineSpacing; 1226 FontChanged; 1227end; 1228 1229procedure TLazSynTextArea.SetLeftChar(AValue: Integer); 1230begin 1231 if FLeftChar = AValue then Exit; 1232 FLeftChar := AValue; 1233end; 1234 1235procedure TLazSynTextArea.SetPadding(Side: TLazSynBorderSide; AValue: integer); 1236begin 1237 FPadding[Side] := AValue; 1238 case Side of 1239 bsLeft: FTextBounds.Left := Left + FPadding[bsLeft]; 1240 bsTop: FTextBounds.Top := Top + FPadding[bsTop]; 1241 bsRight: FTextBounds.Right := Right - FPadding[bsRight]; 1242 bsBottom: FTextBounds.Bottom := Bottom - FPadding[bsBottom]; 1243 end; 1244 FontChanged; 1245end; 1246 1247procedure TLazSynTextArea.SetTopLine(AValue: TLinePos); 1248begin 1249 if AValue < 1 then AValue := 1; 1250 if FTopLine = AValue then Exit; 1251 FTopLine := AValue; 1252end; 1253 1254procedure TLazSynTextArea.DoDrawerFontChanged(Sender: TObject); 1255begin 1256 FontChanged; 1257end; 1258 1259procedure TLazSynTextArea.BoundsChanged; 1260begin 1261 FTextBounds.Left := Left + FPadding[bsLeft]; 1262 FTextBounds.Top := Top + FPadding[bsTop]; 1263 FTextBounds.Right := Right - FPadding[bsRight]; 1264 FTextBounds.Bottom := Bottom - FPadding[bsBottom]; 1265 FontChanged; 1266end; 1267 1268function TLazSynTextArea.ScreenColumnToXValue(Col: integer): integer; 1269begin 1270 Result := FTextBounds.Left + (Col - LeftChar) * fCharWidth; 1271end; 1272 1273function TLazSynTextArea.RowColumnToPixels(const RowCol: TPoint): TPoint; 1274begin 1275 // Inludes LeftChar, but not Topline 1276 Result.X := FTextBounds.Left + (RowCol.X - LeftChar) * CharWidth; 1277 Result.Y := FTextBounds.Top + RowCol.Y * LineHeight; 1278end; 1279 1280function TLazSynTextArea.PixelsToRowColumn(Pixels: TPoint; 1281 aFlags: TSynCoordinateMappingFlags): TPoint; 1282begin 1283 // Inludes LeftChar, but not Topline 1284 if (Pixels.X >= FTextBounds.Left) and (Pixels.X < FTextBounds.Right) then begin 1285 if not (scmForceLeftSidePos in aFlags) then 1286 Pixels.X := Pixels.X + (CharWidth div 2); // nearest side of char 1287 Result.X := (Pixels.X - FTextBounds.Left) div CharWidth 1288 + LeftChar; 1289 end 1290 else 1291 Result.X := 0; 1292 Result.Y := (Pixels.Y - FTextBounds.Top) div LineHeight; 1293 1294 if (not(scmIncludePartVisible in aFlags)) and (Result.Y >= LinesInWindow) then begin 1295 // don't return a partially visible last line 1296 Result.Y := LinesInWindow - 1; 1297 end; 1298 if Result.X < 0 then Result.X := 0; 1299 if Result.Y < 0 then Result.Y := 0; 1300end; 1301 1302constructor TLazSynTextArea.Create(AOwner: TWinControl; ATextDrawer: TheTextDrawer); 1303var 1304 i: TLazSynBorderSide; 1305begin 1306 inherited Create(AOwner); 1307 FTextSizeChangeList := TMethodList.Create; 1308 FTokenBreaker := TLazSynPaintTokenBreaker.Create; 1309 FTextDrawer := ATextDrawer; 1310 FTextDrawer.RegisterOnFontChangeHandler(@DoDrawerFontChanged); 1311 FPaintLineColor := TSynSelectedColor.Create; 1312 FPaintLineColor2 := TSynSelectedColor.Create; 1313 for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do 1314 FPadding[i] := 0; 1315 FTopLine := 1; 1316 FLeftChar := 1; 1317 FRightEdgeColumn := 80; 1318 FRightEdgeVisible := True; 1319 FRightEdgeColor := clSilver; 1320 FontChanged; 1321end; 1322 1323destructor TLazSynTextArea.Destroy; 1324begin 1325 FreeAndNil(FTokenBreaker); 1326 FTextDrawer.UnRegisterOnFontChangeHandler(@DoDrawerFontChanged); 1327 FreeAndNil(FPaintLineColor); 1328 FreeAndNil(FPaintLineColor2); 1329 FreeAndNil(FTextSizeChangeList); 1330 inherited Destroy; 1331end; 1332 1333procedure TLazSynTextArea.Assign(Src: TLazSynSurface); 1334var 1335 i: TLazSynBorderSide; 1336begin 1337 inherited Assign(Src); 1338 1339 FTextDrawer := TLazSynTextArea(Src).FTextDrawer; 1340 FTheLinesView := TLazSynTextArea(Src).FTheLinesView; 1341 DisplayView := TLazSynTextArea(Src).DisplayView; 1342 FHighlighter := TLazSynTextArea(Src).FHighlighter; 1343 FMarkupManager := TLazSynTextArea(Src).FMarkupManager; 1344 FForegroundColor := TLazSynTextArea(Src).FForegroundColor; 1345 FBackgroundColor := TLazSynTextArea(Src).FBackgroundColor; 1346 FRightEdgeColor := TLazSynTextArea(Src).FRightEdgeColor; 1347 1348 FExtraCharSpacing := TLazSynTextArea(Src).FExtraCharSpacing; 1349 FExtraLineSpacing := TLazSynTextArea(Src).FExtraLineSpacing; 1350 FCurrentExtraLineSpacing := TLazSynTextArea(Src).FCurrentExtraLineSpacing; 1351 FVisibleSpecialChars := TLazSynTextArea(Src).FVisibleSpecialChars; 1352 FRightEdgeColumn := TLazSynTextArea(Src).FRightEdgeColumn; 1353 FRightEdgeVisible := TLazSynTextArea(Src).FRightEdgeVisible; 1354 1355 for i := low(TLazSynBorderSide) to high(TLazSynBorderSide) do 1356 FPadding[i] := TLazSynTextArea(Src).FPadding[i]; 1357 1358 FTopLine := TLazSynTextArea(Src).FTopLine; 1359 FLeftChar := TLazSynTextArea(Src).FLeftChar; 1360 1361 BoundsChanged; 1362end; 1363 1364procedure TLazSynTextArea.InvalidateLines(FirstTextLine, LastTextLine: TLineIdx); 1365var 1366 rcInval: TRect; 1367 ViewedRange: TLineRange; 1368begin 1369 rcInval := Bounds; 1370 if (FirstTextLine >= 0) then begin 1371 ViewedRange := DisplayView.TextToViewIndex(FirstTextLine); 1372 rcInval.Top := Max(TextBounds.Top, 1373 TextBounds.Top + (ViewedRange.Top - TopLine + 1) * LineHeight); 1374 end; 1375 if (LastTextLine >= 0) then begin 1376 if LastTextLine <> FirstTextLine then 1377 ViewedRange := DisplayView.TextToViewIndex(LastTextLine); 1378 rcInval.Bottom := Min(TextBounds.Bottom, 1379 TextBounds.Top + (ViewedRange.Bottom - TopLine + 2) * LineHeight); 1380 end; 1381 1382 {$IFDEF VerboseSynEditInvalidate} 1383 DebugLn(['TCustomSynEdit.InvalidateTextLines ',DbgSName(self), ' FirstLine=',FirstTextLine, ' LastLine=',LastTextLine, ' rect=',dbgs(rcInval)]); 1384 {$ENDIF} 1385 if (rcInval.Top < rcInval.Bottom) and (rcInval.Left < rcInval.Right) then 1386 InvalidateRect(Handle, @rcInval, FALSE); 1387end; 1388 1389procedure TLazSynTextArea.FontChanged; 1390var 1391 OldChars, OldLines: Integer; 1392 Chg: TSynStatusChanges; 1393begin 1394 // ToDo: wait for handle creation 1395 // Report FLinesInWindow=-1 if no handle 1396 FCharWidth := FTextDrawer.CharWidth; // includes extra 1397 FTextHeight := FTextDrawer.CharHeight + ExtraLineSpacing; 1398 1399 OldChars := FCharsInWindow; 1400 OldLines := FLinesInWindow; 1401 FCharsInWindow := 0; 1402 FLinesInWindow := 0; 1403 if FCharWidth > 0 then 1404 FCharsInWindow := Max(0, (FTextBounds.Right - FTextBounds.Left) div FCharWidth); 1405 if FTextHeight > 0 then 1406 FLinesInWindow := Max(0, (FTextBounds.Bottom - FTextBounds.Top) div FTextHeight); 1407 1408 if assigned(fOnStatusChange) then begin 1409 Chg := []; 1410 if OldChars <> FCharsInWindow then 1411 Chg := Chg + [scCharsInWindow]; 1412 if OldLines <> FLinesInWindow then 1413 Chg := Chg + [scLinesInWindow]; 1414 if (Chg <> []) then 1415 fOnStatusChange(Self, Chg); 1416 end; 1417 FTextSizeChangeList.CallNotifyEvents(Self); 1418end; 1419 1420procedure TLazSynTextArea.AddTextSizeChangeHandler(AHandler: TNotifyEvent); 1421begin 1422 FTextSizeChangeList.Add(TMethod(AHandler)); 1423end; 1424 1425procedure TLazSynTextArea.RemoveTextSizeChangeHandler(AHandler: TNotifyEvent); 1426begin 1427 FTextSizeChangeList.Remove(TMethod(AHandler)); 1428end; 1429 1430procedure TLazSynTextArea.DoPaint(ACanvas: TCanvas; AClip: TRect); 1431var 1432 PadRect, PadRect2: TRect; 1433 ScreenRow1, ScreenRow2, TextColumn1, TextColumn2: integer; 1434 dc: HDC; 1435begin 1436 1437 // paint padding 1438 FCanvas := ACanvas; 1439 dc := ACanvas.Handle; 1440 SetBkColor(dc, ColorToRGB(BackgroundColor)); 1441 1442 if (AClip.Top < FTextBounds.Top) then begin 1443 PadRect2 := Bounds; 1444 PadRect2.Bottom := FTextBounds.Top; 1445 IntersectRect(PadRect{%H-}, AClip, PadRect2); 1446 InternalFillRect(dc, PadRect); 1447 end; 1448 if (AClip.Bottom > FTextBounds.Bottom) then begin 1449 PadRect2 := Bounds; 1450 PadRect2.Top := FTextBounds.Bottom; 1451 IntersectRect(PadRect, AClip, PadRect2); 1452 InternalFillRect(dc, PadRect); 1453 end; 1454 if (AClip.Left < FTextBounds.Left) then begin 1455 PadRect2 := Bounds; 1456 PadRect2.Right := FTextBounds.Left; 1457 IntersectRect(PadRect, AClip, PadRect2); 1458 InternalFillRect(dc, PadRect); 1459 end; 1460 if (AClip.Right > FTextBounds.Right) then begin 1461 PadRect2 := Bounds; 1462 PadRect2.Left := FTextBounds.Right; 1463 IntersectRect(PadRect, AClip, PadRect2); 1464 InternalFillRect(dc, PadRect); 1465 end; 1466 1467 if (AClip.Left >= FTextBounds.Right) or 1468 (AClip.Right <= FTextBounds.Left) or 1469 (AClip.Top >= FTextBounds.Bottom) or 1470 (AClip.Bottom <= FTextBounds.Top) 1471 then 1472 exit; 1473 1474 TextColumn1 := LeftChar; 1475 if (AClip.Left > FTextBounds.Left) then 1476 Inc(TextColumn1, (AClip.Left - FTextBounds.Left) div CharWidth); 1477 TextColumn2 := LeftChar + 1478 ( Min(AClip.Right, FTextBounds.Right) - FTextBounds.Left + CharWidth - 1) div CharWidth; 1479 // lines 1480 ScreenRow1 := Max((AClip.Top - FTextBounds.Top) div fTextHeight, 0); 1481 ScreenRow2 := Min((AClip.Bottom-1 - FTextBounds.Top) div fTextHeight, LinesInWindow + 1); 1482 1483 AClip.Left := Max(AClip.Left, FTextBounds.Left); // Todo: This is also checked in paintLines (together with right side) 1484 AClip.Right := Min(AClip.Right, FTextBounds.Right); 1485 //AClip.Top := Max(AClip.Top, FTextBounds.Top); 1486 //AClip.Bottom := Min(AClip.Bottom, FTextBounds.Bottom); 1487 1488 SetBkMode(dc, TRANSPARENT); 1489 PaintTextLines(AClip, ScreenRow1, ScreenRow2, TextColumn1, TextColumn2); 1490 1491 FCanvas := nil; 1492end; 1493 1494procedure TLazSynTextArea.PaintTextLines(AClip: TRect; FirstLine, LastLine, 1495 FirstCol, LastCol: integer); 1496// FirstLine, LastLine are based 0 1497// FirstCol, LastCol are screen based 1 without scrolling (physical position). 1498// i.e. the real screen position is fTextOffset+Pred(FirstCol)*CharWidth 1499var 1500 bDoRightEdge: boolean; // right edge 1501 nRightEdge: integer; 1502 colEditorBG: TColor; 1503 // painting the background and the text 1504 rcLine, rcToken: TRect; 1505 EraseLeft, DrawLeft: Integer; // LeftSide for EraseBackground, Text 1506 CurLine: integer; // Screen-line index for the loop 1507 CurTextIndex: Integer; // Current Index in text 1508 dc: HDC; 1509 CharWidths: TPhysicalCharWidths; 1510 1511 var 1512 LineBuffer: PChar; 1513 LineBufferLen: Integer; 1514 LineBufferRtlLogPos: Integer; 1515 1516 procedure DrawHiLightMarkupToken(ATokenInfo: TLazSynDisplayTokenInfoEx); 1517 var 1518 HasFrame: Boolean; 1519 s: TLazSynBorderSide; 1520 Attr: TSynSelectedColorMergeResult; 1521 TxtFlags: Integer; 1522 tok: TRect; 1523 c, i, j, k, e, Len, CWLen: Integer; 1524 pl, pt: PChar; 1525 TxtLeft: Integer; 1526 NeedExpansion, NeedTransform: Boolean; 1527 begin 1528 Attr := ATokenInfo.Attr; 1529 FTextDrawer.SetForeColor(Attr.Foreground); 1530 FTextDrawer.SetBackColor(Attr.Background); 1531 FTextDrawer.SetStyle (Attr.Style); 1532 HasFrame := False; 1533 for s := low(TLazSynBorderSide) to high(TLazSynBorderSide) do begin 1534 HasFrame := HasFrame or (Attr.FrameSideColors[s] <> clNone); 1535 FTextDrawer.FrameColor[s] := Attr.FrameSideColors[s]; 1536 FTextDrawer.FrameStyle[s] := Attr.FrameSideStyles[s]; 1537 end; 1538 1539 rcToken.Right := ScreenColumnToXValue(ATokenInfo.PhysicalClipEnd); 1540 if rcToken.Right > AClip.Right then begin 1541 rcToken.Right := AClip.Right; 1542 FTextDrawer.FrameColor[bsRight] := clNone; // right side of char is not painted 1543 end; 1544 1545 //if (rcToken.Right <= rcToken.Left) then exit; 1546 rcToken.Left := ScreenColumnToXValue(ATokenInfo.PhysicalClipStart); // because for the first token, this can be middle of a char, and lead to wrong frame 1547 1548 (* rcToken.Bottom may be less that crLine.Bottom. If a Divider was drawn, then RcToken will not contain it *) 1549 TxtFlags := ETO_OPAQUE; 1550 1551 (* If token includes RightEdge, draw background, and edge first *) 1552 if bDoRightEdge and (nRightEdge<rcToken.Right) and (nRightEdge>=rcToken.Left) 1553 then begin 1554 TxtFlags := 0; 1555 if rcToken.Left < nRightEdge then begin 1556 // draw background left of edge (use rcToken, so we do not delete the divider-draw-line) 1557 tok := rcToken; 1558 tok.Right := nRightEdge; 1559 FTextDrawer.FillRect(tok); 1560 end; 1561 if rcToken.Right > nRightEdge then begin 1562 // draw background right of edge (use rcLine, full height) 1563 tok := rcToken; 1564 tok.Left := nRightEdge; 1565 tok.Bottom := rcLine.Bottom; 1566 FTextDrawer.FillRect(tok); 1567 end; 1568 // draw edge (use rcLine / rcToken may be reduced) 1569 LCLIntf.MoveToEx(dc, nRightEdge, rcLine.Top, nil); 1570 LCLIntf.LineTo (dc, nRightEdge, rcLine.Bottom + 1); 1571 end 1572 else 1573 if HasFrame then begin 1574 (* Draw background for frame *) 1575 TxtFlags := 0; 1576 tok := rcToken; 1577 if rcToken.Right > nRightEdge + 1 then 1578 tok.Bottom := rcLine.Bottom; 1579 FTextDrawer.FillRect(tok); 1580 end; 1581 1582 if HasFrame then begin 1583 // draw frame 1584 tok := rcToken; 1585 if rcToken.Right > nRightEdge + 1 then 1586 tok.Bottom := rcLine.Bottom; 1587 FTextDrawer.DrawFrame(tok); 1588 end; 1589 1590 if ATokenInfo.RtlInfo.IsRtl then begin 1591 // Always draw the entire RTL run, to keep weak chars in context. 1592 // Alternatively, could use ETO_RTLREADING 1593 j := (ATokenInfo.StartPos.Logical - ATokenInfo.RtlInfo.LogFirst); // bytes in rtl-run, before TokenStart 1594 i := (ATokenInfo.RtlInfo.LogLast - ATokenInfo.EndPos.Logical); // bytes in rtl-run, after TokenEnd 1595 ATokenInfo.Tk.TokenStart := ATokenInfo.Tk.TokenStart - j; 1596 ATokenInfo.Tk.TokenLength := ATokenInfo.Tk.TokenLength + j + i; 1597 1598 j := (ATokenInfo.EndPos.Physical - ATokenInfo.RtlInfo.PhysLeft); 1599 i := (ATokenInfo.RtlInfo.PhysRight - ATokenInfo.StartPos.Physical); 1600 ATokenInfo.PhysicalCharStart := ATokenInfo.PhysicalCharStart - j; 1601 ATokenInfo.PhysicalCharEnd := ATokenInfo.PhysicalCharEnd + i; 1602 1603 ATokenInfo.StartPos.Logical := ATokenInfo.RtlInfo.LogFirst; 1604 ATokenInfo.ExpandedExtraBytes := ATokenInfo.RtlExpandedExtraBytes; 1605 ATokenInfo.HasTabs := ATokenInfo.RtlHasTabs; 1606 ATokenInfo.HasDoubleWidth := ATokenInfo.RtlHasDoubleWidth; 1607 end; 1608 1609 NeedExpansion := (ATokenInfo.ExpandedExtraBytes > 0) or (ATokenInfo.HasTabs); 1610 NeedTransform := FTextDrawer.NeedsEto or ATokenInfo.HasDoubleWidth or NeedExpansion 1611 {$IFDEF Windows} or ATokenInfo.RtlInfo.IsRtl {$ENDIF} 1612 ; 1613 Len := ATokenInfo.Tk.TokenLength; 1614 if (not ATokenInfo.RtlInfo.IsRtl) or (LineBufferRtlLogPos <> ATokenInfo.RtlInfo.LogFirst) then 1615 FEtoBuf := nil; 1616 1617 If NeedTransform and ATokenInfo.RtlInfo.IsRtl and (LineBufferRtlLogPos = ATokenInfo.RtlInfo.LogFirst) 1618 then begin 1619 // allready done 1620 if NeedExpansion then begin 1621 ATokenInfo.Tk.TokenStart := LineBuffer; 1622 ATokenInfo.Tk.TokenLength := Len + ATokenInfo.ExpandedExtraBytes; 1623 end; 1624 end 1625 else 1626 If NeedTransform then begin 1627 LineBufferRtlLogPos := ATokenInfo.RtlInfo.LogFirst; 1628 pt := ATokenInfo.Tk.TokenStart; 1629 // prepare LineBuffer 1630 if NeedExpansion then begin 1631 if (LineBufferLen < Len + ATokenInfo.ExpandedExtraBytes + 1) then begin 1632 LineBufferLen := Len + ATokenInfo.ExpandedExtraBytes + 1 + 128; 1633 ReAllocMem(LineBuffer, LineBufferLen); 1634 end; 1635 pl := LineBuffer; 1636 end; 1637 1638 // Prepare FETOBuf 1639 if FTextDrawer.NeedsEto or ATokenInfo.HasDoubleWidth 1640 {$IFDEF Windows} or ATokenInfo.RtlInfo.IsRtl {$ENDIF} // RTL may have script with ligature 1641 then begin 1642 FEtoBuf := FTextDrawer.Eto; 1643 FEtoBuf.SetMinLength(Len + ATokenInfo.ExpandedExtraBytes + 1); 1644 c := FTextDrawer.GetCharWidth; 1645 end 1646 else 1647 c := 0; 1648 e := 0; 1649 1650 CWLen := Length(CharWidths); 1651 1652 // Copy to LineBuffer (and maybe FetoBuf 1653 if NeedExpansion then begin 1654 j := ATokenInfo.StartPos.Logical - 1; 1655 for i := 0 to Len - 1 do begin 1656 if j < CWLen 1657 then k := (CharWidths[j] and PCWMask) 1658 else k := 1; 1659 // combining chars will get 0 widths 1660 if (pt^ in [#0..#127, #192..#255]) and (FetoBuf <> nil) then begin 1661 FEtoBuf.EtoData[e] := k * c; 1662 inc(e); 1663 end; 1664 1665 case pt^ of 1666 #9: begin 1667 dec(e); 1668 if (vscTabAtFirst in FVisibleSpecialChars) and (j < CWLen) then begin 1669 pl^ := #194; inc(pl); 1670 pl^ := #187; inc(pl); 1671 dec(k); 1672 if FetoBuf <> nil then FEtoBuf.EtoData[e] := c; 1673 inc(e); 1674 end; 1675 while k > 0 do begin 1676 pl^ := ' '; inc(pl); 1677 dec(k); 1678 if FetoBuf <> nil then FEtoBuf.EtoData[e] := c; 1679 inc(e); 1680 end; 1681 if (vscTabAtLast in FVisibleSpecialChars) and ((pl-1)^=' ') and (j < CWLen) then begin 1682 (pl-1)^ := #194; 1683 pl^ := #187; inc(pl); 1684 if FetoBuf <> nil then FEtoBuf.EtoData[e] := c; 1685 inc(e); 1686 end; 1687 end; 1688 ' ': begin 1689 if (vscSpace in FVisibleSpecialChars) and (j < CWLen) then begin 1690 pl^ := #194; inc(pl); 1691 pl^ := #183; inc(pl); 1692 end 1693 else begin 1694 pl^ := pt^; 1695 inc(pl); 1696 end; 1697 end; 1698 else begin 1699 pl^ := pt^; 1700 inc(pl); 1701 end; 1702 end; 1703 inc(pt); 1704 inc(j); 1705 end; 1706 pl^ := #0; 1707 1708 // Finish linebuffer 1709 ATokenInfo.Tk.TokenStart := LineBuffer; 1710 ATokenInfo.Tk.TokenLength := Len + ATokenInfo.ExpandedExtraBytes; 1711 // TODO skip expanded half tab 1712 1713 end 1714 else 1715 // FETOBuf only 1716 begin 1717 for j := ATokenInfo.StartPos.Logical - 1 to ATokenInfo.StartPos.Logical - 1 + Len do begin 1718 if pt^ in [#0..#127, #192..#255] then begin 1719 // combining chars will get 0 widths 1720 if j < CWLen 1721 then k := (CharWidths[j] and PCWMask) 1722 else k := 1; 1723 FEtoBuf.EtoData[e] := k * c; 1724 inc(e); 1725 end; 1726 inc(pt); 1727 end; 1728 end; 1729 end; 1730 1731 if (ATokenInfo.PhysicalCharStart <> ATokenInfo.PhysicalClipStart) or 1732 (ATokenInfo.PhysicalCharEnd <> ATokenInfo.PhysicalClipEnd) 1733 then 1734 TxtFlags := TxtFlags + ETO_CLIPPED; 1735 1736 tok := rcToken; 1737 if rcToken.Right > nRightEdge + 1 then 1738 tok.Bottom := rcLine.Bottom; 1739 TxtLeft := ScreenColumnToXValue(ATokenInfo.PhysicalCharStart); // because for the first token, this can be middle of a char, and lead to wrong frame 1740 fTextDrawer.NewTextOut(TxtLeft, rcToken.Top, TxtFlags, tok, 1741 ATokenInfo.Tk.TokenStart, ATokenInfo.Tk.TokenLength, FEtoBuf); 1742 1743 1744 rcToken.Left := rcToken.Right; 1745 end; 1746 1747 procedure PaintLines; 1748 var 1749 ypos: Integer; 1750 DividerInfo: TSynDividerDrawConfigSetting; 1751 TV, cl: Integer; 1752 TokenInfoEx: TLazSynDisplayTokenInfoEx; 1753 MaxLine: Integer; 1754 begin 1755 // Initialize rcLine for drawing. Note that Top and Bottom are updated 1756 // inside the loop. Get only the starting point for this. 1757 rcLine := AClip; 1758 rcLine.Bottom := TextBounds.Top + FirstLine * fTextHeight; 1759 1760 TV := TopLine - 1; 1761 1762 // Now loop through all the lines. The indices are valid for Lines. 1763 MaxLine := DisplayView.GetLinesCount-1; 1764 1765 CurLine := FirstLine-1; 1766 while CurLine<LastLine do begin 1767 inc(CurLine); 1768 if TV + CurLine > MaxLine then break; 1769 // Update the rcLine rect to this line. 1770 rcLine.Top := rcLine.Bottom; 1771 Inc(rcLine.Bottom, fTextHeight); 1772 // Paint the lines depending on the assigned highlighter. 1773 rcToken := rcLine; 1774 // Delete the whole Line 1775 fTextDrawer.BackColor := colEditorBG; 1776 SetBkColor(dc, ColorToRGB(colEditorBG)); 1777 rcLine.Left := EraseLeft; 1778 InternalFillRect(dc, rcLine); 1779 rcLine.Left := DrawLeft; 1780 LineBufferRtlLogPos := -1; 1781 1782 FTokenBreaker.SetHighlighterTokensLine(TV + CurLine, CurTextIndex); 1783 CharWidths := FTokenBreaker.CharWidths; 1784 fMarkupManager.PrepareMarkupForRow(CurTextIndex+1); 1785 1786 DividerInfo := DisplayView.GetDrawDividerInfo; // May call HL.SetRange 1787 if (DividerInfo.Color <> clNone) and (nRightEdge >= FTextBounds.Left) then 1788 begin 1789 ypos := rcToken.Bottom - 1; 1790 cl := DividerInfo.Color; 1791 if cl = clDefault then 1792 cl := RightEdgeColor; 1793 fTextDrawer.DrawLine(nRightEdge, ypos, FTextBounds.Left - 1, ypos, cl); 1794 dec(rcToken.Bottom); 1795 end; 1796 1797 while FTokenBreaker.GetNextHighlighterTokenEx(TokenInfoEx) do begin 1798 DrawHiLightMarkupToken(TokenInfoEx); 1799 end; 1800 1801 fMarkupManager.FinishMarkupForRow(CurTextIndex+1); 1802 end; 1803 CurLine := -1; 1804 AClip.Top := rcLine.Bottom; 1805 end; 1806 1807{ end local procedures } 1808 1809begin 1810 fMarkupManager.BeginMarkup; 1811 FTokenBreaker.Prepare(DisplayView, FTheLinesView, FMarkupManager, FirstCol, LastCol); 1812 FTokenBreaker.ForegroundColor := ForegroundColor; 1813 FTokenBreaker.BackgroundColor := BackgroundColor; 1814 FTokenBreaker.SpaceExtraByteCount := 0; 1815 FTokenBreaker.TabExtraByteCount := 0; 1816 if (vscSpace in FVisibleSpecialChars) then 1817 FTokenBreaker.SpaceExtraByteCount := 1; 1818 if (vscTabAtFirst in FVisibleSpecialChars) then 1819 FTokenBreaker.TabExtraByteCount := FTokenBreaker.TabExtraByteCount + 1; 1820 if (vscTabAtLast in FVisibleSpecialChars) then 1821 FTokenBreaker.TabExtraByteCount := FTokenBreaker.TabExtraByteCount + 1; 1822 //if (AClip.Right < TextLeftPixelOffset(False)) then exit; 1823 //if (AClip.Left > ClientWidth - TextRightPixelOffset) then exit; 1824 1825 //DebugLn(['TCustomSynEdit.PaintTextLines ',dbgs(AClip)]); 1826 CurLine:=-1; 1827 //DebugLn('TCustomSynEdit.PaintTextLines ',DbgSName(Self),' TopLine=',dbgs(TopLine),' AClip=',dbgs(AClip)); 1828 colEditorBG := BackgroundColor; 1829 // If the right edge is visible and in the invalid area, prepare to paint it. 1830 // Do this first to realize the pen when getting the dc variable. 1831 bDoRightEdge := False; 1832 if FRightEdgeVisible then begin // column value 1833 nRightEdge := FTextBounds.Left + (RightEdgeColumn - LeftChar + 1) * CharWidth; // pixel value 1834 if (nRightEdge >= AClip.Left) and (nRightEdge <= AClip.Right) then 1835 bDoRightEdge := True; 1836 if nRightEdge > AClip.Right then 1837 nRightEdge := AClip.Right; // for divider draw lines (don't draw into right gutter) 1838 end 1839 else 1840 nRightEdge := AClip.Right; 1841 1842 Canvas.Pen.Color := RightEdgeColor; // used for code folding too 1843 Canvas.Pen.Width := 1; 1844 // Do everything else with API calls. This (maybe) realizes the new pen color. 1845 dc := Canvas.Handle; 1846 SetBkMode(dc, TRANSPARENT); 1847 1848 // Adjust the invalid area to not include the gutter (nor the 2 ixel offset to the guttter). 1849 EraseLeft := AClip.Left; 1850 if (AClip.Left < FTextBounds.Left) then 1851 AClip.Left := FTextBounds.Left ; 1852 DrawLeft := AClip.Left; 1853 1854 if (LastLine >= FirstLine) then begin 1855 // Paint the visible text lines. To make this easier, compute first the 1856 // necessary information about the selected area: is there any visible 1857 // selected area, and what are its lines / columns? 1858 // Moved to two local procedures to make it easier to read. 1859 1860 LineBufferLen := 0; 1861 LineBuffer := nil; 1862 if Assigned(fHighlighter) then begin 1863 fHighlighter.CurrentLines := FTheLinesView; 1864 end; 1865 1866 DisplayView.InitHighlighterTokens(FHighlighter); 1867 fTextDrawer.Style := []; //Font.Style; 1868 fTextDrawer.BeginDrawing(dc); 1869 try 1870 PaintLines; 1871 finally 1872 fTextDrawer.EndDrawing; 1873 DisplayView.FinishHighlighterTokens; 1874 ReAllocMem(LineBuffer, 0); 1875 end; 1876 end; 1877 1878 if (AClip.Top < AClip.Bottom) then begin 1879 // Delete the remaining area 1880 SetBkColor(dc, ColorToRGB(colEditorBG)); 1881 AClip.Left := EraseLeft; 1882 InternalFillRect(dc, AClip); 1883 AClip.Left := DrawLeft; 1884 1885 // Draw the right edge if necessary. 1886 if bDoRightEdge then begin 1887 LCLIntf.MoveToEx(dc, nRightEdge, AClip.Top, nil); 1888 LCLIntf.LineTo(dc, nRightEdge, AClip.Bottom + 1); 1889 end; 1890 end; 1891 1892 fMarkupManager.EndMarkup; 1893end; 1894 1895end. 1896 1897