Merge pull request #1285 from Npc8/master

Add ColumnHeaderSpanning event

Author: joachimmarder

Source/VirtualTrees.BaseTree.pas

@@ -326,6 +326,8 @@   TClipboardFormats = class(TStringList)
                                           const APlusSelectedHotBM :TBitmap; const AMinusBM : TBitmap; const AMinusHotBM : TBitmap;
                                           const AMinusSelectedHotBM :TBitmap; var ASize : TSize) of object;
 
+  TVTColumnHeaderSpanningEvent = procedure(Sender: TVTHeader; Column: TColumnIndex; var Count: Cardinal) of object;
+
   // search, sort
   TVTCompareEvent = procedure(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
     var Result: Integer) of object;
@@ -680,6 +682,7 @@   TBaseVirtualTree = class abstract(TVTBaseAncestor)
                                                  // not covered by any node
     FOnMeasureItem: TVTMeasureItemEvent;         // Triggered when a node is about to be drawn and its height was not yet
                                                  // determined by the application.
+    FOnColumnHeaderSpanning: TVTColumnHeaderSpanningEvent; // triggered before the header column area been create for painting
     FOnGetUserClipboardFormats: TVTGetUserClipboardFormatsEvent; // gives application/descendants the opportunity to
                                                  // add own clipboard formats on the fly
     FOnPaintText: TVTPaintText;                  // triggered before either normal or fixed text is painted to allow
@@ -1055,6 +1058,7 @@   TBaseVirtualTree = class abstract(TVTBaseAncestor)
     procedure DoStructureChange(Node: PVirtualNode; Reason: TChangeReason); virtual;
     procedure DoTimerScroll; virtual;
     procedure DoUpdating(State: TVTUpdateState); virtual;
+    procedure DoColumnHeaderSpanning(Column: TColumnIndex; var Count: Cardinal); virtual;
     function DoValidateCache: Boolean; virtual;
     procedure DragAndDrop(AllowedEffects: DWord; const DataObject: TVTDragDataObject; var DragEffect: Integer); virtual;
     procedure DragCanceled; override;
@@ -1375,6 +1379,7 @@   TBaseVirtualTree = class abstract(TVTBaseAncestor)
     property OnStateChange: TVTStateChangeEvent read FOnStateChange write FOnStateChange;
     property OnStructureChange: TVTStructureChangeEvent read FOnStructureChange write FOnStructureChange;
     property OnUpdating: TVTUpdatingEvent read FOnUpdating write FOnUpdating;
+    property OnColumnHeaderSpanning: TVTColumnHeaderSpanningEvent read FOnColumnHeaderSpanning write FOnColumnHeaderSpanning;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -9671,6 +9676,14 @@ procedure TBaseVirtualTree.DoColumnDblClick(Column: TColumnIndex; Shift: TShiftS
 
 //----------------------------------------------------------------------------------------------------------------------
 
+procedure TBaseVirtualTree.DoColumnHeaderSpanning(Column: TColumnIndex; var Count: Cardinal);
+begin
+  if Assigned(FOnColumnHeaderSpanning) then
+    FOnColumnHeaderSpanning(Self.Header, Column, Count);
+end;
+
+//----------------------------------------------------------------------------------------------------------------------
+
 procedure TBaseVirtualTree.DoColumnResize(Column: TColumnIndex);
 
 var

Source/VirtualTrees.Header.pas

@@ -5743,6 +5743,8 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas : TCanvas; R : TRect; con
 var
   TargetRect : TRect;
   MaxX       : TDimension;
+  Count: Cardinal;
+  EndCol: TColumnIndex;
 begin
   if IsRectEmpty(R) then
     Exit;
@@ -5799,7 +5801,21 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas : TCanvas; R : TRect; con
     // Now go for each button.
     while (Run > NoColumn) and (TargetRect.Left < MaxX) do
     begin
-      TargetRect.Right := TargetRect.Left + Items[Run].Width;
+
+      //let application decide how many columns can be spanned
+      Count:= 1;
+      TreeViewControl.DoColumnHeaderSpanning(Run, Count);
+
+      if Count > FHeader.Columns.Count then Count := FHeader.Columns.Count;
+      if Count < 1 then Count := 1;
+
+      EndCol:= Run;
+      TargetRect.Right := TargetRect.Left;
+      repeat
+        Inc(TargetRect.Right, Items[EndCol].Width);
+        Dec(Count);
+        EndCol := GetNextVisibleColumn(EndCol);
+      until (Count = 0) or (EndCol <= NoColumn);
 
       // create a clipping rect to limit painting to button area
       ClipCanvas(TargetCanvas, Rect(Max(TargetRect.Left, Target.X), Target.Y + R.Top,
@@ -5810,7 +5826,8 @@ procedure TVirtualTreeColumns.PaintHeader(TargetCanvas : TCanvas; R : TRect; con
       SelectClipRgn(Handle, 0);
 
       TargetRect.Left := TargetRect.Right;
-      Run := GetNextVisibleColumn(Run);
+
+      Run := EndCol;
     end;
   end;
 end;

Source/VirtualTrees.pas

@@ -595,6 +595,7 @@   TVirtualStringTree = class(TCustomVirtualStringTree)
     property OnCanResize;
     property OnGesture;
     property Touch;
+    property OnColumnHeaderSpanning;
   end;
 
 //----------------------------------------------------------------------------------------------------------------------