diff --git a/components/lazutils/lazmethodlist.pas b/components/lazutils/lazmethodlist.pas index 5823c6ddfa..88bf5cad2d 100644 --- a/components/lazutils/lazmethodlist.pas +++ b/components/lazutils/lazmethodlist.pas @@ -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 iIndex) then + RaiseDuplicate; FItems[Index]:=AValue; end; +procedure TMethodList.InternalInsert(Index: integer; const AMethod: TMethod); +begin + inc(FCount); + ReAllocMem(FItems,FCount*SizeOf(TMethod)); + if IndexFCount) 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],