was macht AllocateHWND genau?

[snook]

okay, sry war wohl noch etwas zu früh am morgen , ich häng mal die unit rein

Delphi-Quellcode:

unit ExtDLLTimer;

interface

uses Windows, SysUtils, Classes, messages;

const
  CTI_MULT_FACTOR     = 10000;
  CTI_MAXINTERVAL     = $8000000000000000;
  CTI_MAXINTERVAL_MS  = CTI_MAXINTERVAL div CTI_MULT_FACTOR;

// Timeout to wait for finishing timer-thread
  CTI_EXITTIMEOUT     = 1000;

type
  TAPIWaitableTimer = class(TThread)
  private
    FOnTimer    : TNotifyEvent;
    FTimer,
    FCloseEvent,
    FPauseEvent,
    FExitEvent  : Cardinal;
    FInterval   : Int64;
    FRunning,
    FContinuous : boolean;
    FHandle     : HWND;
    procedure CLoseHandles;
    function GetEnabled: boolean;
    procedure ThrowTimerEvent;
    procedure SetEnabled(const Value: boolean);
    procedure SetInterval(const Value: Int64);
  protected
    procedure Execute; override;
    procedure StartTimer;
    procedure StopTimer;
  public
    constructor Create(AContinuous: boolean; ATimerObject: HWND;
      AExitEvent: Cardinal); reintroduce;
    destructor Destroy; override;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property Enabled: boolean read GetEnabled write SetEnabled;
    property CloseEvent: Cardinal read FCloseEvent;
    property Interval: Int64 read FInterval write SetInterval;
  end;

  TDLLTimer = class(TObject)
  private
    FHandle    : HWND;
    FExitEvent : Cardinal;
    FOnTimer   : TNotifyEvent;
    FTimer     : TAPIWaitableTimer;
    FContinuous: boolean;
    FInterval  : Cardinal;
    function GetEnabled: boolean;
    procedure OnAPITimer(Sender: TObject);
    procedure APITimerTerminated(Sender: TObject);
  public
    constructor Create(AContinuous: boolean); reintroduce;
    destructor Destroy; override;
    procedure WndProc(var Msg: TMessage);
    procedure StartTimer(AInterval: Int64);
    procedure StopTimer;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
    property Enabled: boolean read GetEnabled;
  end;

implementation

{ TAPIWaitableTimer }

constructor TAPIWaitableTimer.Create(AContinuous: boolean; ATimerObject: HWND;
  AExitEvent: Cardinal);
begin
  inherited create(false);
  FHandle     := ATimerObject;
  FExitEvent  := AExitEvent;
  FTimer      := CreateWaitableTimer(nil, false, PChar(''));
  FCloseEvent := CreateEvent(nil, false, false, PChar(''));
  FPauseEvent := CreateEvent(nil, false, false, PChar(''));
  FRunning    := false;
  FContinuous := AContinuous;
  FreeOnTerminate := true;
  SetInterval(1000);
end;

destructor TAPIWaitableTimer.Destroy;
begin
  CloseHandles;            
  SetEvent(FExitEvent);
  inherited;
end;

procedure TAPIWaitableTimer.CloseHandles;
begin
  if FTimer > 0 then
    closehandle(FTimer);
  if FCLoseEvent > 0 then
    closehandle(FCloseEvent);
  if FPauseEvent > 0 then
    closehandle(FPauseEvent);
  FTimer      := 0;
  FCloseEvent := 0;
end;

procedure TAPIWaitableTimer.Execute;
var objs : Array[0..2] of Cardinal;
    lQuit: boolean;
begin
  lQuit := false;
  if (FTimer > 0) and (FCloseEvent > 0) then
  begin
    objs[0] := FTimer;
    objs[1] := FCloseEvent;
    objs[2] := FPauseEvent;
    repeat

      case WaitForMultipleObjects(3, @objs, false, INFINITE) of
        WAIT_OBJECT_0    :
          begin
//            synchronize(ThrowTimerEvent);
            PostMessage(FHandle, WM_TIMER, 0, 0);
            FRunning := false;
            if FContinuous then StartTimer;
          end;
        WAIT_OBJECT_0 + 1: lQuit := true;
        WAIT_OBJECT_0 + 2:
          case Enabled of
            true  : StopTimer;
            false : StartTimer;
          end;
      end;
    until lQuit;
  end;
  Terminate;
