Вариантные типы
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 .
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Вариантные типы", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!