Cambiar el tamaño de los paneles de la barra de estado para que quepan en el contenido

Question

Digamos que mi barra de estado tiene 3 paneles y el de la izquierda es el nombre del archivo en el que está trabajando la aplicación.

Esa vez me c:\my.log o c:\a\very\deeply\nested\sub-directory\extremely_long_file_name_indeed.log

¿Hay una manera fácil de ajustar el tamaño de los paneles de barras 3 de estado cuando me carga un nuevo archivo? (tal vez incluso un componente de FOSS VCL, aunque no puedo encontrar uno)?

Answer 1

Esto, en realidad es más como la primera versión del Tlama de su respuesta borrado, lo que me gustó mucho mejor:

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; 

Lo anterior acorta la ruta si no se ajusta a una anchura máxima, pero el original el nombre del archivo no es visible para el usuario de ninguna manera. Para poder utilizar el soporte de sugerencia nativa para los paneles de la barra de estado, el ancho de un panel debe ser más corto de lo que el texto puede caber.

Así que, como alternativa, el siguiente trunca la parte posterior del nombre del archivo cuando es más largo que un ancho máximo y muestra un texto de ayuda cuando flotaba con el ratón:

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;