* extended TFPGMap so that it's possible to add a custom compare function for data. Default compare function is binary compare.

git-svn-id: trunk@14888 -

rtl/objpas/fgl.pp

@@ -197,16 +197,20 @@ type
     FDataSize: Integer;
     FDuplicates: TDuplicates;
     FSorted: Boolean;
-    FOnPtrCompare: TFPSListCompareFunc;
+    FOnKeyPtrCompare: TFPSListCompareFunc;
+    FOnDataPtrCompare: TFPSListCompareFunc;
     procedure SetSorted(Value: Boolean);
   protected
-    function BinaryCompare(Key1, Key2: Pointer): Integer;
+    function BinaryCompareKey(Key1, Key2: Pointer): Integer;
+    function BinaryCompareData(Data1, Data2: Pointer): Integer;
+    procedure SetOnKeyPtrCompare(Proc: TFPSListCompareFunc);
+    procedure SetOnDataPtrCompare(Proc: TFPSListCompareFunc);
+    procedure InitOnPtrCompare; virtual;
     procedure CopyKey(Src, Dest: Pointer); virtual;
     procedure CopyData(Src, Dest: Pointer); virtual;
     function GetKey(Index: Integer): Pointer;
     function GetKeyData(AKey: Pointer): Pointer;
     function GetData(Index: Integer): Pointer;
-    procedure InitOnPtrCompare; virtual;
     function LinearIndexOf(AKey: Pointer): Integer;
     procedure PutKey(Index: Integer; AKey: Pointer);
     procedure PutKeyData(AKey: Pointer; NewData: Pointer);
@@ -232,18 +236,22 @@ type
     property Data[Index: Integer]: Pointer read GetData write PutData;
     property KeyData[Key: Pointer]: Pointer read GetKeyData write PutKeyData; default;
     property Sorted: Boolean read FSorted write SetSorted;
-    property OnPtrCompare: TFPSListCompareFunc read FOnPtrCompare write FOnPtrCompare;
+    //property OnPtrCompare: TFPSListCompareFunc read FOnKeyCompareFunc write FOnKeyCompareFunc; deprecated;
+    property OnKeyPtrCompare: TFPSListCompareFunc read FOnKeyPtrCompare write SetOnKeyPtrCompare;
+    property OnDataPtrCompare: TFPSListCompareFunc read FOnDataPtrCompare write SetOnDataPtrCompare;
   end;
 
 {$ifndef VER2_0}
 
   generic TFPGMap<TKey, TData> = class(TFPSMap)
   type public
-    TCompareFunc = function(const Key1, Key2: TKey): Integer;
+    TKeyCompareFunc = function(const Key1, Key2: TKey): Integer;
+    TDataCompareFunc = function(const Data1, Data2: TData): Integer;
     PKey = ^TKey;
     PData = ^TData;
   var protected
-    FOnCompare: TCompareFunc;
+    FOnKeyCompare: TKeyCompareFunc;
+    FOnDataCompare: TDataCompareFunc;
     procedure CopyItem(Src, Dest: Pointer); override;
     procedure CopyKey(Src, Dest: Pointer); override;
     procedure CopyData(Src, Dest: Pointer); override;
@@ -254,10 +262,13 @@ type
     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 SetOnCompare(NewCompare: TCompareFunc);
+    procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc);
+    procedure SetOnDataCompare(NewCompare: TDataCompareFunc);
   public
     constructor Create;
     function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
@@ -271,7 +282,9 @@ type
     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: TCompareFunc read FOnCompare write SetOnCompare;
+    //property OnCompare: TCompareFunc read FOnKeyCompare write SetOnKeyCompare;
+    property OnKeyCompare: TKeyCompareFunc read FOnKeyCompare write SetOnKeyCompare;
+    property OnDataCompare: TDataCompareFunc read FOnDataCompare write SetOnDataCompare;
   end;
 
 {$endif}
@@ -967,11 +980,6 @@ begin
   System.Move(Src^, Dest^, FDataSize);
 end;
 
-function TFPSMap.BinaryCompare(Key1, Key2: Pointer): Integer;
-begin
-  Result := CompareByte(Key1^, Key2^, FKeySize);
-end;
-
 function TFPSMap.GetKey(Index: Integer): Pointer;
 begin
   Result := Items[Index];
@@ -993,9 +1001,36 @@ begin
     Error(SMapKeyError, PtrUInt(AKey));
 end;
 
