TVirtualTreePerItemAction: Moved code from ExecuteTarget() to DoBeforeExecute() and DoAfterExecute() which simplifies creating derived actions that do not use IterateSubtree() / fToExecute.

Author: Joachim Marder

Source/VirtualTrees.Actions.pas

@@ -5,6 +5,7 @@ interface
 uses
   System.Classes,
   System.Actions,
+  Vcl.Controls,
   Vcl.ActnList,
   VirtualTrees;
 
@@ -20,7 +21,7 @@   TVirtualTreeAction = class(TCustomAction)
     fFilter: TVirtualNodeStates; // Apply only of nodes which match these states
     procedure SetControl(Value: TBaseVirtualTree); // Setter for the property "Control"
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-    procedure DoAfterExecute; // Fires the event "OnAfterExecute"
+    procedure DoAfterExecute; virtual;// Fires the event "OnAfterExecute"
     property SelectedOnly: Boolean read GetSelectedOnly write SetSelectedOnly default False;
   public
     function HandlesTarget(Target: TObject): Boolean; override;
@@ -45,9 +46,11 @@   TVirtualTreeAction = class(TCustomAction)
   TVirtualTreePerItemAction = class(TVirtualTreeAction)
   strict private
     fOnBeforeExecute: TNotifyEvent;
+    fOldCursor: TCursor;
   strict protected
     fToExecute: TVTGetNodeProc; // method which is executed per item to perform this action
-    procedure DoBeforeExecute;
+    procedure DoBeforeExecute();
+    procedure DoAfterExecute(); override;// Fires the event "OnAfterExecute"
   public
     constructor Create(AOwner: TComponent); override;
     procedure ExecuteTarget(Target: TObject); override;
@@ -79,10 +82,10 @@   TVirtualTreeSelectAll = class(TVirtualTreeAction)
 
   // Base class for actions that are applied to selected nodes only
   TVirtualTreeForSelectedAction = class(TVirtualTreeAction)
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
   TVirtualTreeCopy = class(TVirtualTreeForSelectedAction)
   public
     procedure ExecuteTarget(Target: TObject); override;
@@ -109,7 +112,7 @@ procedure Register;
 implementation
 
 uses
-  Controls, Forms;
+  Vcl.Forms;
 
 procedure Register;
 begin
@@ -128,18 +131,18 @@ constructor TVirtualTreeAction.Create(AOwner: TComponent);
 end;
 
 function TVirtualTreeAction.GetSelectedOnly: Boolean;
-begin
-  exit(TVirtualNodeState.vsSelected in fFilter);
-end;
-
+begin
+  exit(TVirtualNodeState.vsSelected in fFilter);
+end;
+
 procedure TVirtualTreeAction.SetSelectedOnly(const Value: Boolean);
-begin
-  if Value then
-    Include(fFilter, TVirtualNodeState.vsSelected)
-  else
-    Exclude(fFilter, TVirtualNodeState.vsSelected);
-end;
-
+begin
+  if Value then
+    Include(fFilter, TVirtualNodeState.vsSelected)
+  else
+    Exclude(fFilter, TVirtualNodeState.vsSelected);
+end;
+
 procedure TVirtualTreeAction.DoAfterExecute;
 begin
   if Assigned(fOnAfterExecute) then
@@ -160,7 +163,7 @@ procedure TVirtualTreeAction.UpdateTarget(Target: TObject);
 
 procedure TVirtualTreeAction.ExecuteTarget(Target: TObject);
 begin
-  DoAfterExecute();
+  DoAfterExecute();
 end;
 
 procedure TVirtualTreeAction.Notification(AComponent: TComponent; Operation: TOperation);
@@ -186,35 +189,40 @@ procedure TVirtualTreeAction.SetControl(Value: TBaseVirtualTree);
 { TVirtualTreePerItemAction }
 
 constructor TVirtualTreePerItemAction.Create(AOwner: TComponent);
