Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a status bar that displays the system's time, date and keyboard st Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
26-Aug-02
Category
VCL-General
Language
Delphi All Versions
Views
68
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

How to create a status bar that displays the system's time, date and keyboard status

Answer:

1   unit Status;
2   
3   interface
4   
5   uses
6     SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7     Forms, Dialogs, ExtCtrls, Menus, Gauges;
8   
9   type
10    TStatus = class(TCustomPanel)
11    private
12      FDate: Boolean;
13      FKeys: Boolean;
14      FTime: Boolean;
15      FResources: Boolean;
16      DateTimePanel: TPanel;
17      ResPanel: TPanel;
18      ResGauge: TGauge;
19      CapPanel: TPanel;
20      NumPanel: TPanel;
21      InsPanel: TPanel;
22      HelpPanel: TPanel;
23      UpdateWidth: Boolean;
24      FTimer: TTimer;
25      procedure SetDate(A: Boolean);
26      procedure SetKeys(A: Boolean);
27      procedure SetTime(A: Boolean);
28      procedure SetResources(A: Boolean);
29      procedure SetCaption(A: string);
30      function GetCaption: string;
31      procedure CMFontChanged(var message: TMessage); message CM_FONTCHANGED;
32    public
33      constructor Create(AOwner: TComponent); override;
34      destructor Destroy; override;
35      procedure SetupPanelFields(ThePanel: TPanel);
36      procedure SetupPanel(ThePanel: TPanel; WidthMask: string);
37      procedure UpdateStatusBar(Sender: TObject);
38    published
39      property ShowDate: Boolean read FDate write SetDate default True;
40      property ShowKeys: Boolean read FKeys write SetKeys default True;
41      property ShowTime: Boolean read FTime write SetTime default True;
42      property ShowResources: Boolean read FResources write SetResources default True;
43      property BevelInner;
44      property BevelOuter;
45      property BevelWidth;
46      property BorderStyle;
47      property BorderWidth;
48      property Caption: string read GetCaption write SetCaption;
49      property Color;
50      property Ctl3D;
51      property DragCursor;
52      property DragMode;
53      property Enabled;
54      property Font;
55      property ParentColor;
56      property ParentCtl3d;
57      property ParentFont;
58      property ParentShowHint;
59      property PopUpMenu;
60      property ShowHint;
61      property Visible;
62    end;
63  
64  procedure register;
65  
66  implementation
67  
68  procedure register;
69  begin
70    RegisterComponents('Additional', [TStatus]);
71  end;
72  
73  procedure TStatus.SetupPanelFields(ThePanel: TPanel);
74  begin
75    with ThePanel do
76    begin
77      Alignment := taCenter;
78      Caption := '';
79      BevelInner := bvLowered;
80      BevelOuter := bvNone;
81      {Set all these true so they reflect the settings of the TStatus}
82      ParentColor := True;
83      ParentFont := True;
84      ParentCtl3D := True;
85    end;
86  end;
87  
88  procedure TStatus.SetupPanel(ThePanel: TPanel; WidthMask: string);
89  begin
90    SetupPanelFields(ThePanel);
91    with ThePanel do
92    begin
93      Width := Canvas.TextWidth(WidthMask);
94      Align := alRight;
95    end;
96  end;
97  
98  constructor TStatus.Create(AOwner: TComponent);
99  begin
100   inherited Create(AOwner);
101   Parent := TWinControl(AOwner);
102   FTime := True;
103   FDate := True;
104   FKeys := True;
105   FResources := True;
106   {Force the status bar to be aligned bottom}
107   Align := alBottom;
108   Height := 19;
109   BevelInner := bvNone;
110   BevelOuter := bvRaised;
111   {When UpdateWidth is set TRUE, status bar will recalculate panel widths once}
112   UpdateWidth := True;
113   Locked := True;
114   TabOrder := 0;
115   ;
116   TabStop := False;
117   Font.Name := 'Arial';
118   Font.Size := 8;
119   {Create the panel that will hold the date and time}
120   DateTimePanel := TPanel.Create(Self);
121   DateTimePanel.Parent := Self;
122   SetupPanel(DateTimePanel, '  00/00/00 00:00:00 am  ');
123   {Create the panel that will hold the resources graph}
124   ResPanel := TPanel.Create(Self);
125   ResPanel.Parent := Self;
126   SetupPanel(ResPanel, '                    ');
127   {Create the 2 Gauges that will reside within the Resource Panel}
128   ResGauge := TGauge.Create(Self);
129   ResGauge.Parent := ResPanel;
130   ResGauge.Align := alClient;
131   ResGauge.ParentFont := True;
132   ResGauge.BackColor := Color;
133   ResGauge.ForeColor := clLime;
134   ResGauge.BorderStyle := bsNone;
135   {Create the panel that will hold the CapsLock state}
136   CapPanel := TPanel.Create(Self);
137   CapPanel.Parent := Self;
138   SetupPanel(CapPanel, '  Cap  ');
139   {Create the panel that will hold the NumLock state}
140   NumPanel := TPanel.Create(Self);
141   NumPanel.Parent := Self;
142   SetupPanel(NumPanel, '  Num  ');
143   {Create the panel that will hold the Insert/Overwrite state}
144   InsPanel := TPanel.Create(Self);
145   InsPanel.Parent := Self;
146   SetupPanel(InsPanel, '  Ins  ');
147   {Create the panel that will hold the status text}
148   HelpPanel := TPanel.Create(Self);
149   HelpPanel.Parent := Self;
150   SetupPanelFields(HelpPanel);
151   {Have the help panel consume all remaining space}
152   HelpPanel.Align := alClient;
153   HelpPanel.Alignment := taLeftJustify;
154   {This is the timer that will update the status bar at regular intervals}
155   FTimer := TTimer.Create(Self);
156   if FTimer <> nil then
157   begin
158     FTimer.OnTimer := UpdateStatusBar;
159     {Updates will occur twice a second}
160     FTimer.Interval := 500;
161     FTimer.Enabled := True;
162   end;
163 end;
164 
165 destructor TStatus.Destroy;
166 begin
167   FTimer.Free;
168   HelpPanel.Free;
169   InsPanel.Free;
170   NumPanel.Free;
171   CapPanel.Free;
172   ResGauge.Free;
173   ResPanel.Free;
174   DateTimePanel.Free;
175   inherited Destroy;
176 end;
177 
178 procedure TStatus.SetDate(A: Boolean);
179 begin
180   FDate := A;
181   UpdateWidth := True;
182 end;
183 
184 procedure TStatus.SetKeys(A: Boolean);
185 begin
186   FKeys := A;
187   UpdateWidth := True;
188 end;
189 
190 procedure TStatus.SetTime(A: Boolean);
191 begin
192   FTime := A;
193   UpdateWidth := True;
194 end;
195 
196 procedure TStatus.SetResources(A: Boolean);
197 begin
198   FResources := A;
199   UpdateWidth := True;
200 end;
201 
202 {When we set or get the TStatus caption, it is affecting the HelpPanel caption 
203 instead}
204 
205 procedure TStatus.SetCaption(A: string);
206 begin
207   HelpPanel.Caption := ' ' + A;
208 end;
209 
210 function TStatus.GetCaption: string;
211 begin
212   GetCaption := HelpPanel.Caption;
213 end;
214 
215 {This procedure sets the captions appropriately}
216 
217 procedure TStatus.UpdateStatusBar(Sender: TObject);
218 begin
219   if ShowDate and ShowTime then
220     DateTimePanel.Caption := DateTimeToStr(Now)
221   else if ShowDate and not ShowTime then
222     DateTimePanel.Caption := DateToStr(Date)
223   else if not ShowDate and ShowTime then
224     DateTimePanel.Caption := TimeToStr(Time)
225   else
226     DateTimePanel.Caption := '';
227   if UpdateWidth then
228     with DateTimePanel do
229       if ShowDate or ShowTime then
230         Width := Canvas.TextWidth('  ' + Caption + '  ')
231       else
232         Width := 0;
233   if ShowResources then
234   begin
235     ResGauge.Progress := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);
236     if ResGauge.Progress < 20 then
237       ResGauge.ForeColor := clRed
238     else
239       ResGauge.ForeColor := clLime;
240   end;
241   if UpdateWidth then
242     if ShowResources then
243       ResPanel.Width := Canvas.TextWidth('                    ')
244     else
245       ResPanel.Width := 0;
246   if ShowKeys then
247   begin
248     if (GetKeyState(vk_NumLock) and $01) <> 0 then
249       NumPanel.Caption := '  Num  '
250     else
251       NumPanel.Caption := '';
252     if (GetKeyState(vk_Capital) and $01) <> 0 then
253       CapPanel.Caption := '  Cap  '
254     else
255       CapPanel.Caption := '';
256     if (GetKeyState(vk_Insert) and $01) <> 0 then
257       InsPanel.Caption := '  Ins  '
258     else
259       InsPanel.Caption := '';
260   end;
261   if UpdateWidth then
262     if ShowKeys then
263     begin
264       NumPanel.Width := Canvas.TextWidth(' Num ');
265       InsPanel.Width := Canvas.TextWidth(' Ins ');
266       CapPanel.Width := Canvas.TextWidth(' Cap ');
267     end
268     else
269     begin
270       NumPanel.Width := 0;
271       InsPanel.Width := 0;
272       CapPanel.Width := 0;
273     end;
274   UpdateWidth := False;
275 end;
276 
277 {This allows font changes to be detected so the panels will be adjusted}
278 
279 procedure TStatus.CMFontChanged(var message: TMessage);
280 begin
281   inherited;
282   UpdateWidth := True;
283 end;
284 
285 end.
286 
287 interface
288 
289 implementation
290 
291 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC