powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / TCustomVariant (varDecimal)
15 сообщений из 15, страница 1 из 1
TCustomVariant (varDecimal)
    #39579835
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Столкнулся с вариантом у которого Vtype = 14. Делфи этот тип не поддерживает
Код: pascal
1.
//varDecimal  = $000E; { vt_decimal     14 } {UNSUPPORTED as of v6.x code base}


Захотелось к нему написать наследника TCustomVariantType, где описать все манипуляции с ним. Нарвался на такие строчки
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
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
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39579943
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

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

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
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;
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39579946
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кстати целочисленная часть не Int64, а UInt64
А знак определяется старшим битом Reserved1
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39579957
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUvarDecimal обрабатывается как системныйЕсли бы обрабатывался, я бы и тему такую не поднимал
SOFT FOR YOUКстати целочисленная часть не Int64, а UInt64Кстати, целочисленная часть это UInt96 (12 байт)
SOFT FOR YOUА знак определяется старшим битом Reserved1А еще есть точность. Вообще, для корректного доступа к полям, нужно TVarData напрямую приводить к TDecimal
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39579993
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUКстати целочисленная часть не Int64, а UInt64
А знак определяется старшим битом Reserved1

Код, который я привёл выше, у тебя не работает?
У меня работает. Windows 7, Delphi XE 8.
И точность в примере тоже указана - 1 разряд.
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39579995
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_Кстати, целочисленная часть это UInt96 (12 байт)

Да, ты прав, ещё нужно Reserved2 и Reserved3 заполнять
Или RawData[1], или VLongs[0]
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580044
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUКод, который я привёл выше, у тебя не работает?Так. Задумался. На Tokyo все работает. На XE3, но немного не такой пример.

Ага, понял, что меня смутило. Каст работает. Не работает сравнение
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
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'.А вот так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
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 типы сравниваемые.
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580045
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Похоже вместо
Код: pascal
1.
if Var1 = Var2 then

нужно писать
Код: pascal
1.
if VarCmp(TVarData(Var1), TVarData(Var2), 0, 0) = VAR_CMP_EQ then

и тогда все работает
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580095
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Обнаружилась еще одна особенность. VarCmp почти в три раза быстрее. Тест
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
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;

Результаты
Типы=VarCmpvarInteger-varInteger130464969varInteger-varDouble179697468
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580124
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

интересная информация. видимо сравнение идёт через преобразование, а varcmp нативно сравнивает.
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580160
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Та возьмите, да посмотрите в трейсе )
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580163
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
makhaonвидимо сравнение идёт через преобразованиеТак и есть
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
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;


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

У VarCmp есть один минус.Он Windows-only. Но мне не понятно, что мешало Эмбаркадере для Windows вызывать родную VarCmp, а для остальных платформ - свою реализацию. Для некоторых функций они так и делают
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580167
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

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

А хочешь быстрое сравнение - сам напишешь
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580171
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUИз-за Delphi-like типовМдя. Не подумал
...
Рейтинг: 0 / 0
TCustomVariant (varDecimal)
    #39580179
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Хрень полная
Код: pascal
1.
2.
3.
4.
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;
...
Рейтинг: 0 / 0
15 сообщений из 15, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / TCustomVariant (varDecimal)
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]