unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.StdCtrls;
const
ttmSecond : Double = 1/(24*60*60*1000);
type
TCycleThread =
class(TThread)
protected
procedure Execute;
override;
private
StartZyklus : TDateTime;
Procedure Zyklus;
public
SollZykluszeit : Integer;
IstZyklusZeit : Double;
MinCycle,
AktCycle,
MaxCycle: Double;
ChgEvent: TNotifyEvent;
Constructor Create (CreateSuspended : Boolean);
Destructor Destroy;
override;
end;
type
TForm1 =
class(TForm)
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
MyThread : TCycleThread;
procedure ChangeEvent(Sender: TObject);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Elapsedms(LastTime: TDateTime): Double;
begin
Result := (Now - LastTime) / ttmSecond;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
H : THandle;
begin
H := GetCurrentProcess();
SetPriorityClass(H, HIGH_PRIORITY_CLASS);
MyThread := TCycleThread.Create(True);
MyThread.SollZykluszeit := 6;
MyThread.ChgEvent := ChangeEvent;
MyThread.Start;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(MyThread)
then
FreeAndNil(MyThread);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if Assigned(MyThread)
then
begin
Label2.Caption := '
kürzeste Zykluszeit: ' + MyThread.MinCycle.ToString;
Label1.Caption := '
Aktuelle Zykluszeit: ' + MyThread.AktCycle.ToString;
Label3.Caption := '
längste Zykluszeit: ' + MyThread.MaxCycle.ToString;
end;
end;
procedure TForm1.ChangeEvent(Sender: TObject);
begin
Timer1.Enabled := True;
end;
{ TCycleThread }
constructor TCycleThread.Create(CreateSuspended: Boolean);
begin
Inherited Create (CreateSuspended);
Priority := tpHighest;
MinCycle := -1;
AktCycle := -1;
MaxCycle := -1;
end;
destructor TCycleThread.Destroy;
begin
Inherited Destroy;
end;
procedure TCycleThread.Execute;
var
Return : LongWord;
ThreadHandle : THandle;
begin
FreeOnTerminate := False;
StartZyklus := Now;
try
while not Terminated
do
begin
ThreadHandle := Self.ThreadID;
Return := MsgWaitForMultipleObjects (0, ThreadHandle, False, SollZykluszeit, QS_ALLINPUT);
if Return = WAIT_OBJECT_0
then
begin
end
else
begin
if not Terminated
then
begin
Zyklus;
end;
end;
end;
finally
end;
end;
procedure TCycleThread.Zyklus;
begin
if Terminated
then Exit;
//Tue irgendwas
IstZyklusZeit := (Elapsedms (StartZyklus));
StartZyklus := Now;
if (IstZyklusZeit < MinCycle)
or (MinCycle = -1)
then
MinCycle := IstZyklusZeit;
AktCycle := IstZyklusZeit;
if (IstZyklusZeit > MaxCycle)
or (MaxCycle = -1)
then
MaxCycle := IstZyklusZeit;
if Assigned(ChgEvent)
then
ChgEvent(Self);
end;
end.