Can you use a record as a Key value in TDictionary? I want to find objects based on combination of string, integer and integer.
TUserParKey=record
App:string;
ID:integer;
Nr:integer;
end;
...
var
tmpKey:TUserParKey;
tmpObject:TObject;
begin
tmpObject:= TTObject.Create(1);
tmpKey.App:='1';
tmpKey.ID :=1;
tmpKey.Nr :=1;
DTUserPars.Add(tmpKey,tmpObject)
...
var
tmpKey:TUserParKey;
begin
tmpKey.App:='1';
tmpKey.ID :=1;
tmpKey.Nr :=1;
if not DTUserPars.TryGetValue(tmpKey,Result) then begin
result := TTObject.Create(2);
end;
This returns object 2.
Yes, you can use records as keys in a TDictionary but you should provide your own IEqualityComparer when creating the dictionary because the default one for records just does a dumb binary compare of the record.
This fails for a record containing a string because it just compares the pointer of that string which may be different even if the string contains the same value.
Such a comparer would look like this:
type
TUserParKeyComparer = class(TEqualityComparer<TUserParKey>)
function Equals(const Left, Right: TUserParKey): Boolean; override;
function GetHashCode(const Value: TUserParKey): Integer; override;
end;
function TUserParKeyComparer.Equals(const Left, Right: TUserParKey): Boolean;
begin
Result := (Left.App = Right.App) and (Left.ID = Right.ID) and (Left.Nr = Right.Nr);
end;
function TUserParKeyComparer.GetHashCode(const Value: TUserParKey): Integer;
begin
Result := BobJenkinsHash(PChar(Value.App)^, Length(Value.App) * SizeOf(Char), 0);
Result := BobJenkinsHash(Value.ID, SizeOf(Integer), Result);
Result := BobJenkinsHash(Value.Nr, SizeOf(Integer), Result);
end;
Instead of using the record as a key, you could use a string consisting of the serialized record. You could use something like https://github.com/hgourvest/superobject to do the serialization.
Since strings have built-in comparison semantics and hashcodes, you don't need to write comparison and hashcode functions.
My best approach should be to joint the default hash code of the base types.
For instance:
Value.App.GetHashCode + Value.ID.GetHashCode + Value.Nr.GetHashCode;
Related
Can I prevent TStringList from removing key-value-pair when value is set to empty? I use Delphi XE8 and Lazarus which work differently. I want the pair to be left in the TStringlist object even when the value is set to an empty string. For example:
procedure TMyClass.Set(const Key, Value: String);
begin
// FData is a TStringList object
FData.Values[Key] := Value; // Removes pair when value is empty. Count decreases and Key is lost.
end;
Problem that I'm having is that when I compile with Delphi the pair with empty values is removed and I don't know afterwards was a value with a key never set or was it explicitly set to be an empty string. Also I can't get all the keys that have been used. Now I need to hold another collection of keys that holds information about empty ones.
MyKeyValues.Set('foo', 'bar'); // Delphi FData.Count = 1; Lazarus FData.Count = 1
MyKeyValues.Set('foo', ''); // Delphi FData.Count = 0; Lazarus FData.Count = 1
You can write a class helper to implement a new behaviour of the SetValue method of the TStrings class.
If you don't like a solution based on a class helper, you can use a custom class which inherits from TStringList and, again, override its Values property behaviour - the code is very similar to this helper-based implementation.
I'd prefer to use the second choice because the helper will define a new behaviour for all the TStringList objects.
type
TStringsHelper = class helper for TStrings
private
function GetValue(const Name: string): string;
procedure SetValue(const Name, Value: string); reintroduce;
public
property Values[const Name: string]: string read GetValue write SetValue;
end;
function TStringsHelper.GetValue(const Name: string): string;
begin
Result := Self.GetValue(Name);
end;
procedure TStringsHelper.SetValue(const Name, Value: string);
var
I: Integer;
begin
I := IndexOfName(Name);
if I < 0 then I := Add('');
Put(I, Name + NameValueSeparator + Value);
end;
What about this?
procedure TMyClass.Set(const Key, Value: String);
var
i:integer;
begin
i := FData.IndexOfName(Key);
if i = -1 then
FData.Add(Key + '=' + Value)
else
FData[i] := Key + '=' + Value;
end;
You can choose wether to set FData.Sorted:=true; or not.
TStringList doesn't have an option for that. Its behaviour is to delete an entry, when the value is empty ('').
You could implement that behaviour on you own by, for example, adding something like a prefix to your value:
procedure TMyClass.Set(const Key, Value: String);
begin
FData.Values[Key] := '_' + Value;
end;
But that means, you also need a getter, to remove it again:
function TMyClass.Get(const Key): String;
begin
Result := StringReplace(FData.Values[Key], '_', '', []);
end;
Arrays can be indexed using user-defined enumerated types. For example:
type
TIndexValue = (ZERO = 0, ONE, TWO, THREE, FOUR);
var
MyArray: array[Low(TIndexValue) .. High(TIndexValue)] of String;
Elements from this array can then be referenced using TIndexValue values as an index:
MyArray[ZERO] := 'abc';
I am trying to obtain this same general functionality with a TStringList.
One simple solution is to cast every index value to an Integer type at the time of reference:
MyStringList[Integer(ZERO)] := 'abc';
Another solution (to hide all the casting) is to create a subclass of TStringList and defer all the casting to this subclass's subroutines that access the inherited Strings property:
type
TIndexValue = (ZERO = 0, ONE, TWO, THREE, FOUR);
type
TEIStringList = class(TStringList)
private
function GetString(ItemIndex: TIndexValue): String;
procedure SetString(ItemIndex: TIndexValue; ItemValue: String);
public
property Strings[ItemIndex: TIndexValue]: String
read GetString write SetString; default;
end;
function TEIStringList.GetString(ItemIndex: TIndexValue): String;
begin
Result := inherited Strings[Integer(ItemIndex)];
end;
procedure TEIStringList.SetString(ItemIndex: TIndexValue; ItemValue: String);
begin
inherited Strings[Integer(ItemIndex)] := ItemValue;
end;
This works fine for a single implementation that uses the enumerated type TIndexValue.
However, I would like to re-use this same logic or subclass for several different TStringList objects that are indexed by different enumerated types, without having to define TStringList subclasses for each possible enumerated type.
Is something like this possible? I suspect I may have to depend on Delphi's Generics, but I would be very interested to learn that there are simpler ways to achieve this.
I think that generics would be by far the most elegant solution. Using them would be as simple as rewriting your class above as:
TEIStringList<T> = class(TStringList)
and then replacing all TIndexValue references with T. Then you could create it just as any other generic:
var
SL: TEIStringList<TIndexValue>;
begin
SL:=TEIStringList<TIndexValue>.Create;
(...)
ShowMessage(SL[ZERO])
(...)
end;
If you insist on avoiding generics, maybe operator overloading would be of use. Something like the following should work:
type
TIndexValueHolder = record
Value : TIndexValue;
class operator Implicit(A: TMyRecord): integer;
end;
(...)
class operator TIndexValueHolder.Implicit(A: TMyRecord): integer;
begin
Result:=Integer(A);
end;
Then use with:
var
Inx : TIndexValueHolder;
begin
Inx.Value:=ZERO;
ShowMessage(SL[Inx]);
end
UPDATE:
You could adapt TIndexValueHolder for use in a for or while loop by adding Next, HasNext, etc. methods. This might end defeating the purpose, though. I'm still not sure what the purpose is, or why this would be useful, but here's some ideas for how to do it, anyways.
You probably can use a class helper and declare the default property index as Variant:
type
TEnum1 = (Zero = 0, One, Two, Three, Four);
TEnum2 = (Nul = 0, Een, Twee, Drie, Vier);
TEnum3 = (Gds = 0, Psajs, Oeroifd, Vsops, Wowid);
TStringListHelper = class helper for TStringList
private
function GetString(Index: Variant): String;
procedure SetString(Index: Variant; const Value: String);
public
property Strings[Index: Variant]: String read GetString write SetString;
default;
end;
function TStringListHelper.GetString(Index: Variant): String;
begin
Result := inherited Strings[Index];
end;
procedure TStringListHelper.SetString(Index: Variant; const Value: String);
begin
inherited Strings[Index] := Value;
end;
Testing code:
procedure TForm1.Button1Click(Sender: TObject);
var
Strings: TStringList;
begin
Strings := TStringList.Create;
try
Strings.Add('Line 1');
Strings.Add('Second line');
Strings[Zero] := 'First line';
Memo1.Lines.Assign(Strings);
Caption := Strings[Psajs];
finally
Strings.Free;
end;
end;
See edit history for a previous less successful attempt.
Summarization:
TList.IndexOf (TList defined in the unit Classes.pas) iterates linearly through the contained items, and compares the reference. TList.IndexOf (TList defined in the unit Generics.Collections.pas) also iterates linearly through the contained items, but uses a comparer to compare whether the items are equal.
Both TList.Sort and TList.Sort can use a comparer.
=================================================
For an instance of the TForceList type defined in the following unit, I could use
instance.Sort(#ForceCompare);
to QuickSort it using its Value field as sorting criteria. However, when I call
instance.IndexOf(AnotherInstance)
I want to use its ElementZ field as comparing criteria, i.e., the ForceEqual function. I am wondering how can I achieve this?
PS: If the generics collection is used, I guess I could use
TList<TForce>.Create(TComparer<TForce>.Construct(ForceEqual));
The unit:
unit uChemParserCommonForce;
interface
uses
uMathVector3D,
Contnrs;
type
TForce = class;
TForceList = class;
TForce = class
private
FElementZ: Integer;
FValue: TVector3D;
public
property ElementZ: Integer read FElementZ;
property Value: TVector3D read FValue;
constructor Create(aElementZ: Integer; aX, aY, aZ: Double);
function ToString(): string; {$IF DEFINED(FPC) OR DEFINED(VER210)} override; {$IFEND}
end;
// Mastering Delphi 6 - Chapter 5 -
TForceList = class(TObjectList)
protected
procedure SetObject(Index: Integer; Item: TForce);
function GetObject(Index: Integer): TForce;
public
function Add(Obj: TForce): Integer;
procedure Insert(Index: Integer; Obj: TForce);
property Objects[Index: Integer]: TForce read GetObject
write SetObject; default;
end;
function ForceCompare(Item1, Item2: Pointer): Integer;
function ForceEqual(Item1, Item2: Pointer): Boolean;
implementation
uses
Math, SysUtils;
function ForceCompare(Item1, Item2: Pointer): Integer;
begin
// Ascendent
// Result := CompareValue(TForce(Item1).Value.Len, TForce(Item2).Value.Len);
// Descendent
Result := CompareValue(TForce(Item2).Value.Len, TForce(Item1).Value.Len);
end;
function ForceEqual(Item1, Item2: Pointer): Boolean;
begin
Result := TForce(Item1).ElementZ = TForce(Item2).ElementZ;
end;
constructor TForce.Create(aElementZ: Integer; aX, aY, aZ: Double);
begin
FElementZ := aElementZ;
FValue := TVector3D.Create(aX, aY, aZ);
end;
function TForce.ToString: string;
begin
Result := IntToStr(FElementZ) + ' X: ' + FloatToStr(FValue.X) + ' Y: ' +
FloatToStr(FValue.Y) + ' Z: ' + FloatToStr(FValue.Z);
end;
{ TForceList }
function TForceList.Add(Obj: TForce): Integer;
begin
Result := inherited Add(Obj);
end;
procedure TForceList.SetObject(Index: Integer; Item: TForce);
begin
inherited SetItem(Index, Item);
end;
function TForceList.GetObject(Index: Integer): TForce;
begin
Result := inherited GetItem(Index) as TForce;
end;
procedure TForceList.Insert(Index: Integer; Obj: TForce);
begin
inherited Insert(Index, Obj);
end;
end.
The non-generic TObjectList uses TList.IndexOf, which simply iterates through the internal array and compares pointers.
Likewise, the generic TObjectList<T> uses TList<T>.IndexOf, which uses an IComparer. TList<T>.Sort uses TArray.Sort<T> passing in whatever IComparer was assigned at the list's creation.
The comparer is private and only assigned in the list constructor so I don't see an easy way to override this behavior.
Update
TList<T> provides and overloaded Sort that accepts a comparer as an argument, without modifying the private comparer. So you can sort using one comparer and indexof can use a different one.
The entire idea behind the Sort method is it really sorts the list... in other words, after calling the sort method, the physical order of the elements on the list is changed to meet the sort criteria.
The IndexOf method, as you can see in your own Delphi RTL code, is just a linear search by reference returning the physical index of the first matching element.
The index returned can be used to retrieve the object on the list, like this:
SomeIndex := AList.IndexOf(SomeObject);
//more code...
//you can re-use the reference...
//and maybe more...
SomeObject := AList[SomeIndex];
You'll see why, the IndexOf method shall not return a index based on a different criteria than the physical order of the list... and it happens if you call Sort first, the physical order is reflecting the passed sort criteria.
That said, it looks like you may want to
maintain two different lists, sorted with different criteria and use one or another when appropriate.
re-sort the list based on the applicable criteria for the operation your application is processing at a given time.
What is more performant depends on how your application use those objects, the amount of data it is processing and even the memory available to your process at runtime.
Not with the standard TObjectList. It (actually the base TList) is written to support a custom sort function using CustomSort, but there's no such provision for a custom IndexOf. Of course, you could write your own implementation of something that works that way.
Is there a standard way to convert between TVarRec and Variant values?
I want to parse an 'array of const' and use the values to populate parameters in a TMSQuery. To do this I'm using a list of column names (generated from TMSQuery.KeyFields), and matching the values in the array with the column names in KeyFields (by position), then using the column name to set the corresponding parameter using ParamByName.
The code below is what I've come up with, but VarRecToVariant doesn't seem very elegant. Is there a better solution?
keyFields: TStringList;
// List of table column names (keyFields.DelimitedText := query.KeyFields;)
// e.g. Name, Age
query: TMSQuery;
// Parametrized query with a parameter for each field in keyFields
// SELECT * FROM People WHERE Age=:Age AND Name=:Name
// If keyValues is ['Bob', 42] the resulting query should be
// SELECT * FROM People WHERE Age=42 AND Name='Bob'
procedure Read(keyValues: array of const);
var
i: Integer;
name: string;
value: Variant;
begin
...
for i := 0 to keyFields.Count - 1 do
begin
name := keyFields[i];
value := VarRecToVariant(keyValues[i]);
query.ParamByName(name).Value := value;
end;
query.Open
...
end;
function VarRecToVariant(varRec: TVarRec): Variant;
begin
case varRec.VType of
vtInteger: result := varRec.VInteger;
vtBoolean: result := varRec.VBoolean;
vtChar: result := varRec.VChar;
vtExtended: result := varRec.VExtended^;
vtString: result := varRec.VString^;
...
end;
end;
Notes:
The values in the array of const depend on the parameters in the query. The caller knows what these are, but the method that uses the array doesn't know how many or what type to expect. I.e. I can't change the method to Read(name: string; age: integer).
The parameters are not necessarily used in the same order that the values are specified in the array of const. In the example, keyFields are specified as "Name,Age" but the query uses Age before Name. This means Params[i].Value := keyValues[i] won't work. I think VarRecToVariant would still be needed anyway, which I'm trying to avoid).
Replace
procedure Read(keyValues: array of const);
with
procedure Read(keyValues: array of Variant);
Then you will not need to convert TVarRec to Variant.
First, apologies for my English, I hope it makes sense what I`ve written here. Now to my problem.
How can I get the string representation of the content type of a Variant using TypInfo.GetEnumName(). I have tried the following, without luck, I get a numeric representation.
myString := GetEnumName( TypeInfo(TVarType), TVarData(myVar).VType );
Thank you.
Just use the build-in Delphi function for getting the string representation of a Variant type.
var
MyVariantType: string;
MyVariant: Variant;
begin
MyVariant := 'Hello World';
MyVariantType := VarTypeAsText(VarType(MyVariant));
ShowMessage(MyVariantType); //displays: String
MyVariant := 2;
MyVariantType := VarTypeAsText(VarType(MyVariant));
ShowMessage(MyVariantType); //displays: Byte
end;
Quoting from the Delphi 2007 help:
Use GetEnumName to convert a Delphi enumerated value into the symbolic name that represents it in code.
That means that you can't use it for that purpose, as TVarData.VType is not an enumerated value, but an integer which is set to one of the constants in System.pas that are taken from the Windows SDK wtypes.h file. Look at the source of GetEnumName(), it does immediately return a string containing the value of the integer.
Edit:
is there any other way to get the string representation of TVarData.VType
You can determine the string representation manually. First you need to be aware of that there are several bits of information encoded in that integer, so a simple case statement or array lookup will not work. The lower 12 bits are the type mask, and the upper bits encode information about whether it is a vector or array type and whether it is given by reference or not. The important parts are:
const
varTypeMask = $0FFF;
varArray = $2000;
varByRef = $4000;
So you could do something like:
function VariantTypeName(const AValue: TVarData): string;
begin
case AValue.VType and varTypeMask of
vtInteger: Result := 'integer';
// ...
end;
if AValue.VType and varArray <> 0 then
Result := 'array of ' + Result;
if AValue.VType and varByRef <> 0 then
Result := Result + ' by ref';
end;
Since it's not an enum, you'll have to do it manually. Write something like this:
function VariantTypeName(const value: TVarData): string;
begin
case value.VType of
vtInteger: result := 'integer';
//and so on
end;
Or, since the values in System.pas are listed in order, you could try declaring a const array of strings and have your VariantTypeName function return the appropriate member of the array.
Here's a thought for Delphi versions that don't support VarTypeAsText: You could define a enumerate type yourself that follows the VType values:
type
{$TYPEINFO ON}
TMyVarType = (
varEmpty = System.varEmpty,
varNull = System.varNull,
// etc...
);
(Fill the unused enum slots too - see Why do I get "type has no typeinfo" error with an enum type for the reasoning behind this).
Next, use these functions to read the Variants' type as your own enumerate type :
function MyVarType(VType: TVarType): TMyVarType; overload;
begin
Result := TMyVarType(VType);
end;
function MyVarType(V: Variant): TMyVarType; overload;
begin
Result := TMyVarType(TVarData(V).VType);
end;
And then you can convert it to a string like this :
function VarTypeToString(aValue: TMyVarType): string;
begin
Result := GetEnumName(TypeInfo(TMyVarType), Ord(aValue));
end;