* Start events

src/basevents.pas

@@ -0,0 +1,1144 @@
+unit basevents;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch functionreferences}
+
+interface
+
+uses
+  Classes, SysUtils, Contnrs;
+
+Type
+  TEventID = Word;
+  TEventName = UTF8String;
+
+  EEvents = Class(Exception);
+
+  { TAbstractEvent }
+
+  TAbstractEvent = Class(TObject)
+  private
+    FSender: TObject;
+    FEventID : TEventID;
+  public
+    Constructor Create(aSender : TObject; aID : TEventID);
+    // Event name. Mandatory. Will be lowercased.
+    Class Function EventName : TEventName; virtual; abstract;
+    // Register the event class type. Returns the event ID.
+    Class Function Register : TEventID; virtual;
+    // Sender of the event
+    Property Sender : TObject Read FSender Write FSender;
+    // Event ID used for create
+    Property EventID : TEventID Read FEventID;
+  end;
+  TAbstractEventClass = Class of TAbstractEvent;
+
+  TEventHandler = Procedure(Event : TAbstractEvent) of object;
+  TEventCallBack = Procedure(Event : TAbstractEvent);
+  TEventHandlerRef = Reference to Procedure(Event : TAbstractEvent);
+
+  { TEventDef }
+
+  TEventDef = Class(TObject)
+  private
+    FClass: TAbstractEventClass;
+    FID: TEventID;
+  Public
+    Constructor Create(aID : TEventID; aClass : TAbstractEventClass);
+    Property ID : TEventID Read FID;
+    Property EventClass : TAbstractEventClass Read FClass;
+  end;
+  TEventDefArray = Array of TEventDef;
+
+  { TEventRegistry }
+
+  // This class basically maps event names/ids to classes.
+
+  TEventRegistry = class(TObject)
+  private
+    FIDOffset: TEventID;
+    FEventDefs : Array of TEventDef;
+    FHash : TFPObjectHashTable;
+    FNextID : TEventID;
+    class var _Instance: TEventRegistry;
+    procedure SetCapacity(aCapacity: TEVentID);
+  Protected
+    Function GetNextID : TEventID;
+    Class Function DefaultIDOffset : TEventID;  virtual;
+    Class Procedure SetInstance(aInstance : TEventRegistry); static;
+    Function DoRegisterEvent(aID : TEventID; aClass : TAbstractEventClass) : TEventDef;
+    // Registered IDS "Custom" IDs are registered starting at IDOffset;
+    Property IDOffset : TEventID Read FIDOffset;
+  Public
+    Class constructor init;
+    Class destructor done;
+    Constructor Create; virtual;
+    Destructor Destroy; override;
+    Procedure Clear;
+    FUnction GetRegisteredEventCount : Integer;
+    Function RegisterEventWithID(aID : TEventID; aClass : TAbstractEventClass) : TEventID;
+    Function RegisterEvent(aClass : TAbstractEventClass) : TEventID;
+    // Returns Nil if not found
+    function FindEventClass(aEventID: TEventID): TAbstractEventClass; overload;
+    // Raises exception if ID not valie
+    Function GetEventClass(aEventID : TEventID) : TAbstractEventClass; overload;
+    // Returns Nil if not found
+    function FindEventClass(aEventName: TEventName): TAbstractEventClass; overload;
+    // Raises exception if not found.
+    Function GetEventClass(aEventName : TEventName) : TAbstractEventClass; overload;
+    // Returns zero if not found.
+    function FindEventID(aEventName: TEventName): TEventID;
+    // Returns empty if not found.
+    function FindEventName(aEventID : TEventID): TEventName;
+    // Raises exception if not found.
+    Function GetEventID(aEventName : TEventName) : TEventID;
+    // Raises exception if not found.
+    function GetEventName(aEventID : TEventID): TEventName;
+    // Unregister event based on class, event ID or event name.
+    Procedure UnRegisterEvent(aClass : TAbstractEventClass);
+    Procedure UnRegisterEvent(aEventID : TEventID);
+    Procedure UnRegisterEvent(aEventName: TEventName);
+    Class property Instance : TEventRegistry Read _Instance Write SetInstance;
+  end;
+
+
+  { TEventHandlerItem }
+  // One item to keep an event handler
+
+  TEventHandlerItem = Class(TCollectionItem)
+  private
+    FDeleteScheduled: Boolean;
+    FEventID: TEventID;
+    FEventName: TEventName;
+    function GetEventName: TEventName;
+  Protected
+    Procedure CallHandler(aEvent : TAbstractEvent); virtual; abstract;
+    function Match(aEVent : TAbstractEvent) : Boolean; virtual;
+    function MatchHandler(aHandler : TEventHandler; aEventID: TEventID) : Boolean; virtual;
+    function MatchHandler(aHandler : TEventHandlerRef; aEventID: TEventID) : Boolean; virtual;
+    function MatchHandler(aHandler : TEventCallBack; aEventID: TEventID) : Boolean; virtual;
+    Procedure ScheduleDelete; virtual;
+  Public
+    Property DeleteScheduled : Boolean Read FDeleteScheduled;
+    Property EventName : TEventName Read GetEventName Write FEventName;
+    Property EventID : TEventID Read FEventID Write FEventID;
+  end;
+
+
+  { TEventHandlerList }
+
+  // A helper list class for TEventDispatcher. It manages a list of event handlers.
+
+  TEventContinueEvent = Procedure (aEvent: TAbstractEvent; var aContinue : Boolean) of object;
+  TEventHandlerList = Class(TOwnedCollection)
+  private
+    FCalling : Integer;
+    FOnContinueEvent: TEventContinueEvent;
+    function GetH(aIndex : Integer): TEventHandlerItem;
+    procedure SetH(aIndex : Integer; AValue: TEventHandlerItem);
+  Protected
+    Procedure BeginTraverse;
+    Procedure EndTraverse;
+    Function GetEventName(aID : TEventID) : TEVentName;
+    Function FindHandler(aHandler : TEventHandler; aEventID : TEventID) : TEventHandlerItem;
+    Function FindHandler(aHandler : TEventCallBack; aEventID : TEventID) : TEventHandlerItem;
+    Function FindHandler(aHandler : TEventHandlerRef; aEventID : TEventID) : TEventHandlerItem;
+    Function ContinueEvent(aEvent : TAbstractEvent) : Boolean; virtual;
+    Procedure DeleteScheduled;
+  Public
+    Procedure UnregisterHandler(aHandler : TEventHandlerItem);
+    Function CallAllHandlers(aEvent : TAbstractEvent) : Integer;
+    Property Handlers[aIndex : Integer] : TEventHandlerItem Read GetH Write SetH; default;
+    Property OnContinueEvent : TEventContinueEvent Read FOnContinueEvent Write FOnContinueEvent;
+  end;
+
+
+  { TEventDispatcher }
+
+  TEventSetupHandler = Procedure(Event : TAbstractEvent) of object;
+  TEventSetupCallBack = Procedure(Event : TAbstractEvent);
+  TEventSetupHandlerRef = Reference to Procedure(Event : TAbstractEvent);
+
+  // This class can be used by any other class to send events on its behalf.
+
+  TEventDispatcher = class(TPersistent)
+  Private
+    FDefaultSender: TObject;
+    FHandlerList : TEventHandlerList;
+    FRegistry: TEventRegistry;
+    function GetCount: Integer;
+  Protected
+    Class function GlobalRegistry : TEventRegistry; virtual;
+    function GetRegistry : TEventRegistry; virtual;
+    Function GetEventName(aID : TEventID) : TEventName;
+    Function CreateHandlerList : TEventHandlerList; virtual;
+    Function CreateHandlerItem(aHandler : TEventHandler) : TEventHandlerItem; virtual;
+    Function CreateHandlerItem(aHandler : TEventCallBack) : TEventHandlerItem; virtual;
+    Function CreateHandlerItem(aHandler : TEventHandlerRef) : TEventHandlerItem; virtual;
+    Function DoRegisterHandler(aHandler : TEventHandler; aEventID : TEventID) : TEventHandlerItem; virtual;
+    Function DoRegisterHandler(aHandler : TEventCallBack; aEventID : TEventID) : TEventHandlerItem; virtual;
+    Function DoRegisterHandler(aHandler : TEventHandlerRef; aEventID : TEventID) : TEventHandlerItem; virtual;
+  Public
+    Constructor Create(aDefaultSender : TObject); virtual;
+    Destructor Destroy; override;
+    // Various forms to register an event handler
+    Function RegisterHandler(aHandler : TEventHandler; aEventID : TEventID) : TEventHandlerItem;
+    Function RegisterHandler(aHandler : TEventCallBack; aEventID : TEventID) : TEventHandlerItem;
+    Function RegisterHandler(aHandler : TEventHandlerRef; aEventID : TEventID) : TEventHandlerItem;
+    Function RegisterHandler(aHandler : TEventCallback; aEventName : TEventName) : TEventHandlerItem;
+    Function RegisterHandler(aHandler : TEventHandler; aEventName : TEventName) : TEventHandlerItem;
+    Function RegisterHandler(aHandler : TEventHandlerRef; aEventName : TEventName) : TEventHandlerItem;
+    // Remove all event handlers for a given ID/name.
+    Procedure UnregisterHandler(aEventID : TEventID);
+    Procedure UnregisterHandler(aEventName : TEventName);
+    Procedure UnregisterHandler(aItemID : Integer);
+    // Remove all event handlers for a given callback
+    Procedure UnRegisterHandler(aHandler : TEventHandler);
+    Procedure UnRegisterHandler(aHandler : TEventCallBack);
+    Procedure UnRegisterHandler(aHandler : TEventHandlerRef);
+    // Return single handler using it's ID
+    Procedure UnregisterHandler(aItem : TEventHandlerItem);
+    // Remove single handler using combination of handler/event ID
+    Procedure UnRegisterHandler(aHandler : TEventHandler; aEventID : TEventID);
+    Procedure UnRegisterHandler(aHandler : TEventCallBack; aEventID : TEventID);
+    Procedure UnRegisterHandler(aHandler : TEventHandlerRef; aEventID : TEventID);
+    // Remove single handler using combination of handler/event name
+    Procedure UnRegisterHandler(aHandler : TEventCallback; aEventName : TEventName);
+    Procedure UnRegisterHandler(aHandler : TEventHandler; aEventName : TEventName);
+    Procedure UnRegisterHandler(aHandler : TEventHandlerRef; aEventName : TEventName);
+    // Create an event
+    Function CreateEvent(aSender: TObject; aEventID : TEventID) : TAbstractEvent;
+    Function CreateEvent(aSender: TObject; aEventName : TEventName) : TAbstractEvent;
+    // Dispatch an event.
+    // Calls the registered handlers for that event, in the ordeer they were registered.
+    // Returns the number of handlers that were called;
+    Function DispatchEvent(aEvent : TAbstractEvent) : Integer;
+    // Using ID
+    Function DispatchEvent(aEventID : TEventID) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aSender : TObject) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aSender : TObject; aOnSetup : TEventSetupHandler) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aSender : TObject; aOnSetup : TEventSetupCallBack) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aSender : TObject; aOnSetup : TEventSetupHandlerRef) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aOnSetup : TEventSetupHandler) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aOnSetup : TEventSetupCallBack) : Integer;
+    Function DispatchEvent(aEventID : TEventID; aOnSetup : TEventSetupHandlerRef) : Integer;
+    Function DispatchEvent(aEventName : TEventName) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aSender : TObject) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aSender : TObject; aOnSetup : TEventSetupHandler) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aSender : TObject; aOnSetup : TEventSetupCallBack) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aSender : TObject; aOnSetup : TEventSetupHandlerRef) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aOnSetup : TEventSetupHandler) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aOnSetup : TEventSetupCallBack) : Integer;
+    Function DispatchEvent(aEventName : TEventName; aOnSetup : TEventSetupHandlerRef) : Integer;
+    Property DefaultSender : TObject Read FDefaultSender;
+    Property Count : Integer Read GetCount;
+    Property Registry : TEventRegistry Read GetRegistry Write FRegistry;
+  end;
+
+
+implementation
+
+{ TEventHandlerList }
+
+function TEventHandlerList.GetH(aIndex : Integer): TEventHandlerItem;
+begin
+  Result:=TEventHandlerItem(Items[aIndex]);
+end;
+
+procedure TEventHandlerList.SetH(aIndex: Integer; AValue: TEventHandlerItem);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+procedure TEventHandlerList.BeginTraverse;
+begin
+  InterlockedIncrement(FCalling);
+end;
+
+procedure TEventHandlerList.EndTraverse;
+begin
+  InterlockedDecrement(FCalling);
+  If FCalling<=0 then
+    DeleteScheduled;
+end;
+
+function TEventHandlerList.GetEventName(aID: TEventID): TEVentName;
+begin
+  Result:='';
+  If Assigned(Owner) and (Owner is TEventDispatcher) then
+    Result:=TEventDispatcher(Owner).GetEventName(aID);
+end;
+
+function TEventHandlerList.FindHandler(aHandler: TEventHandler;
+  aEventID: TEventID): TEventHandlerItem;
+
+Var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  BeginTraverse;
+  try
+    I:=Count-1;
+    While (I>=0) and Not GetH(i).MatchHandler(aHandler,aEventID) do
+      Dec(I);
+    if I>=0 then
+      Result:=GetH(i);
+  finally
+    EndTraverse;
+  end;
+end;
+
+function TEventHandlerList.FindHandler(aHandler: TEventCallBack;
+  aEventID: TEventID): TEventHandlerItem;
+Var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  BeginTraverse;
+  try
+    I:=Count-1;
+    While (I>=0) and Not GetH(i).MatchHandler(aHandler,aEventID) do
+      Dec(I);
+    if I>=0 then
+      Result:=GetH(i);
+  finally
+    EndTraverse;
+  end;
+end;
+
+function TEventHandlerList.FindHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID): TEventHandlerItem;
+Var
+  I : Integer;
+
+begin
+  Result:=Nil;
+  BeginTraverse;
+  try
+    I:=Count-1;
+    While (I>=0) and Not GetH(i).MatchHandler(aHandler,aEventID) do
+      Dec(I);
+    if I>=0 then
+      Result:=GetH(i);
+  finally
+    EndTraverse;
+  end;
+end;
+
+function TEventHandlerList.ContinueEvent(aEvent: TAbstractEvent): Boolean;
+begin
+  Result:=True;
+  If Assigned(OnContinueEvent) then
+    OnContinueEvent(aEvent,Result);
+end;
+
+procedure TEventHandlerList.DeleteScheduled;
+
+Var
+  I : Integer;
+
+begin
+  InterlockedIncrement(FCalling);
+  try
+    I:=Count-1;
+    While (I>=0) do
+      begin
+      if GetH(I).DeleteScheduled then
+        Delete(I);
+      Dec(I);
+      end;
+  finally
+    InterlockedDecrement(FCalling);
+  end;
+end;
+
+procedure TEventHandlerList.UnregisterHandler(aHandler: TEventHandlerItem);
+begin
+  if FCalling>0 then
+    aHandler.ScheduleDelete
+  else
+    aHandler.Free;
+end;
+
+function TEventHandlerList.CallAllHandlers(aEvent: TAbstractEvent): Integer;
+
+Var
+  I : Integer;
+  H : TEventHandlerItem;
+
+begin
+  Result:=0;
+  InterlockedIncrement(FCalling);
+  try
+    I:=0;
+    While I<Count do
+      begin
+      H:=GetH(I);
+      if Not (H.DeleteScheduled) and H.Match(aEvent) then
+        begin
+        H.CallHandler(aEvent);
+        Inc(Result);
+        if Not ContinueEvent(aEvent) then
+          I:=Count;
+        end;
+      Inc(I);
+      end;
+  finally
+    InterlockedDecrement(FCalling);
+    If FCalling<=0 then
+      DeleteScheduled;
+  end;
+
+end;
+
+{ TEeventHandlerItem }
+
+function TEventHandlerItem.GetEventName: TEventName;
+
+begin
+  Result:=FEventName;
+  if (Result='') and Assigned(Collection) and (Collection is TEventHandlerList) then
+    Result:=TEventHandlerList(Collection).GetEventName(EventID);
+  if Result='' then
+    Result:=IntToStr(EventID);
+end;
+
+function TEventHandlerItem.Match(aEVent: TAbstractEvent): Boolean;
+begin
+  Result:=(aEvent<>Nil) and (aEvent.EventID=Self.FEVentID);
+end;
+
+function TEventHandlerItem.MatchHandler(aHandler: TEventHandler;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(FEventID=aEventID) and (aHandler=Nil);
+end;
+
+function TEventHandlerItem.MatchHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(FEventID=aEventID) and (aHandler=Nil);
+end;
+
+function TEventHandlerItem.MatchHandler(aHandler: TEventCallBack;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(FEventID=aEventID) and (aHandler=Nil);
+end;
+
+procedure TEventHandlerItem.ScheduleDelete;
+begin
+  FDeleteScheduled:=True;
+end;
+
+
+Type
+
+  { TObjectEventHandlerItem }
+
+  TObjectEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventHandler;
+  Protected
+    function MatchHandler(aHandler : TEventHandler; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  end;
+
+  { TCallBackEventHandlerItem }
+
+  TCallBackEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventCallback;
+  Protected
+    function MatchHandler(aHandler : TEventCallBack; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  end;
+
+  { TReferenceEventHandlerItem }
+
+  TReferenceEventHandlerItem = Class(TEventHandlerItem)
+  Private
+    FEventHandler : TEventHandlerRef;
+  Protected
+    function MatchHandler(aHandler :TEventHandlerRef; aEventID : TEventID) : Boolean; override;
+    Procedure CallHandler(aEvent : TAbstractEvent); override;
+  end;
+
+{ TReferenceEventHandlerItem }
+
+function TReferenceEventHandlerItem.MatchHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(aHandler=FEventHandler) and (aEventID=FEventID);
+end;
+
+procedure TReferenceEventHandlerItem.CallHandler(aEvent: TAbstractEvent);
+begin
+  FEventHandler(aEvent);
+end;
+
+
+{ TCallBackEventHandlerItem }
+
+function TCallBackEventHandlerItem.MatchHandler(aHandler: TEventCallBack;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(aHandler=FEventHandler) and (aEventID=FEventID);
+end;
+
+procedure TCallBackEventHandlerItem.CallHandler(aEvent: TAbstractEvent);
+begin
+  FEventHandler(aEvent);
+end;
+
+{ TObjectEventHandlerItem }
+
+function TObjectEventHandlerItem.MatchHandler(aHandler: TEventHandler;
+  aEventID: TEventID): Boolean;
+begin
+  Result:=(aHandler=FEventHandler) and (aEventID=FEventID);
+end;
+
+procedure TObjectEventHandlerItem.CallHandler(aEvent: TAbstractEvent);
+begin
+  FEventHandler(aEvent);
+end;
+
+{ TEventDispatcher }
+
+function TEventDispatcher.GetCount: Integer;
+begin
+  Result:=FHandlerList.Count;
+end;
+
+class function TEventDispatcher.GlobalRegistry: TEventRegistry;
+begin
+  Result:=TEventRegistry.Instance;
+end;
+
+function TEventDispatcher.GetRegistry: TEventRegistry;
+begin
+  if Assigned(FRegistry) then
+    Result:=FRegistry
+  else
+    Result:=GlobalRegistry;
+end;
+
+function TEventDispatcher.GetEventName(aID: TEventID): TEventName;
+begin
+  Result:=Registry.FindEventName(aID);
+end;
+
+function TEventDispatcher.CreateHandlerList: TEventHandlerList;
+begin
+  Result:=TEventHandlerList.Create(Self,TEventHandlerItem);
+end;
+
+function TEventDispatcher.CreateHandlerItem(aHandler: TEventHandler
+  ): TEventHandlerItem;
+begin
+  Result:=TObjectEventHandlerItem.Create(FHandlerList);
+  TObjectEventHandlerItem(Result).FEventHandler:=aHandler;
+end;
+
+function TEventDispatcher.CreateHandlerItem(aHandler: TEventCallBack
+  ): TEventHandlerItem;
+begin
+  Result:=TCallBackEventHandlerItem.Create(FHandlerList);
+  TCallBackEventHandlerItem(Result).FEventHandler:=aHandler;
+end;
+
+function TEventDispatcher.CreateHandlerItem(aHandler: TEventHandlerRef
+  ): TEventHandlerItem;
+begin
+  Result:=TReferenceEventHandlerItem.Create(FHandlerList);
+  TReferenceEventHandlerItem(Result).FEventHandler:=aHandler;
+end;
+
+function TEventDispatcher.DoRegisterHandler(aHandler: TEventHandler;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=CreateHandlerItem(aHandler);
+  Result.FEventID:=aEventID;
+end;
+
+
+function TEventDispatcher.DoRegisterHandler(aHandler: TEventCallBack;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=CreateHandlerItem(aHandler);
+  Result.FEventID:=aEventID;
+end;
+
+function TEventDispatcher.DoRegisterHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=CreateHandlerItem(aHandler);
+  Result.FEventID:=aEventID;
+end;
+
+constructor TEventDispatcher.Create(aDefaultSender: TObject);
+begin
+  inherited create;
+  FDefaultSender:=aDefaultSender;
+  FHandlerList:=CreateHandlerList;
+end;
+
+destructor TEventDispatcher.Destroy;
+begin
+  FreeAndNil(FHandlerList);
+  inherited Destroy;
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventHandler;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,aEventID);
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventCallBack;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,aEventID);
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,aEventID);
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventCallback;
+  aEventName: TEventName): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,Registry.GetEventID(aEventName));
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventHandler;
+  aEventName: TEventName): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,Registry.GetEventID(aEventName));
+end;
+
+function TEventDispatcher.RegisterHandler(aHandler: TEventHandlerRef;
+  aEventName: TEventName): TEventHandlerItem;
+begin
+  Result:=DoRegisterHandler(aHandler,Registry.GetEventID(aEventName));
+
+end;
+
+procedure TEventDispatcher.UnregisterHandler(aItem: TEventHandlerItem);
+begin
+  FHandlerList.UnregisterHandler(aItem);
+end;
+
+procedure TEventDispatcher.UnregisterHandler(aEventID: TEventID);
+
+Var
+  I : Integer;
+  Itm : TEventHandlerItem;
+
+begin
+  for I:=FHandlerList.Count-1 downto 0 do
+    begin
+    Itm:=FHandlerList[I];
+    If Itm.EventID=aEventID then
+      FHandlerList.UnregisterHandler(Itm);
+    end;
+end;
+
+procedure TEventDispatcher.UnregisterHandler(aEventName: TEventName);
+begin
+  UnregisterHandler(Registry.GetEventID(aEventName));
+end;
+
+procedure TEventDispatcher.UnregisterHandler(aItemID: Integer);
+Var
+  aItem: TEventHandlerItem;
+begin
+  aItem:=TEventHandlerItem(FHandlerList.FindItemID(aItemID));
+  if Assigned(aItem) then
+    FHandlerList.UnregisterHandler(aItem);
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandler);
+Var
+  I : Integer;
+  Itm : TEventHandlerItem;
+
+begin
+  for I:=FHandlerList.Count-1 downto 0 do
+    begin
+    Itm:=FHandlerList[I];
+    If Itm.MatchHandler(aHandler,Itm.EventID) then
+      FHandlerList.UnregisterHandler(Itm);
+    end;
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventCallBack);
+Var
+  I : Integer;
+  Itm : TEventHandlerItem;
+
+begin
+  for I:=FHandlerList.Count-1 downto 0 do
+    begin
+    Itm:=FHandlerList[I];
+    If Itm.MatchHandler(aHandler,Itm.EventID) then
+      FHandlerList.UnregisterHandler(Itm);
+    end;
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandlerRef);
+Var
+  I : Integer;
+  Itm : TEventHandlerItem;
+
+begin
+  for I:=FHandlerList.Count-1 downto 0 do
+    begin
+    Itm:=FHandlerList[I];
+    If Itm.MatchHandler(aHandler,Itm.EventID) then
+      FHandlerList.UnregisterHandler(Itm);
+    end;
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandler;
+  aEventID: TEventID);
+
+Var
+  aItem: TEventHandlerItem;
+
+begin
+  aItem:=FHandlerList.FindHandler(aHandler,aEventID);
+  UnregisterHandler(aItem);
+end;
+
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventCallBack;
+  aEventID: TEventID);
+Var
+  aItem: TEventHandlerItem;
+
+begin
+  aItem:=FHandlerList.FindHandler(aHandler,aEventID);
+  UnregisterHandler(aItem);
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandlerRef;
+  aEventID: TEventID);
+
+Var
+  aItem: TEventHandlerItem;
+
+begin
+  aItem:=FHandlerList.FindHandler(aHandler,aEventID);
+  UnregisterHandler(aItem);
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventCallback;
+  aEventName: TEventName);
+begin
+  UnregisterHandler(aHandler,Registry.FindEventID(aEventName));
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandler;
+  aEventName: TEventName);
+begin
+  UnregisterHandler(aHandler,Registry.FindEventID(aEventName));
+end;
+
+procedure TEventDispatcher.UnRegisterHandler(aHandler: TEventHandlerRef;
+  aEventName: TEventName);
+begin
+  UnregisterHandler(aHandler,Registry.FindEventID(aEventName));
+end;
+
+function TEventDispatcher.CreateEvent(aSender: TObject; aEventID: TEventID
+  ): TAbstractEvent;
+
+Var
+  aClass : TAbstractEventClass;
+
+begin
+  If aSender=Nil then
+    Raise EEvents.Create('Cannot create event without sender.');
+  aClass:=Registry.GetEventClass(aEventID);
+  Result:=aClass.Create(aSender,aEventID);
+end;
+
+function TEventDispatcher.CreateEvent(aSender: TObject; aEventName: TEventName
+  ): TAbstractEvent;
+begin
+  Result:=CreateEvent(aSender,Registry.GetEventID(aEventName))
+end;
+
+function TEventDispatcher.DispatchEvent(aEvent: TAbstractEvent): Integer;
+begin
+  Result:=FHandlerList.CallAllHandlers(aEvent);
+end;
+
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aOnSetup: TEventSetupHandler): Integer;
+begin
+  If DefaultSender=Nil then
+    Raise EEvents.Create('Cannot dispatch without sender: defaultsender not set');
+  Result:=DispatchEvent(aEventID,DefaultSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aOnSetup: TEventSetupCallBack): Integer;
+begin
+  If DefaultSender=Nil then
+    Raise EEvents.Create('Cannot dispatch without sender: defaultsender not set');
+  Result:=DispatchEvent(aEventID,DefaultSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aOnSetup: TEventSetupHandlerRef): Integer;
+begin
+  If DefaultSender=Nil then
+    Raise EEvents.Create('Cannot dispatch without sender: defaultsender not set');
+  Result:=DispatchEvent(aEventID,DefaultSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName));
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aSender: TObject): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aSender);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aSender: TObject; aOnSetup: TEventSetupHandler): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aSender: TObject; aOnSetup: TEventSetupCallBack): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aSender: TObject; aOnSetup: TEventSetupHandlerRef): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aSender,aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aOnSetup: TEventSetupHandler): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aOnSetup: TEventSetupCallBack): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventName: TEventName; aOnSetup: TEventSetupHandlerRef): Integer;
+begin
+  Result:=DispatchEvent(Registry.GetEventID(aEventName),aOnSetup);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID): Integer;
+begin
+  If DefaultSender=Nil then
+    Raise EEvents.Create('Cannot dispatch without sender: defaultsender not set');
+  Result:=DispatchEvent(aEventID,DefaultSender);
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aSender: TObject
+  ): Integer;
+begin
+  Result:=DispatchEvent(aEventID,aSender,TEventSetupHandler(Nil));
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aSender: TObject;
+  aOnSetup: TEventSetupHandler): Integer;
+
+Var
+  Evt : TAbstractEvent;
+
+begin
+  Evt:=CreateEvent(aSender,aEventID);
+  try
+    if Assigned(aOnSetup) then
+      aOnSetup(Evt);
+    Result:=DispatchEvent(Evt);
+  finally
+    Evt.Free;
+  end;
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aSender: TObject;
+  aOnSetup: TEventSetupCallBack): Integer;
+Var
+  Evt : TAbstractEvent;
+
+begin
+  Evt:=CreateEvent(aSender,aEventID);
+  try
+    if Assigned(aOnSetup) then
+      aOnSetup(Evt);
+    Result:=DispatchEvent(Evt);
+  finally
+    Evt.Free;
+  end;
+end;
+
+function TEventDispatcher.DispatchEvent(aEventID: TEventID; aSender: TObject;
+  aOnSetup: TEventSetupHandlerRef): Integer;
+Var
+  Evt : TAbstractEvent;
+
+begin
+  Evt:=CreateEvent(aSender,aEventID);
+  try
+    if Assigned(aOnSetup) then
+      aOnSetup(Evt);
+    Result:=DispatchEvent(Evt);
+  finally
+    Evt.Free;
+  end;
+end;
+
+
+{ TEventDef }
+
+constructor TEventDef.Create(aID: TEventID; aClass: TAbstractEventClass);
+begin
+  FID:=aID;
+  FClass:=aClass;
+end;
+
+{ TEventRegistry }
+
+function TEventRegistry.GetNextID: TEventID;
+begin
+  if FNextID>=Length(FEventDefs) then
+    SetCapacity(Length(FEventDefs)+100);
+  Result:=FNextID;
+  Inc(FNextID);
+end;
+
+class function TEventRegistry.DefaultIDOffset: TEventID;
+begin
+  Result:=0;
+end;
+
+class procedure TEventRegistry.SetInstance(aInstance: TEventRegistry);
+begin
+  FreeandNil(_Instance);
+  _Instance:=aInstance;
+end;
+
+function TEventRegistry.DoRegisterEvent(aID: TEventID;
+  aClass: TAbstractEventClass): TEventDef;
+
+begin
+  Result:=TEventDef.Create(aID,aClass);
+  FEventDefs[aID]:=Result;
+  FHash.Add(LowerCase(aClass.EventName),Result);
+end;
+
+class constructor TEventRegistry.init;
+begin
+  TEventRegistry._instance:=TEventRegistry.Create;
+end;
+
+class destructor TEventRegistry.done;
+begin
+  FreeAndNil(TEventRegistry._instance);
+end;
+
+constructor TEventRegistry.Create;
+begin
+  FIDOffset:=DefaultIDOffset;
+  FNextID:=FIDOffset+1;
+  SetCapacity(FIDOffset+100);
+  FHash:=TFPObjectHashTable.Create(False);
+end;
+
+destructor TEventRegistry.Destroy;
+begin
+  Clear;
+  SetCapacity(0);
+  FreeAndNil(FHash);
+  inherited Destroy;
+end;
+
+procedure TEventRegistry.Clear;
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to Length(FEventDefs)-1 do
+    FreeAndNil(FEventDefs[i]);
+  FNextID:=FIDOffset+1;
+  FHash.Clear;
+end;
+
+function TEventRegistry.GetRegisteredEventCount: Integer;
+
+Var
+  Def : TEventDef;
+
+begin
+  Result:=0;
+  For Def in FEventDefs do
+    if Def<>Nil then
+      Inc(Result);
+end;
+
+procedure TEventRegistry.SetCapacity(aCapacity: TEVentID);
+
+begin
+  if aCapacity>=High(TEventID) then
+    Raise EEvents.CreateFmt('Invalid capacity for event lists: %d',[aCapacity]);
+  SetLength(FEventDefs,aCapacity);
+end;
+
+function TEventRegistry.RegisterEventWithID(aID: TEventID;
+  aClass: TAbstractEventClass): TEventID;
+begin
+  Result:=0;
+  if (aID=0) or (aID>=FIDOffset) then
+    Raise EEvents.CreateFmt('Invalid event ID for registration: %d',[aID]);
+  if FindEventID(aClass.EventName)<>0 then
+    Raise EEvents.CreateFmt('Duplicate event name for registration: %s',[aClass.EventName]);
+  if FEventDefs[aID]<>Nil then
+    Raise EEvents.CreateFmt('Duplicate event ID for registration (%s): %d',[aClass.EventName,aid]);
+  Result:=DoRegisterEvent(aID,aClass).ID;
+end;
+
+function TEventRegistry.RegisterEvent(aClass: TAbstractEventClass): TEventID;
+begin
+  if FindEventID(aClass.EventName)<>0 then
+    Raise EEvents.CreateFmt('Duplicate event name for registration: %s',[aClass.EventName]);
+  Result:=DoRegisterEvent(GetNextID,aClass).ID;
+end;
+
+function TEventRegistry.FindEventClass(aEventID: TEventID): TAbstractEventClass;
+
+var
+  aDef: TEventDef;
+begin
+  Result:=nil;
+  aDef:=Nil;
+  if (aEventID>=1) and (aEventID<Length(FEventDefs)) then
+    aDef:=FEventDefs[aEventID];
+  if Assigned(aDef) then
+    Result:=aDef.EventClass;
+end;
+
+function TEventRegistry.GetEventClass(aEventID: TEventID): TAbstractEventClass;
+
+begin
+  Result:=FindEventClass(aEventID);
+  if Result=nil then
+    Raise EEvents.CreateFmt('Unknown event ID: %d',[aEventID]);
+end;
+
+function TEventRegistry.FindEventClass(aEventName: TEventName): TAbstractEventClass;
+
+Var
+  Def : TEventDef;
+
+begin
+  Result:=Nil;
+  Def:=TEventDef(FHash.Items[LowerCase(aEventName)]);
+  if Assigned(Def) then
+    Result:=Def.EventClass;
+end;
+
+function TEventRegistry.GetEventClass(aEventName: TEventName): TAbstractEventClass;
+begin
+  Result:=FindEventClass(aEventName);
+  if Result=Nil then
+    Raise EEvents.CreateFmt('Unknown event name: %s',[aEventName]);
+end;
+
+function TEventRegistry.FindEventID(aEventName: TEventName): TEventID;
+
+Var
+  Def : TEventDef;
+
+begin
+  Result:=0;
+  Def:=TEventDef(FHash.Items[LowerCase(aEventName)]);
+  if Assigned(Def) then
+    Result:=Def.ID;
+end;
+
+function TEventRegistry.FindEventName(aEventID: TEventID): TEventName;
+
+Var
+  Def : TEventDef;
+
+begin
+  Result:='';
+  Def:=FEventDefs[aEventID];
+  if Assigned(Def) and assigned(Def.EventClass) then
+    Result:=Def.EventClass.EventName;
+end;
+
+function TEventRegistry.GetEventID(aEventName: TEventName): TEventID;
+begin
+  Result:=FindEventID(aEventName);
+  if Result=0 then
+    Raise EEvents.CreateFmt('Unknown event name: %s',[aEventName]);
+end;
+
+function TEventRegistry.GetEventName(aEventID: TEventID): TEventName;
+begin
+  Result:=FindEVentName(aEventID);
+  if Result='' then
+    Raise EEvents.CreateFmt('Unknown event ID: %d',[aEventID]);
+end;
+
+procedure TEventRegistry.UnRegisterEvent(aClass: TAbstractEventClass);
+begin
+  UnRegisterEvent(aClass.EventName);
+end;
+
+procedure TEventRegistry.UnRegisterEvent(aEventID: TEventID);
+
+begin
+  if (aEventID>0) and (aEventID<Length(FEventDefs)) then
+    if Assigned(FEventDefs[aEventID]) then
+      begin
+      FHash.Delete(FEventDefs[aEventID].EventClass.EventName);
+      FreeAndNil(FeventDefs[aEventID])
+      end;
+  // We ignore invalid aEventIDs.
+end;
+
+procedure TEventRegistry.UnRegisterEvent(aEventName: TEventName);
+
+var
+  aID : TEventID;
+begin
+  aID:=FindEventID(aEventName);
+  if aID<>0 then
+    UnregisterEvent(aID);
+end;
+
+{ TAbstractEvent }
+
+constructor TAbstractEvent.Create(aSender: TObject; aID: TEventID);
+begin
+  FSender:=aSender;
+  FEventID:=aID;
+end;
+
+class function TAbstractEvent.Register: TEventID;
+begin
+  Result:=TEventRegistry.Instance.RegisterEvent(Self);
+end;
+
+end.
+

