Autosize у колонок в Virtual Treeview

Для Delphi есть такая замечательная компонента Virtual Treeview. Очень гибкая и настраиваемая, но в один момент гибкости не хватило. Требовалось подстраивать ширину колонок так, что бы в них помещался текст полностью. В Virtual Treeview есть метод AutoFitColumns который это может сделать. Но проблема в том, что ему приходится проверять ширину текста каждого элемента. Соответственно если их много то метод AutoFitColumns будет выполнятся слишком долго.

 Как я уже говорил, компонента действительно очень гибкая. У колонок есть опция coSmartResize, которая указывает что надо изменять размер колонки, учитывая только просматриваемые элементы. В самом методе AutoFitColumns(Animated: Boolean = True; SmartAutoFitType: TSmartAutoFitType = smaUseColumnOption; RangeStartCol: Integer = NoColumn; RangeEndCol: Integer = NoColumn); есть параметр SmartAutoFitType который позволяет указать как вычислять ширину колонки

• - smaUseColumnOption - учитывая настройку coSmartResize для каждой колонки
• - smaAllColumns - вычислять ширину по-умному (только просматриваемые элементы) для всех колонок
• - smaNoColumn - вычислять ширину учитывая все элементы

Таким образом, простейшее решение состоит в том, что бы в обработчике OnScroll дерева вызывать Header.AutoFitColumns(False,smaAllColumns); Если учесть возможное изменение размеров контрола, то получится вполне работоспособное решение.
Однако, не всегда удобно, что все колонки изменяют размер автоматически. Хорошо бы можно было вручную изменить и зафиксировать размер некоторых колонок. Будет логично, если после изменения размера колонки мышкой этот размер в дальнейшем не будет меняться автоматически. Для этого надо с каждой колонкой ассоциировать свойство AutoSize: Boolean.
Это можно сделать разными способами. Если нельзя менять исходник Virtual Treeview или создать свой наследник TVirtualStringTree (или TVirtualDrawTree). То придется завести какой-нибудь список в котором хранить значение AutoSize для каждой колонки (например, AutoSizeByColumnIndex: array of Boolean).
Для изменения размера колонок использовать метод, наподобие этого:

procedure TSpeedForm.AutosizeView;
var
  I: Integer;
begin
 VST1.BeginUpdate;
  for I := 0 to VST1.Header.Columns.Count - 1 do
    if AutoSizeByColumnIndex[I] then
         VST1.Header.AutoFitColumns(False,smaAllColumns,I,I);
 VST1.EndUpdate;
end;

который вызывать при прокрутке и изменении размеров дерева. Для того, что бы пользователь мог включить AutoSize колонки двойным кликом по разделителю колонок, надо в обработчике OnColumnWidthDblClickResize прописать:

procedure TSpeedForm.VST1ColumnWidthDblClickResize(Sender: TVTHeader;
  Column: TColumnIndex; Shift: TShiftState; P: TPoint; var Allowed: Boolean);
begin
  AutoSizeByColumnIndex[Column]:=True;
  AutosizeView;
  Allowed := False;
end;

Что бы пользователь мог вручную изменить размер колонки и отключить AutoSize надо в обработчике OnColumnWidthTracking сделать AutoSizeByColumnIndex[Column] := False;

Но лучше сделать свой наследник, особенно если подобные дополнения к дереву нужны не в одном  месте. Кстати, мне все больше нравится идея создавать контролы в Run-time, а не в редакторе форм Delphi. Возможность быстро сменить класс контрола является одним из плюсов этого подхода. Ниже представлен модуль с реализацией Autosize для колонок. Свойство Header.FixMaxAutosize определяет надо ли уменьшать размер колонок при автоматическом изменении или можно только увеличивать. Если оно выставлено в True ширина будет только увеличиваться.
Обратите внимание, что если бы в базовом классе не было методов GetColumnClass, GetHeaderClass, то расширять дерево с помощью наследования было бы значительно сложнее. Это пример реализации паттерна фабричный метод. И обычно, это является хорошей идеей дать возможность потомку выбрать реализацию вложенных объектов. В Delphi есть как минимум два пути для этого - сделать виртуальную функцию возвращающую класс (как это сделано в Virtual Treeview) или возвращающую созданный объект.
Если вносить правки непосредственно в Virtual Treeview  (TBaseVirtualTree и т.д.)  то количество кода будет значительно меньше. Не потребуются перекрывать свойства Items и другие, что бы дать клиентам доступ к потомку.

unit VirtualTreesEx;

interface
uses VirtualTrees, Math, Windows, Classes;
type
TVirtualTreeColumnEx = class(TVirtualTreeColumn)
  private
    FAutoSize: Boolean;
    procedure SetAutoSize(const Value: Boolean);
  public
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
end;
TVirtualTreeColumnsEx = class(TVirtualTreeColumns)
  private
    function GetItem(Index: TColumnIndex): TVirtualTreeColumnEx;
    procedure SetItem(Index: TColumnIndex; const Value: TVirtualTreeColumnEx);
  public
    property Items[Index: TColumnIndex]: TVirtualTreeColumnEx read GetItem write SetItem; default;
