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