БОЛЬШОЙ FAQ ПО DELPHI



Показ даты, времени и состояния клавиш в строке состояния

Предположим, у вас есть 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://exelab.ru/pro/



Видеокурс ВЗЛОМ