delphi - 调整状态栏面板的大小以适应内容

Question

假设我的状态栏有 3 个面板，最左边的是应用程序正在运行的文件的名称。

那可能是我c:\my.log或c:\a\very\deeply\nested\sub-directory\extremely_long_file_name_indeed.log

加载新文件时，是否有一种简单的方法可以调整 3 个状态栏面板的大小？（甚至可能是 FOSS VCL 组件——尽管我找不到）？

Answer 1

这实际上更像是 TLama 删除的答案的第一个版本，我更喜欢它：

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    procedure FormResize(Sender: TObject);
  private
    procedure SetLeftPanelWidth;
  ..

uses
  filectrl, commctrl;

...

procedure TForm1.SetLeftPanelWidth;
var
  Borders: array[0..2] of Integer;
  PanelWidth, MaxWidth: Integer;
begin
  // calculate a little indent on both sides of the text (credit @TLama)
  SendMessage(StatusBar1.Handle, SB_GETBORDERS, 0, LPARAM(@Borders));

  StatusBar1.Canvas.Font := StatusBar1.Font;
  PanelWidth := StatusBar1.Canvas.TextWidth(StatusBar1.Panels[0].Text)
      + 2 * Borders[1] + 2;

  // Per Ken's comment, specify a maximum width, otherwise the panel can overgrow
  MaxWidth := StatusBar1.Width div 4 * 3; // arbitrary requirement
  if PanelWidth > MaxWidth then begin
    StatusBar1.Panels[0].Text := MinimizeName(TFileName(StatusBar1.Panels[0].Text),
        StatusBar1.Canvas, MaxWidth);
    // recalculate
    PanelWidth := StatusBar1.Canvas.TextWidth(StatusBar1.Panels[0].Text) +
        2 * Borders[1] + 2;
  end;
  StatusBar1.Panels[0].Width := PanelWidth;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  // have to set the text again since original filename might have been minimized
  StatusBar1.Panels[0].Text := ...;
  SetLeftPanelWidth;
end;

如果路径不适合最大宽度，则上面会缩短路径，但原始文件名对用户不可见。为了能够对状态栏面板使用本机提示支持，面板的宽度必须小于文本可以容纳的宽度。

因此，作为替代方案，当文件名的长度超过最大宽度时，下面会截断文件名的尾随部分，并在鼠标悬停时显示工具提示：

type
  TStatusBar = class(comctrls.TStatusBar)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    procedure FormResize(Sender: TObject);
  private
    procedure SetLeftPanelWidth;
  ..


procedure TStatusBar.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or SBT_TOOLTIPS;
end;

procedure TForm1.SetLeftPanelWidth;
var
  Borders: array[0..2] of Integer;
  PanelWidth, MaxWidth: Integer;
begin
  SendMessage(StatusBar1.Handle, SB_GETBORDERS, 0, LPARAM(@Borders));

  StatusBar1.Canvas.Font := StatusBar1.Font;
  PanelWidth := StatusBar1.Canvas.TextWidth(StatusBar1.Panels[0].Text)
      + 2 * Borders[1] + 2;

  MaxWidth := StatusBar1.Width div 4 * 3; // arbitrary requirement
  if PanelWidth > MaxWidth then begin
    SendMessage(StatusBar1.Handle, SB_SETTIPTEXT, 0,
        NativeInt(PChar(StatusBar1.Panels[0].Text)));
    PanelWidth := MaxWidth;
  end else
    SendMessage(StatusBar1.Handle, SB_SETTIPTEXT, 0, 0);

  StatusBar1.Panels[0].Width := PanelWidth;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  SetLeftPanelWidth;
end;