Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
 TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
Столкнулся с вариантом у которого Vtype = 14. Делфи этот тип не поддерживает
//varDecimal  = $000E; { vt_decimal     14 } {UNSUPPORTED as of v6.x code base}

Захотелось к нему написать наследника TCustomVariantType, где описать все манипуляции с ним. Нарвался на такие строчки
CMinVarType = $0100;

constructor TCustomVariantType.Create(RequestedVarType: TVarType);
var
  LSlot, LWas, LNewLength, I: Integer;
begin
  inherited Create;
  MonitorEnter(LVarTypeSync);
  try
    LSlot := RequestedVarType - CMinVarType;
    if (LSlot < 0) or (RequestedVarType < CFirstUserType) then
      raise EVariantError.CreateFmt(SVarTypeOutOfRangeWithPrefix, [HexDisplayPrefix, RequestedVarType]);
Для varDecimal LSlot будет меньше нуля и возникнет исключение.

Правильно ли я понимаю, что для varDecimal сделать TCustomVariantType невозможно? Или есть обходные пути?

Сейчас, в момент получения такого варианта вызывается VariantChangeType с кастом в минимально доступный тип

С уважением, Vasilisk
5 янв 18, 18:21    [21083584]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
_Vasilisk_,

Там не только дело в конструкторе, там CMinVarType везде фигурирует, и для varDecimal ты TCustomVariantType не переопределишь
Но зачем?
varDecimal обрабатывается как системный

procedure TForm1.FormCreate(Sender: TObject);
var
  V: Variant;
  X: Double;
begin
  TVarData(V).VType := $000E;
  TVarData(V).Reserved1 := 1;
  TVarData(V).VInt64 := 1234;
  X := V;
  Caption := FloatToStr(X);
end;
5 янв 18, 23:38    [21084041]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
Кстати целочисленная часть не Int64, а UInt64
А знак определяется старшим битом Reserved1
5 янв 18, 23:43    [21084047]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
SOFT FOR YOU
varDecimal обрабатывается как системный
Если бы обрабатывался, я бы и тему такую не поднимал
SOFT FOR YOU
Кстати целочисленная часть не Int64, а UInt64
Кстати, целочисленная часть это UInt96 (12 байт)
SOFT FOR YOU
А знак определяется старшим битом Reserved1
А еще есть точность. Вообще, для корректного доступа к полям, нужно TVarData напрямую приводить к TDecimal
6 янв 18, 00:25    [21084110]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
SOFT FOR YOU
Кстати целочисленная часть не Int64, а UInt64
А знак определяется старшим битом Reserved1


Код, который я привёл выше, у тебя не работает?
У меня работает. Windows 7, Delphi XE 8.
И точность в примере тоже указана - 1 разряд.
6 янв 18, 10:10    [21084311]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
_Vasilisk_
Кстати, целочисленная часть это UInt96 (12 байт)


Да, ты прав, ещё нужно Reserved2 и Reserved3 заполнять
Или RawData[1], или VLongs[0]
6 янв 18, 10:19    [21084317]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
SOFT FOR YOU
Код, который я привёл выше, у тебя не работает?
Так. Задумался. На Tokyo все работает. На XE3, но немного не такой пример.

Ага, понял, что меня смутило. Каст работает. Не работает сравнение
procedure TForm1.Button1Click(Sender: TObject);
var
  LIn, LOut: OleVariant;
begin
  LIn := VarAsType(10, varInteger);
  OleCheck(VariantChangeType(LOut, LIn, 0, VT_DECIMAL));
  if LIn = LOut then
    ShowMessage('Equal')
  else
    ShowMessage('not Equal');
end;
Project Project1.exe raised exception class EVariantInvalidOpError with message 'Invalid variant operation'.
А вот так
procedure TForm1.Button1Click(Sender: TObject);
var
  LIn, LOut: OleVariant;
  LInt: Integer;
begin
  LIn := VarAsType(10, varInteger);
  OleCheck(VariantChangeType(LOut, LIn, 0, VT_DECIMAL));
  LOut := VarAsType(LOut, varInteger);
  if LIn = LOut then
    ShowMessage('Equal')
  else
    ShowMessage('not Equal');
