Вариантные типы

unit VariaF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ListBox1: TListBox;
    BtnCreate: TButton;
    BtnClear: TButton;
    BtnConvert: TButton;
    procedure BtnClearClick(Sender: TObject);
    procedure BtnConvertClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnCreateClick(Sender: TObject);
  private
    Variant1: Variant;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ComObj;

function VarTypeToString(VType: Integer): string;
begin
  case VType of
    varEmpty: Result := 'varEmpty';
    varNull: Result := 'varNull';
    varSmallint: Result := 'varSmallint';
    varInteger: Result := 'varInteger';
    varSingle: Result := 'varSingle';
    varDouble: Result := 'varDouble';
    varCurrency: Result := 'varCurrency';
    varDate: Result := 'varDate';
    varOleStr: Result := 'varOleStr';
    varDispatch: Result := 'varDispatch';
    varError: Result := 'varError';
    varBoolean: Result := 'varBoolean';
    varVariant: Result := 'varVariant';
    varUnknown: Result := 'varUnknown';
    varByte: Result := 'varByte';
    varString: Result := 'varString';
    varTypeMask: Result := 'varTypeMask';
    varArray: Result := 'varArray';
    varByRef: Result := 'varByRef';
  else
    Result := 'Error: Undefined variant type';
  end;
end;

procedure ShowVariantInfo(V: Variant; Str: TStrings);
begin
  Str.Clear;
  Str.Add('Var type: ' +
    VarTypeToString(VarType(V)));
  if VarIsArray(V) then
    Str.Add('Is an array');
  if VarIsEmpty(V) then
    Str.Add('Empty variant');
  if VarIsNull(V) then
    Str.Add('Null variant');
  // protect conversion methods and show default strings
  try
    Str.Add('String value: ' + VarToStr(V));
  except
    on EVariantError do
      Str.Add('String value: <Undefined>');
  end;
  try
    Str.Add('Numeric value: ' + FloatToStr(V));
  except
    on EVariantError do
      Str.Add('Numeric value: <Undefined>');
  end;
end;

procedure TForm1.BtnClearClick(Sender: TObject);
begin
  VarClear(Variant1);
  ShowVariantInfo(Variant1, Memo1.Lines);
end;

procedure TForm1.BtnConvertClick(Sender: TObject);
var
  VType: Integer;
begin
  VType := Integer(
    ListBox1.Items.Objects[ListBox1.ItemIndex]);
  try
    Variant1 := VarAsType(Variant1, VType);
    ShowVariantInfo(Variant1, Memo1.Lines);
  except
    on EVariantError do
      ShowMessage('Conversion not supported');
  end;
end;

const
  VarList: array[1..10] of Integer =
  (varSmallint, varInteger, varSingle, varDouble,
    varCurrency, varDate, varOleStr, varDispatch,
    varBoolean, varString);

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // fill the list with variant type constants
  // (their description and their value)
  for I := 1 to High(VarList) do
    ListBox1.Items.AddObject(
      VarTypeToString(VarList[I]),
      TObject(VarList[I]));
  // select the first item
  ListBox1.ItemIndex := 0;
  ShowVariantInfo(Variant1, Memo1.Lines);
end;

procedure TForm1.BtnCreateClick(Sender: TObject);
var
  VType: Integer;
begin
  VType := Integer(
    ListBox1.Items.Objects[ListBox1.ItemIndex]);
  case VType of
    varSmallint: Variant1 := VarAsType(
        10, varSmallint);
    varInteger: Variant1 := Integer(1000);
    varSingle: Variant1 :=
      VarAsType(1.1, varSingle);
    varDouble: Variant1 := Sqrt(1000.01);
    varCurrency: Variant1 := 100.01;
    varDate: Variant1 := Now;
    varOleStr: Variant1 :=
      VarAsType('Hello', VarOleStr);
    varDispatch: Variant1 :=
      CreateOleObject('Word.Basic');
    varBoolean: Variant1 := WordBool(True);
    varString: Variant1 := 'Delphi';
  end;
  ShowVariantInfo(Variant1, Memo1.Lines);
end;

end.