How do I pass a Variant or TObject in one method argument?

Question

How do I pass a Variant or TObject in one method argument?

I have two overloading methods:

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

They run much the same repetitive code, except for minor changes depending on whether it is an Value

option or TObject

.

I want to use a generic 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: so far I've 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 overloading 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 if I like this solution because of IsValueObject

. I would rather find a type from the normal "container" type.

I could use TVarRec

:

VarRec: TVarRec;

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

And pass VarRec

to the general method. but I'm not sure if I like it.

EDIT 2: What am I trying to do? I am trying to extend properties for anythingTObject

like the SetProp API.

Here's the whole 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;

Application:

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

not yet implemented.

+3

delphi delphi-7

zig June 10. 17 at 6:26 am

source to share

1 answer

Dave olson · Accepted Answer · 2017-06-10T14:55:26+0000

You are fighting the compiler; You should keep using overloads.

"I'd rather discover a type from a generic container."

Your choice is a variant or an untyped pointer. You will have to unpack the Value parameter. With an untyped pointer, you have to do all the work; with a variant you have to do most of the work. Very dirty.

"They run much the same repetitive code, except for minor changes depending on whether the value is a variant or a TObject."

If this is the case, you should continue to use overloads, but add an internal "SetProp" method that accepts "normalized" data that does the actual work. Your "duplicate" code is setting property values. But you still have custom code to write to hack the incoming Value parameter, whether you have a single method that accepts a container type or multiple overloaded methods that accept different types that you want to accept. In type one-method-container, you will have a (complex) if-then-else block that mangles the value. There is no if-testing in the type of overloaded methods; you are just hacking the value for the type that each method takes. The main advantage is that your object is better documented:you can see what types are acceptable for "value" and, even better, the compiler helps you because it "knows" what types are acceptable. Because of your single-method method, the compiler cannot help you apply the Value type; you do all the work.

Also, using overloaded methods, I wouldn't have a variant that accepts a variant (although the example is below). Have a separate overload for each line, 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;

How do I pass a Variant or TObject in one method argument?

More articles: