Zeitabhängige Ereignisse auslösen

[Rumpi]

Hi,

vieleicht hilft dir ja das weiter

mit
MyTimerThread := TTimerThread.Create( OneSecProc ); wird alle sec die OneSecProc gerufen

mit
MyTimerThread := TTimerThread.Create( XXXX, Proc ); wird alle XXXX ms die Proc gerufen

mit
MyTimerThread.Enabled := False; kannst du ihn auch mal anhalten.

mit
MyTimerThread.Stop; beseitigt sich der "Timer-Thread" von allein

Delphi-Quellcode:

unit cl_Thread;

interface
  uses Windows, Classes, syncobjs, Sysutils;

type

  TTimerThread = class(TThread)
  private
    { Private-Deklarationen }
    FEnabled     : Boolean;
    FOneSec      : Boolean;
    FOnNotify    : TNotifyEvent;
    FInterval    : Longint;
    FTag         : Longint;
    FCloseEvent  : TSimpleEvent;
    FEnableEvent : TSimpleEvent;
    FLastSec     : Word;
  public
    constructor Create( OnNotify: TNotifyEvent ); overload;
    constructor Create( aInterval: Longint; OnNotify: TNotifyEvent ); overload;
    destructor  Destroy; override;
    procedure   Stop;
  protected
    procedure Execute; override;
    procedure Notify;
    procedure SetEnabled( Value: Boolean );
    procedure SetInterval( Value: Longint );
  published
    property Interval: Longint read FInterval write SetInterval;
    property Enabled : Boolean read FEnabled write SetEnabled;
    property Tag     : Longint read FTag write FTag;
  end;

implementation

constructor TTimerThread.Create( OnNotify: TNotifyEvent );
begin
  inherited Create( True );
  FreeOnTerminate := True;
  FOnNotify     := OnNotify;
  FInterval     := 50;
  FCloseEvent   := TSimpleEvent.Create;
  FEnableEvent  := TSimpleEvent.Create;
  FEnabled      := True;
  FOneSec       := True;
  Resume;
end;

constructor TTimerThread.Create( aInterval: Longint; OnNotify: TNotifyEvent );
begin
  inherited Create( True );
  FreeOnTerminate := True;
  FOnNotify   := OnNotify;
  FInterval   := aInterval;
  FCloseEvent := TSimpleEvent.Create;
  FEnableEvent:= TSimpleEvent.Create;
  FEnabled    := False;
  FOneSec     := False;
  Resume;
end;

destructor TTimerThread.Destroy;
begin
  FCloseEvent.Free;
  Inherited Destroy;
end;

procedure TTimerThread.Execute;
var
  Signaled    : Integer;
  h, m, s, ms : Word;
  EventHandles: array[0..1] of THandle;
begin
  EventHandles[0] := FCloseEvent.Handle;
  EventHandles[1] := FEnableEvent.Handle;
  repeat
    Signaled := WaitForMultipleObjects( 2, @EventHandles, False, FInterval );
    case Signaled of

      // Close event, terminate the thread
      WAIT_OBJECT_0 :
        begin
          ResetEvent(FCloseEvent.Handle);
          Break;
        end;

      WAIT_OBJECT_0 + 1:
        begin
          ResetEvent(FEnableEvent.Handle);
          FEnabled := True;
        end;

      // Timer Event
      WAIT_TIMEOUT  :
        if Not FOneSec then
          Synchronize(Notify)
        else
        begin
          // Has a second passed ?
          DecodeTime( Now, h, m, s, ms );
          if s <> FLastSec then
          begin
            Synchronize(Notify);
            FLastSec := s;
          end;
        end;

    end;
  until Terminated;
end;

procedure TTimerThread.Notify;
begin
  if Assigned( FOnNotify ) and FEnabled then
    FOnNotify( Self );
end;

procedure TTimerThread.Stop;
begin
  FEnabled := False;
  SetEvent(FCloseEvent.Handle);
end;

procedure TTimerThread.SetEnabled( Value: Boolean );
begin
  if FEnabled <> Value then
    if Value then
      SetEvent(FEnableEvent.Handle)
    else
      FEnabled := False;
end;

procedure TTimerThread.SetInterval( Value: Longint );
begin
  if FEnabled then
  begin
    FEnabled  := False;
    FInterval := Value;
    SetEvent(FEnableEvent.Handle);
  end
  else
    FInterval := Value;
end;


end.

mfg Rumpi