Created by
Stefan Glienke
last modified
| program Project1;
{$APPTYPE CONSOLE}
uses
Rtti,
SysUtils;
type
TValueDataImpl = class(TInterfacedObject, IValueData)
private
FInstance: TObject;
public
constructor Create(const instance: TObject);
destructor Destroy; override;
function GetDataSize: Integer;
procedure ExtractRawData(ABuffer: Pointer);
procedure ExtractRawDataNoCopy(ABuffer: Pointer);
function GetReferenceToRawData: Pointer;
end;
TValueHelper = record helper for TValue
class function FromObject(const value: TObject; ownsObject: Boolean = True): TValue; static;
end;
class function TValueHelper.FromObject(const value: TObject;
ownsObject: Boolean): TValue;
begin
Result := value;
{$IFNDEF AUTOREFCOUNT}
if ownsObject then
TValueData(Result).FValueData := TValueDataImpl.Create(value);
{$ENDIF}
end;
constructor TValueDataImpl.Create(const instance: TObject);
begin
inherited Create;
FInstance := instance;
end;
destructor TValueDataImpl.Destroy;
begin
FInstance.Free;
inherited;
end;
procedure TValueDataImpl.ExtractRawData(ABuffer: Pointer);
begin
end;
procedure TValueDataImpl.ExtractRawDataNoCopy(ABuffer: Pointer);
begin
end;
function TValueDataImpl.GetDataSize: Integer;
begin
Result := 0;
end;
function TValueDataImpl.GetReferenceToRawData: Pointer;
begin
Result := nil;
end;
procedure Main;
var
v: TValue;
o: TObject;
begin
o := TObject.Create;
v := o;
v := TValue.FromObject(o);
Writeln(TObject(v.GetReferenceToRawData^).ClassName);
end;
begin
try
Main;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
ReportMemoryLeaksOnShutdown := True;
Readln;
end.
|