mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* 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 -
This commit is contained in:
ivost
parent
83fc2dd1ea
commit
0637586076
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user