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
|
{ Source provided for Free Pascal Bug Report 14708 }
{ Submitted by "Anton Kavalenka" on 2009-11-11 }
{ e-mail: }
program tw14709;
{$mode delphi}{$H+}
{$apptype console}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes,Sysutils
{ you can add units after this };
var ok : boolean = true;
type
TIntComponent=class(TComponent)
public
procedure DoChange(Sender:TObject);
end;
TTestComponent=class(TComponent)
private
fButton,
fEdit:TIntComponent;
fOnChangeButton,fOnChangeEdit:TNotifyEvent;
fStr:string;
public
constructor Create(AnOwner:TComponent);override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent);override;
procedure Change;
published
property Str:string read fStr write fStr;
property OnChangeButton:TNotifyEvent read fOnChangeButton write fOnChangeButton;
property OnChangeEdit:TNotifyEvent read fOnChangeEdit write fOnChangeEdit;
end;
procedure TIntComponent.DoChange(Sender:TObject);
begin
writeln(Self.className+' reports that '+Sender.ClassName+' changed');
end;
constructor TTestComponent.Create(AnOwner:TComponent);
begin
inherited Create(AnOwner);
fStr:='Test string';
fButton:=TIntComponent.Create(Self);
fOnChangeButton:=fButton.DoChange;
fEdit:=TIntComponent.Create(Self);
fOnChangeEdit:=fEdit.DoChange;
end;
procedure TTestComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
i:integer;
begin
{ for i:=0 to Componentcount-1 do
Proc(Components[i]);
}
end;
procedure TTestComponent.Change;
begin
writeln(format('OnChangeButton code=%x data=%x',
[ptruint(TMethod(fOnChangeButton).Code),
ptruint(TMethod(fOnChangeButton).Data)]));
writeln(format('OnChangeEdit code=%x data=%x',
[ptruint(TMethod(fOnChangeEdit).Code),
ptruint(TMethod(fOnChangeEdit).Data)]));
if Assigned(OnChangeButton) then
OnChangeButton(Self)
else
begin
writeln('OnChangeButton handler is clear');
ok:=false;
end;
if Assigned(OnChangeEdit) then
OnChangeEdit(Self)
else
begin
writeln('OnChangeEdit handler is clear');
ok:=false;
end;
end;
var
tc:TTestComponent;
ms,os,f:TStream;
begin
RegisterClasses([TTestComponent,TIntComponent]);
tc:=TTestComponent.Create(nil);
writeln('Testing....');
tc.Change;
ms:=TmemoryStream.Create;
ms.WriteComponent(tc);
writeln('Cleanup...');
tc.free;
ms.Position:=0;
writeln('Dumping streamed object as text:');
f:=TFileStream.Create('dump.bin',fmCreate);
f.CopyFrom(ms,ms.size);
f.free;
ms.Position:=0;
os:=TMemoryStream.Create;
ObjectBinaryToText(ms,os);
os.Position:=0;
repeat
write(char(os.ReadByte));
until os.Position>=os.Size;
writeln();
ms.Position:=0;
tc:=TTestComponent(ms.ReadComponent(nil));
writeln('Just read, testing ...');
tc.Change;
tc.free;
ms.free;
os.Free;
if not ok then
halt(1);
end.
|
