1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
unit LazMethodList;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TMethodList - array of TMethod }
TMethodList = class
private
FItems: ^TMethod;
FCount: integer;
function GetItems(Index: integer): TMethod;
procedure SetItems(Index: integer; const AValue: TMethod);
public
destructor Destroy; override;
function Count: integer;
function NextDownIndex(var Index: integer): boolean;
function IndexOf(const AMethod: TMethod): integer;
procedure Delete(Index: integer);
procedure Remove(const AMethod: TMethod);
procedure Add(const AMethod: TMethod);
procedure Add(const AMethod: TMethod; AsLast: boolean);
procedure Insert(Index: integer; const AMethod: TMethod);
procedure Move(OldIndex, NewIndex: integer);
procedure RemoveAllMethodsOfObject(const AnObject: TObject);
procedure CallNotifyEvents(Sender: TObject);
public
property Items[Index: integer]: TMethod read GetItems write SetItems; default;
end;
implementation
{ TMethodList }
function TMethodList.GetItems(Index: integer): TMethod;
begin
Result:=FItems[Index];
end;
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
begin
FItems[Index]:=AValue;
end;
destructor TMethodList.Destroy;
begin
ReAllocMem(FItems,0);
inherited Destroy;
end;
function TMethodList.Count: integer;
begin
if Self<>nil then
Result:=FCount
else
Result:=0;
end;
function TMethodList.NextDownIndex(var Index: integer): boolean;
begin
if Self<>nil then begin
dec(Index);
if (Index>=FCount) then
Index:=FCount-1;
end else
Index:=-1;
Result:=(Index>=0);
end;
function TMethodList.IndexOf(const AMethod: TMethod): integer;
begin
if Self<>nil then begin
Result:=FCount-1;
while Result>=0 do begin
if (FItems[Result].Code=AMethod.Code)
and (FItems[Result].Data=AMethod.Data) then exit;
dec(Result);
end;
end else
Result:=-1;
end;
procedure TMethodList.Delete(Index: integer);
begin
dec(FCount);
if FCount>Index then
System.Move(FItems[Index+1],FItems[Index],(FCount-Index)*SizeOf(TMethod));
ReAllocMem(FItems,FCount*SizeOf(TMethod));
end;
procedure TMethodList.Remove(const AMethod: TMethod);
var
i: integer;
begin
if Self<>nil then begin
i:=IndexOf(AMethod);
if i>=0 then Delete(i);
end;
end;
procedure TMethodList.Add(const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
FItems[FCount-1]:=AMethod;
end;
procedure TMethodList.Add(const AMethod: TMethod; AsLast: boolean);
begin
if AsLast then
Add(AMethod)
else
Insert(0,AMethod);
end;
procedure TMethodList.Insert(Index: integer; const AMethod: TMethod);
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
if Index<FCount then
System.Move(FItems[Index],FItems[Index+1],(FCount-Index-1)*SizeOf(TMethod));
FItems[Index]:=AMethod;
end;
procedure TMethodList.Move(OldIndex, NewIndex: integer);
var
MovingMethod: TMethod;
begin
if OldIndex=NewIndex then exit;
MovingMethod:=FItems[OldIndex];
if OldIndex>NewIndex then
System.Move(FItems[NewIndex],FItems[NewIndex+1],
SizeOf(TMethod)*(OldIndex-NewIndex))
else
System.Move(FItems[NewIndex+1],FItems[NewIndex],
SizeOf(TMethod)*(NewIndex-OldIndex));
FItems[NewIndex]:=MovingMethod;
end;
procedure TMethodList.RemoveAllMethodsOfObject(const AnObject: TObject);
var
i: Integer;
begin
if Self=nil then exit;
i:=FCount-1;
while i>=0 do begin
if TObject(FItems[i].Data)=AnObject then Delete(i);
dec(i);
end;
end;
procedure TMethodList.CallNotifyEvents(Sender: TObject);
var
i: LongInt;
begin
i:=Count;
while NextDownIndex(i) do
TNotifyEvent(Items[i])(Sender);
end;
end.
|
