type
TEventList = class(TComponent)
private
FList: array of TMethod;
FLock: TRTLCriticalSection;
FUnpackList: array of TMethod;
procedure Delete(Index: Integer);
function IndexOf(const AEvent: TMethod): Integer;
protected
function AddEvent(const AEvent: TMethod): Integer;
function Count: Integer;
function Event(Index: Integer): TMethod;
function IsEmpty(Index: Integer): Boolean;
procedure LockList;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure RemoveEvent(const AEvent: TMethod);
procedure RemoveEventOf(AComponent: TObject);
procedure UnlockList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TNotifyEventList = class(TEventList)
public
procedure Add(AEvent: TNotifyEvent);
procedure Execute(Sender: TObject);
procedure Remove(AEvent: TNotifyEvent);
end;
{ TEventList }
function TEventList.AddEvent(const AEvent: TMethod): Integer;
var
L: Integer;
begin
if (AEvent.Code = nil) and (AEvent.Data = nil) then
raise EListError.Create('Invalid method value');
EnterCriticalSection(FLock);
try
Result := IndexOf(AEvent);
if Result < 0 then
begin
L := Length(FList);
SetLength(FList, Succ(L));
FList[L] := AEvent;
if TObject(AEvent.Data) is TComponent then
TComponent(AEvent.Data).FreeNotification(Self);
end;
finally
LeaveCriticalSection(FLock);
end;
end;
function TEventList.Count: Integer;
begin
Result := Length(FUnpackList);
end;
constructor TEventList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
InitializeCriticalSection(FLock);
end;
procedure TEventList.Delete(Index: Integer);
var
I: Integer;
M: TMethod;
begin
I := Length(FList);
if (Index < 0) and (Index >= I) then
raise EListError.CreateFmt('List index out of bounds (%d)', [Index]);
Dec(I);
M := FList[Index];
if Index < I then
System.Move(FList[Index + 1], FList[Index],
(I - Index) * SizeOf(TMethod));
SetLength(FList, I);
for I := 0 to High(FUnpackList) do
if (FUnpackList[I].Code = M.Code) and (FUnpackList[I].Data = M.Data) then
begin
FUnpackList[I].Code := nil;
FUnpackList[I].Data := nil;
Exit;
end;
end;
destructor TEventList.Destroy;
begin
SetLength(FList, 0);
DeleteCriticalSection(FLock);
inherited Destroy;
end;
function TEventList.Event(Index: Integer): TMethod;
begin
if (Index < 0) or (Index >= Length(FUnpackList)) then
FillChar(Result, Sizeof(Result), 0)
else
Result := FUnpackList[Index];
end;
function TEventList.IndexOf(const AEvent: TMethod): Integer;
var
I: Integer;
begin
Result := -1;
for I := Pred(Length(FList)) downto 0 do
if (FList[I].Code = AEvent.Code) and (FList[I].Data = AEvent.Data) then
begin
Result := I;
Exit;
end;
end;
function TEventList.IsEmpty(Index: Integer): Boolean;
begin
if (Index < 0) and (Index >= Length(FUnpackList)) then
raise EListError.CreateFmt('List index out of bounds (%d)', [Index]);
Result := (FUnpackList[Index].Code = nil) and
(FUnpackList[Index].Data = nil);
end;
procedure TEventList.LockList;
var
L: Integer;
begin
EnterCriticalSection(FLock);
L := Length(FList);
SetLength(FUnpackList, L);
System.Move(FList[0], FUnpackList[0], L * SizeOf(TMethod));
end;
procedure TEventList.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if Operation = opRemove then
RemoveEventOf(AComponent);
inherited Notification(AComponent, Operation);
end;
procedure TEventList.RemoveEvent(const AEvent: TMethod);
var
I: Integer;
begin
EnterCriticalSection(FLock);
try
for I := Pred(Length(FList)) downto 0 do
if (FList[I].Code = AEvent.Code ) and (FList[I].Data = AEvent.Data) then
begin
Delete(I);
Break;
end;
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TEventList.RemoveEventOf(AComponent: TObject);
var
I: Integer;
begin
EnterCriticalSection(FLock);
try
for I := Pred(Length(FList)) downto 0 do
if FList[I].Data = AComponent then
Delete(I);
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TEventList.UnlockList;
begin
SetLength(FUnpackList, 0);
LeaveCriticalSection(FLock);
end;
{ TNotifyEventList }
procedure TNotifyEventList.Add(AEvent: TNotifyEvent);
begin
AddEvent(TMethod(AEvent));
end;
procedure TNotifyEventList.Execute(Sender: TObject);
var
I: Integer;
begin
LockList;
try
for I := 0 to Count - 1 do if not IsEmpty(I) then
TNotifyEvent(Event(I))(Sender);
finally
UnlockList;
end;
end;
procedure TNotifyEventList.Remove(AEvent: TNotifyEvent);
begin
RemoveEvent(TMethod(AEvent));
end; |
