diff --git a/rtl/objpas/fgl.pp b/rtl/objpas/fgl.pp index 72d1410dca..cb935670af 100644 --- a/rtl/objpas/fgl.pp +++ b/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 = 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);