www.pudn.com > mfcdraw.zip > ATStat.pas
unit ATStat;
{================================================================}
{ TATStatusBar - V1.27 (SpreadWare) }
{================================================================}
{ You don't have to pay for this component it's spreadware }
{ That means that you may spread this (nice??) component. }
{ }
{ MultiLanguage Support for displaying Day (English,Dutch,German,}
{ French) }
{ Also a ProgressBar thing }
{ Added DisplayDate,DisplayTime,DisplayDay, DisplayProgress }
{ Properties (If you set them to False the Time/Day/Date/progress}
{ fields will not be updated by the timer }
{ }
{ Components name will automatically set to StatusBar }
{ If you don't like this remove the following line : }
{ if Name <>'StatusBar' then Name :='StatusBar'; }
{ }
{ New Properties : }
{ Beep - Beeps every second change or not }
{ BeepFreq - The Frequentie of the Beep }
{ BeepTime - Duriation of the beep in Msec(Max. 999msec) }
{ DayLanguage - The language for displaying the Day }
{ DisplayDate - If you set this to false the timer won't update }
{ this Panel anymore }
{ DisplayDay - See DisplayDate }
{ DisplayProgress - See DisplayDate }
{ DisplayTime - See DisplayDate }
{ Progress - Use Integer value's, Sets the progress }
{ Progresscolor - Set a Color for the progressbar }
{ Mode - Set to statusbar to display time, day etc. }
{ Set to progressbar to display the progressbar }
{ }
{ }
{\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/}
{================================================================}
{ USE TATStatusBar AT YOUR OWN RISK. }
{ I AM NOT RESPONSIBLE FOR ANY HARM THIS COMPONENT MIGHT CAUSE!! }
{ (This means that if your computer blows up or does any other }
{ strange things or something else happens and the TATStatusbar }
{ caused this problem I will not be responsible!!!) }
{ }
{ Enjoy, }
{ A.S. Tigelaar }
{ E-Mail : almer1@dds.nl }
{ Homepage : http://huizen.dds.nl/%7Ealmer1/ }
{ }
{================================================================}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Winprocs;
{var}
type
TTimerID =integer;
type
TMode = (mdStatusbar,mdProgressbar);
TDayLanguage = (lgEnglish, lgDutch, lgGerman, lgFrench);
TBeep = (bpNo, bpSecond);
TAlarm = (alOff, alOn);
TAlarmType = (atNone ,atBeepx2 ,atBeepx2UpDown ,atBeepx10 , atQuickBeep,
atBeepx10UpDown,atUpDown);
TATStatusbar = class(TStatusBar)
private
FDayLanguage: TDayLanguage;
FOnResize: TNotifyEvent;
FOnTimer: TNotifyEvent;
FOnAlarm: TNotifyEvent;
FTimerID: integer;
FWindowHandle: HWND;
FDisplayTime : Boolean;
FDisplayDate : Boolean;
FDisplayDay : Boolean;
FMode : TMode;
FBeep : TBeep;
FBeepTime : Integer;
FBeepFreq : Word;
FAlarm : TAlarm;
FAlarmTime : string;
FAlarmType : TAlarmType;
FInterval : integer;
FRing : Boolean;
FProgresscolor : TColor;
FProgress : Integer;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetOnTimer(Value: TNotifyEvent);
procedure SetOnAlarm(Value: TNotifyEvent);
procedure ShowDateTime;
procedure UpdateTimer;
procedure WndProc(var Msg: TMessage);
procedure SetDDate(Value : Boolean); { <\ }
procedure SetDTime(Value : Boolean); { 18 then begin
Freq := Word(1193181 div LongInt(Freq));
B := GetPort($61);
if (B and 3) = 0 then begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;
procedure TATStatusbar.Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages; {allowing access to other controls, etc.}
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;
procedure TATStatusbar.Play(Freq: Word; MSecs: Integer);
begin
Sound(Freq);
Delay(MSecs);
NoSound;
end;
procedure TATStatusbar.Stop;
begin
NoSound;
end;
constructor TATStatusbar.Create(AOwner: TComponent);
var
TimeStr: string[11];
begin
inherited Create(AOwner);
Align :=alBottom;
Cursor :=crDefault;
DragCursor :=crDrag;
DragMode :=dmManual;
Enabled :=True;
Font.Name := 'MS Sans Serif';
Font.Color := clBlack;
Font.Height := -11;
Font.Size := 8;
Font.Style := [];
FWindowHandle := AllocateHWnd(WndProc);
FDisplayTime := True;
FDisplayDate := True;
FDisplayDay := True;
FMode := mdStatusbar;
FBeepTime := 100;
FBeepFreq := 80;
FBeep := bpNo;
FAlarm := alOff;
FAlarmTime := '00:00:00';
FAlarmType := atBeepx2;
FProgress := 0;
FInterval := 1000;
Height :=19;
HelpContext :=0;
Hint :='';
panels.add;
panels.items[0].text :='';
panels.items[0].width :=width-215;
panels.items[0].style :=psText;
panels.items[0].bevel :=pbLowered;
panels.items[0].alignment :=taLeftJustify;
panels.add;
panels.items[1].text :='';
panels.items[1].width :=60;
panels.items[1].style :=psText;
panels.items[1].bevel :=pbLowered;
panels.items[1].alignment :=taLeftJustify;
panels.add;
panels.items[2].text :='';
panels.items[2].width :=90;
panels.items[2].style :=psText;
panels.items[2].bevel :=pbLowered;
panels.items[2].alignment :=taCenter;
panels.add;
panels.items[3].text :='';
panels.items[3].width :=60;
panels.items[3].style :=psText;
panels.items[3].bevel :=pbLowered;
panels.items[3].alignment :=taLeftJustify;
ParentFont :=False;
ParentShowHint :=True;
ShowHint :=True;
SimplePanel :=False;
SimpleText :='';
SizeGrip :=True;
Tag :=0;
Visible :=True;
UpdateTimer;
{ Don't wait 1 second to display the time }
FProgress:=0;
ShowDateTime;
end;
destructor TATStatusbar.Destroy;
begin
if TimerID >0 then KillTimer(FWindowHandle, 1);
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('AT', [TATStatusbar]);
end;
{ Resize event }
procedure TATStatusbar.WMSize(var Message: TWMSize);
begin
if Assigned(FOnResize) then FOnResize(Self);
if GetParentForm(self).width >214 then
panels.items[0].width :=GetParentForm(self).width-214
else
panels.items[0].width :=0;
{====================================================}
{ A resize is called after the object is created. }
{ If desired, the name can be set here. }
{ }
{ }
{----------------------------------------------------}
{ }
{ If you don't want it automatically named }
{ "StatusBar", comment out the following line }
{ }
{====================================================}
if Name <>'StatusBar' then Name :='StatusBar';
end;
procedure TATStatusbar.SetInterval(Value : integer);
begin
FInterval:=Value;
UpdateTimer;
end;
{Timer}
procedure TATStatusbar.UpdateTimer;
begin
if TimerID >0 then KillTimer(FWindowHandle, 1);
TimerID :=SetTimer(FWindowHandle, 1, FInterval, nil)
end;
procedure TATStatusbar.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
Timer;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TATStatusbar.SetOnAlarm(Value:TNotifyEvent);
begin
FOnAlarm := Value;
Update;
end;
procedure TATStatusbar.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;
procedure TATStatusbar.Timer;
begin
ShowDateTime;
Hint :=panels.items[0].text;
if Assigned(FOnTimer) then FOnTimer(Self);
end;
procedure TATStatusbar.SetBeepTime(Value : Integer); {BeepTime in MSec}
begin
if Value > 999 then
begin
Value:=999;
Play(100,40);
Play(200,40);
Play(300,40);
Play(400,40);
Play(500,40);
Play(400,40);
Play(300,40);
Play(200,40);
Play(100,40);
end;
FBeepTime := Value;
end;
procedure TATStatusbar.SetProgress(Value : Integer);
Begin
FProgress:=Value;
if FProgress>100 then FProgress:=100;
ShowDateTime;
end;
procedure TATStatusbar.SetDLanguage(Value : TDayLanguage);
begin
FDayLanguage := Value;
ShowDateTime; {So you don't have to wait 1 second}
end;
procedure TATStatusbar.SetDDate(Value : Boolean);
begin
FDisplayDate := Value;
if FDisplayDate = True then
panels.items[1].text:='';
update;
ShowDateTime; {So you don't have to wait 1 second}
end;
function TATStatusbar.SolveForX(Y, Z: Longint): Longint;
begin
Result := Trunc( Z * (Y * 0.01) );
end;
procedure TATStatusbar.SetDDay(Value : Boolean);
begin
FDisplayDay := Value;
if FDisplayDay = True then
panels.items[2].text:='';
update;
ShowDateTime; {So you don't have to wait 1 second}
end;
procedure TATStatusbar.SetDTime(Value : Boolean);
begin
FDisplayTime := Value;
if FDisplayTime = False then
panels.items[3].text:='';
update;
ShowDateTime; {So you don't have to wait 1 second}
end;
procedure TATStatusbar.ShowDateTime;
var
Curday: string[10];
TmpTime : string[11];
TmpDay : string;
Dya : integer;
wow,I : Longint;
begin
Stop; {To stop any sound running now}
if TimetoStr(Time)=FAlarmTime then
begin
FRing:=True;
if FAlarm=alOn then
if Assigned(FOnAlarm) then FOnAlarm(Self);
end;
if (FAlarm=alOff) then
NoSound;
if (FAlarm=alOn) and (FRing=True) then
begin
FBeep:=bpNo;
if FAlarmType = atBeepx2 then
begin
Play (600, 300);
Play (16, 300); {Nobeepfor 98 msec}
Play (600, 400);
end;
if FAlarmType = atBeepx2UpDown then
begin
Play (500 , 300);
Play (16, 300); {no sound for 100 msec}
play (600 , 400);
end;
if FAlarmType = atBeepx10 then
begin
for I:=0 to 8 do
begin
Play (600 , 98);
Play (16 , 2);
end;
end;
if FAlarmType = atBeepx10UpDown then
begin
for I:=0 to 2 do
begin
Play (600 , 98);
Play (16 , 2);
Play (500 , 98);
Play (16 , 2);
end;
end;
if FAlarmType = atUpDown then
begin
For I:=55 to 60 do
play(I*10,10);
For I:=60 downto 55 do
play(I*10,10);
end;
if FAlarmType = atQuickBeep then
begin
For I:=0 to 8 do
begin
Play(400,50);
Play(16,50);
end;
end;
{End of Alarm rings routine, pfeww!!}
end
else
FRing:=False;
if FMode=mdStatusbar then
begin
if FDisplayDate=true then
panels.items[1].text :=DateToStr(Date)
else
panels.items[1].text :='';
if FDisplayTime=true then
begin
panels.items[3].text :=TimeToStr(Time);
if (FBeep = bpSecond) then
begin
If TimeToStr(Time)<>TmpTime then
Play (BeepFreq, BeepTime);
TmpTime := TimeToStr(Time);
end;
end;
if FDisplayDay=true then
begin
Dya := DayofWeek(Date);
if FDayLanguage = lgEnglish then
case Dya of
1:CurDay:='Sunday';
2:CurDay:='Monday';
3:CurDay:='Tuesday';
4:CurDay:='Wednesday';
5:CurDay:='Thursday';
6:CurDay:='Friday';
7:CurDay:='Saturday';
end;{My English is reasonable, as you can see}
if FDayLanguage = lgDutch then
case Dya of
1:Curday:='Zondag';
2:Curday:='Maandag';
3:Curday:='Dinsdag';
4:Curday:='Woensdag';
5:Curday:='Donderdag';
6:Curday:='Vrijdag';
7:Curday:='Zaterdag';
end;{These should be alright, I am dutch so I should know them}
if FDayLanguage = lgGerman then
case Dya of
1:Curday:='Sonntag';
2:Curday:='Montag';
3:Curday:='Dienstag';
4:Curday:='Mittwoch';
5:Curday:='Donnerstag';
6:Curday:='Freitag';
7:Curday:='Samstag'; {Hope this one is right}
end;
if FDayLanguage = lgFrench then
case Dya of
1:Curday:='Dimanche';
2:Curday:='Lundi';
3:Curday:='Mardi';
4:Curday:='Mercredi';
5:Curday:='Jeudi';
6:Curday:='Vendredi';
7:Curday:='Samedi';
end;
panels.items[2].text:=Curday;
end
else
panels.items[2].text:='';
end
else
begin
Canvas.Pen.Color:=FProgresscolor;
Canvas.Brush.Color:=FProgresscolor;
Canvas.Brush.Style:=bsSolid;
wow:=SolveForX(FProgress,Width-2);
Canvas.rectangle(5,5,wow-5,height-3);
end;
Application.ProcessMessages;
end;
end.