In this post I will detail on how to create a custom Variant for your data type. First of all, the help should be pretty useful in this case, but it if doesn’t help much, there is always the FmtBcd unit which creates a Variant for it’s BCD data type.
There are a few steps to be followed in order to create a custom Variant, and here they are:
- Create a public data type with all the functionality. This is the data type which you will wrap into a custom Variant. It is also a good practice to make that data type and all supporting functions public to consumers. In many cases people will not need a Variant wrapping your data type but rather the data type directly. This improves speed and readability of the code in many cases.
- A Variant is simply a record holding some data which is used by the RTL at run-time to decide which functions to invoke and in what case. So the next step would be to declare such a record. The basic structure of that record is the same except a single 4-byte field in which you will hold a reference to your data type (or a value if it fits directly).
- Step 3 involves creating a descendant class from TCustomVariantType which will act as a proxy between the variant manager (handled by the RTL) and your custom Variant.
- The last step is to “plug-in” your proxy class at unit initialization time; and unplug it at finalization.
In my case, I will make a custom Variant for BigCardinal data type declared HelperLib. First off, all the code I will add will reside in the same unit in which BigCardinal is implemented. I need that to avoid having more units in “uses” clause and secondly I need access to internals of BigCardinal. As the first step is already completed (I already have the data type created), I will start with the second one: Declaring a custom TVarData to hold my data:
type
PBigCardinal = ^BigCardinal;
{ Mapping the BigCardinal into TVarData structure }
TBigCardinalVarData = packed record
{ Var type, will be assigned at runtime }
VType: TVarType;
{ Reserved stuff }
Reserved1, Reserved2, Reserved3: Word;
{ A reference to the enclosed big cardinal }
BigCardinalPtr: PBigCardinal;
{ Reserved stuff }
Reserved4: LongWord;
end;
In this structure, VType will hold an Id (which we will obtain at runtime) that will uniquely identify our variant data type. This Id will be used by the variant manager to call our proxy class for each operation we will make on the Variant. Reserved1, Reserved2, Reserved3 and Reserved4 should be ignored and not used. And finally BigCardinalPtr is a pointer to a BigCardinal structure.
The next step is to create our proxy class that will receive all requests to “work” on the Variants of our type. Here is the declaration:
{ Manager for our variant type }
TBigCardinalVariantType = class(TCustomVariantType)
private
{ Will create a big cardinal, or raise an error }
function VarDataToBigCardinal(const
Value: TVarData): BigCardinal;
{ Will create a variant from a BigCardinal }
procedure BigCardinalToVarData(const Value: BigCardinal;
var OutValue: TVarData);
public
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean); override;
procedure Cast(var Dest: TVarData;
const Source: TVarData); override;
procedure CastTo(var Dest: TVarData;
const Source: TVarData;
const AVarType: TVarType); override;
procedure BinaryOp(var Left: TVarData;
const Right: TVarData;
const Operator: TVarOp); override;
procedure UnaryOp(var Right: TVarData;
const Operator: TVarOp); override;
procedure Compare(const Left, Right: TVarData;
var Relationship: TVarCompareResult); override;
end;
Note that I have only overridden the methods in which I am interested in. If your data type doesn’t support comparison operations, simply do not override the Compare method. The two private methods declared in this class are used internally to easy the coding.
Well, we have created the proxy class, overridden the required methods, now let’s implement them:
function TBigCardinalVariantType.VarDataToBigCardinal
(const Value: TVarData): BigCardinal;
begin
{ Check if the var data has a big cardinal inside }
if Value.VType = VarType then
begin
{ Copy the value to result }
Exit(TBigCardinalVarData(Value).BigCardinalPtr^);
end;
{ OK, try to convert the incoming var type to
something useful }
case Value.VType of
varByte:
Result := Value.VByte;
varShortInt:
Result := Value.VShortInt;
varWord:
Result := Value.VWord;
varSmallint:
Result := Value.VSmallInt;
varInteger:
Result := Value.VInteger;
varLongWord:
Result := Value.VLongWord;
varUInt64:
Result := Value.VUInt64;
varInt64:
Result := Value.VInt64;
varString, varUString, varOleStr:
begin
{ Be careful here, a string may not be a good number }
try
Result := StrToBigCardinal(VarDataToStr(Value));
except
on EConvertError do
RaiseCastError;
end;
end;
end;
end;
Note the fact that we check if the type (Id) of the Value is the same as the one assigned to us by the variant managed. In this case, we are sure that the Value contains a BigCardinal inside, in which case we simply return that value; otherwise we convert the incoming Variant to a BigCardinal.
procedure TBigCardinalVariantType.BigCardinalToVarData
(const Value: BigCardinal; var OutValue: TVarData);
begin
{ Dispose of the old value. Check it it's ours first }
if OutValue.VType = VarType then
Clear(OutValue)
else
VarDataClear(OutValue);
with TBigCardinalVarData(OutValue) do
begin
{ Assign the new variant the var type that was
allocated for us }
VType := VarType;
{ Allocate space for our big cardinal pointer }
New(BigCardinalPtr);
{ Copy self to this memory }
BigCardinalPtr^ := Value;
end;
end;
This function simply clears out the OutValue and then create an instance of our BigCardinal type into it. Again, note that if OutValue contains a BigCardinal inside we must clear it properly (to not leak references of BigCardinal).
procedure TBigCardinalVariantType.BinaryOp(var Left: TVarData;
const Right: TVarData; const Operator: TVarOp);
begin
{ Select the appropriate operation }
case Operator of
opAdd:
BigCardinalToVarData(VarDataToBigCardinal(Left) +
VarDataToBigCardinal(Right), Left);
opAnd:
BigCardinalToVarData(VarDataToBigCardinal(Left) and
VarDataToBigCardinal(Right), Left);
opIntDivide:
BigCardinalToVarData(VarDataToBigCardinal(Left) div
VarDataToBigCardinal(Right), Left);
opModulus:
BigCardinalToVarData(VarDataToBigCardinal(Left) mod
VarDataToBigCardinal(Right), Left);
opMultiply:
BigCardinalToVarData(VarDataToBigCardinal(Left) *
VarDataToBigCardinal(Right), Left);
opOr:
BigCardinalToVarData(VarDataToBigCardinal(Left) or
VarDataToBigCardinal(Right), Left);
opShiftLeft:
BigCardinalToVarData(VarDataToBigCardinal(Left) shl
VarDataToBigCardinal(Right), Left);
opShiftRight:
BigCardinalToVarData(VarDataToBigCardinal(Left) shr
VarDataToBigCardinal(Right), Left);
opSubtract:
BigCardinalToVarData(VarDataToBigCardinal(Left) -
VarDataToBigCardinal(Right), Left);
opXor:
BigCardinalToVarData(VarDataToBigCardinal(Left) xor
VarDataToBigCardinal(Right), Left);
else
RaiseInvalidOp;
end;
end;
This one is pretty simple: for each type of operation we simply invoke the BigCardinal‘s operators. Note that we did not implement all possible operators but rather those that are supported by our BigCardinal data type.
procedure TBigCardinalVariantType.Cast(var Dest: TVarData;
const Source: TVarData);
begin
{ Cast the source to our cardinal type }
VarDataInit(Dest);
BigCardinalToVarData(VarDataToBigCardinal(Source), Dest);
end;
The Cast method is invoked every time another Variant type needs to be converted into our Variant type. What we do is simply initialize the Dest parameter and then invoke our helper method.
procedure TBigCardinalVariantType.CastTo(var Dest: TVarData;
const Source: TVarData; const AVarType: TVarType);
var
Big: BigCardinal;
Temp: TVarData;
begin
if Source.VType = VarType then
begin
{ Only continue if we're invoked for our data type }
Big := TBigCardinalVarData(Source).BigCardinalPtr^;
{ Initilize the destination }
VarDataInit(Dest);
Dest.VType := AVarType;
case AVarType of
varByte:
Dest.VByte := Big.ToByte();
varShortInt:
Dest.VShortInt := Big.ToShortInt();
varWord:
Dest.VWord := Big.ToWord();
varSmallint:
Dest.VSmallInt := Big.ToSmallInt();
varInteger:
Dest.VInteger := Big.ToInteger();
varLongWord:
Dest.VLongWord := Big.ToCardinal();
varUInt64:
Dest.VUInt64 := Big.ToUInt64();
varInt64:
Dest.VInt64 := Big.ToInt64();
varOleStr:
VarDataFromOleStr(Dest, UIntToStr(Big));
varString, varUString:
VarDataFromStr(Dest, UIntToStr(Big));
else
begin
{ No default convertion found! Trying to use the string }
try
VarDataInit(Temp);
VarDataFromStr(Temp, UIntToStr(Big));
VarDataCastTo(Dest, Temp, AVarType);
finally
{ Dispose our variant }
VarDataClear(Temp);
end;
end;
end;
end else
inherited;
end;
This method is the inverse of the Cast one. In most cases we can do a direct cast, while in some we will first try to convert to a string and then from that string convert to the required Variant type (most custom variants implement conversion from ant to strings so that might help).
procedure TBigCardinalVariantType.Clear(var V: TVarData);
begin
{ Clear the variant type }
V.VType := varEmpty;
{ And dispose the value }
Dispose(TBigCardinalVarData(V).BigCardinalPtr);
TBigCardinalVarData(V).BigCardinalPtr := nil;
end;
The Clear method is invoked every time a Variant that contains a BigCardinal is being cleared (either by compiler inserted calls or manually by calling VarClear() method). Our implementation will Dispose() the structure and then make the Variant empty. Note that FreeMem is not an option because it will not finalize the record — which is what we want because we have a reference to a dynamic array there that needs to be cleared out.
procedure TBigCardinalVariantType.Compare
(const Left, Right: TVarData;
var Relationship: TVarCompareResult);
var
Res: Integer;
begin
{ Compare these values }
Res := VarDataToBigCardinal(Left).CompareTo
(VarDataToBigCardinal(Right));
{ Return the compare result }
if Res < 0 then
Relationship := crLessThan
else if Res > 0 then
Relationship := crGreaterThan
else
Relationship := crEqual;
end;
Compare is simple and doesn’t need any explanations. We simply “convert” the variants to BigCardinal and compare them.
procedure TBigCardinalVariantType.Copy(var Dest: TVarData;
const Source: TVarData; const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else
begin
with TBigCardinalVarData(Dest) do
begin
{ Copy the variant type }
VType := VarType;
{ Initialize the pointer }
New(BigCardinalPtr);
{ Copy by value }
BigCardinalPtr^ := TBigCardinalVarData(Source).
BigCardinalPtr^;
end;
end;
end;
This method is invoked every time we assign a Variant to another Variant. See Help for more description on what Indirect and VarDataIsByRef mean in this context.
procedure TBigCardinalVariantType.UnaryOp
(var Right: TVarData; const Operator: TVarOp);
begin
{ Select the appropriate operation }
case Operator of
opNegate:
BigCardinalToVarData(VarDataToBigCardinal(Right), Right);
else
RaiseInvalidOp;
end;
end;
We implement a single operator: opNegate. Even so, negation works on BigCardinals only is overflow checking is disabled.
Now that we have implemented our proxy, let’s plug it in! First you declare a global but implementation-only variable of your proxy type (in our case: TBigCardinalVariantType). You will probably declare that variable at the top of the implementation section so that other code can use it (later on this):
var
{ Our singleton that manages tour variant types }
SgtBigCardinalVariantType: TBigCardinalVariantType;
… and then register it by using this code:
initialization
{ Register our custom variant type }
SgtBigCardinalVariantType := TBigCardinalVariantType.Create();
finalization
{ Unregister our custom variant }
FreeAndNil(SgtBigCardinalVariantType);
When SgtBigCardinalVariantType is created, it’s VarType member (which we used in our functions) is automatically assigned a unique Id by the variant manager. That Id is used in our code to uniquely distinguish our custom Variant.
OK, we’ve go to the point where everything is ready to go with one little exception — there is no public method or routine that can create a Variant type from a BigCardinal. In this case I have decided to implement an “implicit” operator for BigCardinal that will do this creation automatically:
class operator BigCardinal.Implicit
(const ANumber: BigCardinal): Variant;
begin
{ Clear out the result }
VarClear(Result);
with TBigCardinalVarData(Result) do
begin
{ Assign the new variant the var type that was
allocated for us }
VType := SgtBigCardinalVariantType.VarType;
{ Allocate space for our big cardinal pointer }
New(BigCardinalPtr);
{ Copy self to this memory }
BigCardinalPtr^ := ANumber;
end;
end;
That’s all! Now we can write code like this:
var
X: Variant;
begin
X := BigCardinal(1);
X := X + '343267727663266525438020038463';
WriteLn(X);
end;
In the next post I will create an invokable variant.
