variaf.pas

Delphi高级开发指南是开发程序的好帮手

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.