[VST] Spaltenbreite an längsten Eintrag anpassen

[madas]

Hallo,

wir machen das Ganze so (VST ist bei uns in einen Frame integriert):

Delphi-Quellcode:

procedure TFrameVST.AutoFitColumn(Column: TColumnIndex);
var
  cWidth, hWidth: Integer;
begin
  if [coResizable, coVisible] * vst.Header.Columns[Column].Options = [coResizable, coVisible] then 
  begin
    cWidth := vst.GetMaxColumnWidth(Column);
    if (hoVisible in vst.Header.Options) then
    begin
      hWidth := GetMaxHeaderWidth(Column);
      if cWidth < hWidth then
        cWidth := hWidth;
      if cWidth > vst.Header.Columns[Column].MaxWidth then
        cWidth := vst.Header.Columns[Column].MaxWidth;
    end;
    vst.Header.Columns[Column].Width := cWidth;
  end;
end;

function TFrameVST.GetMaxHeaderWidth(Column: TColumnIndex): Integer;
var col: TVirtualTreeColumn;
    Size: TSize;
begin
  col := vst.Header.Columns[Column];
  Result := 2 * col.Margin;
  if (Length(col.Text) > 0) then
  begin
    vst.Canvas.Font := vst.Header.Font;
    GetTextExtentPoint32W(vst.Canvas.Handle, PWideChar(col.Text), Length(col.Text), Size);
    Inc(Result, Size.cx + 4);
  end;
  if (hoShowImages in vst.Header.Options)and(Assigned(vst.Header.Images)) then
    Inc(Result,(vst.Header.Images.Width + col.Spacing));
  if (hoShowSortGlyphs in vst.Header.Options)and(vst.Header.SortColumn = Column) then
    Inc(Result, 20); // Platz für Sortimage
  if Result < col.MinWidth then
    Result := col.MinWidth;
  if Result > col.MaxWidth then
    Result := col.MaxWidth;
end;

procedure TFrameVST.AutoFitColumns;
var
  Column: TColumnIndex;
begin
  vst.BeginUpdate;
  try
    for Column := 0 to vst.Header.Columns.Count-1 do
      AutoFitColumn(Column);
  finally
    vst.EndUpdate;
  end;
end;

Damit die Berechnung nicht so ewig dauert (wurde hier im Forum schon mal angesprochen) solltest du noch
folgendes hinzufügen:

Delphi-Quellcode:

procedure TFrameVST.vstBeforeGetMaxColumnWidth(Sender: TVTHeader;
  Column: TColumnIndex; var UseSmartColumnWidth: Boolean);
begin
  if Assigned(vst.OnBeforeCellPaint) then
  begin
    FmerkOnBeforeCellPaint := vst.OnBeforeCellPaint;
    vst.OnBeforeCellPaint := nil; 
  end;
end;

procedure TFrameVST.vstAfterGetMaxColumnWidth(Sender: TVTHeader;
  Column: TColumnIndex);
begin
  if Assigned(FmerkOnBeforeCellPaint) then
  begin
    vst.OnBeforeCellPaint := FmerkOnBeforeCellPaint;
    FmerkOnBeforeCellPaint := nil;
  end;
end;