end;

function TAPIWaitableTimer.GetEnabled: boolean;
begin
  result := (FTimer > 0) and (FCloseEvent > 0) and FRunning;
end;

procedure TAPIWaitableTimer.SetEnabled(const Value: boolean);
begin
  if Value <> Enabled then
    SetEvent(FPauseEvent);
  if suspended then
    resume;
end;

procedure TAPIWaitableTimer.SetInterval(const Value: Int64);
begin
  FInterval := Value;
  if Enabled then StartTimer;
end;

procedure TAPIWaitableTimer.StartTimer;
const WaitDur = 10;
var Duration: TLargeInteger;
    Per     : Integer;
begin
  // not sure why have to wait, but else timer sometimes behaves corrupted
  sleep(WaitDur);
  if abs(FInterval) > abs(CTI_MAXINTERVAL_MS) then
    raise Exception.Create('Maximum Interval exceeded!');
  FInterval := FInterval - WaitDur;
  Duration  := (-1) * FInterval * CTI_MULT_FACTOR;
  Per       := 0;
  FRunning  := SetWaitableTimer(FTimer, Duration, Per, nil, nil, true);
  if not FRunning then
    raise Exception.Create(SysErrorMessage(GetLastError));
  if suspended then
    resume;
end;

procedure TAPIWaitableTimer.StopTimer;
begin                                                     
  FRunning := false;
  if not CancelWaitableTimer(FTimer) then
    raise Exception.Create(SysErrorMessage(GetLastError));
end;

procedure TAPIWaitableTimer.ThrowTimerEvent;
begin
  if FRunning and Assigned(FOnTimer) then
    FOnTimer(self);
end;

{ TDLLTimer }

constructor TDLLTimer.Create(AContinuous: boolean);
begin
  inherited create;
{$IFDEF MSWINDOWS}
  FHandle := Classes.AllocateHWnd(WndProc);
{$ENDIF}
{$IFDEF LINUX}
  FHandle := WinUtils.AllocateHWnd(WndProc);
{$ENDIF}
  FContinuous := AContinuous;
  FExitEvent  := CreateEvent(nil, false, false, '');
  FTimer := TAPIWaitableTimer.Create(AContinuous, FHandle, FExitEvent);
  FTImer.OnTimer := OnAPITimer;
  FTimer.OnTerminate := APITimerTerminated;
end;

destructor TDLLTimer.Destroy;
begin
{$IFDEF MSWINDOWS}
  Classes.DeallocateHWnd(FHandle);
{$ENDIF}
{$IFDEF LINUX}
  WinUtils.DeallocateHWnd(FHandle);
{$ENDIF}
  FTimer.OnTerminate := nil;
  ResetEvent(FExitEvent);
  SetEvent(FTimer.CloseEvent);
  case WaitForSingleObject(FExitEvent, CTI_EXITTIMEOUT) of
    WAIT_OBJECT_0: FTimer := nil;
    WAIT_TIMEOUT : raise Exception.Create('Error releasing DLLTimer');
  end;
  inherited;
end;

procedure TDLLTimer.APITimerTerminated(Sender: TObject);
var lEnabled: boolean;
begin
  lEnabled := FTimer.Enabled;
  if Assigned(FTimer.FatalException) then
    raise Exception.Create(Exception(FTimer.FatalException).Message)
  else
  begin
    ResetEvent(FExitEvent);
    FTimer := TAPIWaitableTimer.Create(FContinuous, FHandle, FExitEvent);
    FTImer.OnTimer := OnAPITimer;
    FTimer.OnTerminate := APITimerTerminated;
    FTimer.Interval    := FInterval;
    if lEnabled then
      FTimer.StartTimer;
  end;
end;

function TDLLTimer.GetEnabled: boolean;
begin
  result := FTimer.Enabled;
end;

procedure TDLLTimer.OnAPITimer(Sender: TObject);
begin
  if Assigned(FOnTimer) then
    FOnTimer(Sender);
end;

procedure TDLLTimer.StartTimer(AInterval: Int64);
begin
  FInterval := AInterval;
  FTimer.Interval := AInterval;
  FTimer.Enabled  := true;;
end;

procedure TDLLTimer.StopTimer;
begin
  FTimer.Enabled := false;
end;

procedure TDLLTimer.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_TIMER: OnApiTimer(FTimer);
  end;
end;

en

d.