end;
все работает. Но мне нужно сравнить на равенство именно два варианта с произвольными типами. И в моем понимании, varInteger и varDecimal типы сравниваемые.
6 янв 18, 14:16    [21084529]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
Похоже вместо
if Var1 = Var2 then
нужно писать
if VarCmp(TVarData(Var1), TVarData(Var2), 0, 0) = VAR_CMP_EQ then
и тогда все работает
6 янв 18, 14:18    [21084530]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
Обнаружилась еще одна особенность. VarCmp почти в три раза быстрее. Тест
var
  LVar1, LVar2: OleVariant;
  LBool: Boolean;
  LInt: Integer;
  LStart: Cardinal;
begin
  LVar1 := VarAsType(10, varInteger);
  LVar2 := VarAsType(10, varInteger);
//  LVar2 := VarAsType(10, varDouble);
  LStart := GetTickCount;
  for LInt := 0 to Round(1E+8) do
    LBool := VarCmp(TVarData(LVar1), TVarData(LVar2), 0, 0) = VAR_CMP_EQ;
//    LBool := LVar1 = LVar2;
  ShowMessage(IntToStr(GetTickCount - LStart));
end;
Результаты
Типы=VarCmp
varInteger-varInteger130464969
varInteger-varDouble179697468
6 янв 18, 16:44    [21084702]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
makhaon
Member

Откуда: A galaxy far far away
Сообщений: 2574
_Vasilisk_,

интересная информация. видимо сравнение идёт через преобразование, а varcmp нативно сравнивает.
6 янв 18, 18:44    [21084850]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
Та возьмите, да посмотрите в трейсе )
6 янв 18, 20:37    [21084987]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
makhaon
видимо сравнение идёт через преобразование
Так и есть
+
function VarCompareSimple(const Left, Right: TVarData; const OpCode: TVarOp): TVarCompareResult;
const
  CmpTypeMap: array[TBaseType, TBaseType] of TBaseType = (
         {btErr, btEmp, btNul, btInt, btFlt, btCur, btStr, btBol, btDat, btI64, btU64, btAny}
  {btErr}(btErr, btErr, btErr, btErr, btErr, btErr, btErr, btErr, btErr, btErr, btErr, btErr),
  {btEmp}(btErr, btEmp, btNul, btInt, btFlt, btCur, btStr, btBol, btDat, btI64, btU64, btAny),
  {btNul}(btErr, btNul, btNul, btNul, btNul, btNul, btNul, btNul, btNul, btNul, btNul, btAny),
  {btInt}(btErr, btInt, btNul, btInt, btFlt, btCur, btFlt, btInt, btDat, btI64, btU64, btAny),
  {btFlt}(btErr, btFlt, btNul, btFlt, btFlt, btCur, btFlt, btFlt, btDat, btFlt, btFlt, btAny),
  {btCur}(btErr, btCur, btNul, btCur, btCur, btCur, btCur, btCur, btDat, btCur, btCur, btAny),
  {btStr}(btErr, btStr, btNul, btFlt, btFlt, btCur, btStr, btBol, btDat, btFlt, btFlt, btAny),
  {btBol}(btErr, btBol, btNul, btInt, btFlt, btCur, btBol, btBol, btDat, btI64, btU64, btAny),
  {btDat}(btErr, btDat, btNul, btDat, btDat, btDat, btDat, btDat, btDat, btDat, btDat, btAny),
  {btI64}(btErr, btI64, btNul, btI64, btFlt, btCur, btFlt, btI64, btDat, btI64, btU64, btAny),
  {btU64}(btErr, btU64, btNul, btU64, btFlt, btCur, btFlt, btU64, btDat, btU64, btU64, btAny),
  {btAny}(btErr, btAny, btAny, btAny, btAny, btAny, btAny, btAny, btAny, btAny, btAny, btAny));

var
  L, R: TBaseType;
begin
  L := BaseTypeMap[CheckType(Left.VType)];
  R := BaseTypeMap[CheckType(Right.VType)];
  case CmpTypeMap[L, R] of
    btErr:
      begin
        VarInvalidOp;
        Result := crEqual;
      end;
    btEmp:  Result := EmptyCompare(L, R);
    btNul:  Result := NullCompare(L, R, OpCode);
    btInt:  Result := IntCompare(_VarToInteger(Left), _VarToInteger(Right));
    btI64:  Result := Int64Compare(_VarToInt64(Left), _VarToInt64(Right));
    btU64:  Result := UInt64Compare(_VarToUInt64(Left), _VarToUInt64(Right));
    btFlt:  Result := RealCompare(_VarToDouble(Left), _VarToDouble(Right));
    btDat:  Result := DateCompare(_VarToDate(Left), _VarToDate(Right));
    btCur:  Result := CurrCompare(_VarToCurrency(Left), _VarToCurrency(Right));
    btStr:  Result := StringCompare(Left, Right);
    btBol:  Result := IntCompare(Integer(_VarToBoolean(Left)), Integer(_VarToBoolean(Right)));
    btAny:  Result := VarCompareAny(Left, Right, OpCode);
  else
    VarInvalidOp;
    Result := crEqual;
  end;
