Eigene Timer Komponente aus der MMSystem

[stoxx]

so ...

gruß Stoxx

Delphi-Quellcode:

unit SystemTimerU;
interface

uses
  Windows, SysUtils, MMSystem, Classes; 

type

  TMMTimerData = record
    Instanz : TObject;
  end;
  PMMTimerData = ^TMMTimerData;


  TSystemTimer = class(TObject)
    private

      pSelfData : PMMTimerData;
      TimerID: Longword;
      FOnTimer: TNotifyEvent;
      FInterval: integer;
      procedure SetInterval(Value: integer);
      function GetInterval: integer;
    public
      procedure StartTimer;
      procedure StopTimer;
      constructor Create;
      destructor Destroy; override;
    published
      property Interval: integer read GetInterval write SetInterval;
      property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;


implementation

//==============================================================================
constructor TSystemTimer.Create;
begin
  inherited Create;
  TimerID := 0;
  new(PSelfData);
end;
//==============================================================================
destructor TSystemTimer.Destroy;
begin
  FOnTimer := nil;
  self.stopTimer;
  dispose(PSelfData);
  sleep(50);  // eigenartige Abstürze ohne dies
  inherited Destroy;
end;
//==============================================================================

procedure TSystemTimer.SetInterval(Value: integer); 
begin
  FInterval := Value;
end;

//==============================================================================

function TSystemTimer.GetInterval: integer; 
begin
  Result := FInterval;
end;

//==============================================================================

procedure TimerCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall; pascal;
var
   Timer : TSystemTimer;
   selfData : TMMTimerData;

begin

if dwUser <> 0 then begin
    SelfData := pMMTimerData(dwUser)^;
    Timer := TSystemTimer(selfdata.instanz);

    if assigned(Timer.FOnTimer)
      then Timer.FOnTimer(Timer);
    end;
end;

//==============================================================================

procedure TSystemTimer.StartTimer;
begin
  PSelfData.Instanz := Self;

  if TimerID = 0
     then TimerID := timeSetEvent(FInterval, 0, @TimerCallback, Integer(pSelfData), TIME_PERIODIC);
end;

//==============================================================================

procedure TSystemTimer.StopTimer;
begin

  pSelfData.Instanz := nil;
  if TimerID <> 0
   then timeKillEvent(TimerID);
  TimerID := 0;


end;

end.