Показ даты, времени и состояния клавиш в строке состояния
01.01.2007
Предположим, у вас есть StatusBar с 4-мя панелями, плюс таймер. Тогда вы можете сделать:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
with StatusBar1 do
begin
if GetKeyState(VK_CAPITAL) <> 0 then
panels[0].text := ' CAP'
else
panels[0].text := '';
if GetKeyState(VK_NUMLOCK) <> 0 then
panels[1].text := ' NUM'
else
panels[1].text := '';
if GetKeyState(VK_SCROLL) <> 0 then
panels[2].text := ' SCRL'
else
panels[2].text := '';
panels[3].text := ' ' + DateTimeToStr(now);
end;
end;
О том, как можно изменить формат вывода даты, доходчиво и с примерами изложено в электронной справке, в разделе, посвященный датам (Date). Обратите внимание на то, что свойство Text имеет тип строки, поэтому вы не можете написать panels[0].text := DateTime(now), т.к. дата/время имеет тип Double.
unit Status;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, Menus, Gauges;
type
TStatus = class(TCustomPanel)
private
FDate: Boolean;
FKeys: Boolean;
FTime: Boolean;
FResources: Boolean;
DateTimePanel: TPanel;
ResPanel: TPanel;
ResGauge: TGauge;
CapPanel: TPanel;
NumPanel: TPanel;
InsPanel: TPanel;
HelpPanel: TPanel;
UpdateWidth: Boolean;
FTimer: TTimer;
procedure SetDate(A: Boolean);
procedure SetKeys(A: Boolean);
procedure SetTime(A: Boolean);
procedure SetResources(A: Boolean);
procedure SetCaption(A: string);
function GetCaption: string;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetupPanelFields(ThePanel: TPanel);
procedure SetupPanel(ThePanel: TPanel; WidthMask: string);
procedure UpdateStatusBar(Sender: TObject);
published
property ShowDate: Boolean read FDate write SetDate default True;
property ShowKeys: Boolean read FKeys write SetKeys default True;
property ShowTime: Boolean read FTime write SetTime default True;
property ShowResources: Boolean read FResources write SetResources
default True;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderStyle;
property BorderWidth;
property Caption: string read GetCaption write SetCaption;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ParentColor;
property ParentCtl3d;
property ParentFont;
property ParentShowHint;
property PopUpMenu;
property ShowHint;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TStatus]);
end;
procedure TStatus.SetupPanelFields(ThePanel: TPanel);
begin
with ThePanel do
begin
Alignment := taCenter;
Caption := '';
BevelInner := bvLowered;
BevelOuter := bvNone;
{Установите все в True, чтобы все это отразилось на TStatus}
ParentColor := True;
ParentFont := True;
ParentCtl3D := True;
end;
end;
procedure TStatus.SetupPanel(ThePanel: TPanel; WidthMask: string);
begin
SetupPanelFields(ThePanel);
with ThePanel do
begin
Width := Canvas.TextWidth(WidthMask);
Align := alRight;
end;
end;
constructor TStatus.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := TWinControl(AOwner);
FTime := True;
FDate := True;
FKeys := True;
FResources := True;
{Заставляем строку состояния выровняться по нижнему краю}
Align := alBottom;
Height := 19;
BevelInner := bvNone;
BevelOuter := bvRaised;
{Если UpdateWidth равен TRUE, StatusBar пересчитывает только ширину панелей}
UpdateWidth := True;
Locked := True;
TabOrder := 0;
;
TabStop := False;
Font.Name := 'Arial';
Font.Size := 8;
{Создаем панель, которая будет отображать дату и время}
DateTimePanel := TPanel.Create(Self);
DateTimePanel.Parent := Self;
SetupPanel(DateTimePanel, ' 00/00/00 00:00:00 дп ');
{СОздаем панель, которая будет содержать графику ресурсов}
ResPanel := TPanel.Create(Self);
ResPanel.Parent := Self;
SetupPanel(ResPanel, ' ');
{Создаем 2 Gauges, которые размещаем на Resource Panel}
ResGauge := TGauge.Create(Self);
ResGauge.Parent := ResPanel;
ResGauge.Align := alClient;
ResGauge.ParentFont := True;
ResGauge.BackColor := Color;
ResGauge.ForeColor := clLime;
ResGauge.BorderStyle := bsNone;
{Создаем панель, которая будет отображать состояние CapsLock}
CapPanel := TPanel.Create(Self);
CapPanel.Parent := Self;
SetupPanel(CapPanel, ' Cap ');
{Создаем панель, которая будет отображать состояние NumLock}
NumPanel := TPanel.Create(Self);
NumPanel.Parent := Self;
SetupPanel(NumPanel, ' Num ');
{Создаем панель, которая будет отображать состояние Insert/Overwrite}
InsPanel := TPanel.Create(Self);
InsPanel.Parent := Self;
SetupPanel(InsPanel, ' Ins ');
{Создаем панель, которая будет отображать текст состояния}
HelpPanel := TPanel.Create(Self);
HelpPanel.Parent := Self;
SetupPanelFields(HelpPanel);
{Имеем вспомогательную панель, занимающую все остальное пространство}
HelpPanel.Align := alClient;
HelpPanel.Alignment := taLeftJustify;
{Это таймер, который регулярно обновляет строку состояния}
FTimer := TTimer.Create(Self);
if FTimer <> nil then
begin
FTimer.OnTimer := UpdateStatusBar;
{Обновление происходит дважды в секунду}
FTimer.Interval := 500;
FTimer.Enabled := True;
end;
end;
destructor TStatus.Destroy;
begin
FTimer.Free;
HelpPanel.Free;
InsPanel.Free;
NumPanel.Free;
CapPanel.Free;
ResGauge.Free;
ResPanel.Free;
DateTimePanel.Free;
inherited Destroy;
end;
procedure TStatus.SetDate(A: Boolean);
begin
FDate := A;
UpdateWidth := True;
end;
procedure TStatus.SetKeys(A: Boolean);
begin
FKeys := A;
UpdateWidth := True;
end;
procedure TStatus.SetTime(A: Boolean);
begin
FTime := A;
UpdateWidth := True;
end;
procedure TStatus.SetResources(A: Boolean);
begin
FResources := A;
UpdateWidth := True;
end;
{Если мы получаем или устанавливаем заголовок TStatus, то вместо этого задаем
заголовок HelpPanel}
procedure TStatus.SetCaption(A: string);
begin
HelpPanel.Caption := ' ' + A;
end;
function TStatus.GetCaption: string;
begin
GetCaption := HelpPanel.Caption;
end;
{Данная процедура устанавливает соответствующие заголовки}
procedure TStatus.UpdateStatusBar(Sender: TObject);
begin
if ShowDate and ShowTime then
DateTimePanel.Caption := DateTimeToStr(Now)
else if ShowDate and not ShowTime then
DateTimePanel.Caption := DateToStr(Date)
else if not ShowDate and ShowTime then
DateTimePanel.Caption := TimeToStr(Time)
else
DateTimePanel.Caption := '';
if UpdateWidth then
with DateTimePanel do
if ShowDate or ShowTime then
Width := Canvas.TextWidth(' ' + Caption + ' ')
else
Width := 0;
if ShowResources then
begin
ResGauge.Progress := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);
if ResGauge.Progress < 20 then
ResGauge.ForeColor := clRed
else
ResGauge.ForeColor := clLime;
end;
if UpdateWidth then
if ShowResources then
ResPanel.Width := Canvas.TextWidth(' ')
else
ResPanel.Width := 0;
if ShowKeys then
begin
if (GetKeyState(vk_NumLock) and $01) <> 0 then
NumPanel.Caption := ' Num '
else
NumPanel.Caption := '';
if (GetKeyState(vk_Capital) and $01) <> 0 then
CapPanel.Caption := ' Cap '
else
CapPanel.Caption := '';
if (GetKeyState(vk_Insert) and $01) <> 0 then
InsPanel.Caption := ' Ins '
else
InsPanel.Caption := '';
end;
if UpdateWidth then
if ShowKeys then
begin
NumPanel.Width := Canvas.TextWidth(' Num ');
InsPanel.Width := Canvas.TextWidth(' Ins ');
CapPanel.Width := Canvas.TextWidth(' Cap ');
end
else
begin
NumPanel.Width := 0;
InsPanel.Width := 0;
CapPanel.Width := 0;
end;
UpdateWidth := False;
end;
{Позволяем изменять шрифты, используемые панелями для вывода текста}
procedure TStatus.CMFontChanged(var Message: TMessage);
begin
inherited;
UpdateWidth := True;
end;
end.
interface
implementation
end.
Взято с https://delphiworld.narod.ru