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
|
program stored;
{$mode objfpc}{$h+}
uses
SysUtils, Classes;
const
ShowTheException = true; //set this to false for halt(128) instead of exception
StoredTrue = True;
type
TGLNode = class (TCollectionItem)
private
FCoords : array[0..6] of double;
procedure SetCoordinate(aIndx: Integer; AValue: double);
protected
function StoreCoordinate(aIndx: Integer) : Boolean;
published
property X: double index 0 read FCoords[0] write SetCoordinate stored StoreCoordinate;
property Y: double index 1 read FCoords[1] write SetCoordinate stored StoreCoordinate;
property Z: double index 2 read FCoords[2] write SetCoordinate stored StoreCoordinate;
property X2: double index 3 read FCoords[3] write SetCoordinate stored true;
property Y2: double index 4 read FCoords[4] write SetCoordinate stored true;
property Z2: double index 5 read FCoords[5] write SetCoordinate stored StoredTrue;
end;
{ TNodeContainer }
TNodeContainer = class (TComponent)
private
FNodes: TCollection;
procedure SetNodes(const AValue: TCollection);
public
constructor Create(AOwner: TComponent); virtual;
published
property Nodes : TCollection read FNodes write SetNodes;
end;
{ TNodeContainer }
procedure TNodeContainer.SetNodes(const AValue: TCollection);
begin
if FNodes=AValue then exit;
FNodes:=AValue;
end;
constructor TNodeContainer.create(AOwner: TComponent);
begin
inherited create(AOwner);
fNodes:=TCollection.Create(TGLNode);
end;
{ TGLNode }
procedure TGLNode.SetCoordinate(aIndx: Integer; AValue: double);
begin
if (aIndx in [0..2]) or ShowTheException then
FCoords[aIndx]:=AValue
else begin
writeln('SetCoordinate called with index=',aIndx);
halt(128);
end;
end;
function TGLNode.StoreCoordinate(aIndx: Integer): Boolean;
begin
if (aIndx in [0..2]) or ShowTheException then
result:=(PtrUInt((@FCoords[aIndx])^)<>0)
else begin
writeln('StoreCoordinate called with index=',aIndx);
halt(128);
end;
end;
var gNodes : TNodeContainer;
gFile : TFileStream;
i : word;
begin
gNodes:=TNodeContainer.create(nil);
for i := 1 to 3 do begin
with (gNodes.Nodes.Add as TGLNode) do begin
PtrUInt((@x)^):=$FF80 or i;
PtrUInt((@y)^):=$FFA0 or i;
PtrUInt((@z)^):=$FFC0 or i;
PtrUInt((@x2)^):=$FF80 or i;
PtrUInt((@y2)^):=$FFA0 or i;
PtrUInt((@z2)^):=$FFC0 or i;
end;
end;
gFile:=TFileStream.Create('testfile.tmp',fmCreate);
gFile.WriteComponent(gNodes);
gFile.Free;
gNodes.Nodes.Clear;
gFile:=TFileStream.Create('testfile.tmp',fmOpenRead);
gFile.ReadComponent(gNodes);
gFile.Free;
for i := 1 to 3 do begin
with (gNodes.Nodes.Items[i-1] as TGLNode) do begin
if PtrUInt((@x)^) <> ($FF80 or i) then begin writeln('Node ',i,' X-Value is wrong: ',hexStr(PtrUInt((@x)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FF80 or i,sizeof(PtrUInt)*2)); halt(128); end;
if PtrUInt((@y)^) <> ($FFA0 or i) then begin writeln('Node ',i,' Y-Value is wrong: ',hexStr(PtrUInt((@y)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FFA0 or i,sizeof(PtrUInt)*2)); halt(128); end;
if PtrUInt((@z)^) <> ($FFC0 or i) then begin writeln('Node ',i,' Z-Value is wrong: ',hexStr(PtrUInt((@z)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FFC0 or i,sizeof(PtrUInt)*2)); halt(128); end;
if PtrUInt((@x2)^) <> ($FF80 or i) then begin writeln('Node ',i,' X-Value is wrong: ',hexStr(PtrUInt((@x)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FF80 or i,sizeof(PtrUInt)*2)); halt(128); end;
if PtrUInt((@y2)^) <> ($FFA0 or i) then begin writeln('Node ',i,' Y-Value is wrong: ',hexStr(PtrUInt((@y)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FFA0 or i,sizeof(PtrUInt)*2)); halt(128); end;
if PtrUInt((@z2)^) <> ($FFC0 or i) then begin writeln('Node ',i,' Z-Value is wrong: ',hexStr(PtrUInt((@z)^),sizeof(PtrUInt)*2),' but should be ',hexStr($FFC0 or i,sizeof(PtrUInt)*2)); halt(128); end;
end;
end;
writeln('ok. done.');
DeleteFile('testfile.tmp');
end.
|
