Search code examples
delphidelphi-7

How can I pass either Variant or TObject to the same method argument?


I have the two overload methods:

procedure TProps.SetProp(Value: TObject); overload;
procedure TProps.SetProp(const Value: Variant); overload;

They do pretty much the same repeating code except from minor variations depending on whether the Value is Variant or TObject.

I want to use a common method:

procedure TProps.DoSetProp(Value: <what type here?>); // <--

So I can pass both Variant or TObject from SetProp and be able to distinguish between the two types. what are my options?


Edit: for now I used:

procedure TProps.DoSetProp(Value: Pointer; IsValueObject: Boolean);
begin
  // common code...
  if IsValueObject then
    PropValue.Obj := Value
  else
    PropValue.V := PVariant(Value)^;
  // common code...
  if IsValueObject then
    PropValue.Obj := Value
  else
    PropValue.V := PVariant(Value)^;
  // etc...
end;

and the overload methods:

procedure TProps.SetProp(const Value: Variant); overload;
begin
  DoSetProp(@Value, False);
end;

procedure TProps.SetProp(Value: TObject); overload;
begin
  DoSetProp(Value, True);  
end;

I'm not sure I like this solution because of the IsValueObject. I would rather detect the type from a common type "container".

I could use TVarRec:

VarRec: TVarRec;

// for Variant:
VarRec.VType := vtVariant;
VarRec.VVariant := @Value;
// for TObject
VarRec.VType := vtObject;
VarRec.VObject := Value;

And pass the VarRec to the common method. but I'm not sure I like it either.


EDIT 2: What I am trying to do? I'm trying to extend properties for any TObject similar to SetProp API.

Here is the entire MCVE:

function ComparePointers(A, B: Pointer): Integer;
begin
  if Cardinal(A) = Cardinal(B) then
    Result := 0
  else if Cardinal(A) < Cardinal(B) then
    Result := -1
  else
    Result := 1
end;

type
  TPropValue = class
  private
    V: Variant;
    Obj: TObject;
    procedure SetValue(const Value: Pointer; IsValueObject: Boolean);
  end;

  TPropNameValueList = class(TStringList)
  public
    destructor Destroy; override;
    procedure Delete(Index: Integer); override;
  end;

  TObjectProps = class
  private
    BaseObject: TObject;
    PropList: TPropNameValueList;
  public
    constructor Create(AObject: TObject);
    destructor Destroy; override;
  end;

  TProps = class(TComponent)
  private
    FList: TObjectList;
  protected
    procedure DoSetProp(AObject: TObject; const PropName: string; const Value: Pointer; IsValueObject: Boolean);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    function Find(AObject: TObject; var Index: Integer): Boolean;
    procedure SetProp(AObject: TObject; const PropName: string; const Value: Variant); overload;
    procedure SetProp(AObject: TObject; const PropName: string; Value: TObject); overload;
    function RemoveProp(AObject: TObject; const PropName: string): Boolean;
    function RemoveProps(AObject: TObject): Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

{ TPropValue }
procedure TPropValue.SetValue(const Value: Pointer; IsValueObject: Boolean);
begin
  if IsValueObject then
    Obj := Value
  else
    V := PVariant(Value)^;
end;

{ TPropNameValueList }
destructor TPropNameValueList.Destroy;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Objects[I].Free; // TPropValue
  inherited;
end;

procedure TPropNameValueList.Delete(Index: Integer);
begin
  Objects[Index].Free;
  inherited;
end;

{ TObjectProps }
constructor TObjectProps.Create(AObject: TObject);
begin
  BaseObject := AObject;
  PropList := TPropNameValueList.Create;
  PropList.Sorted := True;
  PropList.Duplicates := dupError;
end;

destructor TObjectProps.Destroy;
begin
  PropList.Free;
  inherited;
end;

{ TProps }
constructor TProps.Create(AOwner: TComponent);
begin
  inherited;
  FList := TObjectList.Create(true);
end;

procedure TProps.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent <> nil) then
  begin
    RemoveProps(AComponent);
  end;
end;

destructor TProps.Destroy;
begin
  FList.Free;
  inherited;
end;