-begin
-  inherited;
-  fToExecute := nil;
-  fOnBeforeExecute := nil;
-end;
-
+begin
+  inherited;
+  fToExecute := nil;
+  fOnBeforeExecute := nil;
+  fOldCursor := crNone;
+end;
+
+procedure TVirtualTreePerItemAction.DoAfterExecute;
+begin
+  inherited;
+  Control.EndUpdate;
+  if fOldCursor <> crNone then
+    Screen.Cursor := fOldCursor;
+end;
+
 procedure TVirtualTreePerItemAction.DoBeforeExecute;
 begin
+  if Screen.Cursor <> crHourGlass then begin
+    fOldCursor := Screen.Cursor;
+    Screen.Cursor := crHourGlass;
+  end;//if
   if Assigned(fOnBeforeExecute) then
     fOnBeforeExecute(Self);
+  Control.BeginUpdate();
 end;
 
 procedure TVirtualTreePerItemAction.ExecuteTarget(Target: TObject);
-var
-  lOldCursor: TCursor;
 begin
-  if Assigned(Self.Control) then
-    Target := Self.Control;
   DoBeforeExecute();
-  lOldCursor := Screen.Cursor;
-  Screen.Cursor := crHourGlass;
-  Control.BeginUpdate();
   try
     Control.IterateSubtree(nil, Self.fToExecute, nil, fFilter);
-  finally
-    Control.EndUpdate;
-    Screen.Cursor := lOldCursor;
+  finally
+    DoAfterExecute();
   end;
-  Inherited ExecuteTarget(Target);
 end;
 
 { TVirtualTreeCheckAll }
@@ -244,62 +252,62 @@ constructor TVirtualTreeUncheckAll.Create(AOwner: TComponent);
 
 
 { TVirtualStringSelectAll }
-
+
 procedure TVirtualTreeSelectAll.UpdateTarget(Target: TObject);
 begin
-  Inherited;
-  //Enabled := Enabled and (toMultiSelect in Control.TreeOptions.SelectionOptions)  // TreeOptions is protected  :-(
+  Inherited;
+  //Enabled := Enabled and (toMultiSelect in Control.TreeOptions.SelectionOptions)  // TreeOptions is protected  :-(
 end;
 
 procedure TVirtualTreeSelectAll.ExecuteTarget(Target: TObject);
-begin
-  Control.SelectAll(False);
-  inherited;
-end;
-
-
-{ TVirtualTreeForSelectedAction }
+begin
+  Control.SelectAll(False);
+  inherited;
+end;
+
+
+{ TVirtualTreeForSelectedAction }
 
 constructor TVirtualTreeForSelectedAction.Create(AOwner: TComponent);
-begin
-  inherited;
-  SelectedOnly := True;
-end;
-
-
-{ TVirtualTreeCopy }
-
-procedure TVirtualTreeCopy.ExecuteTarget(Target: TObject);
-begin
-  Control.CopyToClipboard();
-  Inherited;
-end;
+begin
+  inherited;
+  SelectedOnly := True;
+end;
+
+
+{ TVirtualTreeCopy }
+
+procedure TVirtualTreeCopy.ExecuteTarget(Target: TObject);
+begin
+  Control.CopyToClipboard();
+  Inherited;
+end;
 
 
 { TVirtualTreeCut }
-
-procedure TVirtualTreeCut.ExecuteTarget(Target: TObject);
-begin
-  Control.CutToClipboard();
-  Inherited;
-end;
+
+procedure TVirtualTreeCut.ExecuteTarget(Target: TObject);
+begin
+  Control.CutToClipboard();
+  Inherited;
+end;
 
 
 { TVirtualTreePaste }
-
-procedure TVirtualTreePaste.ExecuteTarget(Target: TObject);
-begin
-  Control.PasteFromClipboard();
-  Inherited;
-end;
+
+procedure TVirtualTreePaste.ExecuteTarget(Target: TObject);
+begin
+  Control.PasteFromClipboard();
+  Inherited;
+end;
 
 
 { TVirtualTreeDelete }
-
-procedure TVirtualTreeDelete.ExecuteTarget(Target: TObject);
-begin
-  Control.DeleteSelectedNodes();
-  Inherited;
+
+procedure TVirtualTreeDelete.ExecuteTarget(Target: TObject);
+begin
+  Control.DeleteSelectedNodes();
+  Inherited;
 end;