From 5f39d255e12bb1cef2d67f2663d4877121132e4a Mon Sep 17 00:00:00 2001 From: ivost Date: Sat, 27 Nov 2010 16:02:01 +0000 Subject: [PATCH] * added TFPGMapInterfacedObjectData: This generic class expects a TInterfacedObject as type of TData. The advantage over TFPGMap is, that refcounting is used. It's compareable to TFPGInterfacedObjectList. Note that this only works within the TData part, TKey is not refcounted! git-svn-id: trunk@16455 - --- rtl/objpas/fgl.pp | 206 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 206 insertions(+) diff --git a/rtl/objpas/fgl.pp b/rtl/objpas/fgl.pp index 9e1725d421..6e3ca512b2 100644 --- a/rtl/objpas/fgl.pp +++ b/rtl/objpas/fgl.pp @@ -294,6 +294,51 @@ type property OnDataCompare: TDataCompareFunc read FOnDataCompare write SetOnDataCompare; end; + generic TFPGMapInterfacedObjectData = class(TFPSMap) + public + type + TKeyCompareFunc = function(const Key1, Key2: TKey): Integer; + TDataCompareFunc = function(const Data1, Data2: TData): Integer; + PKey = ^TKey; + PData = ^TData; + {$ifndef OldSyntax}protected var{$else}var protected{$endif} + FOnKeyCompare: TKeyCompareFunc; + FOnDataCompare: TDataCompareFunc; + procedure CopyItem(Src, Dest: Pointer); override; + procedure CopyKey(Src, Dest: Pointer); override; + procedure CopyData(Src, Dest: Pointer); override; + procedure Deref(Item: Pointer); override; + procedure InitOnPtrCompare; override; + function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif} + function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif} + function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif} + function KeyCompare(Key1, Key2: Pointer): Integer; + function KeyCustomCompare(Key1, Key2: Pointer): Integer; + //function DataCompare(Data1, Data2: Pointer): Integer; + function DataCustomCompare(Data1, Data2: Pointer): Integer; + procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef CLASSESINLINE} inline; {$endif} + procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif} + procedure PutData(Index: Integer; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif} + procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc); + procedure SetOnDataCompare(NewCompare: TDataCompareFunc); + public + constructor Create; + function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif} + function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif} + function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif} + function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif} + function IndexOfData(const AData: TData): Integer; + procedure InsertKey(Index: Integer; const AKey: TKey); + procedure InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData); + function Remove(const AKey: TKey): Integer; + property Keys[Index: Integer]: TKey read GetKey write PutKey; + property Data[Index: Integer]: TData read GetData write PutData; + property KeyData[const AKey: TKey]: TData read GetKeyData write PutKeyData; default; + property OnCompare: TKeyCompareFunc read FOnKeyCompare write SetOnKeyCompare; //deprecated; + property OnKeyCompare: TKeyCompareFunc read FOnKeyCompare write SetOnKeyCompare; + property OnDataCompare: TDataCompareFunc read FOnDataCompare write SetOnDataCompare; + end; + implementation uses @@ -1376,4 +1421,165 @@ begin Result := inherited Remove(@AKey); end; +{**************************************************************************** + TFPGMapInterfacedObjectData + ****************************************************************************} + +constructor TFPGMapInterfacedObjectData.Create; +begin + inherited Create(SizeOf(TKey), SizeOf(TData)); +end; + +procedure TFPGMapInterfacedObjectData.CopyItem(Src, Dest: Pointer); +begin + CopyKey(Src, Dest); + CopyData(PByte(Src)+KeySize, PByte(Dest)+KeySize); +end; + +procedure TFPGMapInterfacedObjectData.CopyKey(Src, Dest: Pointer); +begin + TKey(Dest^) := TKey(Src^); +end; + +procedure TFPGMapInterfacedObjectData.CopyData(Src, Dest: Pointer); +begin + if Assigned(Pointer(Dest^)) then + TData(Dest^)._Release; + TData(Dest^) := TData(Src^); + if Assigned(Pointer(Dest^)) then + TData(Dest^)._AddRef; +end; + +procedure TFPGMapInterfacedObjectData.Deref(Item: Pointer); +begin + Finalize(TKey(Item^)); + if Assigned(PPointer(PByte(Item)+KeySize)^) then + TData(Pointer(PByte(Item)+KeySize)^)._Release; +end; + +function TFPGMapInterfacedObjectData.GetKey(Index: Integer): TKey; +begin + Result := TKey(inherited GetKey(Index)^); +end; + +function TFPGMapInterfacedObjectData.GetData(Index: Integer): TData; +begin + Result := TData(inherited GetData(Index)^); +end; + +function TFPGMapInterfacedObjectData.GetKeyData(const AKey: TKey): TData; +begin + Result := TData(inherited GetKeyData(@AKey)^); +end; + +function TFPGMapInterfacedObjectData.KeyCompare(Key1, Key2: Pointer): Integer; +begin + if PKey(Key1)^ < PKey(Key2)^ then + Result := -1 + else if PKey(Key1)^ > PKey(Key2)^ then + Result := 1 + else + Result := 0; +end; + +{function TFPGMapInterfacedObjectData.DataCompare(Data1, Data2: Pointer): Integer; +begin + if PData(Data1)^ < PData(Data2)^ then + Result := -1 + else if PData(Data1)^ > PData(Data2)^ then + Result := 1 + else + Result := 0; +end;} + +function TFPGMapInterfacedObjectData.KeyCustomCompare(Key1, Key2: Pointer): Integer; +begin + Result := FOnKeyCompare(TKey(Key1^), TKey(Key2^)); +end; + +function TFPGMapInterfacedObjectData.DataCustomCompare(Data1, Data2: Pointer): Integer; +begin + Result := FOnDataCompare(TData(Data1^), TData(Data2^)); +end; + +procedure TFPGMapInterfacedObjectData.SetOnKeyCompare(NewCompare: TKeyCompareFunc); +begin + FOnKeyCompare := NewCompare; + if NewCompare <> nil then + OnKeyPtrCompare := @KeyCustomCompare + else + OnKeyPtrCompare := @KeyCompare; +end; + +procedure TFPGMapInterfacedObjectData.SetOnDataCompare(NewCompare: TDataCompareFunc); +begin + FOnDataCompare := NewCompare; + if NewCompare <> nil then + OnDataPtrCompare := @DataCustomCompare + else + OnDataPtrCompare := nil; +end; + +procedure TFPGMapInterfacedObjectData.InitOnPtrCompare; +begin + SetOnKeyCompare(nil); + SetOnDataCompare(nil); +end; + +procedure TFPGMapInterfacedObjectData.PutKey(Index: Integer; const NewKey: TKey); +begin + inherited PutKey(Index, @NewKey); +end; + +procedure TFPGMapInterfacedObjectData.PutData(Index: Integer; const NewData: TData); +begin + inherited PutData(Index, @NewData); +end; + +procedure TFPGMapInterfacedObjectData.PutKeyData(const AKey: TKey; const NewData: TData); +begin + inherited PutKeyData(@AKey, @NewData); +end; + +function TFPGMapInterfacedObjectData.Add(const AKey: TKey): Integer; +begin + Result := inherited Add(@AKey); +end; + +function TFPGMapInterfacedObjectData.Add(const AKey: TKey; const AData: TData): Integer; +begin + Result := inherited Add(@AKey, @AData); +end; + +function TFPGMapInterfacedObjectData.Find(const AKey: TKey; out Index: Integer): Boolean; +begin + Result := inherited Find(@AKey, Index); +end; + +function TFPGMapInterfacedObjectData.IndexOf(const AKey: TKey): Integer; +begin + Result := inherited IndexOf(@AKey); +end; + +function TFPGMapInterfacedObjectData.IndexOfData(const AData: TData): Integer; +begin + { TODO: loop ? } + Result := inherited IndexOfData(@AData); +end; + +procedure TFPGMapInterfacedObjectData.InsertKey(Index: Integer; const AKey: TKey); +begin + inherited InsertKey(Index, @AKey); +end; + +procedure TFPGMapInterfacedObjectData.InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData); +begin + inherited InsertKeyData(Index, @AKey, @AData); +end; + +function TFPGMapInterfacedObjectData.Remove(const AKey: TKey): Integer; +begin + Result := inherited Remove(@AKey); +end; + end.