Property für Anwender READONLY, intern nicht

[Schokohase]

Man kann ein Interface nehmen, muss es aber in diesem Fall doch gar nicht.

Delphi-Quellcode:

TFoo = class
private
  FName: atring;
protected
  function GetName: string; virtual;
  procedure SetName( const Value: string ); virtual;
public
  property Name: string read GetName write SetName;
end;

TReadOnlyFoo = class(TFoo)
private
  FFoo: TFoo;
protected
  function GetName: string; override;
  procedure SetName( const Value: string ); override;
public
  constructor Create( const AFoo: TFoo );
end;

function TReadOnlyFoo.GetName: string;
begin
  Result := FFoo.Name;
end;

procedure TReadOnlyFoo.SetName( const Value: string );
begin
  raise EInvalidOperation.Create( 'Readonly' );
end;

oder hier als ausführliches Beispiel

Delphi-Quellcode:

program ReadOnlyClassProp;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  System.Classes,
  ReadOnlyClassProp.Types in 'ReadOnlyClassProp.Types.pas';

procedure TestRun;
var
  b: TBar;
begin
  b := TBar.Create( );
  try
    b.ExecuteAction( );
    WriteLn( b.Foo.SomeValue );

    try
      b.Foo.SomeValue := 'Test the readonly Setter';
    except
      on E: EInvalidOperation do; // eat the expected exception
    end;

    WriteLn( b.Foo.SomeValue );

  finally
    b.Free;
  end;
end;

begin
  try
    TestRun;
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Delphi-Quellcode:

unit ReadOnlyClassProp.Types;

interface

uses
  System.Classes,
  System.SysUtils;

type
  TFoo = class
  strict private
    FSomeValue: string;
  strict protected
    function GetIsReadOnly: Boolean; virtual;
    function GetSomeValue: string; virtual;
    procedure SetSomeValue( const Value: string ); virtual;
  public
    property IsReadOnly: Boolean read GetIsReadOnly;
    property SomeValue:  string read GetSomeValue write SetSomeValue;
  end;

  TReadOnlyFoo = class( TFoo )
  strict private
    FFoo: TFoo;
  strict protected
    function GetIsReadOnly: Boolean; override;
    function GetSomeValue: string; override;
    procedure SetSomeValue( const Value: string ); override;
  public
    constructor Create( const AFoo: TFoo );
  end;

  TBar = class
  private
    FFoo:         TFoo;
    FInternalFoo: TFoo;
    procedure SetInternalFoo( const Value: TFoo );
  protected
    property InternalFoo: TFoo read FInternalFoo write SetInternalFoo;
  public
    constructor Create;
    destructor Destroy; override;

    property Foo: TFoo read FFoo;

    procedure ExecuteAction( );
  end;

implementation

{ TFoo }

function TFoo.GetIsReadOnly: Boolean;
begin
  Result := False;
end;

function TFoo.GetSomeValue: string;
begin
  Result := FSomeValue;
end;

procedure TFoo.SetSomeValue( const Value: string );
begin
  FSomeValue := Value;
end;

{ TReadOnlyFoo }

constructor TReadOnlyFoo.Create( const AFoo: TFoo );
begin
  inherited Create( );
  if not Assigned( AFoo )
  then
    raise EArgumentNilException.Create( 'AFoo' );

  FFoo := AFoo;
end;

function TReadOnlyFoo.GetIsReadOnly: Boolean;
begin
  Result := True;
end;

function TReadOnlyFoo.GetSomeValue: string;
begin
  Result := FFoo.SomeValue;
end;

procedure TReadOnlyFoo.SetSomeValue( const Value: string );
begin
  raise EInvalidOperation.Create( 'Readonly' );
end;

{ TBar }

constructor TBar.Create;
begin
  inherited;
  InternalFoo := TFoo.Create;
end;

destructor TBar.Destroy;
begin
  InternalFoo := nil;
  inherited;
end;

procedure TBar.ExecuteAction;
begin
  InternalFoo.SomeValue := DateTimeToStr( Now( ) );
end;

procedure TBar.SetInternalFoo( const Value: TFoo );
begin
  FreeAndNil( FInternalFoo );
  FreeAndNil( FFoo );

  if Value <> nil
  then
    begin
      FInternalFoo := Value;
      FFoo         := TReadOnlyFoo.Create( Value );
    end;
end;

end.

Aber threadsafe ist das so noch nicht, das müsste man in TBar dann noch einweben.