end;

function _VarToDouble(const V: TVarData): Double;
begin
  case V.VType of
    varEmpty:    Result := 0;
    varNull:
      begin
        if NullStrictConvert then
          VarCastError(varNull, varDouble);
        Result := 0;
      end;
    varSmallInt: Result := V.VSmallInt;
    varInteger:  Result := V.VInteger;
    varSingle:   Result := V.VSingle;
    varDouble:   Result := V.VDouble;
    varCurrency: Result := V.VCurrency;
    varDate:     Result := V.VDate;
    varOleStr:   Result := VarToDoubleAsString(V);
    varBoolean:  Result := Integer(V.VBoolean);
    varShortInt: Result := V.VShortInt;
    varByte:     Result := V.VByte;
    varWord:     Result := V.VWord;
    varUInt32:   Result := V.VUInt32;
    varInt64:    Result := V.VInt64;
    varUInt64:   Result := V.VUInt64;

    varVariant:  Result := _VarToDouble(PVarData(V.VPointer)^);

    varDispatch,
    varUnknown:  Result := VarToDoubleViaOS(V);
  else
    case V.VType of
      varString: Result := VarToDoubleAsString(V);
      varUString: Result := VarToDoubleAsString(V);
      varAny:    Result := VarToDoubleAny(V);
    else
      if V.VType and varByRef <> 0 then
        case V.VType and not varByRef of
          varSmallInt: Result := PSmallInt(V.VPointer)^;
          varInteger:  Result := PInteger(V.VPointer)^;
          varSingle:   Result := PSingle(V.VPointer)^;
          varDouble:   Result := PDouble(V.VPointer)^;
          varCurrency: Result := PCurrency(V.VPointer)^;
          varDate:     Result := PDate(V.VPointer)^;
          varOleStr:   Result := VarToDoubleAsString(V);
          varBoolean:  Result := Integer(PWordBool(V.VPointer)^);
          varShortInt: Result := PShortInt(V.VPointer)^;
          varByte:     Result := PByte(V.VPointer)^;
          varWord:     Result := PWord(V.VPointer)^;
          varUInt32:   Result := PCardinal(V.VPointer)^;
          varInt64:    Result := PInt64(V.VPointer)^;
          varUInt64:   Result := PUInt64(V.VPointer)^;

          varVariant:  Result := _VarToDouble(PVarData(V.VPointer)^);
        else
          Result := VarToDoubleViaOS(V);
        end
      else
        if not VarToDoubleCustom(V, Result) then
          Result := VarToDoubleViaOS(V);
    end;
  end;
end;

function RealCompare(const A, B: Double): TVarCompareResult;
begin
  if A < B then
    Result := crLessThan
  else if A > B then
    Result := crGreaterThan
  else
    Result := crEqual;
end;

makhaon
varcmp нативно сравнивает.
Не совсем понятно, что такое "нативно".

У VarCmp есть один минус.Он Windows-only. Но мне не понятно, что мешало Эмбаркадере для Windows вызывать родную VarCmp, а для остальных платформ - свою реализацию. Для некоторых функций они так и делают
6 янв 18, 20:40    [21084996]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
SOFT FOR YOU
Member [заблокирован]

Откуда:
Сообщений: 2761
_Vasilisk_,

Из-за Delphi-like типов
AnsiString, например, или UnicodeString

А хочешь быстрое сравнение - сам напишешь
6 янв 18, 20:43    [21085004]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
SOFT FOR YOU
Из-за Delphi-like типов
Мдя. Не подумал
6 янв 18, 20:56    [21085022]     Ответить | Цитировать Сообщить модератору
 Re: TCustomVariant (varDecimal)  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 10308
Хрень полная
LVar1 := VarAsType(10, varOleStr);
LVar2 := VarAsType(10, varInteger);
LWinCmp :=  VarCmp(TVarData(LVar1), TVarData(LVar2), VAR_LOCALE_USER_DEFAULT, 0);
LNativeCmp := LVar1 = LVar2;

LWinCmp = VAR_CMP_GT;
LNativeCmp = True;
6 янв 18, 21:24    [21085075]     Ответить | Цитировать Сообщить модератору
Все форумы / Delphi Ответить