Mega Code Archive
Event Chain Mechanism II
<![CDATA[
Title: Event Chain Mechanism II
Question: Attach and detach many event handlers to an event at runtime
Answer:
My last event chain mechanism doesn't include UnSaveEvent method. We use UnSafeEvent method for removing an event from event chain. EventId parameter is removed from event chain mechanism, so only event wrapper mechanism can be used.
There aren't any changes on SaveEvent usage, here's the example:
procedure TfrmEventChain.btnAttachEvent1Click(Sender: TObject);
begin
SaveEvent(btnTrigger.OnClick,Event1Click,btnTrigger);
btnTrigger.OnClick:=Event1Click;
end;
There aren't any changes on ChainedEvent usage also, here's the example:
procedure TfrmEventChain.Event1Click(Sender: TObject);
begin
ChainedEvent(Event1Click,TComponent(Sender));
chbEvent1.Checked:=not chbEvent1.Checked;
end;
I only add new usage of UnSaveEvent, here's the example:
procedure TfrmEventChain.btnDetachEvent1Click(Sender: TObject);
var
NextEvent:TNotifyEvent;
begin
NextEvent:=UnSaveEvent(Event1Click,btnTrigger);
if SameEvent(btnTrigger.OnClick,Event1Click) then
btnTrigger.OnClick:=NextEvent;
end;
OK, here's the unit source code for TNotifyEvent (this unit and the demo project will be sent to delphi3000 admin immediately):
unit EventChain;
interface
uses Classes, SysUtils;
type
ECircularEventChain = class(Exception);
//EventId is removed,
//use event handler wrapper to differentiate events of single component
//that share one event handler
procedure SaveEvent(OldEvent,NewEvent:TNotifyEvent;Sender:TComponent);overload;
procedure ChainedEvent(NewEvent:TNotifyEvent;Sender:TComponent);overload
function UnSaveEvent(Event:TNotifyEvent;Sender:TComponent):TNotifyEvent;overload
function SameEvent(LeftEvent,RightEvent:TNotifyEvent):boolean;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);
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));
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);
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));
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;
function UnSaveEvent(Event:TNotifyEvent;Sender:TComponent):TNotifyEvent;overload
var
i,u,pstn,separator:integer;
EventName,EventString,EventCodeString,SenderString,NextEventString:string;
begin
Result:=nil;
if Assigned(Event) and Assigned(Sender) then
begin
NextEventString:=IntToStr(Integer(TMethod(Result).Data))+'.'+
IntToStr(Integer(TMethod(Result).Code));
EventCodeString:=IntToStr(Integer(TMethod(Event).Code));
EventString:=IntToStr(Integer(TMethod(Event).Data))+'.'+
EventCodeString;
SenderString:=IntToStr(Integer(Sender));
u:=EventList.Count-1;
pstn:=EventList.IndexOfName(SenderString+'.'+EventCodeString);
for i:=u downto 0 do
begin
EventName:=EventList.Names[i];
if (pos(SenderString,EventName)=1)and(EventList.Values[EventName]=EventString)then
begin
//Next event found redirect next event
if pstn=0 then
NextEventString:=EventList.Values[SenderString+'.'+EventCodeString];
EventList.Values[EventName]:=NextEventString;
end;
end;
if pstn=0 then
begin
NextEventString:=EventList.Values[SenderString+'.'+EventCodeString];
Separator:=pos('.',NextEventString);
TMethod(Result).Data:=Pointer(StrToInt(Copy(NextEventString,1,Separator-1)));
TMethod(Result).Code:=Pointer(StrToInt(Copy(NextEventString,Separator+1,length(NextEventString)-Separator)));;
EventList.Delete(pstn);
end;
end;
end;
function SameEvent(LeftEvent,RightEvent:TNotifyEvent):boolean;
begin
with TMethod(LeftEvent) do
Result:=(Data=TMethod(RightEvent).Data)and(Code=TMethod(RightEvent).Code);
end;
end.
]]>