Added a new OnDrawTextEx event, updated DoTextDrawing and new tests f…

Source/VirtualTrees.pas

@@ -212,6 +212,9 @@   TCustomVirtualStringTree = class;
     Column: TColumnIndex; const Text: string; var Extent: TDimension) of object;
   TVTDrawTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
     Column: TColumnIndex; const Text: string; const CellRect: TRect; var DefaultDraw: Boolean) of object;
+  TVTDrawTextExEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
+    Column: TColumnIndex; const Text: string; const CellRect: TRect;
+    var DefaultDraw: Boolean; var DrawFormat: Cardinal) of object;
 
   /// Event arguments of the OnGetCellText event
   TVSTGetCellTextEventArgs = record
@@ -242,6 +245,7 @@   TCustomVirtualStringTree = class(TVTAncestor)
     FOnMeasureTextWidth: TVTMeasureTextEvent;      // used to adjust the width of the cells
     FOnMeasureTextHeight: TVTMeasureTextEvent;
     FOnDrawText: TVTDrawTextEvent;                 // used to custom draw the node text
+    FOnDrawTextEx: TVTDrawTextExEvent;             // a more advanced version, with all parameters
     /// Returns True if the property DefaultText has a value that differs from the default value, False otherwise.
     function IsDefaultTextStored(): Boolean;
     function GetImageText(Node: PVirtualNode; Kind: TVTImageKind;
@@ -308,6 +312,7 @@   TCustomVirtualStringTree = class(TVTAncestor)
     property OnMeasureTextWidth: TVTMeasureTextEvent read FOnMeasureTextWidth write FOnMeasureTextWidth;
     property OnMeasureTextHeight: TVTMeasureTextEvent read FOnMeasureTextHeight write FOnMeasureTextHeight;
     property OnDrawText: TVTDrawTextEvent read FOnDrawText write FOnDrawText;
+    property OnDrawTextEx: TVTDrawTextExEvent read FOnDrawTextEx write FOnDrawTextEx;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy(); override;
@@ -490,6 +495,7 @@   TVirtualStringTree = class(TCustomVirtualStringTree)
     property OnDragDrop;
     property OnDrawHint;
     property OnDrawText;
+    property OnDrawTextEx;
     property OnEditCancelled;
     property OnEdited;
     property OnEditing;
@@ -1420,12 +1426,14 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co
   lText: string;
 begin
   DefaultDraw := True;
-  if Assigned(FOnDrawText) then
+  if not Assigned(FOnDrawTextEx) and Assigned(FOnDrawText) then
     FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw);
   if ((DrawFormat and DT_RIGHT) > 0) and (TFontStyle.fsItalic in PaintInfo.Canvas.Font.Style) then
     lText := Text + ' '
   else
     lText := Text;
+  if Assigned(FOnDrawTextEx) then
+    FOnDrawTextEx(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, lText, CellRect, DefaultDraw, DrawFormat);
   if DefaultDraw then
     Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(lText), Length(lText), CellRect, DrawFormat);
 end;

Tests/Tests.dpr

@@ -14,7 +14,8 @@ uses
   VirtualTreeTests in 'VirtualTreeTests.pas',
   VirtualStringTreeTests in 'VirtualStringTreeTests.pas',
   VTWorkerThreadIssue1001Tests in 'VTWorkerThreadIssue1001Tests.pas',
-  VTOnEditCancelledTests in 'VTOnEditCancelledTests.pas';
+  VTOnEditCancelledTests in 'VTOnEditCancelledTests.pas',
+  VTOnDrawTextTests in 'VTOnDrawTextTests.pas';
 
 var
   runner : ITestRunner;

Tests/Tests.dproj

@@ -102,6 +102,7 @@
         <DCCReference Include="VirtualStringTreeTests.pas"/>
         <DCCReference Include="VTWorkerThreadIssue1001Tests.pas"/>
         <DCCReference Include="VTOnEditCancelledTests.pas"/>
+        <DCCReference Include="VTOnDrawTextTests.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

Tests/VTOnDrawTextTests.pas

