Examples Delphi

  1. Home
  2. Delphi
  3. Examples
  4. Event Chain Mechanism
Title: Event Chain Mechanism
Question: How can we attach more than one event handler to an event of a single component?
Answer:
In my database project architecture the OnChange event of a single TField instance can have three event handlers.
First event handler comes from the datasets repository (prototype design pattern). You can see the early form of this mechanism at http://www.delphi3000.com/articles/article_2414.asp.
Second event handler comes from my auto lookup mechanism (query on retrieve and lookup on modification). You can see the early form of this mechanism at http://www.delphi3000.com/articles/article_2308.asp.
Third event handler comes from the form that has the dataset cloned from repository.
So I made a mechanism that allow me to attach more than one handler to an event of a single component easily. This mechanism even checks for circular event chaining and does garbage collection automatically.
For an event handler that shared by more than one event of a single component, precaution must be taken. For example:
NewAfterPost--------Chained AfterPost
-------NewCommontEvent
NewAfterDelete------Chained AfterDelete
NewAfterPost and NewAfterDelete event handlers are wrappers for NewCommonEvent so the mechanism knows exactly the chained events. Here is the snippet:
procedure Form1.NewAfterPost(DataSet: TDataSet);
begin
ChainedEvent(NewAfterPost,DataSet);
NewCommonEvent(DataSet);
end;
procedure Form1.NewAfterDelete(DataSet: TDataSet);
begin
ChainedEvent(NewAfterDelete,DataSet);
NewCommonEvent(DataSet);
end;
procedure Form1.NewCommonEvent(DataSet: TDataSet);
begin
...
end;
//save chained events
SaveEvent(Query1.AfterPost,NewAfterPost,Query1);
Query1.AfterPost:=NewAfterPost;
SaveEvent(Query1.AfterDelete,NewAfterDelete,Query1);
Query1.AfterDelete:=NewAfterDelete;
If you could determine the current event being executed, you can ommit event handler wrappers by using EventId. EventId is a string used to differentiate events that share one event handler. For example:
//save chained events
SaveEvent(Query1.AfterPost,NewCommonEvent,Query1,'AfterPost');
Query1.AfterPost:=NewCommonEvent;
SaveEvent(Query1.AfterDelete,NewCommonEvent,Query1,'AfterDelete');
Query1.AfterDelete:=NewCommonEvent;
procedure Form1.NewCommonEvent(DataSet: TDataSet);
begin
ChainedEvent(NewCommonEvent,DataSet,EventIdOfQuery(DataSet));
//EventIdOfQuery return the string id ('AfterPost', 'AfterDelete' etc) of current event being executed.
...
end;
Here is the EventChain unit complete source code (this unit and the demo project will be sent to delphi3000 admin immediately):
unit EventChain;
interface
uses Classes, SysUtils, Db;
type
ECircularEventChain = class(Exception);
//use EventId to differentiate events that share one event handler
procedure SaveEvent(OldEvent,NewEvent:TNotifyEvent;Sender:TComponent;EventId:string='');overload;
procedure ChainedEvent(NewEvent:TNotifyEvent;Sender:TComponent;EventId:string='');overload
procedure SaveEvent(OldEvent,NewEvent:TFieldNotifyEvent;Sender:TField;EventId:string='');overload;
procedure ChainedEvent(NewEvent:TFieldNotifyEvent;Sender:TField;EventId:string='');overload
procedure SaveEvent(OldEvent,NewEvent:TDataSetNotifyEvent;Sender:TDataSet;EventId:string='');overload;
procedure ChainedEvent(NewEvent:TDataSetNotifyEvent;Sender:TDataSet;EventId:string='');overload
var
EventList:TStringList;
//move declaration to implementation section after testing
implementation
type
TEventListCleaner = class(TComponent)
protected
procedure Notification(AComponent: TComponent;Operation: TOperation);override;
end;
var
EventListCleaner:TEventListCleaner;
procedure SaveEvent(OldEvent,NewEvent:TNotifyEvent;Sender:TComponent;EventId:string);
var
EventName:string;
EventString:string;
i,u:integer;
SenderString:string;
begin
if Assigned(OldEvent) and Assigned(NewEvent) and Assigned(Sender) and (@OldEvent@NewEvent) then
begin
EventString:=IntToStr(Integer(TMethod(NewEvent).Data))+'.'+
IntToStr(Integer(TMethod(NewEvent).Code));
u:=EventList.Count-1;
SenderString:=IntToStr(Integer(Sender));
//check for circular event chain
for i:=0 to u do
begin
EventName:=EventList.Names[i];
if (pos(SenderString,EventName)=1)and
(EventList.Values[EventName]=EventString) then
raise ECircularEventChain.Create('Circular event chain found!');
end;
EventName:=SenderString+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=IntToStr(Integer(TMethod(OldEvent).Data))+'.'+
IntToStr(Integer(TMethod(OldEvent).Code));
EventList.Values[EventName]:=EventString;
Sender.FreeNotification(EventListCleaner);
end;
end;
procedure ChainedEvent(NewEvent:TNotifyEvent;Sender:TComponent;EventId:string);
var
EventName:string;
OldEvent:TNotifyEvent;
EventString:string;
Separator:integer;
begin
if Assigned(NewEvent) and Assigned(Sender) then
begin
EventName:=IntToStr(Integer(Sender))+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=EventList.Values[EventName];
if (EventString'') then
begin
Separator:=pos('.',EventString);
TMethod(OldEvent).Data:=Pointer(StrToInt(Copy(EventString,1,Separator-1)));
TMethod(OldEvent).Code:=Pointer(StrToInt(Copy(EventString,Separator+1,length(EventString)-Separator)));;
if Assigned(OldEvent) then
OldEvent(Sender);
end;
end;
end;
procedure SaveEvent(OldEvent,NewEvent:TFieldNotifyEvent;Sender:TField;EventId:string);
var
EventName:string;
EventString:string;
i,u:integer;
SenderString:string;
begin
if Assigned(OldEvent) and Assigned(NewEvent) and Assigned(Sender) and (@OldEvent@NewEvent) then
begin
EventString:=IntToStr(Integer(TMethod(NewEvent).Data))+'.'+
IntToStr(Integer(TMethod(NewEvent).Code));
u:=EventList.Count-1;
SenderString:=IntToStr(Integer(Sender));
//check for circular event chain
for i:=0 to u do
begin
EventName:=EventList.Names[i];
if (pos(SenderString,EventName)=1)and
(EventList.Values[EventName]=EventString) then
raise ECircularEventChain.Create('Circular event chain found!');
end;
EventName:=SenderString+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=IntToStr(Integer(TMethod(OldEvent).Data))+'.'+
IntToStr(Integer(TMethod(OldEvent).Code));
EventList.Values[EventName]:=EventString;
Sender.FreeNotification(EventListCleaner);
end;
end;
procedure ChainedEvent(NewEvent:TFieldNotifyEvent;Sender:TField;EventId:string);
var
EventName:string;
OldEvent:TFieldNotifyEvent;
EventString:string;
Separator:integer;
begin
if Assigned(NewEvent) and Assigned(Sender) then
begin
EventName:=IntToStr(Integer(Sender))+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=EventList.Values[EventName];
if (EventString'') then
begin
Separator:=pos('.',EventString);
TMethod(OldEvent).Data:=Pointer(StrToInt(Copy(EventString,1,Separator-1)));
TMethod(OldEvent).Code:=Pointer(StrToInt(Copy(EventString,Separator+1,length(EventString)-Separator)));;
if Assigned(OldEvent) then
OldEvent(Sender);
end;
end;
end;
procedure SaveEvent(OldEvent,NewEvent:TDataSetNotifyEvent;Sender:TDataSet;EventId:string);
var
EventName:string;
EventString:string;
i,u:integer;
SenderString:string;
begin
if Assigned(OldEvent) and Assigned(NewEvent) and Assigned(Sender) and (@OldEvent@NewEvent) then
begin
EventString:=IntToStr(Integer(TMethod(NewEvent).Data))+'.'+
IntToStr(Integer(TMethod(NewEvent).Code));
u:=EventList.Count-1;
SenderString:=IntToStr(Integer(Sender));
//check for circular event chain
for i:=0 to u do
begin
EventName:=EventList.Names[i];
if (pos(SenderString,EventName)=1)and
(EventList.Values[EventName]=EventString) then
raise ECircularEventChain.Create('Circular event chain found!');
end;
EventName:=SenderString+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=IntToStr(Integer(TMethod(OldEvent).Data))+'.'+
IntToStr(Integer(TMethod(OldEvent).Code));
EventList.Values[EventName]:=EventString;
Sender.FreeNotification(EventListCleaner);
end;
end;
procedure ChainedEvent(NewEvent:TDataSetNotifyEvent;Sender:TDataSet;EventId:string);
var
EventName:string;
OldEvent:TDataSetNotifyEvent;
EventString:string;
Separator:integer;
begin
if Assigned(NewEvent) and Assigned(Sender) then
begin
EventName:=IntToStr(Integer(Sender))+'.'+IntToStr(Integer(@NewEvent))+EventId;
EventString:=EventList.Values[EventName];
if (EventString'') then
begin
Separator:=pos('.',EventString);
TMethod(OldEvent).Data:=Pointer(StrToInt(Copy(EventString,1,Separator-1)));
TMethod(OldEvent).Code:=Pointer(StrToInt(Copy(EventString,Separator+1,length(EventString)-Separator)));;
if Assigned(OldEvent) then
OldEvent(Sender);
end;
end;
end;
{ TEventListCleaner }
procedure TEventListCleaner.Notification(AComponent: TComponent;
Operation: TOperation);
var
i,u:integer;
EventName:string;
SenderString:string;
begin
inherited;
//garbage collection
if(Operation=opRemove)then
begin
SenderString:=IntToStr(Integer(AComponent));
u:=EventList.Count-1;
for i:=u downto 0 do
begin
EventName:=EventList.Names[i];
if (pos(SenderString,EventName)=1)then
EventList.Delete(i);
end;
end;
end;
initialization
EventList:=TStringList.Create;
EventListCleaner:=TEventListCleaner.Create(nil);
finalization
EventListCleaner.Free;
EventList.Free;
end.