function TProps.Find(AObject: TObject; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := ComparePointers(TObjectProps(FList[I]).BaseObject, AObject);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

procedure TProps.DoSetProp(AObject: TObject; const PropName: string; const Value: Pointer; 
  IsValueObject: Boolean);
var
  OP: TObjectProps;
  PropValue: TPropValue;
  Index, NameIndex: Integer;
  Found: Boolean;
  I: Integer;
begin
  Found := Find(AObject, Index);
  if not Found then
  begin
    OP := TObjectProps.Create(AObject);
    if AObject is TComponent then
      TComponent(AObject).FreeNotification(Self);
    PropValue := TPropValue.Create;
    PropValue.SetValue(Value, IsValueObject);    
    OP.PropList.AddObject(PropName, PropValue);
    FList.Insert(Index, OP);
  end
  else
  begin
    OP := TObjectProps(FList[Index]);
    NameIndex := OP.PropList.IndexOf(PropName);
    if NameIndex <> -1 then
    begin
      PropValue := TPropValue(OP.PropList.Objects[NameIndex]);
      PropValue.SetValue(Value, IsValueObject);      
    end
    else
    begin
      PropValue := TPropValue.Create;
      PropValue.SetValue(Value, IsValueObject);      
      OP.PropList.AddObject(PropName, PropValue);
    end;
  end;
end;

procedure TProps.SetProp(AObject: TObject; const PropName: string; const Value: Variant);
begin
  DoSetProp(AObject, PropName, @Value, False);
end;

procedure TProps.SetProp(AObject: TObject; const PropName: string; Value: TObject);
begin
  DoSetProp(AObject, PropName, Value, True);
end;

function TProps.RemoveProp(AObject: TObject; const PropName: string): Boolean;
var
  Index, NameIndex: Integer;
  OP: TObjectProps;
begin
  Result := False;
  if not Find(AObject, Index) then Exit;
  OP := TObjectProps(FList[Index]);
  NameIndex := OP.PropList.IndexOf(PropName);
  if NameIndex <> -1 then
  begin
    OP.PropList.Delete(NameIndex);
    Result := True;
  end;
end;

function TProps.RemoveProps(AObject: TObject): Boolean;
var
  Index: Integer;
  OP: TObjectProps;
begin
  if not Find(AObject, Index) then
  begin
    Result := False;
    Exit;
  end;
  OP := TObjectProps(FList[Index]);
  Result := FList.Remove(OP) <> -1;
end;

Usage:

Props := TProps.Create(Self);
Props.SetProp(Button1, 'myprop1', Self); // TObject property
Props.SetProp(Button1, 'myprop2', 666); // variant
Props.SetProp(Button2, 'myprop', 'Hello'); // variant
Props.SetProp(MyObject, 'foo', 123.123);

Note: TProps.GetProp is not yet implemented.


Solution

  • You are fighting the compiler; You should continue to use overloads.

    "I would rather detect the type from a common type 'container'."

    Your choices are variant or untyped pointer. You are going to have to unpack the "Value" parameter. With an untyped pointer you will have to do all the work; with a variant you will have to do most of the work. Very messy.

    "They do pretty much the same repeating code except from minor variations depending on whether the Value is Variant or TObject."

    If that is really true then you should still continue to use overloads but add an internal "SetProp" method that takes "normalized" data that does the actual work. Your "repeating" code is the setting of the property values. But you still have specific code to write to crack the incoming "Value" parameter whether you have one method that accepts a "container" type or multiple overloaded methods that take the various types you want to accept. In the one-method-container type you will have a (complex) if-then-else block that cracks the Value. In the overloaded-methods type there is no if-testing; you just crack the Value for the type that each method accepts. The major advantage is that your object is better documented: you can see what types are acceptable for "Value" and, better still, the compiler helps you because it "knows" what types are acceptable. With your one-method approach the compiler will not be able to help you enforce the type of "Value"; you are doing all the work.

    Also, using the overloaded methods, I wouldn't have one that accepts variant (although the example below does). Have an separate overload for each of string, integer, double, etc.

    type
       TNormalizedPropValue = record
       // ....
       end;
    
    
    procedure TProps.internalSetProp(Value : TNormalizedPropValue);
    
    begin
    //
    // Set the property value from the "Normalized" pieces and parts.
    //
    end;
    
    procedure TProps.SetProp(Value : TObject);
    
    var  
       NormalizedObjectPropValue : TNormalizedPropValue;
    
    begin
       // Copy the pieces and parts from "Value" into NormalizedObjectPropValue
       //
    
       internalSetProp(NormalizedObjectPropValue);
    end;
    
    procedure TProps.SetProp(Value : variant);
    
    var  
       NormalizedVariantPropValue : TNormalizedPropValue;
    
    begin
       // Crack "Value" variant and copy the pieces and parts into NormalizedVariantPropValue
       //
    
       internalSetProp(NormalizedVariantPropValue);
    end;