Skip to content

Commit d17de7b

Browse files
joachimmarderjoachimmarder
authored
Merge pull request #1331 from chuacw/OnDrawTextEx
Added a new OnDrawTextEx event, updated DoTextDrawing and new tests f…
2 parents a9b7e53 + 641e0d1 commit d17de7b

4 files changed

Lines changed: 191 additions & 2 deletions

File tree

‎Source/VirtualTrees.pas‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -212,6 +212,9 @@ TCustomVirtualStringTree = class;
212212
Column: TColumnIndex; const Text: string; var Extent: TDimension) of object;
213213
TVTDrawTextEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
214214
Column: TColumnIndex; const Text: string; const CellRect: TRect; var DefaultDraw: Boolean) of object;
215+
TVTDrawTextExEvent = procedure(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
216+
Column: TColumnIndex; const Text: string; const CellRect: TRect;
217+
var DefaultDraw: Boolean; var DrawFormat: Cardinal) of object;
215218

216219
/// Event arguments of the OnGetCellText event
217220
TVSTGetCellTextEventArgs = record
@@ -242,6 +245,7 @@ TCustomVirtualStringTree = class(TVTAncestor)
242245
FOnMeasureTextWidth: TVTMeasureTextEvent; // used to adjust the width of the cells
243246
FOnMeasureTextHeight: TVTMeasureTextEvent;
244247
FOnDrawText: TVTDrawTextEvent; // used to custom draw the node text
248+
FOnDrawTextEx: TVTDrawTextExEvent; // a more advanced version, with all parameters
245249
/// Returns True if the property DefaultText has a value that differs from the default value, False otherwise.
246250
function IsDefaultTextStored(): Boolean;
247251
function GetImageText(Node: PVirtualNode; Kind: TVTImageKind;
@@ -308,6 +312,7 @@ TCustomVirtualStringTree = class(TVTAncestor)
308312
property OnMeasureTextWidth: TVTMeasureTextEvent read FOnMeasureTextWidth write FOnMeasureTextWidth;
309313
property OnMeasureTextHeight: TVTMeasureTextEvent read FOnMeasureTextHeight write FOnMeasureTextHeight;
310314
property OnDrawText: TVTDrawTextEvent read FOnDrawText write FOnDrawText;
315+
property OnDrawTextEx: TVTDrawTextExEvent read FOnDrawTextEx write FOnDrawTextEx;
311316
public
312317
constructor Create(AOwner: TComponent); override;
313318
destructor Destroy(); override;
@@ -490,6 +495,7 @@ TVirtualStringTree = class(TCustomVirtualStringTree)
490495
property OnDragDrop;
491496
property OnDrawHint;
492497
property OnDrawText;
498+
property OnDrawTextEx;
493499
property OnEditCancelled;
494500
property OnEdited;
495501
property OnEditing;
@@ -1420,12 +1426,14 @@ procedure TCustomVirtualStringTree.DoTextDrawing(var PaintInfo: TVTPaintInfo; co
14201426
lText: string;
14211427
begin
14221428
DefaultDraw := True;
1423-
if Assigned(FOnDrawText) then
1429+
if not Assigned(FOnDrawTextEx) and Assigned(FOnDrawText) then
14241430
FOnDrawText(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, Text, CellRect, DefaultDraw);
14251431
if ((DrawFormat and DT_RIGHT) > 0) and (TFontStyle.fsItalic in PaintInfo.Canvas.Font.Style) then
14261432
lText := Text + ' '
14271433
else
14281434
lText := Text;
1435+
if Assigned(FOnDrawTextEx) then
1436+
FOnDrawTextEx(Self, PaintInfo.Canvas, PaintInfo.Node, PaintInfo.Column, lText, CellRect, DefaultDraw, DrawFormat);
14291437
if DefaultDraw then
14301438
Winapi.Windows.DrawTextW(PaintInfo.Canvas.Handle, PWideChar(lText), Length(lText), CellRect, DrawFormat);
14311439
end;

‎Tests/Tests.dpr‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,8 @@ uses
1414
VirtualTreeTests in 'VirtualTreeTests.pas',
1515
VirtualStringTreeTests in 'VirtualStringTreeTests.pas',
1616
VTWorkerThreadIssue1001Tests in 'VTWorkerThreadIssue1001Tests.pas',
17-
VTOnEditCancelledTests in 'VTOnEditCancelledTests.pas';
17+
VTOnEditCancelledTests in 'VTOnEditCancelledTests.pas',
18+
VTOnDrawTextTests in 'VTOnDrawTextTests.pas';
1819

1920
var
2021
runner : ITestRunner;

‎Tests/Tests.dproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,7 @@
102102
<DCCReference Include="VirtualStringTreeTests.pas"/>
103103
<DCCReference Include="VTWorkerThreadIssue1001Tests.pas"/>
104104
<DCCReference Include="VTOnEditCancelledTests.pas"/>
105+
<DCCReference Include="VTOnDrawTextTests.pas"/>
105106
<BuildConfiguration Include="Base">
106107
<Key>Base</Key>
107108
</BuildConfiguration>

‎Tests/VTOnDrawTextTests.pas‎

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
unit VTOnDrawTextTests;
2+
3+
interface
4+
5+
uses
6+
DUnitX.TestFramework,
7+
Vcl.Forms,
8+
VirtualTrees, System.Types;
9+
10+
type
11+
12+
[TestFixture]
13+
TVTOnDrawTextTests = class
14+
strict private
15+
fTree: TVirtualStringTree;
16+
fForm: TForm;
17+
18+
FDrawText1Called: Boolean;
19+
FDrawTextEx1Called: Boolean;
20+
21+
FDrawText2Called: Boolean;
22+
FDrawTextEx2Called: Boolean;
23+
24+
FDrawText3Called: Boolean;
25+
FDrawTextEx3Called: Boolean;
26+
27+
procedure DrawText1Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
28+
Node: PVirtualNode; Column: TColumnIndex; const Text: string;
29+
const CellRect: TRect; var DefaultDraw: Boolean);
30+
31+
procedure DrawTextEx2Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
32+
Node: PVirtualNode; Column: TColumnIndex; const Text: string;
33+
const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal);
34+
35+
procedure DrawText3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
36+
Node: PVirtualNode; Column: TColumnIndex; const Text: string;
37+
const CellRect: TRect; var DefaultDraw: Boolean);
38+
procedure DrawTextEx3Event(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
39+
Node: PVirtualNode; Column: TColumnIndex; const Text: string;
40+
const CellRect: TRect; var DefaultDraw: Boolean; var DrawFormat: Cardinal);
41+
42+
procedure GetTextEvent(Sender: TBaseVirtualTree; Node: PVirtualNode;
43+
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
44+
public
45+
[Setup]
46+
procedure Setup;
47+
[TearDown]
48+
procedure TearDown;
49+
50+
[Test]
51+
procedure TestOnDrawText;
52+
53+
[Test]
54+
procedure TestOnDrawTextOnDrawTextEx;
55+
56+
[Test]
57+
procedure TestOnDrawTextEx;
58+
end;
59+
60+
implementation
61+
62+
uses
63+
System.SysUtils, VirtualTrees.Types;
64+
65+
const
66+
colCaption = 0;
67+
colData = 1;
68+
69+
procedure TVTOnDrawTextTests.DrawText1Event(Sender: TBaseVirtualTree;
70+
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
71+
const Text: string; const CellRect: TRect; var DefaultDraw: Boolean);
72+
begin
73+
FDrawText1Called := True;
74+
end;
75+
76+
procedure TVTOnDrawTextTests.DrawText3Event(Sender: TBaseVirtualTree;
77+
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
78+
const Text: string; const CellRect: TRect; var DefaultDraw: Boolean);
79+
begin
80+
FDrawText3Called := True;
81+
end;
82+
83+
procedure TVTOnDrawTextTests.DrawTextEx2Event(Sender: TBaseVirtualTree;
84+
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
85+
const Text: string; const CellRect: TRect; var DefaultDraw: Boolean;
86+
var DrawFormat: Cardinal);
87+
begin
88+
FDrawTextEx2Called := True;
89+
end;
90+
91+
procedure TVTOnDrawTextTests.DrawTextEx3Event(Sender: TBaseVirtualTree;
92+
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
93+
const Text: string; const CellRect: TRect; var DefaultDraw: Boolean;
94+
var DrawFormat: Cardinal);
95+
begin
96+
FDrawTextEx3Called := True;
97+
end;
98+
99+
procedure TVTOnDrawTextTests.GetTextEvent(Sender: TBaseVirtualTree;
100+
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
101+
var CellText: string);
102+
begin
103+
case Column of
104+
colCaption: begin
105+
CellText := 'Caption';
106+
end;
107+
colData: begin
108+
CellText := 'Data';
109+
end;
110+
end;
111+
end;
112+
113+
procedure TVTOnDrawTextTests.Setup;
114+
begin
115+
FDrawText1Called := False;
116+
FDrawTextEx1Called := False;
117+
118+
FDrawText2Called := False;
119+
FDrawTextEx2Called := False;
120+
121+
FDrawText3Called := False;
122+
FDrawTextEx3Called := False;
123+
124+
fForm := TForm.Create(nil);
125+
fTree := TVirtualStringTree.Create(fForm);
126+
fForm.InsertControl(fTree);
127+
128+
fTree.OnGetText := GetTextEvent;
129+
130+
var LCol1 := fTree.Header.Columns.Add;
131+
var LCol2 := fTree.Header.Columns.Add;
132+
LCol1.Text := 'Caption';
133+
LCol2.Text := 'Data';
134+
135+
fTree.AddChild(fTree.RootNode);
136+
fTree.AddChild(fTree.RootNode);
137+
fForm.Show;
138+
end;
139+
140+
procedure TVTOnDrawTextTests.TearDown;
141+
begin
142+
FreeAndNil(fForm);
143+
end;
144+
145+
procedure TVTOnDrawTextTests.TestOnDrawText;
146+
begin
147+
// This test ensures that OnDrawText event is called when OnDrawText is assigned
148+
fTree.OnDrawText := DrawText1Event;
149+
fTree.OnDrawTextEx := nil;
150+
fTree.Update;
151+
152+
Assert.IsTrue(FDrawText1Called and not FDrawTextEx1Called);
153+
end;
154+
155+
procedure TVTOnDrawTextTests.TestOnDrawTextEx;
156+
begin
157+
// This test ensures that OnDrawTextEx event is called when OnDrawTextEx is assigned
158+
// and that OnDrawText is not called
159+
fTree.OnDrawText := nil;
160+
fTree.OnDrawTextEx := DrawTextEx2Event;
161+
fTree.Update;
162+
163+
Assert.IsTrue(not FDrawText2Called and FDrawTextEx2Called);
164+
end;
165+
166+
procedure TVTOnDrawTextTests.TestOnDrawTextOnDrawTextEx;
167+
begin
168+
// This test ensures that only the OnDrawTextEx event is called when both
169+
// OnDrawText and OnDrawTextEx are assigned and that OnDrawText is not called
170+
fTree.OnDrawText := DrawText3Event;
171+
fTree.OnDrawTextEx := DrawTextEx3Event;
172+
fTree.Update;
173+
174+
Assert.IsTrue(not FDrawText3Called and FDrawTextEx3Called);
175+
end;
176+
177+
initialization
178+
TDUnitX.RegisterTestFixture(TVTOnDrawTextTests);
179+
end.

0 commit comments

Comments
 (0)