当我使用TObjectDictionary时,TKey是对象,我的应用程序工作不正确.
我有两个单元,它包含两个类.第一单元：
我有两个单元,它包含两个类.第一单元：
unit RubTerm;
interface
type
TRubTerm = Class(TObject)
private
FRubricName: String;
FTermName: String;
public
property RubricName: String read FRubricName;
property TermName: String read FTermName;
constructor Create(ARubricName,ATermName: String);
end;
implementation
constructor TRubTerm.Create(ARubricName,ATermName: String);
begin
Self.FRubricName := ARubricName;
Self.FTermName := ATermName;
end;
end;
第二单元：
unit ClassificationMatrix;
interface
uses
System.Generics.Collections,System.Generics.Defaults,System.SysUtils,RubTerm;
type
TClassificationMatrix = class(TObject)
private
FTable: TObjectDictionary<TRubTerm,Integer>;
public
constructor Create;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName,ATermName: String);
function TClassificationMatrix.GetCount(ARubName,ATermName: String): Integer;
end;
implementation
constructor TClassificationMatrix.Create;
begin
FTable := TObjectDictionary<TRubTerm,Integer>.Create;
end;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName,ATermName: String);
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName,ATermName);
FTable.Add(ARubTerm,ADocsCount);
end;
function TClassificationMatrix.GetCount(ARubName,ATermName: String): Integer;
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName,ATermName);
FTable.TryGetValue(ARubTerm,Result);
end;
end;
但是这段代码工作不正常：
procedure TestTClassificationMatrix.TestGetCount;
var
DocsCountTest: Integer;
begin
FClassificationMatrix.AddCount(10,'R','T');
DocsCountTest := FClassificationMatrix.GetCount('R','T');
end;
// DocsCountTest = 0! Why not 10? Where is problem?
谢谢！
解决方法
字典取决于键值.您正在存储对键中对象的引用.如果您创建两个设置相同的对象,则具有不同的值,因此具有不同的键.
var
ARubTerm1: TRubTerm;
ARubTerm2: TRubTerm;
begin
ARubTerm1 := TRubTerm.Create('1','1');
ARubTerm2 := TRubTerm.Create('1','1');
// ARubTerm1 = ARubTerm2 is not possible here as ARubTerm1 points to a different address than ARubTerm2
end;
相反,您可以使用String作为TObjectDictonary中的第一个类型参数,该参数基于RubricName和TermName.有了这个,你就可以得到相同的价值.
还应该注意,XE2中的上述代码会产生两个内存泄漏.必须释放创建的每个对象.因此这部分代码也是泄漏内存
function TClassificationMatrix.GetCount(ARubName,Result); end;
鉴于所有这些.如果要将Object用作Key,可以使用Custom Equality Comparer执行此操作.以下是您的示例已更改为实现IEqualityComparer< T>,并修复了一些内存泄漏.
unit ClassificationMatrix;
interface
uses
Generics.Collections,Generics.Defaults,SysUtils,Integer>;
public
constructor Create;
procedure AddCount(ADocsCount: Integer; ARubName,ATermName: String);
function GetCount(ARubName,ATermName: String): Integer;
end;
implementation
constructor TClassificationMatrix.Create;
var
Comparer : IEqualityComparer<RubTerm.TRubTerm>;
begin
Comparer := TRubTermComparer.Create;
FTable := TObjectDictionary<TRubTerm,Integer>.Create([doOwnsKeys],TRubTermComparer.Create);
end;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName,ATermName);
try
if Not FTable.TryGetValue(ARubTerm,Result) then
result := 0;
finally
ARubTerm.Free;
end;
end;
end.
还有RubTerm.pas单元
unit RubTerm;
interface
uses Generics.Defaults;
type
TRubTerm = Class(TObject)
private
FRubricName: String;
FTermName: String;
public
property RubricName: String read FRubricName;
property TermName: String read FTermName;
constructor Create(ARubricName,ATermName: String);
function GetHashCode: Integer; override;
end;
TRubTermComparer = class(TInterfacedObject,IEqualityComparer<TRubTerm>)
public
function Equals(const Left,Right: TRubTerm): Boolean;
function GetHashCode(const Value: TRubTerm): Integer;
end;
implementation
constructor TRubTerm.Create(ARubricName,ATermName: String);
begin
Self.FRubricName := ARubricName;
Self.FTermName := ATermName;
end;
{ TRubTermComparer }
function TRubTermComparer.Equals(const Left,Right: TRubTerm): Boolean;
begin
result := (Left.RubricName = Right.RubricName) and (Left.TermName = Right.TermName);
end;
function TRubTermComparer.GetHashCode(const Value: TRubTerm): Integer;
begin
result := Value.GetHashCode;
end;
//The Hashing code was taken from David's Answer to make this a complete answer.
{$IFOPT Q+}
{$DEFINE OverflowChecksEnabled}
{$Q-}
{$ENDIF}
function CombinedHash(const Values: array of Integer): Integer;
var
Value: Integer;
begin
Result := 17;
for Value in Values do begin
Result := Result*37 + Value;
end;
end;
{$IFDEF OverflowChecksEnabled}
{$Q+}
{$ENDIF}
function GetHashCodeString(const Value: string): Integer;
begin
Result := BobJenkinsHash(PChar(Value)^,SizeOf(Char) * Length(Value),0);
end;
function TRubTerm.GetHashCode: Integer;
begin
Result := CombinedHash([GetHashCodeString(Value.RubricName),GetHashCodeString(Value.TermName)]);
end;
end.