src/fresnel.events.pas

@@ -0,0 +1,420 @@
+unit fresnel.events;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, basevents;
+
+{$ScopedEnums ON}
+
+Const
+  evtUnknown = 0;
+  evtKeyDown = 1;
+  evtKeyUp = 2;
+  evtKeyPress = 3;
+  evtEnter = 4;
+  evtLeave = 5;
+  evtClick = 6;
+  evtDblClick = 7;
+  evtChange = 8;
+  evtDrag = 9;
+  evtDragEnd = 10;
+  evtDragEnter = 11;
+  evtDragOver = 12;
+  evtDragLeave = 13;
+  evtDragStart = 14;
+  evtDrop = 15;
+  evtMouseMove = 16;
+  evtMouseDown = 17;
+  evtMouseUp = 18;
+  evtMouseOver = 19;
+  evtMouseEnter = 20;
+  evtMouseLeave = 21;
+  evtMouseWheel = 22;
+  evtFocusIn = 24;
+  evtFocusOut = 25;
+  evtFocus = 26;
+  evtBlur = 27;
+
+
+
+
+
+  MaxFresnelEvents = evtChange;
+
+
+Type
+
+  { TFresnelEvent }
+
+  TFresnelEvent = Class(TAbstractEvent)
+  private
+    FDefaultPrevented: Boolean;
+  public
+    Class Function FresnelEventID : TEventID; virtual; abstract;
+    class function StandardEventName(aEventID: TEventID): TEventName;
+    class function EventName: TEventName; override;
+    Procedure PreventDefault; virtual;
+    Property DefaultPrevented : Boolean Read FDefaultPrevented;
+  end;
+  TFresnelEventClass = Class of TFresnelEvent;
+
+  TFresnelUIEvent = class(TFresnelEvent)
+
+  end;
+
+  TMouseButton = (mbMain,mbAux,mbSecond,mbFourth,mbFifth);
+  TMouseButtons = set of TMouseButton;
+
+  { TFresnelMouseEvent }
+
+  TFresnelMouseEventInit = Record
+    Button: TMouseButton;
+    Buttons: TMouseButtons;
+    PageX: Integer;
+    PageY: Integer;
+    ScreenX: Integer;
+    ScreenY: Integer;
+    Shiftstate: TShiftState;
+    X: Integer;
+    Y: Integer;
+  end;
+
+  TFresnelMouseEvent = Class(TFresnelUIEvent)
+  private
+    FInit : TFresnelMouseEventInit;
+    function GetShiftKey(AIndex: Integer): Boolean;
+  Public
+    Constructor Create(const aInit : TFresnelMouseEventInit);
+    Property PageX : Integer Read FInit.PageX;
+    Property PageY : Integer Read FInit.PageY;
+    Property ScreenX : Integer Read FInit.ScreenX;
+    Property ScreenY : Integer Read FInit.ScreenY;
+    Property X : Integer Read FInit.X;
+    Property Y : Integer Read FInit.Y;
+    Property Buttons: TMouseButtons Read FInit.Buttons;
+    Property Button : TMouseButton Read FInit.Button;
+    Property ShiftState : TShiftState Read FInit.Shiftstate;
+    Property Altkey : Boolean Index Ord(ssAlt) read GetShiftKey;
+    Property MetaKey : Boolean Index Ord(ssMeta) read GetShiftKey;
+    Property CtrlKey : Boolean Index Ord(ssCtrl) read GetShiftKey;
+    Property ShiftKey : Boolean Index Ord(ssShift) read GetShiftKey;
+  end;
+
+  { TFresnelMouseClickEvent }
+
+  TFresnelMouseClickEvent = class(TFresnelMouseEvent)
+    class function FresnelEventID : TEventID; override;
+  end;
+
+  TFresnelKeyEventInit = Record
+    ShiftState : TShiftState;
+    IsComposing : Boolean;
+    NumKey : Cardinal;
+    Key : String;
+    Code : ShortString;
+  end;
+
+  { TFresnelKeyEvent }
+
+  TFresnelKeyEvent = class(TFresnelEvent)
+  Private
+    FInit : TFresnelKeyEventInit;
+    function GetShiftKey(AIndex: Integer): Boolean;
+  Public
+    Constructor Create(const aInit : TFresnelKeyEventInit);
+    Property Code: ShortString Read FInit.Code;
+    Property Key : String Read Finit.Key;
+    Property NumKey : Cardinal Read Finit.NumKey;
+    Property Altkey : Boolean Index Ord(ssAlt) read GetShiftKey;
+    Property MetaKey : Boolean Index Ord(ssMeta) read GetShiftKey;
+    Property CtrlKey : Boolean Index Ord(ssCtrl) read GetShiftKey;
+    Property ShiftKey : Boolean Index Ord(ssShift) read GetShiftKey;
+  end;
+
+  { TFresnelKeyUpEvent }
+
+  TFresnelKeyUpEvent = class(TFresnelKeyEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelKeyDownEvent }
+
+  TFresnelKeyDownEvent = class(TFresnelKeyEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelChangeEvent }
+
+  TFresnelChangeEvent = class(TFresnelEvent)
+    Class Function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelFocusEvent }
+
+  TFresnelFocusEvent = Class(TFresnelUIEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelFocusInEvent }
+
+  TFresnelFocusInEvent = Class(TFresnelFocusEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelFocusOutEvent }
+
+  TFresnelFocusOutEvent = Class(TFresnelFocusEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  { TFresnelBlurEvent }
+
+  TFresnelBlurEvent = Class(TFresnelUIEvent)
+    Class function FresnelEventID: TEventID; override;
+  end;
+
+  // List taken from
+  // https://rawgit.com/w3c/input-events/v1/index.html#interface-InputEvent-Attributes
+
+  TFresnelInputType = (
+   insertText,insertReplacementText,insertLineBreak,
+   insertParagraph,insertOrderedList,insertUnorderedList,
+   insertHorizontalRule,insertFromYank,insertFromDrop,
+   insertFromPaste,insertFromPasteAsQuotation,insertTranspose,
+   insertCompositionText,insertLink,
+   deleteWordBackward,deleteWordForward,deleteSoftLineBackward,
+   deleteSoftLineForward,deleteEntireSoftLine,deleteHardLineBackward,
+   deleteHardLineForward,deleteByDrag,deleteByCut,
+   deleteContent,deleteContentBackward,deleteContentForward,
+   historyUndo,historyRedo,
+   formatBold,formatItalic,formatUnderline,formatStrikeThrough,
+   formatSuperscript,formatSubscript,formatJustifyFull,formatJustifyCenter,
+   formatJustifyRight,formatJustifyLeft,formatIndent, formatOutdent,
+   formatRemove,formatSetBlockTextDirection,formatSetInlineTextDirection,
+   formatBackColor,formatFontColor,formatFontName
+  );
+  TFresnelInputEventInit = record
+    data : string;
+    inputtype : TFresnelInputType;
+  end;
+
+  { TFresnelInputEvent }
+
+  TFresnelInputEvent = Class(TFresnelUIEvent)
+  Private
+    FInit : TFresnelInputEventInit;
+    function GetInputType: string;
+  Public
+    Constructor Create(aInit : TFresnelInputEventInit);
+    Property Data : String Read FInit.Data;
+    Property FresnelInputType : TFresnelInputType Read FInit.inputtype;
+    Property InputType : string Read GetInputType;
+  end;
+
+
+  TDeltaMode = (pixel,line,page);
+  TFresnelWheelInit = record
+    deltaMode : TDeltaMode;
+    deltaX : Integer;
+    deltaY : Integer;
+    DeltaZ : Integer;
+  end;
+
+  TFresnelWheelEventInit = Record
+    MouseInit : TFresnelMouseEventInit;
+    WheelInit : TFresnelWheelInit;
+  end;
+
+  { TFresnelWheelEvent }
+
+  TFresnelWheelEvent = Class(TFresnelMouseEvent)
+  Private
+    FWheelInit : TFresnelWheelInit;
+  Public
+    Constructor Create(aInit : TFresnelWheelEventInit); reintroduce;
+    Property DeltaMode : TDeltaMode Read FWheelInit.DeltaMode;
+    Property DeltaX : Integer Read FWheelInit.DeltaX;
+    Property DeltaY : Integer Read FWheelInit.DeltaY;
+    Property DeltaZ : Integer Read FWheelInit.DeltaZ;
+  end;
+
+   { TFresnelEventDispatcher }
+
+   TFresnelEventDispatcher = Class(TEventDispatcher)
+   Protected
+     Function GetRegistry: TEventRegistry; override;
+   Public
+     Class Function FresnelRegistry : TEventRegistry;
+     Class Procedure RegisterFresnelEvents;
+   end;
+
+
+implementation
+
+uses TypInfo;
+
+Const
+  FresnelEventNames : Array[0..MaxFresnelEvents] of TEventName = (
+    '?',
+    'KeyDown',
+    'KeyUp',
+    'KeyPress',
+    'Enter',
+    'Leave',
+    'MouseClick',
+    'MouseMove',
+    'Change'
+  );
+
+{ TFresnelWheelEvent }
+
+constructor TFresnelWheelEvent.Create(aInit: TFresnelWheelEventInit);
+begin
+  Inherited Create(aInit.MouseInit);
+  FWheelInit:=aInit.WheelInit;
+end;
+
+{ TFresnelInputEvent }
+
+function TFresnelInputEvent.GetInputType: string;
+begin
+  Result:=GetEnumName(TypeInfo(TFresnelInputType),Ord(FInit.inputtype));
+end;
+
+constructor TFresnelInputEvent.Create(aInit: TFresnelInputEventInit);
+begin
+  FInit:=AInit;
+end;
+
+{ TFresnelBlurEvent }
+
+class function TFresnelBlurEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtBlur;
+end;
+
+{ TFresnelFocusOutEvent }
+
+class function TFresnelFocusOutEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtFocusOut;
+end;
+
+{ TFresnelFocusInEvent }
+
+class function TFresnelFocusInEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtFocusin;
+end;
+
+{ TFresnelFocusEvent }
+
+class function TFresnelFocusEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtFocus;
+end;
+
+{ TFresnelKeyDownEvent }
+
+class function TFresnelKeyDownEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtKeyDown;
+end;
+
+{ TFresnelKeyUpEvent }
+
+class function TFresnelKeyUpEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtKeyUp;
+end;
+
+{ TFresnelKeyEvent }
+
+
+function TFresnelKeyEvent.GetShiftKey(AIndex: Integer): Boolean;
+begin
+  Result:=TShiftStateEnum(aIndex) in Finit.ShiftState;
+end;
+
+
+constructor TFresnelKeyEvent.Create(const aInit: TFresnelKeyEventInit);
+begin
+  FInit:=aInit;
+end;
+
+{ TFresnelMouseEvent }
+
+function TFresnelMouseEvent.GetShiftKey(AIndex: Integer): Boolean;
+begin
+  Result:=TShiftStateEnum(aIndex) in ShiftState;
+end;
+
+constructor TFresnelMouseEvent.Create(const aInit: TFresnelMouseEventInit);
+begin
+  FInit:=aInit;
+end;
+
+
+{ TFresnelChangeEvent }
+
+class function TFresnelChangeEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtChange;
+end;
+
+{ TFresnelMouseClickEvent }
+
+class function TFresnelMouseClickEvent.FresnelEventID: TEventID;
+begin
+  Result:=evtClick;
+end;
+
+{ TFresnelEvent }
+
+class function TFresnelEvent.StandardEventName(aEventID : TEventID): TEventName;
+begin
+  If (aEventID>=0) and (aEventID<Length(FresnelEventNames)) then
+    Result:=FresnelEventNames[aEventID]
+  else
+    Result:=IntToStr(aEventID);
+end;
+
+class function TFresnelEvent.EventName: TEventName;
+begin
+  Result:=StandardEventName(FresnelEventID);
+end;
+
+procedure TFresnelEvent.PreventDefault;
+begin
+  FDefaultPrevented:=True;
+end;
+
+{ TFresnelEventDispatcher }
+
+function TFresnelEventDispatcher.GetRegistry: TEventRegistry;
+begin
+  Result:=FresnelRegistry;
+end;
+
+class function TFresnelEventDispatcher.FresnelRegistry: TEventRegistry;
+begin
+  Result:=GlobalRegistry;
+end;
+
+class procedure TFresnelEventDispatcher.RegisterFresnelEvents;
+
+  Procedure R(aClass : TFresnelEventClass);
+
+  begin
+    FresnelRegistry.RegisterEventWithID(aClass.FresnelEventID,aClass);
+  end;
+
+begin
+  R(TFresnelChangeEvent);
+end;
+
+end.
+

src/tests/testfresnel.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testfresnel"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="FCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="testfresnel.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utcbaseevents.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../basevents.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../fresnel.events.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testfresnel"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value=".."/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

src/tests/testfresnel.lpr

@@ -0,0 +1,28 @@
+program testfresnel;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, utcbaseevents, basevents, fresnel.events;
+
+type
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.

src/tests/utcbaseevents.pas

@@ -0,0 +1,1067 @@
+unit utcbaseevents;
+
+{$mode objfpc}
+{$H+}
+{$modeswitch functionreferences}
+{$modeswitch nestedprocvars}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, basevents;
+
+Const
+  MaxEvents = 5;
+
+type
+
+  TEvent1 = Class(TAbstractEvent)
+    class function EventName: TEventName; override;
+  end;
+
+  { TEvent2 }
+
+  TEvent2 = Class(TAbstractEvent)
+    class function EventName: TEventName; override;
+  end;
+
+  { TEvent3 }
+
+  TEvent3 = Class(TAbstractEvent)
+    class function EventName: TEventName; override;
+  end;
+
+  { TMyRegistry }
+
+  TMyRegistry = class(TEventRegistry)
+   class Function DefaultIDOffset: TEventID; override;
+  end;
+
+  { TCEventsRegistry }
+  TCBaseEvents = class(TTestCase)
+  Private
+    FRegistry : TEventRegistry;
+    FRegs : Array[1..3] of TEventID;
+  Protected
+    procedure Register(event : integer);
+    procedure RegisterID(event : Integer; aID : Integer = -1);
+    procedure Register1;
+    procedure Register2;
+    procedure Register2As1;
+    procedure Register2As11;
+    procedure Register3;
+    Procedure RegisterAll;
+    Procedure RegisterAllGlobally;
+    Procedure EnableOffset;
+    procedure SetUp; override;
+    procedure TearDown; override;
+    property Registry : TEventRegistry Read FRegistry;
+  end;
+
+  TCEventsRegistry = class(TCBaseEvents)
+  protected
+    procedure FindNonExistent;
+    procedure FindNonExistentClass;
+    procedure FindNonExistentClassByID;
+    procedure FindNonExistentID;
+  published
+    procedure TestHookUp;
+    procedure TestRegister;
+    procedure TestRegisterDuplicate;
+    procedure TestRegisterOffset;
+    procedure TestRegisterWithID;
+    procedure TestRegisterWithIDDUplicate;
+    procedure TestRegisterWithIDOutOfRange;
+    procedure TestFindEventID;
+    procedure TestGetEventID;
+    procedure TestFindEventName;
+    procedure TestGetEventName;
+    procedure TestFindEventClass;
+    procedure TestGetEventClass;
+    procedure TestFindEventClassByID;
+    procedure TestGetEventClassByID;
+    procedure TestUnregisterEventClass;
+    procedure TestUnregisterEventID;
+    procedure TestUnregisterEventName;
+    Procedure TestClear;
+    Procedure TestRegisterGLobally;
+  end;
+
+
+  { TCEventsDispatcher }
+  THandlerType = (htObject,htProc,htRef);
+
+  TCEventsDispatcher = class(TCBaseEvents)
+  private
+    Class var FHandlerCallCount : Array[THandlerType] of Integer;
+    Class var FHandlerCallEvent : Array[1..MaxEvents,THandlerType] of TAbstractEvent;
+    Class var FExpectedEvent : TAbstractEvent;
+
+    class procedure RegisterEvent(aType: THandlerType; aEvent: TAbstractEvent);
+    class procedure AssertCalled(const Msg: String; aType: THandlerType;
+      aEvent: TAbstractEvent; aIndex, aCount: Integer);
+  private
+    FDispatcher: TEventDispatcher;
+    FRHandler:TEventHandlerRef;
+    FRHandler2:TEventHandlerRef;
+    FEvents : Array[1..3] of TAbstractEvent;
+    FSecondEvent : TAbstractEvent;
+
+    Procedure RegisterEvent2P;
+    Procedure RegisterEvent2R;
+    Procedure RegisterEvent2O;
+  protected
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Function CreateEvent(aID : Integer) : TAbstractEvent;
+    Procedure EventHandlerO(aEvent : TAbstractEvent);
+    Procedure EventHandlerO2(aEvent : TAbstractEvent);
+    function RegisterHandlerO(aEventName: String): TEventHandlerItem;
+    function RegisterHandlerO2(aEventName: String): TEventHandlerItem;
+    function RegisterHandlerP(aEventName: String): TEventHandlerItem;
+    function RegisterHandlerP2(aEventName: String): TEventHandlerItem;
+    function RegisterHandlerR(aEventName: String): TEventHandlerItem;
+    function RegisterHandlerR2(aEventName: String): TEventHandlerItem;
+    Property Dispatcher : TEventDispatcher Read FDispatcher;
+  Published
+    Procedure TestHookup;
+    Procedure TestRegisterHandlerO;
+    Procedure TestRegisterHandlerR;
+    Procedure TestRegisterHandlerP;
+    Procedure TestRegisterHandlerOUnknown;
+    Procedure TestRegisterHandlerRUnknown;
+    Procedure TestRegisterHandlerPUnknown;
+    Procedure TestUnRegisterHandlerO;
+    Procedure TestUnRegisterHandlerR;
+    Procedure TestUnRegisterHandlerP;
+    Procedure TestUnRegisterHandlerOName;
+    Procedure TestUnRegisterHandlerRName;
+    Procedure TestUnRegisterHandlerPName;
+    Procedure TestUnRegisterHandlerOUnknownEvent;
+    Procedure TestUnRegisterHandlerRUnknownEvent;
+    Procedure TestUnRegisterHandlerPUnknownEvent;
+    Procedure TestUnRegisterHandlerOUnknownHandler;
+    Procedure TestUnRegisterHandlerRUnknownHandler;
+    Procedure TestUnRegisterHandlerPUnknownHandler;
+    Procedure TestUnRegisterHandlerOAllName;
+    Procedure TestUnRegisterHandlerRAllName;
+    Procedure TestUnRegisterHandlerPAllName;
+    Procedure TestUnRegisterHandlerMixedAllName;
+    Procedure TestUnRegisterHandlerOAllHandler;
+    Procedure TestUnRegisterHandlerRAllHandler;
+    Procedure TestUnRegisterHandlerPAllHandler;
+    Procedure TestCreateEventByName;
+    Procedure TestCreateEventByID;
+    Procedure TestDispatchEvent;
+    Procedure TestDispatchEventProc;
+    Procedure TestDispatchEventRef;
+    Procedure TestDispatchEvent2Handlers;
+    Procedure TestDispatchEvent2MixedHandlers;
+    Procedure TestDispatchEventInEvent;
+  end;
+
+implementation
+
+{ TCEventsDispatcher }
+
+procedure TCEventsDispatcher.SetUp;
+
+var
+  H : THandlerType;
+  I : Integer;
+
+begin
+  inherited SetUp;
+  FRHandler:=Nil;
+  FDispatcher:=TEventDispatcher.Create(Self);
+  FDispatcher.Registry:=Self.Registry;
+  For H in THandlerType do
+    begin
+    FHandlerCallCount[H]:=0;
+    For I:=1 to MaxEvents do
+    FHandlerCallEVent[i,H]:=Nil;
+    end;
+end;
+
+procedure TCEventsDispatcher.TearDown;
+
+var
+  I : Integer;
+begin
+  FRHandler:=Nil;
+  FreeAndNil(FDispatcher);
+  for I:=1 to 3 do
+    FreeAndNil(FEvents[i]);
+  inherited TearDown;
+end;
+
+function TCEventsDispatcher.CreateEvent(aID: Integer): TAbstractEvent;
+begin
+  if Assigned(FEvents[aID]) then
+    Fail('Event %d already created',[aID]);
+  FEvents[aID]:=Dispatcher.CreateEvent(Self,aID);
+  Result:=FEvents[aID];
+end;
+
+class procedure TCEventsDispatcher.RegisterEvent(aType: THandlerType;
+  aEvent: TAbstractEvent);
+
+begin
+  Inc(FHandlerCallCount[aType]);
+  if FHandlerCallCount[aType]>MaxEvents then
+    Fail('Max number of recursive events reached');
+  FHandlerCallEvent[FHandlerCallCount[aType],aType]:=aEvent;
+  if (FExpectedEvent<>Nil) then
+    AssertSame('Correct event object registered',FExpectedEvent,aEvent);
+end;
+
+class procedure TCEventsDispatcher.AssertCalled(const Msg: String;
+  aType: THandlerType; aEvent: TAbstractEvent; aIndex, aCount: Integer);
+begin
+  AssertEquals(Msg+'Correct handler count',aCount,FHandlerCallCount[aType]);
+  AssertSame(Msg+' Correct event passed',aEvent,FHandlerCallEvent[aIndex,aType]);
+end;
+
+procedure TCEventsDispatcher.RegisterEvent2P;
+begin
+  RegisterHandlerP('event2');
+end;
+
+procedure TCEventsDispatcher.RegisterEvent2R;
+begin
+  RegisterHandlerR('event2');
+end;
+
+procedure TCEventsDispatcher.RegisterEvent2O;
+begin
+  RegisterHandlerO('event2');
+end;
+
+procedure TCEventsDispatcher.EventHandlerO(aEvent: TAbstractEvent);
+begin
+  RegisterEvent(htObject,aEvent);
+  if Assigned(FSecondEvent) then
+    begin
+    FExpectedEvent:=FSecondEVent;
+    Dispatcher.DispatchEvent(FSecondEvent);
+    end;
+end;
+
+procedure TCEventsDispatcher.EventHandlerO2(aEvent: TAbstractEvent);
+begin
+  RegisterEvent(htObject,aEvent);
+end;
+
+function TCEventsDispatcher.RegisterHandlerO(aEventName: String): TEventHandlerItem;
+begin
+  Result:=Dispatcher.RegisterHandler(@EventHandlerO,aEventName);
+end;
+
+function TCEventsDispatcher.RegisterHandlerO2(aEventName: String
+  ): TEventHandlerItem;
+begin
+  Result:=Dispatcher.RegisterHandler(@EventHandlerO2,aEventName);
+end;
+
+Procedure EventHandlerP(aEvent : TAbstractEVent);
+
+begin
+  TCEventsDispatcher.RegisterEvent(htProc,aEvent);
+end;
+
+Procedure EventHandlerP2(aEvent : TAbstractEVent);
+
+begin
+  TCEventsDispatcher.RegisterEvent(htProc,aEvent);
+end;
+
+function TCEventsDispatcher.RegisterHandlerP(aEventName: String): TEventHandlerItem;
+begin
+  Result:=Dispatcher.RegisterHandler(@EventHandlerP,aEventName);
+end;
+
+function TCEventsDispatcher.RegisterHandlerP2(aEventName: String
+  ): TEventHandlerItem;
+begin
+  Result:=Dispatcher.RegisterHandler(@EventHandlerP2,aEventName);
+end;
+
+function TCEventsDispatcher.RegisterHandlerR(aEventName: String) : TEventHandlerItem;
+
+  Procedure EventHandlerR(aEvent : TAbstractEVent);
+
+  begin
+    RegisterEvent(htRef,aEvent);
+  end;
+
+begin
+  FRHandler:=@EventHandlerR;
+  Result:=Dispatcher.RegisterHandler(FRHandler,aEventName);
+end;
+
+function TCEventsDispatcher.RegisterHandlerR2(aEventName: String
+  ): TEventHandlerItem;
+
+  Procedure EventHandlerR2(aEvent : TAbstractEVent);
+
+  begin
+    RegisterEvent(htRef,aEvent);
+  end;
+
+begin
+  FRHandler2:=@EventHandlerR2;
+  Result:=Dispatcher.RegisterHandler(FRHandler,aEventName);
+end;
+
+procedure TCEventsDispatcher.TestHookup;
+begin
+  AssertNotNull('Dispatcher',Dispatcher);
+  AssertEquals('No handlers',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerO;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  RegisterAll;
+  Itm:=RegisterHandlerO('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Event ID',1,Itm.EventID);
+  AssertEquals('Event name','event1',Itm.EventName);
+  AssertEquals('Count',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerR;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  RegisterAll;
+  Itm:=RegisterHandlerR('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Event ID',1,Itm.EventID);
+  AssertEquals('Event name','event1',Itm.EventName);
+  AssertEquals('Count',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerP;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  RegisterAll;
+  Itm:=RegisterHandlerP('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Event ID',1,Itm.EventID);
+  AssertEquals('Event name','event1',Itm.EventName);
+  AssertEquals('Count',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerOUnknown;
+begin
+  Register1;
+  AssertException('Not known',EEvents,@RegisterEvent2O,'Unknown event name: event2');
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerRUnknown;
+begin
+  Register1;
+  AssertException('Not known',EEvents,@RegisterEvent2R,'Unknown event name: event2');
+end;
+
+procedure TCEventsDispatcher.TestRegisterHandlerPUnknown;
+begin
+  Register1;
+  AssertException('Not known',EEvents,@RegisterEvent2P,'Unknown event name: event2');
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerO;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerO('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(Itm);
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerR;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerR('event1');
+  AssertNotNull('Register returns item',Itm) ;
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(Itm);
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerP;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerP('event1');
+  AssertNotNull('Register returns item',Itm) ;
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(Itm);
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerOName;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerO('event1');
+  AssertNotNull('Register returns item',Itm);
+
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerO,'event1');
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerRName;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerR('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(FRHandler,'event1');
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerPName;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Itm:=RegisterHandlerP('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerP,'event1');
+  AssertEquals('Dispatcher count',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerOUnknownEvent;
+
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Register2;
+  Itm:=RegisterHandlerO('event1');
+  AssertNotNull('Register returns item',Itm);
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerO,'event2');
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerRUnknownEvent;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Register2;
+  Itm:=RegisterHandlerR('event1');
+  AssertNotNull('Register returns item',Itm);
+
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(FRHandler,'event2');
+  AssertEquals('Dispatcher count',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerPUnknownEvent;
+
+
+begin
+  Register1;
+  Register2;
+  RegisterHandlerP('event1');
+  AssertEquals('Dispatcher count before',1,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerP,'event2');
+  AssertEquals('Dispatcher count after',1,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerOUnknownHandler;
+
+begin
+  Register1;
+  Register2;
+  RegisterHandlerO('event1');
+  RegisterHandlerO2('event2');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerO2,'event1');
+  AssertEquals('Dispatcher count after',2,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerRUnknownHandler;
+
+begin
+  Register1;
+  Register2;
+  RegisterHandlerR('event1');
+  RegisterHandlerR2('event2');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(FRHandler2,'event1');
+  AssertEquals('Dispatcher count after',2,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerPUnknownHandler;
+Var
+  Itm : TEventHandlerItem;
+
+begin
+  Register1;
+  Register2;
+  Itm:=RegisterHandlerP('event1');
+  AssertNotNull('Register returns item',Itm);
+  Itm:=RegisterHandlerP2('event2');
+  AssertNotNull('Register 2 returns item',Itm);
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerP2,'event1');
+  AssertEquals('Dispatcher count after',2,Dispatcher.Count);
+
+
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerOAllName;
+
+begin
+  Register1;
+  Register2;
+  RegisterHandlerP('event1');
+  RegisterHandlerP2('event1');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler('event1');
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerRAllName;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerR('event1');
+  RegisterHandlerR2('event1');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler('event1');
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerPAllName;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerP('event1');
+  RegisterHandlerP2('event1');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler('event1');
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerMixedAllName;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerP('event1');
+  RegisterHandlerO2('event1');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler('event1');
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerOAllHandler;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerO('event1');
+  RegisterHandlerO('event2');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerO);
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerRAllHandler;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerR('event1');
+  Dispatcher.RegisterHandler(FRHandler,'event2');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(FRHandler);
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestUnRegisterHandlerPAllHandler;
+begin
+  Register1;
+  Register2;
+  RegisterHandlerP('event1');
+  RegisterHandlerP('event2');
+  AssertEquals('Dispatcher count before',2,Dispatcher.Count);
+  Dispatcher.UnregisterHandler(@EventHandlerP);
+  AssertEquals('Dispatcher count after',0,Dispatcher.Count);
+end;
+
+procedure TCEventsDispatcher.TestCreateEventByName;
+var
+  E : TAbstractEvent;
+begin
+  Register1;
+  E:=Dispatcher.CreateEvent(Self,'event1');
+  AssertEquals('Correct class',TEvent1,E.ClassType);
+  AssertSame('Correct sender',Self,E.Sender);
+  AssertEquals('Event ID',1,E.EventID);
+  E.Free;
+end;
+
+procedure TCEventsDispatcher.TestCreateEventByID;
+var
+  E : TAbstractEvent;
+begin
+  Register1;
+  E:=Dispatcher.CreateEvent(Self,1);
+  AssertEquals('Correct class',TEvent1,E.ClassType);
+  AssertSame('Correct sender',Self,E.Sender);
+  E.Free;
+end;
+
+procedure TCEventsDispatcher.TestDispatchEvent;
+
+Var
+  Evt : TAbstractEvent;
+  aCount : Integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  RegisterHandlerO('event1');
+  RegisterHandlerO2('event2');
+  FExpectedEvent:=Evt;
+  aCOunt:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Count',1,aCount);
+  AssertCalled('Event handler called',htObject,Evt,1,1);
+end;
+
+procedure TCEventsDispatcher.TestDispatchEventProc;
+
+Var
+  Evt : TAbstractEvent;
+  aCount : integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  RegisterHandlerP('event1');
+  RegisterHandlerP2('event2');
+  FExpectedEvent:=Evt;
+  aCount:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Count',1,aCount);
+  AssertCalled('Event handler called',htProc,Evt,1,1);
+end;
+
+procedure TCEventsDispatcher.TestDispatchEventRef;
+
+Var
+  Evt : TAbstractEvent;
+  aCount : integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  RegisterHandlerR('event1');
+  RegisterHandlerR2('event2');
+  FExpectedEvent:=Evt;
+  aCount:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Count',1,aCount);
+  AssertEquals('Count',1,aCount);
+  AssertCalled('Event handler called',htRef,Evt,1,1);
+
+end;
+
+procedure TCEventsDispatcher.TestDispatchEvent2Handlers;
+Var
+  Evt : TAbstractEvent;
+  aCount : integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  RegisterHandlerO('event1');
+  RegisterHandlerO2('event1');
+  FExpectedEvent:=Evt;
+  aCount:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Count',2,aCount);
+
+  AssertCalled('Event handler called',htObject,Evt,1,2);
+  AssertCalled('Event handler called',htObject,Evt,2,2);
+end;
+
+procedure TCEventsDispatcher.TestDispatchEvent2MixedHandlers;
+Var
+  Evt : TAbstractEvent;
+  aCount :Integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  RegisterHandlerO('event1');
+  RegisterHandlerP('event1');
+  FExpectedEvent:=Evt;
+  aCount:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Count',2,aCount);
+  AssertCalled('Event handler called',htObject,Evt,1,1);
+  AssertCalled('Event handler called',htProc,Evt,1,1);
+
+end;
+
+procedure TCEventsDispatcher.TestDispatchEventInEvent;
+
+Var
+  Evt,Evt2 : TAbstractEvent;
+  aCount : Integer;
+
+begin
+  Register1;
+  Register2;
+  Evt:=CreateEvent(1);
+  Evt2:=CreateEvent(2);
+  RegisterHandlerO('event1');
+  RegisterHandlerO2('event2');
+  FExpectedEvent:=Evt;
+  FSecondEvent:=Evt2;
+  aCount:=Dispatcher.DispatchEvent(Evt);
+  AssertEquals('Event handler count',1,aCount);
+  AssertCalled('Event handler 1 called',htObject,Evt,1,2);
+  AssertCalled('Event handler 2 called',htObject,Evt2,2,2);
+end;
+
+{ TMyRegistry }
+
+class function TMyRegistry.DefaultIDOffset: TEventID;
+begin
+  Result:=10;
+end;
+
+{ TEvent3 }
+
+class function TEvent3.EventName: TEventName;
+begin
+  Result:='event3';
+end;
+
+{ TEvent2 }
+
+class function TEvent2.EventName: TEventName;
+begin
+  Result:='event2';
+end;
+
+{ TEvent1 }
+
+class function TEvent1.EventName: TEventName;
+begin
+  Result:='event1';
+end;
+
+procedure TCBaseEvents.Register(event: integer);
+begin
+  case event of
+  1 : FRegs[1]:=Registry.RegisterEvent(TEvent1);
+  2 : FRegs[2]:=Registry.RegisterEvent(TEvent2);
+  3 : FRegs[3]:=Registry.RegisterEvent(TEvent3);
+  end;
+end;
+
+procedure TCBaseEvents.RegisterID(event: Integer; aID: Integer);
+begin
+  if aID=-1 then aID:=event;
+  case event of
+    1 : FRegs[1]:=Registry.RegisterEventWithID(aID,TEvent1);
+    2 : FRegs[2]:=Registry.RegisterEventWithID(aID,TEvent2);
+    3 : FRegs[3]:=Registry.RegisterEventWithID(aID,TEvent3);
+  end;
+end;
+
+procedure TCBaseEvents.Register1;
+begin
+  Register(1);
+end;
+
+procedure TCBaseEvents.Register2;
+begin
+  Register(2);
+end;
+
+procedure TCBaseEvents.Register2As1;
+begin
+  RegisterID(2,1);
+end;
+
+procedure TCBaseEvents.Register2As11;
+begin
+  RegisterID(2,11);
+end;
+
+procedure TCBaseEvents.Register3;
+begin
+  Register(3);
+end;
+
+procedure TCBaseEvents.RegisterAll;
+begin
+  Register1;
+  Register2;
+  Register3;
+end;
+
+procedure TCBaseEvents.RegisterAllGlobally;
+begin
+  FRegs[1]:=TEvent1.Register;
+  FRegs[2]:=TEvent2.Register;
+  FRegs[3]:=TEvent3.Register;
+end;
+
+procedure TCBaseEvents.EnableOffset;
+begin
+  FreeAndNil(Fregistry);
+  FRegistry:=TMyRegistry.Create;
+end;
+
+procedure TCBaseEvents.SetUp;
+begin
+  FRegistry:=TEventRegistry.Create;
+end;
+
+procedure TCBaseEvents.TearDown;
+begin
+  FreeAndNil(FRegistry);
+  TEventRegistry.Instance.Clear;
+end;
+
+procedure TCEventsRegistry.TestHookUp;
+begin
+  AssertNotNull(FRegistry);
+  AssertEquals('No events',0,Registry.GetRegisteredEventCount);
+end;
+
+procedure TCEventsRegistry.TestRegister;
+begin
+  Register(1);
+  AssertEquals('Event1',1,FRegs[1]);
+  Register(2);
+  AssertEquals('Event2',2,FRegs[2]);
+  Register(3);
+  AssertEquals('Event3',3,FRegs[3]);
+end;
+
+procedure TCEventsRegistry.TestRegisterDuplicate;
+begin
+  Register1;
+  AssertException('Cannot register same name twice',EEvents,@Register1);
+end;
+
+procedure TCEventsRegistry.TestRegisterOffset;
+begin
+  EnableOffset;
+  Register(1);
+  AssertEquals('Event1',11,FRegs[1]);
+  Register(2);
+  AssertEquals('Event2',12,FRegs[2]);
+  Register(3);
+  AssertEquals('Event3',13,FRegs[3]);
+end;
+
+procedure TCEventsRegistry.TestRegisterWithID;
+begin
+  EnableOffset;
+  RegisterID(1,3);
+  AssertEquals('Event1',3,FRegs[1]);
+end;
+
+procedure TCEventsRegistry.TestRegisterWithIDDUplicate;
+begin
+  EnableOffset;
+  RegisterID(1,1);
+  AssertException('Duplicate with Event1',EEvents,@Register2As1);
+
+end;
+
+procedure TCEventsRegistry.TestRegisterWithIDOutOfRange;
+begin
+  EnableOffset;
+  RegisterID(1,1);
+  AssertException('ID out of allowed range',EEvents,@Register2as11)
+end;
+
+procedure TCEventsRegistry.TestFindEventID;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',FRegs[1],Registry.FindEventID('event1'));
+  AssertEquals('Event 2',FRegs[2],Registry.FindEventID('event2'));
+  AssertEquals('Event 3',FRegs[3],Registry.FindEventID('event3'));
+  AssertEquals('Nonexisting event',0,Registry.FindEventID('event4'));
+
+end;
+
+procedure TCEventsRegistry.TestGetEventID;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',FRegs[1],Registry.GetEventID('event1'));
+  AssertEquals('Event 2',FRegs[2],Registry.GetEventID('event2'));
+  AssertEquals('Event 3',FRegs[3],Registry.GetEventID('event3'));
+  AssertException('Nonexisting event',EEvents,@FindNonExistent);
+
+end;
+
+procedure TCEventsRegistry.TestFindEventName;
+begin
+  RegisterAll;
+  AssertEquals('Event 1','event1',Registry.GetEventName(FRegs[1]));
+  AssertEquals('Event 2','event2',Registry.GetEventName(FRegs[2]));
+  AssertEquals('Event 3','event3',Registry.GetEventName(FRegs[3]));
+  AssertException('Nonexisting event',EEvents,@FindNonExistentID);
+end;
+
+procedure TCEventsRegistry.TestGetEventName;
+begin
+  RegisterAll;
+  AssertEquals('Event 1','event1',Registry.FindEventName(FRegs[1]));
+  AssertEquals('Event 2','event2',Registry.FindEventName(FRegs[2]));
+  AssertEquals('Event 3','event3',Registry.FIndEventName(FRegs[3]));
+  AssertEquals('Nonexisting event','',Registry.FIndEventName(4));
+end;
+
+procedure TCEventsRegistry.TestFindEventClass;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',TEvent1,Registry.FindEventClass('event1'));
+  AssertEquals('Event 2',TEvent2,Registry.FindEventClass('event2'));
+  AssertEquals('Event 3',TEvent3,Registry.FindEventClass('event3'));
+  AssertNull('Nonexisting event',Registry.FindEventClass('event4'));
+
+end;
+
+procedure TCEventsRegistry.TestGetEventClass;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',TEvent1,Registry.GetEventClass('event1'));
+  AssertEquals('Event 2',TEvent2,Registry.GetEventClass('event2'));
+  AssertEquals('Event 3',TEvent3,Registry.GetEventClass('event3'));
+  AssertException('Nonexisting event',EEvents,@FindNonExistentClass);
+end;
+
+procedure TCEventsRegistry.TestFindEventClassByID;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',TEvent1,Registry.FindEventClass(FRegs[1]));
+  AssertEquals('Event 2',TEvent2,Registry.FindEventClass(FRegs[2]));
+  AssertEquals('Event 3',TEvent3,Registry.FindEventClass(FRegs[3]));
+  AssertNull('Nonexisting event',Registry.FindEventClass(122));
+
+end;
+
+procedure TCEventsRegistry.TestGetEventClassByID;
+begin
+  RegisterAll;
+  AssertEquals('Event 1',TEvent1,Registry.GetEventClass(FRegs[1]));
+  AssertEquals('Event 2',TEvent2,Registry.GetEventClass(FRegs[2]));
+  AssertEquals('Event 3',TEvent3,Registry.GetEventClass(FRegs[3]));
+  AssertException('Nonexisting event',EEvents,@FindNonExistentClassByID);
+
+end;
+
+procedure TCEventsRegistry.TestUnregisterEventClass;
+begin
+  RegisterAll;
+  Registry.UnRegisterEvent(TEVent1);
+  AssertEquals('Not found',0,Registry.FindEventID('event1'));
+  Register1;
+end;
+
+procedure TCEventsRegistry.TestUnregisterEventID;
+begin
+  RegisterAll;
+  Registry.UnRegisterEvent(FRegs[1]);
+  AssertEquals('Not found',0,Registry.FindEventID('event1'));
+  Register1;
+end;
+
+procedure TCEventsRegistry.TestUnregisterEventName;
+begin
+  RegisterAll;
+  Registry.UnRegisterEvent('event1');
+  AssertEquals('Not found',0,Registry.FindEventID('event1'));
+  Register1;
+end;
+
+procedure TCEventsRegistry.TestClear;
+begin
+  RegisterAll;
+  Registry.Clear;
+  AssertNull('Nonexisting event1',Registry.FindEventClass(1));
+  AssertNull('Nonexisting event2',Registry.FindEventClass(2));
+  AssertNull('Nonexisting event3',Registry.FindEventClass(3));
+  TestRegister;
+end;
+
+procedure TCEventsRegistry.TestRegisterGLobally;
+begin
+  RegisterAllGlobally;
+  AssertEquals('Event 1',TEvent1,TEventRegistry.Instance.FindEventClass(FRegs[1]));
+  AssertEquals('Event 2',TEvent2,TEventRegistry.Instance.FindEventClass(FRegs[2]));
+  AssertEquals('Event 3',TEvent3,TEventRegistry.Instance.FindEventClass(FRegs[3]));
+end;
+
+procedure TCEventsRegistry.FindNonExistent;
+
+begin
+  Registry.GetEventID('event4');
+end;
+
+procedure TCEventsRegistry.FindNonExistentClass;
+begin
+  Registry.GetEventClass('event4');
+end;
+
+procedure TCEventsRegistry.FindNonExistentClassByID;
+begin
+  Registry.GetEventClass(4);
+end;
+
+procedure TCEventsRegistry.FindNonExistentID;
+begin
+  Registry.GetEventName(4);
+end;
+
+initialization
+  RegisterTests([TCEventsRegistry,TCEventsDispatcher]);
+end.
+