mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 08:18:12 +02:00
136 lines
2.9 KiB
ObjectPascal
136 lines
2.9 KiB
ObjectPascal
{%delfiles=dump.bin}
|
|
|
|
{ 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.
|
|
|