如何根据其内容正确设置 ListView 列的大小？

Question

我有许多用于显示数据的列表视图控件 (TListView)。所有这些列表视图都设置为“详细信息”模式，并且都将 TImageList 分配给它们的“SmallIcons”属性。

我正在尝试根据它们的内容设置这些列的宽度，就像用户双击每个列标题末尾的分隔滑块一样。

首先，我尝试将列宽设置为“-1”和“-2”以自动调整它们的大小：这不仅无法正常工作（一些包含本地字符的列 - 我使用的是 D6 并且表示 ANSI 字符串 - 太低了），但它也使列的显示非常慢（当它以固定宽度瞬时显示时，最多需要 30 秒才能显示具有 6 列和 150 个项目的列表视图）。

我尝试在每个单元格上使用 GetTextExtent 来获得文本的预期宽度，添加一些边距（从 2 到 10 像素），如果列的宽度低于计算的文本宽度，则扩展列的宽度。对第一列 (Items.caption) 应用特殊处理以考虑图标的显示（我将图标的宽度加上边距添加到单元格文本的宽度）。

这也不起作用：在许多情况下（例如，以“yyyy/mm/dd hh:nn:ss”格式显示日期会导致文本太大而无法放入列中）。

考虑到问题可能来自窗口主题引擎，我已切换到使用 GetThemeTextExtent 而不是 GetTextExtent，但得到了相同的结果。

似乎唯一可行的方法是为每个列宽添加任意较大的边距（20 像素），但当然，这会产生比应有的更大的列。

那么，有什么替代策略吗？我不需要任何东西，只需要计算一次正确宽度的东西：当第一次填充列表时。 “单击列分隔符”后面的代码工作得很好，但我找不到如何通过代码触发它（好吧，我想我可以将双击消息直接发送到标题作为 hack）

为了澄清，这里是我尝试以下代码的事情：

（在调用情况下，调用了ListView.canvas.Font.Assign(ListView.font)。它不在这些函数中，因为单个赋值就足够了，但是代码会在列表视图的所有非自动调整大小的列上循环）。

编辑

我最初尝试使用 Windows Theme API：

function _GetTextWidth1(AText: widestring; IsHeader: boolean = false): Integer;
var
  ATheme: HTheme;
  rValue: TRect;
  iPartID: integer;
  AWidetext: WideString;
const
  LVP_GROUPHEADER  = 6;
begin
  // try to get text width using theme API
  ZeroMemory(@rValue, SizeOf(rValue));
  ATheme := OpenThemeData(ListView.Handle, 'LISTVIEW');
  try
    if not IsHeader then
      iPartID := LVP_LISTITEM
    else
      iPartID := LVP_GROUPHEADER;
    AWidetext := AText;
    GetThemeTextExtent( ATheme,
                        ListView.Canvas.Handle,
                        iPartID,
                        LIS_NORMAL,
                        PWideChar(AWidetext),
                        -1,
                        DT_LEFT or DT_SINGLELINE or DT_CALCRECT,
                        nil,
                        rValue
                        );
  finally // wrap up
    CloseThemeData(ATheme);
  end;    // try/finally
  result := rValue.Right;
end;

下一次尝试使用 DrawText/DrawTextW：

function _GetTextWidth2(AText: widestring; IsHeader: boolean = false): Integer;
var
  rValue: TRect;
  lFlags: Integer;
begin
  // try to get text width using DrawText/DrawTextW
  rValue := Rect(0, 0, 0, 0);
  lFlags := DT_CALCRECT or DT_EXPANDTABS or DT_NOPREFIX or DT_LEFT or DT_EXTERNALLEADING;
  DrawText(ListView.canvas.Handle, PChar(AText), Length(AText), rValue, lFlags);
  //DrawTextW(ListView.canvas.Handle, PWideChar(AText), Length(AText), rValue, lFlags);
  result := rValue.Right;
end;

第三次尝试使用delphi的TextWidth函数

function _GetTextWidth3(AText: widestring; IsHeader: boolean = false): Integer;
begin
  // try to get text width using delphi wrapped around GetTextExtentPoint32
  result := ListView.canvas.TextWidth(Atext);
end;

在所有情况下，我都会为结果宽度添加边距：我尝试了高达 20 像素的值。我还考虑了视图使用图标的可能性（在这种情况下，我将图标的宽度加上边距再次添加到第一列）。

Answer 1

你可以使用 canvas.TextWidth 方法。但请务必使用 TListView 画布（不是其他，即 TForm）并首先从 TListView 为画布分配字体。 例如：

var
  s: integer;
begin
  ListView1.AddItem('test example item', nil);
  ListView1.canvas.Font.Assign(ListView1.font);
  s := ListView1.canvas.TextWidth(ListView1.Items[0].Caption) + 10; //this "+10" is a small additional margin
  if s > ListView1.Columns[0].Width then
    ListView1.Columns[0].Width := s;

对我来说很好用。