如何将 Variant 或 TObject 传递给相同的方法参数?

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

我有两种重载方法:

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

除了 minor 变化之外,它们执行几乎相同的重复代码,具体取决于 Value 是 Variant 还是 TObject

我想用一个常用的方法:

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

所以我可以从 SetProp 传递 VariantTObject 并且能够区分这两种类型。我有什么选择?


编辑: 目前我使用:

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;

和重载方法:

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

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

由于 IsValueObject,我不确定我是否喜欢这个解决方案。我宁愿从普通类型 "container".

中检测类型

我可以使用 TVarRec:

VarRec: TVarRec;

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

并将VarRec传递给通用方法。但我也不确定我是否喜欢它。


编辑 2: 我正在尝试做什么? 我正在尝试扩展任何 TObject 类似于 SetProp API.

的属性

这是整个 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;

用法:

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);

注意:TProps.GetProp尚未实施。

你在和编译器作对;你应该继续使用重载。

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

您的选择是变体或无类型指针。您将不得不解压缩 "Value" 参数。使用无类型指针,您将必须完成所有工作;使用变体,您将必须完成大部分工作。很乱。

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

如果确实如此,那么您仍应继续使用重载,但添加一个内部 "SetProp" 方法,该方法采用 "normalized" 数据来完成实际工作。您的 "repeating" 代码是 属性 值的设置。但是您仍然需要编写特定的代码来破解传入的 "Value" 参数,无论您有一个方法接受 "container" 类型还是多个重载方法接受您想要接受的各种类型。在单方法容器类型中,您将有一个(复杂的)if-then-else 块来破解值。在重载方法类型中没有 if 测试;您只需破解每个方法接受的类型的值。 主要优点是您的对象有更好的文档记录:您可以看到 "Value" 可以接受哪些类型,更好的是,编译器可以帮助您,因为它 "knows" 可以接受哪些类型。使用单一方法,编译器将无法帮助您强制执行 "Value" 的类型;你正在做所有的工作。

此外,使用重载方法,我不会有一个接受变体的方法(尽管下面的示例可以)。对每个字符串、整数、双精度等都有单独的重载。

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;