Resize status bar panels to fit contents

Question

Let's say my status bar has 3 panels and he leftmost is the name of the file on which the app is working.

That might me c:\my.log or c:\a\very\deeply\nested\sub-directory\extremely_long_file_name_indeed.log

Is there an easy way to adjust the size of the 3 status bar panels when I load a new file? (maybe even a FOSS VCL component - although I can't find one)?

Answer 1

This, actually is more like TLama's first version of his deleted answer, which I liked better:

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;

The above shortens the path if it doesn't fit to a maximum width, but the original file name is not visible to the user in any way. To be able to use native hint support for status bar panels, the width of a panel must be shorter than the text can fit.

So, as an alternative, the below truncates the trailing part of the file name when it is longer than a maximum width and shows a tooltip when hovered with the mouse:

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;