Hi,

Below is a program showing that the varSingle is not handled correctly. It actually get assigned varDouble. The program below tests a whole bunch of other variant types as well.

-----------------------------------------------------
program Project1;
{$mode objfpc}{$H+}
uses
   Classes, SysUtils, Variants;
function IsVariantOfType( pVariant : Variant ; pVarType : TVarType ) :
boolean ;
var
   xVT : TVarType;
   xVTHigh : TVarType;
//  xVTLow : TVarType;
begin
//  result := ( varType( pVariant ) and pVarType ) = pVarType ;
// Contr: VarType is varDate = 0007, pVarType is varInteger=0003.
// 0007 and 0003 = 0003. WRONG!
   xVT := VarType(pVariant);
//  xVTLow:=xVT and varTypeMask;
   xVTHigh := xVT and (not varTypeMask);
   // in true pVarType can be and OR of two types: varArray and
varString (or others)
   // we have to recognize it.
   // there shouldn't be xVTLow because when we have array of string
(normal) then
   // xVT=$2008 = $2000 (var Array) or $0008 (var String)
   // then when we asked:
   //   is $2000 (varArray)? we should receive TRUE (xVTHigh=pVarType)
   //   is $2008 (varArray of varString)? we should receive TRUE
(xVT=pVarType)
   //   is $0008 (varString)? we should receive FALSE
   Result := (xVT=pVarType) or ((xVTHigh=pVarType) and (xVTHighvarEmpty));
end ;
procedure TestIsVariantOfType ;
   procedure _tiIsVariantOfType(xVar : variant; xExpected : TVarType;
xMsg : string);
     procedure __tiIsVariantOfType(xxCheck : TVarType; xxMsg : string);
     begin
       if xxCheck=xExpected then
       begin
         If not IsVariantOfType( xVar, xxCheck ) then
           Writeln(xMsg);
       end
       else
       begin
         If IsVariantOfType( xVar, xxCheck ) then
           Writeln(xMsg + ' - ' + xxMsg);
       end;
     end;
   begin
     __tiIsVariantOfType(varEmpty,'varEmpty');
     __tiIsVariantOfType(varNull,'varNull');
     __tiIsVariantOfType(varSmallint,'varSmallInt');
     __tiIsVariantOfType(varInteger,'varInteger');
     __tiIsVariantOfType(varSingle,'varSingle');
     __tiIsVariantOfType(varDouble,'varDouble');
     __tiIsVariantOfType(varDate,'varDate');
     __tiIsVariantOfType(varBoolean,'varBoolean');
     __tiIsVariantOfType(varOleStr,'varOleStr');
   end;
var
   lVar : Variant ;
   lSmallInt : Smallint;
   lInteger : Integer;
   lDouble : Double;
   lDateTimeNow : TDateTime;
   lDateTimeDate : TDateTime;
   lOleString : WideString;
   lString : string;
   lBoolean : boolean;
   lCurrency : Currency;
begin
   lSmallInt := 123;
   lInteger := High(Integer);
   lDouble := 123.45678901234567890;
   lDateTimeNow := Now;
   lDateTimeDate := Date;
   lOleString := 'OLE STRING TEST';
   lString := 'STRING TEST';
   lBoolean := true;
   lCurrency := 12345678.9876;
   lVar := Unassigned;
   _tiIsVariantOfType(lVar,varEmpty,'Failed with varEmpty');
   lVar := Null ;
   _tiIsVariantOfType(lVar,varNull,'Failed with varNull');
   // There is no other way to receive variant of type small int...
   lVar:=VarAsType(lSmallInt,varSmallint);
   _tiIsVariantOfType(lVar,varSmallInt,'Failed with VarSmallint');
   lVar:=lInteger;
   _tiIsVariantOfType(lVar,varInteger,'Failed with Integer');
// Can't make this one work
   lVar:=VarAsType(123.456,varSingle);
   _tiIsVariantOfType(lVar,varSingle,'Failed with VarSingle');
   lVar:=lDouble;
   _tiIsVariantOfType(lVar,varDouble,'Failed with VarDouble');
   lVar:=lDateTimeDate;
   _tiIsVariantOfType(lVar,varDate,'Failed with varDate - DATE');
   lVar:=lDateTimeNow;
   _tiIsVariantOfType(lVar,varDate,'Failed with varDate - NOW');
   lVar:=lBoolean;
   _tiIsVariantOfType(lVar,varBoolean,'Failed with varBoolean');
   lVar:=lOleString;
   _tiIsVariantOfType(lVar,varOLEStr,'Failed with varOLEStr');
   lVar := lString;
   _tiIsVariantOfType(lVar, varString, 'Failed with varString');
   lVar:=lCurrency;
   _tiIsVariantOfType(lVar,varCurrency,'Failed with varCurrency');
// These ones have not been tested
// varCurrency	Currency floating-point value (type Currency).
// varDispatch	Reference to an Automation object (an IDispatch interface
pointer).
// varError	Operating system error code.
// varUnknown	Reference to an unknown COM object (an IUnknown interface
pointer).
// varByte	8-bit unsigned integer (type Byte).
// varTypeMask	Bit mask for extracting type code.
// varArray	Bit indicating variant array.
// varByRef	Bit indicating variant contains a reference (rather than a
value).
end;
begin
   TestIsVariantOfType;
end.

-----------------------------------------------------

Regards,
- Graeme -