Async event component

unit UAsyncEvent;

interface

uses
  WinAPI.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms, System.SysUtils, Generics.Collections;

const
  WM_ASYNCEVENT = WM_USER + 1001;

type
  TAsyncEvent = class(TComponent)
  private
    FHWnd: THandle;
    FProcList: TList<TProc>;

    procedure AllocWnd;
    procedure DestroyWnd;

    procedure WndProc(var Msg: TMessage); virtual;
    procedure WndProcWrapper(var Message: TMessage);
  protected
    procedure DoAsyncEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Post(const proc: TProc);
  end;



procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyComponents', [TAsyncEvent]);
end;

{ TAsyncEvent }

procedure TAsyncEvent.AllocWnd;
begin
  FHWnd := AllocateHWnd(WndProcWrapper);
end;

constructor TAsyncEvent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FProcList := TList<TProc>.Create;
  AllocWnd;
end;

destructor TAsyncEvent.Destroy;
begin
  DestroyWnd;

  FProcList.Free;

  inherited;
end;

procedure TAsyncEvent.DestroyWnd;
begin
  DestroyWindow(FHWnd);
end;

procedure TAsyncEvent.DoAsyncEvent;
var
  proc: TProc;
begin
  Assert(FProcList.Count > 0, 'Consistency error in AsyncEvent');

  proc := FProcList[0];
  FProcList.Delete(0);

  proc();
end;

procedure TAsyncEvent.Post(const proc: TProc);
begin
  FProcList.Add(proc);
  PostMessage(FHWnd, WM_ASYNCEVENT, 0, 0);
end;

procedure TAsyncEvent.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_ASYNCEVENT: begin
      DoAsyncEvent();
    end;
  end;
end;

procedure TAsyncEvent.WndProcWrapper(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    Application.HandleException(Self);
  end;
end;

end.