unit StatusBar; {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, ExtCtrls, Math, AppTheme; type TMainStatusBar = class(TPanel) private FCells: array[0..7] of TPanel; FLabels: array[0..7] of TLabel; procedure CreateStatusCell(Index: Integer; const Cap: string); procedure LayoutCells; protected procedure Resize; override; public constructor Create(AOwner: TComponent); override; procedure SetStatusText(Index: Integer; const Text: string); procedure ApplyTheme(const T: TAppTheme); end; implementation const STATUS_H = 26; GAP = 1; PAD_X = 8; SEQ_MIN_W = 90; STATUS_ORDER: array[0..7] of Integer = (2, 0, 1, 3, 7, 4, 5, 6); BASE_W: array[0..7] of Integer = (280, 160, 170, 150, 190, 180, 130, 90); INITIAL_TEXT: array[0..7] of string = ( 'Board --', 'IP --', 'Disconnected', 'Supply --', 'RX idle', 'TX idle', 'SEQ --', 'PLL --' ); constructor TMainStatusBar.Create(AOwner: TComponent); var I: Integer; begin inherited Create(AOwner); Align := alBottom; Height := STATUS_H; BevelOuter := bvNone; for I := Low(STATUS_ORDER) to High(STATUS_ORDER) do CreateStatusCell(STATUS_ORDER[I], INITIAL_TEXT[STATUS_ORDER[I]]); LayoutCells; end; procedure TMainStatusBar.CreateStatusCell(Index: Integer; const Cap: string); begin FCells[Index] := TPanel.Create(Self); FCells[Index].Parent := Self; FCells[Index].BevelOuter := bvNone; FCells[Index].Align := alNone; FCells[Index].Width := BASE_W[Index]; FCells[Index].Top := 1; FCells[Index].Height := Height - 2; FLabels[Index] := TLabel.Create(Self); FLabels[Index].Parent := FCells[Index]; FLabels[Index].AutoSize := False; FLabels[Index].Align := alClient; FLabels[Index].BorderSpacing.Left := PAD_X; FLabels[Index].BorderSpacing.Right := PAD_X; FLabels[Index].Alignment := taLeftJustify; FLabels[Index].Layout := tlCenter; FLabels[Index].Caption := Cap; FLabels[Index].Font.Name := 'Courier New'; FLabels[Index].Font.Size := 8; end; procedure TMainStatusBar.LayoutCells; var PPI, X, I, Idx, W, H, G, Pad, FixedNatural, FixedAvail: Integer; function S(Value: Integer): Integer; begin Result := (Int64(Value) * PPI + 48) div 96; if (Value > 0) and (Result < 1) then Result := 1; end; function FixedCellWidth(Index: Integer): Integer; begin Result := S(BASE_W[Index]); if FixedAvail <= 0 then Result := 0 else if FixedAvail < FixedNatural then begin Result := (Int64(Result) * FixedAvail + FixedNatural div 2) div FixedNatural; if FixedAvail >= S(48) * 7 then Result := Max(S(48), Result); end; end; begin PPI := Screen.PixelsPerInch; if PPI <= 0 then PPI := 96; G := S(GAP); Pad := S(PAD_X); if Height <> S(STATUS_H) then Height := S(STATUS_H); H := Max(1, ClientHeight - G * 2); FixedNatural := 0; for I := Low(STATUS_ORDER) to High(STATUS_ORDER) - 1 do Inc(FixedNatural, S(BASE_W[STATUS_ORDER[I]])); FixedAvail := ClientWidth - S(SEQ_MIN_W) - G * 8; X := 0; for I := Low(STATUS_ORDER) to High(STATUS_ORDER) do begin Idx := STATUS_ORDER[I]; if FCells[Idx] = nil then Continue; Inc(X, G); if Idx = 6 then W := Max(0, ClientWidth - X) else W := FixedCellWidth(Idx); FCells[Idx].SetBounds(X, G, W, H); if FLabels[Idx] <> nil then begin FLabels[Idx].BorderSpacing.Left := Pad; FLabels[Idx].BorderSpacing.Right := Pad; end; Inc(X, W); end; end; procedure TMainStatusBar.Resize; begin inherited Resize; LayoutCells; end; procedure TMainStatusBar.SetStatusText(Index: Integer; const Text: string); begin if (Index < Low(FLabels)) or (Index > High(FLabels)) then Exit; if FLabels[Index] = nil then Exit; if FLabels[Index].Caption <> Text then FLabels[Index].Caption := Text; end; procedure TMainStatusBar.ApplyTheme(const T: TAppTheme); var I: Integer; begin Color := T.Border; for I := Low(FCells) to High(FCells) do begin if FCells[I] <> nil then begin FCells[I].Color := T.Panel; FCells[I].Font.Color := T.Text; end; if FLabels[I] <> nil then begin if I in [4, 5] then FLabels[I].Font.Color := T.TextDim else if I = 6 then FLabels[I].Font.Color := T.Amber else if I = 2 then FLabels[I].Font.Color := T.TbStartText else FLabels[I].Font.Color := T.Text; FLabels[I].Color := T.Panel; end; end; end; end.