unit FortranWriter;
interface
type
TFortranObjectWriter =
abstract class(TObject)
protected
class procedure GetDataObjectClass: TClass;
virtual;
abstract;
class procedure WriteToBuffer(ABuffer: TCustomStream; AValue: Double);
overload:
class procedure WriteToBuffer(ABuffer: TCustomStream; AValue: Integer);
overload:
class procedure Register;
class procedure UnRegister;
public
class property DataObjectClass: TClass
read GetDataObjectClass;
class procedure WriteObjectToBuffer(ABuffer: TCustomStream; AObject: TObject);
virtual;
abstract;
end;
TFortranObjectWriterClass =
class of TFortranObjectWriter;
TFortranWriter =
class(TObject)
constructor Create(AStream: TCustomStream);
destructor Destroy;
private
FBuffer: TMemmoryStream;
FStream: TCustomStream;
class var FObjectWriter: TClassList;
protected
class procedure RegisterObjectWriter(AClass: TFortranObjectWriterClass);
class procedure UnRegisterObjectWriter(AClass: TFortranObjectWriterClass);
class procedure GetObjectWriter(AClass: TClass): TFortranObjectWriterClass;
public
procedure Write(AObject: TObject);
virtual;
end;
implementation
constructor TFortranWriter.Create(AStream: TCustomStream);
begin
inherited Create;
FStream := AStream;
FBuffer := TMemmoryStream.Create;
end;
destructor TFortranWriter.Destroy;
begin
FBuffer.Free;
inherited;
end;
procedure TFortranWriter.
Write(AObject: TObject);
var
ObjectWriter: TFortranObjectWriterClass;
ByteSize: Byte;
begin
FBuffer.Clear;
ObjectWriter := GetObjectWriter(AObject.
Class);
if not Assigned(ObjectWriter)
then
raise Exception.Create('
...');
ObjectWriter.WriteObjectToBuffer(FBuffer, AObject);
if FBuffer.Size = 0
then
raise Exception.Create('
...');
if FBuffer.Size > 255
then
raise Exception.Create('
...');
ByteSize := FBuffer.Size;
FStream.
Write(ByteSize, SizeOf(ByteSize));
FBuffer.WriteToStream(FStream);
FStream.
Write(ByteSize, SizeOf(ByteSize));
end;
class procedure TFortranWriter.RegisterObjectWriter(AClass: TFortranObjectWriterClass);
begin
if not Assigned(FObjectWriter)
then
FObjectWriter := TClassList.Create;
FObjectWriter.Add(AClass);
end;
class procedure TFortranWriter.UnregisterObjectWriter(AClass: TFortranObjectWriterClass);
begin
if not Assigned(FObjectWriter)
then
Exit;
FObjectWriter.Remove(AClass);
if FObjectWriter.Count = 0
then
FreeAndNil(FObjectWriter);
end;
class procedure TFortranWriter.GetObjectWriter(AClass: TClass): TFortranObjectWriterClass;
begin
if Assigned(FObjectWriter)
then
begin
for i := FObjectWriter.Count - 1
downto 0
do
begin
Result := TFortranObjectWriter(FObjectWriter[i]);
if AClass
is Result.DataObjectClass
then
Exit;
end;
end;
Result :=
nil;
end;
class procedure TFortranObjectWriter.WriteToBuffer(ABuffer: TCustomStream; AValue: Double);
begin
ABuffer.
Write(AValue, SizeOf(AValue));
end;
class procedure TFortranObjectWriter.WriteToBuffer(ABuffer: TCustomStream; AValue: Integer);
begin
ABuffer.
Write(AValue, SizeOf(AValue));
end;
class procedure TFortranObjectWriter.
Register;
begin
TFortranWriter.
Register(Self);
end;
class procedure TFortranObjectWriter.UnRegister;
begin
TFortranWriter.UnRegister(Self);
end;
end.