* 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

@@ -294,6 +294,51 @@ type
     property OnDataCompare: TDataCompareFunc read FOnDataCompare write SetOnDataCompare;
   end;
 
+  generic TFPGMapInterfacedObjectData<TKey, TData> = 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.