Skip to content

Updated tests and code for missing OnChange event #1354

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
joachimmarder merged 1 commit into from
Feb 8, 2026
+515 −126
Merged

Updated tests and code for missing OnChange event #1354

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
204 changes: 115 additions & 89 deletions Source/VirtualTrees.BaseTree.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -978,9 +978,15 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor)
procedure DoCanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex;
var Allowed: Boolean); virtual;
procedure DoChange(Node: PVirtualNode); virtual;

/// <summary>
/// Notifies that the selected cells have changed. Nodes can be empty
/// Notifies that the selected cells have changed. Cells can be empty
/// </summary>
/// <remarks>
/// Multiple events might be fired for the same selection
/// Do not assume that only 1 cell change event will be fired for the same
/// cell change
/// </remarks>
/// <param name="Cells">
/// </param>
procedure DoChangeCell(const Cells: TVTCellArray); virtual;
Expand Down Expand Up @@ -1143,19 +1149,46 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor)
ForceInsert: Boolean): Boolean; overload;

/// <summary>
/// <remarks>
/// Multiple cell select support / multicell
/// Multi-selection requires [toExtendedFocus, toMultiSelect] - [toFullRowSelect]
/// </remarks>
/// Adds a cell to the existing selection
/// </summary>
/// <param name="Cell">
/// Cell to add to existing selection
/// </param>
/// <param name="ForceInsert">
/// </param>
/// <returns>
/// True if added successfully, false if Cell already exists, or not added
/// </returns>
function InternalAddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean): Boolean;

/// <summary>
/// Removes a cell from the existing selection
/// </summary>
/// <param name="Cell">
/// Cell to remove from existing selection
/// </param>
procedure InternalRemoveFromCellSelection(const Cell: TVTCell); virtual;
procedure InternalClearCellSelection; virtual;

/// <summary>
/// </summary>
/// <remarks>
/// With the current design, cell multi-selection hinges on the existing
/// toMultiSelect in addition to toExtendedFocus being present and
/// toFullRowSelect being absent. When overriding this function,
/// be sure to check that the logic is compatible with existing code
/// </remarks>
/// <returns>
/// True if cell selection has been enabled, false otherwise
/// </returns>
function IsCellSelectionEnabled: Boolean; virtual;
procedure AddToCellSelection(const Cell: TVTCell; ForceInsert: Boolean);
procedure RemoveFromCellSelection(const Cell: TVTCell);

function InternalIsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean;
// Internal functions do not check if cell selection is enabled, since they
// should already be performed by their wrapper functions
function InternalIsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean; overload;
function InternalIsCellSelected(const Cell: TVTCell): Boolean; overload;
procedure InternalSelectCells(StartCell, EndCell: TVTCell; AddOnly: Boolean); virtual;
procedure InternalUnselectCells(StartCell, EndCell: TVTCell); virtual;

Expand Down Expand Up @@ -1338,9 +1371,15 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor)
property OnCanSplitterResizeHeader: TVTCanSplitterResizeHeaderEvent read FOnCanSplitterResizeHeader write FOnCanSplitterResizeHeader;
property OnCanSplitterResizeNode: TVTCanSplitterResizeNodeEvent read FOnCanSplitterResizeNode write FOnCanSplitterResizeNode;
property OnChange: TVTChangeEvent read FOnChange write FOnChange;

/// <summary>
/// Called when cell selection changes
/// Notifies that the selected cells have changed. Cells can be empty
/// </summary>
/// <remarks>
/// Multiple events might be fired for the same selection
/// Do not assume that only 1 cell change event will be fired for the same
/// cell change
/// </remarks>
property OnChangeCell: TVTChangeCellEvent read FOnChangeCell write FOnChangeCell;
property OnChecked: TVTChangeEvent read FOnChecked write FOnChecked;
property OnChecking: TVTCheckChangingEvent read FOnChecking write FOnChecking;
Expand Down Expand Up @@ -1664,7 +1703,9 @@ TBaseVirtualTree = class abstract(TVTBaseAncestor)
/// If True, adds the range to the existing selection without clearing it.
/// </param>
procedure SelectCells(StartNode: PVirtualNode; StartColumn:
TColumnIndex; EndNode: PVirtualNode; EndColumn: TColumnIndex; AddOnly: Boolean);
TColumnIndex; EndNode: PVirtualNode; EndColumn: TColumnIndex; AddOnly: Boolean); overload;

procedure SelectCells(const StartCell, EndCell: TVTCell; AddOnly: Boolean); overload;

