如何将 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
传递 Variant
或 TObject
并且能够区分这两种类型。我有什么选择?
编辑: 目前我使用:
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;
我有两种重载方法:
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
传递 Variant
或 TObject
并且能够区分这两种类型。我有什么选择?
编辑: 目前我使用:
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;