Add a variable to a class instance at runtime: Difference between revisions

Content added Content deleted
m (Automated syntax highlighting fixup (second round - minor fixes))
(Pascal entry)
Line 1,279: Line 1,279:


To add a variable number of features and attributes, you can use [http://www.mozart-oz.org/documentation/base/class.html Class.new].
To add a variable number of features and attributes, you can use [http://www.mozart-oz.org/documentation/base/class.html Class.new].

=={{header|Pascal}}==
Works with FPC (tested with version 3.2.2).

This could be done by playing around with the custom variants a bit.

Let's put the following code in a separate unit:
<syntaxhighlight lang="pascal">
unit MyObjDef;
{$mode objfpc}{$h+}{$interfaces com}
interface

function MyObjCreate: Variant;

implementation
uses
Variants, Generics.Collections;

var
MyObjType: TInvokeableVariantType;

type
IMyObj = interface
procedure SetVar(const aName: string; const aValue: Variant);
function GetVar(const aName: string): Variant;
end;

TMyObj = class(TInterfacedObject, IMyObj)
strict private
FMap: specialize TDictionary<string, Variant>;
public
constructor Create;
destructor Destroy; override;
procedure SetVar(const aName: string; const aValue: Variant);
function GetVar(const aName: string): Variant;
end;

TMyData = packed record
VType: TVarType;
Dummy1: array[0..5] of Byte;
Dummy2: Pointer;
FObj: IMyObj;
end;

TMyObjType = class(TInvokeableVariantType)
procedure Clear(var V: TVarData); override;
procedure Copy(var aDst: TVarData; const aSrc: TVarData; const Indir: Boolean); override;
function GetProperty(var aDst: TVarData; const aData: TVarData; const aName: string): Boolean; override;
function SetProperty(var V: TVarData; const aName: string; const aData: TVarData): Boolean; override;
end;

function MyObjCreate: Variant;
begin
VarClear(Result);
TMyData(Result).VType := MyObjType.VarType;
TMyData(Result).FObj := TMyObj.Create;
end;

constructor TMyObj.Create;
begin
FMap := specialize TDictionary<string, Variant>.Create;
end;

destructor TMyObj.Destroy;
begin
FMap.Free;
inherited;
end;

procedure TMyObj.SetVar(const aName: string; const aValue: Variant);
begin
FMap.AddOrSetValue(LowerCase(aName), aValue);
end;

function TMyObj.GetVar(const aName: string): Variant;
begin
if not FMap.TryGetValue(LowerCase(aName), Result) then Result := Null;
end;

procedure TMyObjType.Clear(var V: TVarData);
begin
TMyData(V).FObj := nil;
V.VType := varEmpty;
end;

procedure TMyObjType.Copy(var aDst: TVarData; const aSrc: TVarData; const Indir: Boolean);
begin
VarClear(Variant(aDst));
TMyData(aDst) := TMyData(aSrc);
end;

function TMyObjType.GetProperty(var aDst: TVarData; const aData: TVarData; const aName: string): Boolean;
begin
Result := True;
Variant(aDst) := TMyData(aData).FObj.GetVar(aName);
end;

function TMyObjType.SetProperty(var V: TVarData; const aName: string; const aData: TVarData): Boolean;
begin
Result := True;
TMyData(V).FObj.SetVar(aName, Variant(aData));
end;

initialization
MyObjType := TMyObjType.Create;
finalization
MyObjType.Free;
end.
</syntaxhighlight>

And main program:
<syntaxhighlight lang="pascal">
program test;
{$mode objfpc}{$h+}
uses
MyObjDef;

var
MyObj: Variant;

begin
MyObj := MyObjCreate;
MyObj.Answer := 42;
MyObj.Foo := 'Bar';
MyObj.When := TDateTime(34121);
WriteLn(MyObj.Answer);
WriteLn(MyObj.Foo);
//check if variable names are case-insensitive, as it should be in Pascal
WriteLn(MyObj.wHen);
end.
</syntaxhighlight>
{{out}}
<pre>
42
Bar
01.06.1993
</pre>


=={{header|Perl}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Add_a_variable_to_a_class_instance_at_runtime"