end;
TVTHeaderEx = class(TVTHeader)
  private
    FFixMaxAutosize: Boolean;
    function GetColumns: TVirtualTreeColumnsEx;
    procedure SetColumns(const Value: TVirtualTreeColumnsEx);
    function GetAutosizeAll: Boolean;
    procedure SetAutosizeAll(const Value: Boolean);
  protected
    function GetColumnsClass: TVirtualTreeColumnsClass; override;
    function DoColumnWidthDblClickResize(Column: TColumnIndex; P: TPoint; Shift: TShiftState): Boolean; override;
  public
    property AutosizeAll: Boolean read GetAutosizeAll write SetAutosizeAll;
    property FixMaxAutosize: Boolean read FFixMaxAutosize write FFixMaxAutosize;
    property Columns: TVirtualTreeColumnsEx read GetColumns write SetColumns stored False;
end;
TVirtualStringTreeEx = class(TVirtualStringTree)
  private
    function GetHeader: TVTHeaderEx;
    procedure SetHeader(const Value: TVTHeaderEx);
  protected
    FSkipAutosize: Boolean;
    function GetColumnClass: TVirtualTreeColumnClass; override;
    function GetHeaderClass: TVTHeaderClass; override;
    function DoSetOffsetXY(Value: TPoint; Options: TScrollUpdateOptions; ClipRect: PRect = nil): Boolean; override;
    procedure UpdateScrollBars(DoRepaint: Boolean); override;
  public
    procedure AutosizeView;
    property Header: TVTHeaderEx read GetHeader write SetHeader;
end;
implementation
{ TVirtualStringTreeEx }
procedure TVirtualStringTreeEx.AutosizeView;
var
  I: integer;
begin
 if FSkipAutosize or (hoAutoResize in Header.Options) or (hoAutoSpring in Header.Options) then
   Exit;
 FSkipAutosize := True;
 BeginUpdate;
 for I := 0 to Header.Columns.Count - 1 do
 begin
   if Header.Columns[I].AutoSize then
     if Header.FixMaxAutosize then
       Header.Columns[I].Width := Max(Header.Columns[I].Width, GetMaxColumnWidth(0,true))
     else
       Header.Columns[I].Width := GetMaxColumnWidth(0,true);
 end;
 EndUpdate;
 FSkipAutosize := False;
end;
function TVirtualStringTreeEx.DoSetOffsetXY(Value: TPoint;
  Options: TScrollUpdateOptions; ClipRect: PRect): Boolean;
begin
  Result := inherited DoSetOffsetXY(Value, Options, ClipRect);
  AutosizeView;
end;
function TVirtualStringTreeEx.GetColumnClass: TVirtualTreeColumnClass;
begin
  Result := TVirtualTreeColumnEx;
end;
function TVirtualStringTreeEx.GetHeader: TVTHeaderEx;
begin
 Result := TVTHeaderEx(TVirtualStringTree(Self).Header);
end;
function TVirtualStringTreeEx.GetHeaderClass: TVTHeaderClass;
begin
 Result := TVTHeaderEx
end;
procedure TVirtualStringTreeEx.SetHeader(const Value: TVTHeaderEx);
begin
  TVirtualStringTree(Self).Header := Value;
end;
procedure TVirtualStringTreeEx.UpdateScrollBars(DoRepaint: Boolean);
begin
  inherited;
  AutosizeView;
end;
{ TVTHeaderEx }
function TVTHeaderEx.DoColumnWidthDblClickResize(Column: TColumnIndex;
  P: TPoint; Shift: TShiftState): Boolean;
begin
 inherited DoColumnWidthDblClickResize(Column, P, Shift);
 result := False;
 Columns[Column].AutoSize := True;
end;
function TVTHeaderEx.GetAutosizeAll: Boolean;
var
 I: Integer;
begin
  for I := 0 to Columns.Count - 1 do
    if not Columns[I].AutoSize then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;
function TVTHeaderEx.GetColumns: TVirtualTreeColumnsEx;
begin
  Result :=  TVirtualTreeColumnsEx(TVTHeader(Self).Columns)
end;
function TVTHeaderEx.GetColumnsClass: TVirtualTreeColumnsClass;
begin
  Result := TVirtualTreeColumnsEx;
end;
procedure TVTHeaderEx.SetAutosizeAll(const Value: Boolean);
var
 I: Integer;
begin
  for I := 0 to Columns.Count - 1 do
    Columns[I].FAutoSize := Value;
  if Value then
    (TreeView as TVirtualStringTreeEx).AutosizeView;
end;
procedure TVTHeaderEx.SetColumns(const Value: TVirtualTreeColumnsEx);
begin
  TVTHeader(Self).Columns := Value;
end;
{ TVirtualTreeColumnsEx }
function TVirtualTreeColumnsEx.GetItem(
  Index: TColumnIndex): TVirtualTreeColumnEx;
begin
  Result := TVirtualTreeColumnEx(TVirtualTreeColumns(Self).Items[Index]);
end;
procedure TVirtualTreeColumnsEx.SetItem(Index: TColumnIndex;
  const Value: TVirtualTreeColumnEx);
begin
  TVirtualTreeColumns(Self).Items[Index] := Value;
end;
{ TVirtualTreeColumnEx }
procedure TVirtualTreeColumnEx.SetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    if FAutoSize then
      (Owner.Header.TreeView as TVirtualStringTreeEx).AutosizeView;
  end;
end;
end.