+function TFPSMap.BinaryCompareKey(Key1, Key2: Pointer): Integer;
+begin
+  Result := CompareByte(Key1^, Key2^, FKeySize);
+end;
+
+function TFPSMap.BinaryCompareData(Data1, Data2: Pointer): Integer;
+begin
+  Result := CompareByte(Data1^, Data1^, FDataSize);
+end;
+
+procedure TFPSMap.SetOnKeyPtrCompare(Proc: TFPSListCompareFunc);
+begin
+  if Proc <> nil then
+    FOnKeyPtrCompare := Proc
+  else
+    FOnKeyPtrCompare := @BinaryCompareKey;
+end;
+
+procedure TFPSMap.SetOnDataPtrCompare(Proc: TFPSListCompareFunc);
+begin
+  if Proc <> nil then
+    FOnDataPtrCompare := Proc
+  else
+    FOnDataPtrCompare := @BinaryCompareData;
+end;
+
 procedure TFPSMap.InitOnPtrCompare;
 begin
-  FOnPtrCompare := @BinaryCompare;
+  SetOnKeyPtrCompare(nil);
+  SetOnDataPtrCompare(nil);
 end;
 
 procedure TFPSMap.PutKey(Index: Integer; AKey: Pointer);
@@ -1061,7 +1096,7 @@ begin
   while L<=R do
   begin
     I := (L+R) div 2;
-    Dir := FOnPtrCompare(Items[I], AKey);
+    Dir := FOnKeyPtrCompare(Items[I], AKey);
     if Dir < 0 then
       L := I+1
     else begin
@@ -1083,7 +1118,7 @@ var
 begin
   Result := 0;
   ListItem := First;
-  while (Result < FCount) and (FOnPtrCompare(ListItem, AKey) <> 0) do
+  while (Result < FCount) and (FOnKeyPtrCompare(ListItem, AKey) <> 0) do
   begin
     Inc(Result);
     ListItem := PByte(ListItem)+FItemSize;
@@ -1107,7 +1142,7 @@ var
 begin
   Result := 0;
   ListItem := First+FKeySize;
-  while (Result < FCount) and (CompareByte(ListItem^, AData^, FDataSize) <> 0) do
+  while (Result < FCount) and (FOnDataPtrCompare(ListItem, AData) <> 0) do
   begin
     Inc(Result);
     ListItem := PByte(ListItem)+FItemSize;
@@ -1151,7 +1186,7 @@ end;
 
 procedure TFPSMap.Sort;
 begin
-  inherited Sort(FOnPtrCompare);
+  inherited Sort(FOnKeyPtrCompare);
 end;
 
 {****************************************************************************
@@ -1202,11 +1237,6 @@ begin
   Result := TData(inherited GetKeyData(@AKey)^);
 end;
 
-procedure TFPGMap.InitOnPtrCompare;
-begin
-  OnPtrCompare := @KeyCompare;
-end;
-
 function TFPGMap.KeyCompare(Key1, Key2: Pointer): Integer;
 begin
   if PKey(Key1)^ < PKey(Key2)^ then
@@ -1217,9 +1247,48 @@ begin
     Result := 0;
 end;
 
+{function TFPGMap.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 TFPGMap.KeyCustomCompare(Key1, Key2: Pointer): Integer;
 begin
-  Result := FOnCompare(TKey(Key1^), TKey(Key2^));
+  Result := FOnKeyCompare(TKey(Key1^), TKey(Key2^));
+end;
+
+function TFPGMap.DataCustomCompare(Data1, Data2: Pointer): Integer;
+begin
+  Result := FOnDataCompare(TData(Data1^), TData(Data2^));
+end;
+
+procedure TFPGMap.SetOnKeyCompare(NewCompare: TKeyCompareFunc);
+begin
+  FOnKeyCompare := NewCompare;
+  if NewCompare <> nil then
+    OnKeyPtrCompare := @KeyCustomCompare
+  else
+    OnKeyPtrCompare := @KeyCompare;
+end;
+
+procedure TFPGMap.SetOnDataCompare(NewCompare: TDataCompareFunc);
+begin
+  FOnDataCompare := NewCompare;
+  if NewCompare <> nil then
+    OnDataPtrCompare := @DataCustomCompare
+  else
+    OnDataPtrCompare := nil;
+end;
+
+procedure TFPGMap.InitOnPtrCompare;
+begin
+  SetOnKeyCompare(nil);
+  SetOnDataCompare(nil);
 end;
 
 procedure TFPGMap.PutKey(Index: Integer; const NewKey: TKey);
@@ -1237,15 +1306,6 @@ begin
   inherited PutKeyData(@AKey, @NewData);
 end;
 
-procedure TFPGMap.SetOnCompare(NewCompare: TCompareFunc);
-begin
-  FOnCompare := NewCompare;
-  if NewCompare <> nil then
-    OnPtrCompare := @KeyCustomCompare
-  else
-    InitOnPtrCompare;
-end;
-
 function TFPGMap.Add(const AKey: TKey): Integer;
 begin
   Result := inherited Add(@AKey);