paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 03:56:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

lazutils: TMethodList: added AllowDuplicates, default false

Browse Source 
git-svn-id: trunk@44331 -
This commit is contained in:
mattias 2014-03-03 09:46:31 +00:00
parent 483139f4fb
commit bc1ecef605
1 changed files with 84 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
components/lazutils/lazmethodlist.pas
View File

@ -5,17 +5,21 @@ unit LazMethodList;
interface
uses
Classes, SysUtils;
Classes, SysUtils, RtlConsts;
type
{ TMethodList - array of TMethod }
TMethodList = class
private
FAllowDuplicates: boolean;
FItems: ^TMethod;
FCount: integer;
function GetItems(Index: integer): TMethod;
procedure SetAllowDuplicates(AValue: boolean);
procedure SetItems(Index: integer; const AValue: TMethod);
procedure InternalInsert(Index: integer; const AMethod: TMethod);
procedure RaiseIndexOutOfBounds(Index: integer);
public
destructor Destroy; override;
function Count: integer;
@ -28,9 +32,10 @@ type
procedure Insert(Index: integer; const AMethod: TMethod);
procedure Move(OldIndex, NewIndex: integer);
procedure RemoveAllMethodsOfObject(const AnObject: TObject);
procedure CallNotifyEvents(Sender: TObject);
procedure CallNotifyEvents(Sender: TObject); // calls from Count-1 downto 0, all methods must be TNotifyEvent
public
property Items[Index: integer]: TMethod read GetItems write SetItems; default;
property AllowDuplicates: boolean read FAllowDuplicates write SetAllowDuplicates; // default false, changed in Lazarus 1.3
end;
implementation
@ -42,11 +47,58 @@ begin
Result:=FItems[Index];
end;
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
procedure TMethodList.SetAllowDuplicates(AValue: boolean);
var
i, j: Integer;
begin
if FAllowDuplicates=AValue then Exit;
FAllowDuplicates:=AValue;
if not AllowDuplicates then
begin
i:=0;
while i<FCount do
begin
j:=i+1;
while j<FCount do
begin
if (FItems[i].Code=FItems[j].Code)
and (FItems[i].Data=FItems[j].Data) then
Delete(j)
else
inc(j);
end;
inc(i);
end;
end;
end;
procedure TMethodList.SetItems(Index: integer; const AValue: TMethod);
procedure RaiseDuplicate;
begin
raise EListError.CreateFmt(SDuplicateItem,[AValue.Code]);
end;
begin
if (not AllowDuplicates) and (IndexOf(AValue)<>Index) then
RaiseDuplicate;
FItems[Index]:=AValue;
end;
procedure TMethodList.InternalInsert(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.RaiseIndexOutOfBounds(Index: integer);
begin
raise EListError.CreateFmt(SListIndexError,[Index]);
end;
destructor TMethodList.Destroy;
begin
ReAllocMem(FItems,0);
@ -104,9 +156,21 @@ begin
end;
procedure TMethodList.Add(const AMethod: TMethod);
var
i: Integer;
begin
if AllowDuplicates then
i:=-1
else
i:=IndexOf(AMethod);
if (i<0) then
begin
inc(FCount);
ReAllocMem(FItems,FCount*SizeOf(TMethod));
end else begin
if i=FCount-1 then exit;
System.Move(FItems[i+1],FItems[i],SizeOf(TMethod)*(FCount-i-1));
end;
FItems[FCount-1]:=AMethod;
end;
@ -119,12 +183,20 @@ begin
end;
procedure TMethodList.Insert(Index: integer; const AMethod: TMethod);
var
i: Integer;
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;
if AllowDuplicates then
i:=-1
else
i:=IndexOf(AMethod);
if i<0 then
begin
if (Index<0) or (Index>FCount) then
RaiseIndexOutOfBounds(Index);
InternalInsert(Index,AMethod)
end else
Move(i,Index);
end;
procedure TMethodList.Move(OldIndex, NewIndex: integer);
@ -132,6 +204,8 @@ var
MovingMethod: TMethod;
begin
if OldIndex=NewIndex then exit;
if (NewIndex<0) or (NewIndex>=FCount) then
RaiseIndexOutOfBounds(NewIndex);
MovingMethod:=FItems[OldIndex];
if OldIndex>NewIndex then
System.Move(FItems[NewIndex],FItems[NewIndex+1],