/// <summary>
/// Unselects the rectangular range of cells specified by the rest of the
Expand Down Expand Up @@ -1886,7 +1927,12 @@ procedure TBaseVirtualTree.SelectCells(StartNode: PVirtualNode; StartColumn: TCo
begin
S := TVTCell.Create(StartNode, StartColumn);
E := TVTCell.Create(EndNode, EndColumn);
InternalSelectCells(S, E, AddOnly);
SelectCells(S, E, AddOnly);
end;

procedure TBaseVirtualTree.SelectCells(const StartCell, EndCell: TVTCell; AddOnly: Boolean);
begin
InternalSelectCells(StartCell, EndCell, AddOnly);
ChangeCell(FSelectedCells);
end;

Expand All @@ -1913,7 +1959,6 @@ procedure TBaseVirtualTree.ClearCellSelection;
//----------------------------------------------------------------------------------------------------------------------

function TBaseVirtualTree.IsCellSelected(Node: PVirtualNode; Column: TColumnIndex): Boolean;

begin
Result := InternalIsCellSelected(Node, Column);
end;
Expand Down Expand Up @@ -3707,10 +3752,11 @@ procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNo
ClickedCell: TVTCell;

// Handles multi-selection with mouse click.

LCellSelectionEnabled: LongBool;
begin
LCellSelectionEnabled := IsCellSelectionEnabled;
// Support cell selection when clicking a specific column (and full-row-select is off)
if (FLastHitInfo.HitColumn > NoColumn) and not (toFullRowSelect in FOptions.SelectionOptions) then
if (FLastHitInfo.HitColumn > NoColumn) and LCellSelectionEnabled then
begin
// build the clicked cell (use ClickIndex as it reflects the saved hit column)
ClickedCell.Node := NewNode;
Expand All @@ -3731,20 +3777,21 @@ procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNo
else
FCellRangeAnchor := ClickedCell;
end;
InternalSelectCells(FCellRangeAnchor, ClickedCell, True);
SelectCells(FCellRangeAnchor, ClickedCell, True);
Invalidate;
end
else
begin
if not (toSiblingSelectConstraint in FOptions.SelectionOptions) then
FCellRangeAnchor := ClickedCell;
if DragPending then
DoStateChange([tsToggleFocusedSelection])
else
if InternalIsCellSelected(ClickedCell.Node, ClickedCell.Column) then
RemoveFromCellSelection(ClickedCell)
begin
if not (toSiblingSelectConstraint in FOptions.SelectionOptions) then
FCellRangeAnchor := ClickedCell;
if DragPending then
DoStateChange([tsToggleFocusedSelection])
else
AddToCellSelection(ClickedCell, True);
end;
if InternalIsCellSelected(ClickedCell.Node, ClickedCell.Column) then
RemoveFromCellSelection(ClickedCell)
else
AddToCellSelection(ClickedCell, True);
end;
end
else
// Shift key down
Expand All @@ -3760,15 +3807,15 @@ procedure TBaseVirtualTree.HandleClickSelection(LastFocused, NewNode: PVirtualNo
else
FCellRangeAnchor := ClickedCell;
end;
InternalSelectCells(FCellRangeAnchor, ClickedCell, True);
SelectCells(FCellRangeAnchor, ClickedCell, True);
Invalidate;
end
else
begin
// Clear any existing cell selection and select the clicked cell.
InternalClearCellSelection;
AddToCellSelection(ClickedCell, True);
FCellRangeAnchor := ClickedCell;
// Clear any existing cell selection and select the clicked cell.
InternalClearCellSelection;
AddToCellSelection(ClickedCell, True);
FCellRangeAnchor := ClickedCell;
end;
Exit;
end;
Expand Down Expand Up @@ -7393,7 +7440,7 @@ procedure TBaseVirtualTree.WMKeyDown(var Message: TWMKeyDown);
// multicell support / select multiple cells
SelectedCell := TVTCell.Create(FFocusedNode, FFocusedColumn);
OldCell := FCellRangeAnchor;
InternalSelectCells(OldCell, SelectedCell, True);
SelectCells(OldCell, SelectedCell, True);
end;

if Assigned(FFocusedNode) then
Expand Down Expand Up @@ -12797,6 +12844,8 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T
else
AltPressed := False;

// Cell multi-selection hinges on the existing toMultiSelect in addition
// to toExtendedFocus being present and toFullRowSelect being absent
LCellSelectionEnabled := IsCellSelectionEnabled;

// Various combinations determine what states the tree enters now.
Expand Down Expand Up @@ -12942,7 +12991,7 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T
end
else
ClearSelection(False);
end;
end;

// pending node edit
if Focused and
Expand Down Expand Up @@ -13003,7 +13052,8 @@ procedure TBaseVirtualTree.HandleMouseDown(var Message: TWMMouse; var HitInfo: T
FRangeAnchor := HitInfo.HitNode;

// If a column was hit on a plain click, clear existing cell selection and select the clicked cell.
if ShiftEmpty and MultiSelect and Assigned(HitInfo.HitNode) and (Column > NoColumn) then
// !!! MultiSelect <> LCellSelectionEnabled, not interchangeable !!!
if ShiftEmpty and LCellSelectionEnabled and Assigned(HitInfo.HitNode) and (Column > NoColumn) then
begin
InternalClearCellSelection;
ClickedCell.Node := HitInfo.HitNode;
Expand Down Expand Up @@ -15599,7 +15649,7 @@ procedure TBaseVirtualTree.AddToCellSelection(const Cell: TVTCell; ForceInsert:
InvalidateNode(Cell.Node)
else
InvalidateColumn(Cell.Column);
DoChangeCell(FSelectedCells);
ChangeCell(FSelectedCells);
end;
end;

Expand All @@ -15614,7 +15664,7 @@ procedure TBaseVirtualTree.RemoveFromCellSelection(const Cell: TVTCell);
InvalidateNode(Cell.Node)
else
InvalidateColumn(Cell.Column);
DoChangeCell(FSelectedCells);
ChangeCell(FSelectedCells);
end;

//----------------------------------------------------------------------------------------------------------------------
Expand All @@ -15631,12 +15681,22 @@ function TBaseVirtualTree.InternalIsCellSelected(Node: PVirtualNode; Column: TCo

//----------------------------------------------------------------------------------------------------------------------

function TBaseVirtualTree.InternalIsCellSelected(const Cell: TVTCell): Boolean;
begin
Result := InternalIsCellSelected(Cell.Node, Cell.Column);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TBaseVirtualTree.InternalSelectCells(StartCell, EndCell: TVTCell; AddOnly: Boolean);
type
TNextColFunc = function (Column: TColumnIndex; ConsiderAllowFocus: Boolean = False): TColumnIndex of object;
var
NodeFrom, NodeTo, NodeIter: PVirtualNode;
ColFrom, ColTo, ColIter: TColumnIndex;
ColNext: TColumnIndex;
TempCell: TVTCell;
NextColFunc: TNextColFunc;
begin
// Normalize start cell
if StartCell.Node = nil then
Expand Down Expand Up @@ -15666,71 +15726,37 @@ procedure TBaseVirtualTree.InternalSelectCells(StartCell, EndCell: TVTCell; AddO
if not AddOnly then
InternalClearCellSelection;

if ColFrom <= ColTo then
NextColFunc := FHeader.Columns.GetNextVisibleColumn else
NextColFunc := FHeader.Columns.GetPreviousVisibleColumn;

NodeIter := NodeFrom;
while NodeIter <> NodeTo do
begin
// iterate columns between ColFrom and ColTo (inclusive)
if ColFrom <= ColTo then
begin
ColIter := ColFrom;
repeat
begin
TempCell.Node := NodeIter; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
end;
ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
end
else
begin
ColIter := ColFrom;
repeat
begin
TempCell.Node := NodeIter; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
end;
ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
end;
ColIter := ColFrom;
repeat
TempCell.Node := NodeIter; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
ColNext := NextColFunc(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
NodeIter := GetNextVisible(NodeIter, True);
end;
// include last node
if Assigned(NodeTo) then
begin
if ColFrom <= ColTo then
begin
ColIter := ColFrom;
repeat
begin
TempCell.Node := NodeTo; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
end;
ColNext := FHeader.Columns.GetNextVisibleColumn(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
end
else
begin
ColIter := ColFrom;
repeat
begin
TempCell.Node := NodeTo; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
end;
ColNext := FHeader.Columns.GetPreviousVisibleColumn(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
end;
ColIter := ColFrom;
repeat
TempCell.Node := NodeTo; TempCell.Column := ColIter;
AddToCellSelection(TempCell, True);
ColNext := NextColFunc(ColIter);
if ColIter = ColTo then
Break;
ColIter := ColNext;
until ColIter = InvalidColumn;
end;
end;

Expand Down
3 changes: 2 additions & 1 deletion Tests/Tests.dpr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@ uses
VTOnDrawTextTests in 'VTOnDrawTextTests.pas',
VTCellSelectionTests in 'VTCellSelectionTests.pas',
VirtualTrees.MouseUtils in 'VirtualTrees.MouseUtils.pas',
VTCellSelectionTests.VisibilityForm in 'VTCellSelectionTests.VisibilityForm.pas' {VisibilityForm};
VTCellSelectionTests.VisibilityForm in 'VTCellSelectionTests.VisibilityForm.pas' {VisibilityForm},
VTCellSelectionTests.VTSelectionTestForm in 'VTCellSelectionTests.VTSelectionTestForm.pas' {SelectionTestForm};

var
runner : ITestRunner;
Expand Down
4 changes: 4 additions & 0 deletions Tests/Tests.dproj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -111,6 +111,10 @@
<Form>VisibilityForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="VTCellSelectionTests.VTSelectionTestForm.pas">
<Form>SelectionTestForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Expand Down
Loading