Classes e helpers

program Classes;

type
  TAnimal = class(TObject)
  private
    FName: UString;
  public
    constructor Create(const AName: UString);
    procedure Speak; virtual; abstract;
    function Describe: UString; virtual;
    property Name: UString read FName write FName;
  end class;

  TDog = class(TAnimal)
  public
    procedure Speak; override;
  end class;

  TCat = class(TAnimal)
  public
    procedure Speak; override;
    function Describe: UString; override;
  end class;

constructor TAnimal.Create(const AName: UString);
begin
  FName := AName;
end constructor;

function TAnimal.Describe: UString;
begin
  Exit('animal ' + FName);
end function;

procedure TDog.Speak;
begin
  WriteLn(Name, ': au au');
end procedure;

procedure TCat.Speak;
begin
  WriteLn(Name, ': miau');
end procedure;

function TCat.Describe: UString;
begin
  Exit('gato ' + inherited Describe);
end function;

var
  Pets: array[0..1] of TAnimal;
  Pet: TAnimal;
begin
  Pets[0] := TDog.Create('Rex');
  Pets[1] := TCat.Create('Mimi');
  for Pet in Pets do
  begin
    Pet.Speak;                 // despacho virtual
    WriteLn('  ', Pet.Describe);
    if Pet is TCat then
      WriteLn('  (é um gato)');
  end for;
end.

program Properties;

type
  TTemperature = class(TObject)
  private
    FCelsius: Float64;
    FHistory: array[0..3] of Int32;
    function GetFahrenheit: Float64;
    procedure SetFahrenheit(const AValue: Float64);
    function GetReading(const AIndex: Int32): Int32;
    procedure SetReading(const AIndex: Int32; const AValue: Int32);
  public
    // leitura e escrita por campo
    property Celsius: Float64 read FCelsius write FCelsius;
    // leitura e escrita por método
    property Fahrenheit: Float64 read GetFahrenheit write SetFahrenheit;
    // property indexada: os índices vão na frente do valor
    property Reading[const AIndex: Int32]: Int32 read GetReading write SetReading;
  end class;

function TTemperature.GetFahrenheit: Float64;
begin
  Exit(FCelsius * 9 / 5 + 32);
end function;

procedure TTemperature.SetFahrenheit(const AValue: Float64);
begin
  FCelsius := (AValue - 32) * 5 / 9;
end procedure;

function TTemperature.GetReading(const AIndex: Int32): Int32;
begin
  Exit(FHistory[AIndex]);
end function;

procedure TTemperature.SetReading(const AIndex: Int32; const AValue: Int32);
begin
  FHistory[AIndex] := AValue;
end procedure;

var
  T: TTemperature;
begin
  T := TTemperature.Create;
  T.Celsius := 100;
  WriteLn(T.Fahrenheit);
  T.Fahrenheit := 32;
  WriteLn(T.Celsius);
  T.Reading[2] := 99;
  WriteLn(T.Reading[2]);
end.

program Helpers;

type
  // acrescenta métodos a um tipo que já existe (aqui, um tipo básico)
  TInt32Helper = helper for Int32
  public
    function Double: Int32;
    function IsEven: Bool8;
    static function FromText(const S: UString): Int32;
  end helper;

  TGreeter = class(TObject)
  public
    procedure Hello(const S: UString);
  end class;

  // o helper GANHA do tipo quando os dois declaram o mesmo nome; o escondido
  // continua alcançável por inherited
  TGreeterHelper = helper for TGreeter
  public
    procedure Hello(const S: UString);
  end helper;

function TInt32Helper.Double: Int32;
begin
  Exit(Self * 2);               // Self é o próprio Int32
end function;

function TInt32Helper.IsEven: Bool8;
begin
  Exit(Self mod 2 = 0);
end function;

static function TInt32Helper.FromText(const S: UString): Int32;
begin
  Exit(UStrToInt32(S));
end function;

procedure TGreeter.Hello(const S: UString);
begin
  WriteLn('tipo:   ', S);
end procedure;

procedure TGreeterHelper.Hello(const S: UString);
begin
  WriteLn('helper: ', S);
  inherited Hello(S);           // chega no método do tipo estendido
end procedure;

var
  N: Int32;
  G: TGreeter;
begin
  N := 21;
  WriteLn(N.Double, ' ', N.IsEven, ' ', TInt32Helper.FromText('40'));
  G := TGreeter.Create;
  G.Hello('olá');
end.

program Attributes;

// Atributos: lidos pelo compilador, conferidos contra a declaração e gravados
// só no RTTI externo (<saída>.rtti.json). Nada disso entra no binário, e é
// por isso que um meta module consegue lê-los em compilação.

attribute DbTable(const TableName: LString);
attribute DbField(const FieldName: LString);

type
  [DbTable('CUSTOMERS')]
  TCustomer = class(TObject)
  private
    [DbField('ID')]
    FId: Int32;
  public
    // DefReadWrite sintetiza os acessores sobre o campo F<Nome>
    [DbField('NAME')]
    property Name: UString DefReadWrite;
  end class;

var
  C: TCustomer;
begin
  C := TCustomer.Create;
  C.Name := 'Ana';
  WriteLn(C.Name);
end.