blob: fa690065e5a4c3410c4f9d619600bf445ee3bc2c (
plain)
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
program SourceBug;
{$APPTYPE CONSOLE}
{$ifdef FPC}
{$MODE Delphi}
{$endif}
uses
Variants,
SysUtils;
type
TSampleVariant = class(TInvokeableVariantType)
protected
{$ifndef FPC}
function FixupIdent(const AText: string): string; override;
{$endif}
public
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
function GetProperty(var Dest: TVarData; const V: TVarData;
const Name: string): Boolean; override;
function SetProperty(var V: TVarData; const Name: string;
const Value: TVarData): Boolean; override;
end;
procedure TSampleVariant.Clear(var V: TVarData);
begin
V.VType:=varEmpty;
end;
procedure TSampleVariant.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else with Dest do
VType:=Source.VType;
end;
{$ifndef FPC}
function TSampleVariant.FixupIdent(const AText: string): string;
begin
result := AText; // we do not want any uppercase names
end;
{$endif}
function TSampleVariant.GetProperty(var Dest: TVarData; const V: TVarData;
const Name: string): Boolean;
begin
assert(V.VType=varType);
if Name='IntField' then
begin
variant(Dest) := V.VInt64;
result := true;
end
else if Name='FloatField' then
begin
variant(Dest) := V.VDouble;
result := true;
end
else if Name='BoolField' then
begin
variant(Dest) := V.VBoolean;
result := true;
end
else
result := false;
end;
function TSampleVariant.SetProperty(var V: TVarData; const Name: string;
const Value: TVarData): Boolean;
begin
assert(V.VType=varType);
if Name='IntField' then
begin
PVarData(@V)^.VInt64 := variant(Value);
result := true;
end
else if Name='FloatField' then
begin
PVarData(@V)^.VDouble := variant(Value);
result := true;
end
else if Name='BoolField' then
begin
PVarData(@V)^.VBoolean := variant(Value);
result := true;
end
else
result := false;
end;
var
SampleVariant: TSampleVariant;
v: Variant;
GB1 : Byte;
GS1 : Shortint;
GW : Word;
GL : longint;
gsi : single;
gd : double;
gi64 : int64;
gdate: tdatetime;
gb: boolean;
begin
SampleVariant:=TSampleVariant.Create;
v := null;
TVarData(v).VType:=SampleVariant.VarType;
v.IntField := 100;
if v.IntField<>100 then
halt(1);
gb1:=128;
gs1:=127;
gw:=32768;
gl:=longint($b100dbad);
gsi:=12345789.5;
gd:=999991234889879.5;
gi64:=$813245678901234;
gdate:=now;
gb:=false;
v.IntField:=gb1;
if v.IntField<>gb1 then
halt(2);
v.IntField:=gs1;
if v.IntField<>gs1 then
halt(3);
v.IntField:=gw;
if v.IntField<>gw then
halt(4);
v.IntField:=gl;
if v.IntField<>gl then
halt(5);
v.FloatField:=gsi;
if v.FloatField<>gsi then
halt(6);
v.FloatField:=gd;
if v.FloatField<>gd then
halt(7);
v.IntField:=gi64;
if v.IntField<>gi64 then
halt(8);
v.FloatField:=gdate;
if v.FloatField<>gdate then
halt(9);
v.BoolField:=gb;
if boolean(v.BoolField)<>gb then
halt(10);
end.
|
