unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, Math,
{$IFDEF VER150} // Delphi 7
StdCtrls, Buttons, jpeg;
{$ELSE}
Vcl.StdCtrls,
Vcl.Buttons,
Vcl.Imaging.jpeg;
{$ENDIF}
type
TTimerNW =
class(TTimer)
private
fOneSecond : Boolean;
fMidnight : Boolean;
function CalcTimerInterval(iTimerInterval : Integer) : Integer;
function GetEnabled:boolean;
function GetInterval: cardinal;
procedure init;
procedure SetEnabled(e: boolean);
procedure SetInterval(i: cardinal);
procedure SetMidNight(AValue : Boolean);
procedure SetOneSecond(AValue : Boolean);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
property Enabled : Boolean
read GetEnabled
write SetEnabled
default False;
property Interval : Cardinal
read GetInterval
write SetInterval
default 1000;
property OneSecond : Boolean
read fOneSecond
write SetOneSecond;
property MidNight : Boolean
read fMidNight
write SetMidNight;
end;
type
TForm1 =
class(TForm)
BitBtnClose: TBitBtn;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Panel1: TPanel;
StatusBar1: TStatusBar;
TrackBar1: TTrackBar;
procedure BitBtnCloseClick(Sender: TObject);
procedure Sekundenanzeige(Sender: TObject);
procedure Datumsanzeige(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
fTimer : TTimerNW;
ftmDatum : TTimerNW;
procedure Ausgabe;
public
{ Public-Deklarationen }
end;
const
iOneSecond : Integer = 1000;
// eine Sekunde in Millisekunden
iFiveSeconds : Integer = 5000;
// fünf Sekunden in Millisekunden
iFifteenSeconds : Integer = 15000;
// fünfzehn Sekunden in Millisekunden
iOneMinute : Integer = 60000;
// eine Minute in Millisekunden
iFiveMinutes : Integer = 300000;
// Fünf Minuten in Millisekunden
iFifteenMinutes : Integer = 900000;
// Fünfzehn Minuten in Millisekunden
iOneHour : Integer = 3600000;
// Eine Stunde in Millisekunden
iOneDay : Integer = 86400000;
// Ein Tag in Millisekunden
csHeute = '
Der heutige Tag ist der %s des %s. Monates des Jahres %s.';
csUhrzeit = '
%s Stunden, %s Minuten, %s Sekunden und %s Millisekunden';
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TTimerNW.create;
begin
inherited Create(AOwner);
fOneSecond := False;
fMidnight := False;
init;
end;
destructor TTimerNW.Destroy;
begin
inherited Destroy;
end;
procedure TTimerNW.init;
begin
inherited Interval := 1000;
inherited Enabled := True;
end;
procedure TTimerNw.SetEnabled(e: Boolean);
begin
if fOneSecond
then Interval := CalcTimerInterval(iOneSecond)
else if fMidNight
then Interval := CalcTimerInterval(iOneDay);
inherited Enabled := e;
end;
procedure TTimerNW.SetInterval(i: Cardinal);
begin
if i = 0
then i := 1000;
inherited Interval := i;
end;
function TTimerNW.GetInterval;
begin
inherited;
Result :=
inherited Interval;
end;
function TTimerNW.GetEnabled;
begin
Result :=
inherited Enabled;
end;
function TTimerNW.CalcTimerInterval(iTimerInterval : Integer) : Integer;
Var
dNow : Double;
begin
// Interval setzen
// Tagesdatum und Uhrzeit holen
dNow := Now;
// Den Tagesanteil holen (= Nachkommastellen).
dNow := dNow - Trunc(dNow);
// Rest bis Mitternacht holen.
dNow := 1 - dNow;
// Nachkommastellen mal Millisekunden pro Tag
Result := Trunc(dNow * iOneDay);
// wir benötigen den Rest bis zum angegeben Interval, damit der Timer
// zur nächsten Minute, Stunde, 0 Uhr ... aktive wird.
Result := (Result
mod Max(iTimerInterval,1));
end;
procedure TTimerNW.SetOneSecond(AValue : Boolean);
begin
fOneSecond := AValue;
if AValue
then begin
fMidNight := false;
Interval := CalcTimerInterval(iOneSecond);
end;
end;
procedure TTimerNW.SetMidNight(AValue : Boolean);
begin
fMidNight := AValue;
if AValue
then begin
fOneSecond := false;
Interval := CalcTimerInterval(iOneDay);
end;
end;
function DezInRoem(n:Integer):
string;
function teil(
const groessenordnung1,groessenordnung2:integer;
var rest:integer;
const zeichen1,zeichen2:char):
string;
begin
result:='
';
while rest>=groessenordnung1
do
begin
dec(rest,groessenordnung1);
//rest:=rest-groessenordnung;
result:=result+zeichen1;
//z.B. +'M'
end;
if rest>=groessenordnung2
then
begin
dec(rest,groessenordnung2);
result:=result+zeichen2+zeichen1;
//z.B. +'CM'
End;
end;
begin
result := '
';
//in Delphi automatisch
result := result + teil(1000,900,n,'
M','
C');
result := result + teil( 500,400,n,'
D','
C');
result := result + teil( 100, 90,n,'
C','
X');
result := result + teil( 50, 40,n,'
L','
X');
result := result + teil( 10, 9,n,'
X','
I');
result := result + teil( 5, 4,n,'
V','
I');
result := result + teil( 1, 1,n,'
I','
I');
end;
procedure TForm1.BitBtnCloseClick(Sender: TObject);
begin
close;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
startTime: Cardinal;
begin
startTime := GetTickCount;
//Befehlesfolge deren Zeitdauer bestimmt werden soll
Ausgabe;
// ShowMessage('Die Routine benötigte etwa ' + (IntToStr(GetTickCount - startTime)) + ' ms');
fTimer.Enabled := true;
// showMessage(floattostr(timer2.Interval));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
freq: Int64;
startTime: Int64;
endTime: Int64;
begin
fTimer.Enabled := false;
QueryPerformanceFrequency(freq);
QueryPerformanceCounter(startTime);
//Befehlesfolge deren Zeitdauer bestimmt werden soll
Ausgabe;
QueryPerformanceCounter(endTime);
fTimer.Enabled := true;
// ShowMessage('Die Routine benötigte etwa ' + IntToStr((endTime - startTime) * 1000 div freq) + ' ms');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
// Damit der Timer zur nächsten vollen Sekunde ausgelöst wird:
fTimer.Interval := fTimer.CalcTimerInterval(iOneSecond);
//showMessage(inttostr(CalcTimerInterval(iOneSecond)));
// showMessage(inttostr(Timer2.Interval));
// Zur nächsten vollen Viertelstunde, um den Glockenschlag für die Viertelstunde auszulösen:
fTimer.Interval := fTimer.CalcTimerInterval(iFifteenMinutes);
// Oder um Mitternacht, z. B. für den Datumswechsel:
fTimer.Interval := fTimer.CalcTimerInterval(iOneDay);
end;
procedure TForm1.Sekundenanzeige(Sender: TObject);
//Messung Intervall
var
freq : Int64;
startTime: Int64;
endTime : Int64;
Present : TDateTime;
Hour, Min, Sec, MSec: Word;
begin
fTimer.Enabled := false;
QueryPerformanceFrequency(freq);
QueryPerformanceCounter(startTime);
Ausgabe;
Present := Now;
Panel1.Caption := timeToStr(Present);
StatusBar1.Panels[0].Text := TimeToStr(Present);
SysUtils.DecodeTime(Present, Hour, Min, Sec, MSec);
Trackbar1.Position := Sec;
QueryPerformanceCounter(endTime);
fTimer.Enabled := true;
// ShowMessage('Die Routine benötigte etwa ' + IntToStr((endTime - startTime) * 1000 div freq) + ' ms');
end;
procedure TForm1.Datumsanzeige(Sender: TObject);
var
Present : TDateTime;
begin
ftmdatum.Enabled := false;
Present := Now;
Panel1.Caption := timeToStr(Present);
StatusBar1.Panels[1].Text := FormatDateTime('
"Heute ist "dddd," der "d.mmmm yyyy"',Present);
ftmDatum.Enabled := true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fTimer := TTimerNW.Create(Self);
fTimer.OnTimer := Sekundenanzeige;
fTimer.OneSecond := True;
Sekundenanzeige(Sender);
ftmDatum := TTimerNW.Create(Self);
ftmDatum.MidNight := True;
Datumsanzeige(Sender);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ftmDatum.Free;
fTimer.Free;
end;
procedure TForm1.Ausgabe;
var
Present: TDateTime;
Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
Present := Now;
SysUtils.DecodeDate(Present, Year, Month, Day);
SysUtils.DecodeTime(Present, Hour, Min, Sec, MSec);
Label1.Caption := Format(csHeute,[Dezinroem(Day), Dezinroem(Month), DezinRoem(Year)]);
Label2.Caption := Format(csUhrzeit,[DezInRoem(Hour),DezInRoem(Min), DezinRoem(Sec), DezinRoem(MSec)]);
Label4.Caption := DezInRoem(Hour);
Label5.Caption := DezInRoem(Min);
Label6.Caption := DezInRoem(Sec);
Label7.Caption := DezInRoem(mSec);
end;
end.