Vererbungs-Problem: class const überschreiben

[himitsu]

Ist nicht möglich, da die Objekte in der Variable auch nicht statisch sind.

Dieses würde einer Class Var, Class Propery oder einer Class Function gleichen und diese hängen nur vom Typen der Variable (bzw. des Typnamens) ab und nicht vom Objekt in einer Variable.

VarType geht nicht anders zu lösen.

Aber für SetValue besteht die Lösung darin es als Virtual zu deklarieren in den Ableitungen dann entsprechend zu überschreiben.

Es ist eh unschön die Verarbeitung für die Ableitungen im Basistypen vorzunehmen.

Delphi-Quellcode:

VBasic = class(TObject)
private
  FValue : Variant;
  function GetVarType: TVarType; virtual;
  procedure SetValue(const AVar: Variant); virtual;
public
  property VarType: TVarType read GetVarType;
  property Value : Variant read FValue write SetValue;
  function IsNull: Boolean;
end;

VInteger = class(VBasic)
private
  function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;

VString = class(VBasic)
private
  function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;

VFloat = class(VBasic)
private
  function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;



function VBasic.GetVarType: TVarType; 
begin
  Result := varUnknown;
end;

procedure VBasic.SetValue(const AVar: Variant);
begin
  if VarIsClear(AVar) or VarIsNull(AVar) then
    FValue := NULL
  else 
    FValue := AVar;
end;

function VInteger.GetVarType: TVarType; 
begin
  Result := varInteger;
end;

procedure VInteger.SetValue(const AVar: Variant);
begin
  if VarIsClear(AVar) or VarIsNull(AVar) then
    FValue := NULL
  else 
    if VarIsOrdinal(AVar) and not VarSameValue(FValue, AVar) then
      FValue := AVar
    else
      raise Exception.Create('Wert hat ungültiges Format.');
end;

...

[edit]
OK, es sollte möglich sein auch ein Klassen-Property zu überschreiben ... dieses wäre dann als VarType nutzbar

eventuell so:

Delphi-Quellcode:

VBasic = class(TObject)
private
  FValue : Variant;
  class function GetVarType: TVarType; virtual;
  procedure SetValue(const AVar: Variant); virtual;
public
  class property VarType: TVarType read GetVarType;
  property Value : Variant read FValue write SetValue;
  function IsNull: Boolean;
end;

VInteger = class(VBasic)
private
  class function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;

VString = class(VBasic)
private
  class function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;

VFloat = class(VBasic)
private
  class function GetVarType: TVarType; override;
  procedure SetValue(const AVar: Variant); override;
end;



class function VBasic.GetVarType: TVarType; 
begin
  Result := varUnknown;
end;

procedure VBasic.SetValue(const AVar: Variant);
begin
  if VarIsClear(AVar) or VarIsNull(AVar) then
    FValue := NULL
  else 
    FValue := AVar;
end;

class function VInteger.GetVarType: TVarType; 
begin
  Result := varInteger;
end;

procedure VInteger.SetValue(const AVar: Variant);
begin
  if VarIsClear(AVar) or VarIsNull(AVar) then
    FValue := NULL
  else 
    if VarIsOrdinal(AVar) and not VarSameValue(FValue, AVar) then
      FValue := AVar
    else
      raise Exception.Create('Wert hat ungültiges Format.');
end;

...