//function VarTypeAsText() in unit System.Variants
//Upgraded by Nguyen Duy Tuan for VBA and Delphi
function VarTypeAsText(const AType: TVarType; const VBAType: Boolean = True): string;
const
CText: array [Boolean, varEmpty..varUInt64] of string =
(('Empty', 'Null', 'Smallint', //Do not localize
'Integer', 'Single', 'Double', 'Currency', 'Date', 'OleStr', 'Dispatch', //Do not localize
'Error', 'Boolean', 'Variant', 'Unknown', 'Decimal', '$0F', 'ShortInt', //Do not localize
'Byte', 'Word', 'Cardinal', 'Int64', 'UInt64'), //Do not localize
('Empty', 'Null', 'Smallint', //Do not localize
'Integer', 'Single', 'Double', 'Currency', 'Date', 'String', 'Object', //Do not localize
'Error', 'Boolean', 'Variant', 'Unknown', 'Decimal', '$0F', 'ShortInt', //Do not localize
'Byte', 'Word', 'Long', 'LongPtr', 'LongPtr')); //Do not localize
var
LHandler: TCustomVariantType;
begin
if (AType<=varUInt64) or ((AType and varTypeMask) <= varUInt64) then
Result := CText[VBAType, AType and varTypeMask]
else if AType = varString then
Result := 'String' //Do not localize
else if AType = varUString then
Result := 'UnicodeString' //Do not localize
else if AType = varAny then
Result := 'Any' //Do not localize
else if FindCustomVariantType(AType, LHandler) then
Result := Copy(LHandler.ClassName, 2, High(Integer))
else
Result := HexDisplayPrefix + IntToHex(AType and varTypeMask, 4);
if AType and varArray <> 0 then
if VBAType then
Result := Result + '()' //VBA Style
else
Result := 'Array ' + Result; //Do not localize
if not VBAType and (AType and varByRef <> 0) then
Result := 'ByRef ' + Result; //Do not localize
end;
//Function MyTypeName() return type of name as the same TypeName() in VBA
//Created by Nguyen Duy Tuan for
function MyTypeName(const v: PVariantArg; const VBAType: Wordbool = True): PWideChar; stdcall;
var
s: PWideChar;
TypeInfo: ITypeInfo;
Disp, Another: IDispatch;
ProviderClassInfor: IProvideClassInfo;
hr: HRESULT;
tmp: AnsiString;
begin
hr := -1;
if v^.vt and varTypeMask = VT_DISPATCH then
begin
if v^.vt and varByRef <>0 then
Disp := IDispatch(v^.dispVal^)
else
Disp := IDispatch(v^.dispVal);
if Disp = nil then
s := 'Nothing' //from "rờ e" by TQN
else
if Disp.QueryInterface(IProvideClassInfo, ProviderClassInfor)<0 then
begin
if Disp.QueryInterface(IDispatch, Another)<0 then
s := 'Object'
else
begin
hr := Another.GetTypeInfo(0, 1033, TypeInfo);
ProviderClassInfor := IProvideClassInfo(Another);
end;
end
else
hr := ProviderClassInfor.GetClassInfo(TypeInfo);
if hr = S_OK then
begin
TypeInfo.GetDocumentation(MEMBERID_NIL, @s, nil, nil, nil);
TypeInfo._Release;
tmp := AnsiString(s);
SysFreeString(s);
end;
if ProviderClassInfor <> nil then
//ProviderClassInfor._Release; //crash Excel
end
else
s := PWideChar(VarTypeAsText(v^.vt, Boolean(VBAType)));
if Length(tmp)=0 then tmp := AnsiString(s);
Result := SysAllocString(PWideChar(tmp+#0));
end;
