After two introductory posts, here is the actual source code of the custom variant used to implement dynamic method invocation. It is only a rough working prototype. Time permitting, I'd integrate it into the actual class hosting the data (something I did in the past for a different demo). And will try to make the code easier to reuse. Anyway, here is goes. This rather complex code allows you to call method that don't actually exist, as you'll pass the method name as a string parameter to a single processing function. The same could be done for functions and properties. Enjoy.
unit DynamicDslVariant;
interface
uses
TypInfo, Variants, Classes;
function VarDSLDateTimeCreate(const AValue: TDateTime): Variant; overload;
implementation
uses
VarUtils, SysUtils, DateUtils, WIndows, Dialogs;
type
TDslDateTimeVariantType = class (TPublishableVariantType)
protected
function GetInstance(const V: TVarData): TObject; override;
public
procedure Clear(var V: TVarData); override;
procedure CastTo(var Dest: TVarData; const Source: TVarData; const AVarType: TVarType); override;
function DoFunction(var Dest: TVarData; const V: TVarData;
const Name: string; const Arguments: TVarDataArray): Boolean; override;
function DoProcedure(const V: TVarData; const Name: string;
const Arguments: TVarDataArray): Boolean; override;
end;
var
DslDateTimeVariantType: TDslDateTimeVariantType = nil;
type
TDslDateTimeData = class (TPersistent)
private
FDateTime: TDateTime;
public
constructor Create(const AValue: TDateTime); overload;
function AsString: string;
property DateTime: TDateTime read FDateTime write FDateTime;
end;
{ Helper record for variant data }
TDslDateTimeVarData = packed
record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
VDateTime: TDslDateTimeData;
Reserved4: DWord;
end;
{ TDslDateTimeVariantType }
procedure TDslDateTimeVariantType.CastTo(var Dest: TVarData;
const Source: TVarData; const AVarType: TVarType);
var
LTemp: TVarData;
begin
if Source.VType = VarType then
case AVarType of
varString:
VarDataFromStr(Dest, TDslDateTimeVarData (Source).VDateTime.AsString);
else
VarDataInit(LTemp);
try
LTemp.VType := varDate;
LTemp.VDate := TDslDateTimeVarData (Source).VDateTime.DateTime;
VarDataCastTo(Dest, LTemp, AVarType);
finally
VarDataClear(LTemp);
end;
end
else
inherited;
end;
procedure TDslDateTimeVariantType.Clear(var V: TVarData);
begin
V.VType := varEmpty;
FreeAndNil(TDslDateTimeVarData(V).VDateTime);
end;
function TDslDateTimeVariantType.DoFunction(var Dest: TVarData;
const V: TVarData; const Name: string;
const Arguments: TVarDataArray): Boolean;
begin
ShowMessage ('fn calling ' + name);
// Dest :=
Result := True;
end;
function TDslDateTimeVariantType.DoProcedure(const V: TVarData;
const Name: string; const Arguments: TVarDataArray): Boolean;
var
tmp: string;
value, month, day: Integer;
tmpDate: TDateTime;begin
// ShowMessage ('proc calling ' + name);
if Pos ('AM', Name) > 0 then
begin
// parse and process...
tmp := StringReplace (Name, 'AM', '', []);
value := StrToIntDef (tmp, 0);
TDslDateTimeVarData(V).VDateTime.DateTime :=
RecodeTime (TDslDateTimeVarData(V).VDateTime.DateTime, value, 0, 0, 0);
end;
if Pos ('PM', Name) > 0 then
begin
// parse and process...
tmp := StringReplace (Name, 'PM', '', []);
value := StrToIntDef (tmp, 0);
TDslDateTimeVarData(V).VDateTime.DateTime :=
RecodeTime (TDslDateTimeVarData(V).VDateTime.DateTime, value + 12, 0, 0, 0);
end;
if Pos ('NEXT', Name) > 0 then
begin
// parse and process...
tmp := StringReplace (Name, 'NEXT', '', []);
if tmp = 'MONDAY'
then
begin
tmpDate := Now;
value := DayOfWeek(tmpDate);
tmpDate := tmpDate + 7 - value + 2; // monday as 2nd day of the week
TDslDateTimeVarData(V).VDateTime.DateTime :=
DateOf (tmpDate) + TimeOf (TDslDateTimeVarData(V).VDateTime.DateTime);
end;
end;
if Pos ('DEC', Name) > 0 then
begin
month := 12;
// parse and process...
tmp := StringReplace (Name, 'DEC', '', []);
day := StrToIntDef (tmp, 0);
TDslDateTimeVarData(V).VDateTime.DateTime :=
RecodeDate (TDslDateTimeVarData(V).VDateTime.DateTime, YearOf (now), month, day);
end;
Result := True;
end;
function TDslDateTimeVariantType.GetInstance(const V: TVarData): TObject;
begin
Result := TDslDateTimeVarData(V).VDateTime;
end;
{ TDslDateTimeData }
function TDslDateTimeData.AsString: string;
begin
Result := DateTimeToStr (FDateTime);
end;
constructor TDslDateTimeData.Create(const AValue: TDateTime);
begin
FDateTime := AValue;
end;
// variant construction
function VarDSLDateTimeCreate(const AValue: TDateTime): Variant;
begin
VarClear(Result);
TDslDateTimeVarData(Result).VType :=
DslDateTimeVariantType.VarType;
TDslDateTimeVarData(Result).VDateTime :=
TDslDateTimeData.Create(AValue);
end;
initialization
DslDateTimeVariantType :=
TDslDateTimeVariantType.Create;
finalization
FreeAndNil(DslDateTimeVariantType);
end.