@@ -0,0 +1,179 @@
+unit VTOnDrawTextTests;
+
+interface
+
+uses
+  DUnitX.TestFramework,
+  Vcl.Forms,
+  VirtualTrees, System.Types;
+
+type
+
+  [TestFixture]
+  TVTOnDrawTextTests = class
+  strict private
+    fTree: TVirtualStringTree;
+    fForm: TForm;
+
+    FDrawText1Called: Boolean;
+    FDrawTextEx1Called: Boolean;
+
+    FDrawText2Called: Boolean;
+    FDrawTextEx2Called: Boolean;
+
+    FDrawText3Called: Boolean;
+    FDrawTextEx3Called: Boolean;
+
+    procedure DrawText1Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; const Text: string;
+      const CellRect: TRect; var DefaultDraw: Boolean);
+
+    procedure DrawTextEx2Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; const Text: string;
+      const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal);
+
+    procedure DrawText3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; const Text: string;
+      const CellRect: TRect; var DefaultDraw: Boolean);
+    procedure DrawTextEx3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
+      Node: PVirtualNode; Column: TColumnIndex; const Text: string;
+      const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal);
+
+    procedure GetTextEvent(Sender: TBaseVirtualTree; Node: PVirtualNode;
+      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
+  public
+    [Setup]
+    procedure Setup;
+    [TearDown]
+    procedure TearDown;
+
+    [Test]
+    procedure TestOnDrawText;
+
+    [Test]
+    procedure TestOnDrawTextOnDrawTextEx;
+
+    [Test]
+    procedure TestOnDrawTextEx;
+  end;
+
+implementation
+
+uses
+  System.SysUtils, VirtualTrees.Types;
+
+const
+  colCaption = 0;
+  colData    = 1;
+
+procedure TVTOnDrawTextTests.DrawText1Event(Sender: TBaseVirtualTree;
+  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+  const Text: string; const CellRect: TRect; var DefaultDraw: Boolean);
+begin
+  FDrawText1Called := True;
+end;
+
+procedure TVTOnDrawTextTests.DrawText3Event(Sender: TBaseVirtualTree;
+  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+  const Text: string; const CellRect: TRect; var DefaultDraw: Boolean);
+begin
+  FDrawText3Called := True;
+end;
+
+procedure TVTOnDrawTextTests.DrawTextEx2Event(Sender: TBaseVirtualTree;
+  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+  const Text: string; const CellRect: TRect; var DefaultDraw: Boolean;
+  var DrawFormat: Cardinal);
+begin
+  FDrawTextEx2Called := True;
+end;
+
+procedure TVTOnDrawTextTests.DrawTextEx3Event(Sender: TBaseVirtualTree;
+  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+  const Text: string; const CellRect: TRect; var DefaultDraw: Boolean;
+  var DrawFormat: Cardinal);
+begin
+  FDrawTextEx3Called := True;
+end;
+
+procedure TVTOnDrawTextTests.GetTextEvent(Sender: TBaseVirtualTree;
+  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+  var CellText: string);
+begin
+  case Column of
+    colCaption: begin
+      CellText := 'Caption';
+    end;
+    colData: begin
+      CellText := 'Data';
+    end;
+  end;
+end;
+
+procedure TVTOnDrawTextTests.Setup;
+begin
+  FDrawText1Called := False;
+  FDrawTextEx1Called := False;
+
+  FDrawText2Called := False;
+  FDrawTextEx2Called := False;
+
+  FDrawText3Called := False;
+  FDrawTextEx3Called := False;
+
+  fForm := TForm.Create(nil);
+  fTree := TVirtualStringTree.Create(fForm);
+  fForm.InsertControl(fTree);
+
+  fTree.OnGetText := GetTextEvent;
+
+  var LCol1 := fTree.Header.Columns.Add;
+  var LCol2 := fTree.Header.Columns.Add;
+  LCol1.Text := 'Caption';
+  LCol2.Text := 'Data';
+
+  fTree.AddChild(fTree.RootNode);
+  fTree.AddChild(fTree.RootNode);
+  fForm.Show;
+end;
+
+procedure TVTOnDrawTextTests.TearDown;
+begin
+  FreeAndNil(fForm);
+end;
+
+procedure TVTOnDrawTextTests.TestOnDrawText;
+begin
+  // This test ensures that OnDrawText event is called when OnDrawText is assigned
+  fTree.OnDrawText := DrawText1Event;
+  fTree.OnDrawTextEx := nil;
+  fTree.Update;
+
+  Assert.IsTrue(FDrawText1Called and not FDrawTextEx1Called);
+end;
+
+procedure TVTOnDrawTextTests.TestOnDrawTextEx;
+begin
+  // This test ensures that OnDrawTextEx event is called when OnDrawTextEx is assigned
+  // and that OnDrawText is not called
+  fTree.OnDrawText := nil;
+  fTree.OnDrawTextEx := DrawTextEx2Event;
+  fTree.Update;
+
+  Assert.IsTrue(not FDrawText2Called and FDrawTextEx2Called);
+end;
+
+procedure TVTOnDrawTextTests.TestOnDrawTextOnDrawTextEx;
+begin
+  // This test ensures that only the OnDrawTextEx event is called when both
+  // OnDrawText and OnDrawTextEx are assigned and that OnDrawText is not called
+  fTree.OnDrawText := DrawText3Event;
+  fTree.OnDrawTextEx := DrawTextEx3Event;
+  fTree.Update;
+
+  Assert.IsTrue(not FDrawText3Called and FDrawTextEx3Called);
+end;
+
+initialization
+  TDUnitX.RegisterTestFixture(TVTOnDrawTextTests);
+end.