Further to this post whose accepted answer remains very cryptic:
#Button1.OnClick := pPointer(Cardinal(pPointer( procedure (sender: tObject) begin ((sender as TButton).Owner as TForm).Caption := 'Freedom to anonymous methods!' end )^ ) + $0C)^;
I wonder wether it is possible to devise a simplest and elegant way akin to:
Button.OnClick :=
AnonProc2NotifyEvent (
procedure (Sender: TObject)
begin
((Sender as TButton).Owner as TForm).Caption := 'Freedom to anonymous methods!'
end
);
so as to attain the same purpose and where AnonProc2NotifyEvent is a method of the owner of Button with the following signature:
TOwnerOfButton = class(TForm)
Button: TButton;
...
private
...
protected
function AnonProc2NotifyEvent(aProc: TProc<TObject>): TNotifyEvent;
public
...
end;
Is that feasible and if so how to implement it ?
This will do the job readily enough:
type
TNotifyEventWrapper = class(TComponent)
private
FProc: TProc<TObject>;
public
constructor Create(Owner: TComponent; Proc: TProc<TObject>);
published
procedure Event(Sender: TObject);
end;
constructor TNotifyEventWrapper.Create(Owner: TComponent; Proc: TProc<TObject>);
begin
inherited Create(Owner);
FProc := Proc;
end;
procedure TNotifyEventWrapper.Event(Sender: TObject);
begin
FProc(Sender);
end;
function AnonProc2NotifyEvent(Owner: TComponent; Proc: TProc<TObject>): TNotifyEvent;
begin
Result := TNotifyEventWrapper.Create(Owner, Proc).Event;
end;
The Owner parameter in AnonProc2NotifyEvent is so that the lifetime of the wrapper object can be managed. Without something like that you would leak instances of TNotifyEventWrapper.
Pass as Owner, the component to which you are connecting the event. For example:
Button1.OnClick := AnonProc2NotifyEvent(
Button1,
procedure(Sender: TObject)
begin
(Sender as TButton).Caption := 'Clicked';
end
);
So, when the button is destroyed, the TNotifyEventWrapper will also be destroyed. The wrapper object must live at least as long as the object to whose events it is associated. And so the choice of Button1 as the owner is the natural and obvious one.
For reference this what I am getting at, I studied Barry Kelly's blog post referenced in the prior SO post mentioned above and came up with this solution:
function TMainForm.Proc2NotifyEvent(const aProc: TNotifyReference): TNotifyEvent;
type
TVtable = array[0..3] of Pointer;
PVtable = ^TVtable;
PPVtable = ^PVtable;
begin
TMethod(Result).Code := PPVtable((#aProc)^)^^[3];
TMethod(Result).Data := Pointer((#aProc)^);
end;
Still cryptic but encapsuled, so easing the task of the coder compared to the initial method.
I tried to tidy MethRefToMethPtr and MakeNotify and put it all in one method.
Notice that there was (a slight) change in the method's signature, the argument aProc became const.
Related
I have a set of components, that share some global variables to control common properties, e.g. style features.
These are currently accessed at run-time via a global class, e.g. MyCompsSettings().SomeProperty.
I thought it might be useful to allow users to configure some of these properties at design-time, so I converted the global class to a component, and because these properties need to be shared between MyCompsSettings() and instances of my TMyCompsSettings component(s), I used global vars to store the state, e.g.
type
TMyCompsSettings = class(TComponent)
private
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
var
gBackgroundColor: TColor;
gTitleText: string;
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
Result := gBackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
gBackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
Result := gTitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
gTitleText := v;
end;
However, I overlooked that the IDE will also maintain the var states, so when I:
Add a TMyCompsSettings component to a form
Set MyCompsSettings1.TitleText to 'ABC' in the object inspector
Open a different project
Add a TMyCompsSettings component to a form
-> MyCompsSettings1.TitleText is already 'ABC'!
Obvious of course, but I didn't consider that, and it breaks my whole model.
Is there a correct way to do this? e.g. Fields at design-time, vars at run-time, e.g.
type
TMyCompsSettings = class(TComponent)
private
FAuthoritative: Boolean; // Set to true for first instance, which will be MyCompsSettings()
FBackgroundColor: TColor;
FTitleText: string;
function GetBackgroundColor(): TColor;
procedure SetBackgroundColor(const v: TColor);
function GetTitleText(): string;
procedure SetTitleText(const v: string);
published
property BackgroundColor: TColor read GetBackgroundColor write SetBackgroundColor;
property TitleText: string read GetTitleText write SetTitleText;
end;
implementation
function TIEGlobalSettings.GetBackgroundColor(): TColor;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FBackgroundColor
else
Result := MyCompsSettings().BackgroundColor;
end;
procedure TIEGlobalSettings.SetBackgroundColor(const v: TColor);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FBackgroundColor := v
else
MyCompsSettings().BackgroundColor := v;
end;
function TIEGlobalSettings.GetTitleText(): string;
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
Result := FTitleText
else
Result := MyCompsSettings().TitleText;
end;
procedure TIEGlobalSettings.SetTitleText(const v: string);
begin
if FAuthoritative or ( csDesigning in ComponentState ) then
FTitleText := v
else
MyCompsSettings().TitleText := v;
end;
As the IDE is a process, global variables in the process will remain in the process.
If you want to be able to track the settings between different projects in the IDE (which, if they're in a project group, could both have forms open at the same time) then you will need to find a way of tracking them.
Probably the simplest way is to have the settings held in an object - there can be a global object loaded in an initialization section and freed in a finalization section. Your form based TComponents can check if they are in design mode or not and if they are in design mode then they create a new separate copy of the object, if not they connect to the global instance of the object.
Other components that then access those settings will all use the global object - to ensure that the contents of the object match the design time version you would need to overwrite the global object with any form loaded version. You can do this in the TComponent's Loaded routine.
This code is unchecked, but should give you an outline of how it might work.
implementation
type
TMySettings = class(TPersistent) // so you can .Assign
protected
FOwner: TPersistent;
function GetOwner(): TPersistent; override;
public
constructor Create(AOwner: TPersistent); reintroduce;
property
Owner: TPersistent read GetOwner();
end;
TMySettingsComponent = class(TComponent)
protected
procedure Loaded(); override;
public
destructor Destroy(); override;
procedure AfterConstruction(); override;
end;
implementation
var
gpMySettings: TMySettings;
constructor TMySettings.Create(AOwner: TPersistent);
begin
Self.FOwner:=AOwner;
inherited Create();
end;
function TMySettins.GetOwner(): TPersistent;
begin
Result:=Self.FOwner;
end;
destructor TMySettingsComponent.Destroy;
begin
if(Self.FSettings.Owner = Self) then
FreeAndNIl(Self.FSettings);
inherited;
end;
procedure TMySettingsComponent.AfterConstruction();
begin
// our ComponentState will not yet be set
if( (Self.Owner <> nil) And
(csDesigning in Self.Owner.ComponentState) ) then
Self.FSettings:=TMySettings.Create(Self)
else
Self.FSettings:=gpMySettings;
inherited;
end;
procedure TMySettingsComponent.Loaded;
begin
if( (Self.FMySettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FMySettings);
end;
initialization
gpMySettings:=TMySettings.Create(nil);
finalization
FreeAndNIl(gpMySettings);
You would also want to ensure that in your TMySettingsComponent you update the global object when the user is changing the properties. This could be as simple as:
procedure TMyComponentSettings.SetBackgroundColour(FNewValue: TColor);
begin
if(Self.FSettings.FBkColour<>FNewValue) then
begin
Self.FSettings.FBkColour:=FNewValue;
if( (Self.FSettings.Owner=Self) And
(gpMySettings<>nil) ) then
gpMySettings.Assign(Self.FSettings);
// -- or use gpMySettings.FBkColour:=FNewValue;
end;
end;
I'm following the How to call Delphi code from scripts running in a TWebBrowser DelphiDabbler tutorial (by Peter Johnson) to allow Delphi to listen to TWebBrowser JavaScript events.
This works up to the point where I see my Delphi procedures getting called. However, from in there I need to update some form labels, and I see no way to access my form from those procedures.
The DelphiDabbler example code nicely circumvents 'direct form access' by creating THintAction.Create(nil); which will do it's thing:
This let's us decouple our external object implementation quite nicely from the program's form
But I want to access my form! Data to be passed are integers and strings.
I could use PostMessage() and WM_COPYDATA messages, but these would still need the form handle. And isn't there a 'direct' route to the form?
Relevant code:
type
TWebBrowserExternal = class(TAutoIntfObject, IWebBrowserExternal, IDispatch)
protected
procedure SetVanLabel(const ACaption: WideString); safecall; // My 3 procedures that are called...
procedure SetNaarLabel(const AValue: WideString); safecall; // ... declared in the type library.
procedure SetDistanceLabel(AValue: Integer); safecall;
public
constructor Create;
destructor Destroy; override;
end;
type
TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite)
private
fExternalObj: IDispatch; // external object implementation
protected
{ Re-implemented IDocHostUIHandler method }
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
public
constructor Create(const HostedBrowser: TWebBrowser);
end;
constructor TExternalContainer.Create(const HostedBrowser: TWebBrowser);
begin
inherited Create(HostedBrowser);
fExternalObj := TWebBrowserExternal.Create;
end;
The form has a property FContainer: TExternalContainer;, in the FormCreate I do fContainer := TExternalContainer.Create(WebBrowser); (parameter is the design time TWebBrowser), so the
TExternalContainer.fExternalObj is assigned to that.
Question:
procedure TWebBrowserExternal.SetDistanceLabel(AValue: Integer);
begin
// **From here, how do I send AValue to a label caption on my form?**
end;
I must confess that interfaces are not my forte ;-)
[Added:] Note: My forms are all created dynamically, there is no TForm instance in the current unit.
You say you want to access your form, but you really don't - at least not directly. You do want to 'decouple our external object implementation quite nicely from the program's form'. All you need to do really is write a function or procedure to do what you want inside your program, and then call that function or procedure from your web browser. This is what decoupling and interfaces are all about. You never handle data belonging to one application directly from another. Instead you use functions and procedures as your interface. Incidentally that is why interfaces only contain functions and procedure prototypes (and properties - but they are just translated internally as functions and procedures) - never data.
Now down to your specific question. Of course you can access your form - it is a global variable. Suppose your main form is of type TMainForm in a unit called Main.pas, there will be a global variable called MainForm
var
MainForm : TMainForm;
so in your webbrowser unit, in the implementation section you would put
implementation
uses Main;
...
procedure TWebBrowserExternal.SetDistanceLabel(AValue: Integer);
begin
// **From here, how do I send AValue to a label caption on my form?**
FormMain.MyLabel.Caption := StrToInt( AValue );
end;
In the context of what I said, SetDistanceLabel is the interface function, and the Form is only directly accessed from within your Delphi application.
Taking the advice You say you want to access your form, but you really don't - at least not directly from Dsm in his/her answer, I have decided to use PostMessage/SendMessage (as I hinted at in my question).
First I pass the window handle in the constructors of TWebBrowserExternal and TExternalContainer and store it as a private property:
type
TWebBrowserExternal = class(TAutoIntfObject, IWebBrowserExternal, IDispatch)
private
fHandle: HWND;
procedure SendLocationUpdate(AWhere: Integer; ALocation: String); // Helper for SetVanLabel/SetNaarLabel
protected
procedure SetVanLabel(const AValue: WideString); safecall;
procedure SetNaarLabel(const AValue: WideString); safecall;
procedure SetDistanceLabel(AValue: Integer); safecall;
public
constructor Create(AHandle: HWND);
destructor Destroy; override;
end;
type
TExternalContainer = class(TNulWBContainer, IDocHostUIHandler, IOleClientSite)
private
fExternalObj: IDispatch; // external object implementation
protected
{ Re-implemented IDocHostUIHandler method }
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
public
constructor Create(const HostedBrowser: TWebBrowser; AHandle: HWND);
end;
In the FormCreate the TExternalContainer is now created as
fContainer := TExternalContainer.Create(WebBrowser, Self.Handle);
The Set... methods are implemented as:
procedure TWebBrowserExternal.SetDistanceLabel(AValue: Integer);
begin
PostMessage(fHandle,UM_UPDATEDIST,AValue,0); // const UM_UPDATEDIST = WM_USER + 101;
end;
procedure TWebBrowserExternal.SetNaarLabel(const AValue: WideString);
begin
SendLocationUpdate(1,AValue);
end;
procedure TWebBrowserExternal.SetVanLabel(const AValue: WideString);
begin
SendLocationUpdate(0,AValue);
end;
with helper function:
procedure TWebBrowserExternal.SendLocationUpdate(AWhere: Integer; ALocation: String);
var lCopyDataStruct: TCopyDataStruct;
begin
lCopyDataStruct.dwData := AWhere;
lCopyDataStruct.cbData := 2 * 2 * Length(ALocation);
lCopyDataStruct.lpData := PChar(ALocation);
SendMessage(fHandle, WM_COPYDATA, wParam(fHandle), lParam(#lCopyDataStruct));
end;
My form contains two message handlers that actually update the labels:
procedure UpdateDistMsgHandler(var Msg: TMessage); message UM_UPDATEDIST;
procedure WMCopyData(var Msg : TWMCopyData) ; message WM_COPYDATA;
procedure TFrmGoogleMapsLiveUpdate.UpdateDistMsgHandler(var Msg: TMessage);
begin
LabelDistance.Caption := IntToStr(Msg.WParam);
end;
procedure TFrmGoogleMapsLiveUpdate.WMCopyData(var Msg: TWMCopyData);
var
lWhere : integer;
lLocation : string;
begin
lWhere := Msg.CopyDataStruct.dwData;
lLocation := String(PChar(Msg.CopyDataStruct.lpData));
if lWhere = 0 then
LabelVan.Caption := lLocation
else
LabelNaar.Caption := lLocation;
end;
I have to connect several measurement devices to my app (ie. caliper, weight scale, ...), not being tied to a specific brand nor model, so on client side I use interfaces with generic methods (QueryValue). Devices are connected on COM port and accessed on an asynchronous way:
Ask for a value (= send a specific character sequence on
COM port)
Wait for a response
On 'business' side my components use TComPort internally, which data reception event is TComPort.OnRxChar. I wonder how I could fire this event through an interface? Here is what I've done so far:
IDevice = interface
procedure QueryValue;
function GetValue: Double;
end;
TDevice = class(TInterfacedObject, IDevice)
private
FComPort: TComPort;
FValue: Double;
protected
procedure ComPortRxChar;
public
constructor Create;
procedure QueryValue;
function GetValue: Double;
end;
constructor TDevice.Create;
begin
FComPort := TComPort.Create;
FComPort.OnRxChar := ComPortRxChar;
end;
// COM port receiving data
procedure TDevice.ComPortRxChar;
begin
FValue := ...
end;
procedure TDevice.GetValue;
begin
Result := FValue;
end;
But I need an event to know when to call GetValue on client side. What's the usual way to perform that kind of data flow?
You can add event property to interface
IDevice = interface
function GetValue: Double;
procedure SetMyEvent(const Value: TNotifyEvent);
function GetMyEvent: TNotifyEvent;
property MyEvent: TNotifyEvent read GetMyEvent write SetMyEvent;
end;
and realize it in TDevice class
TDevice = class(TInterfacedObject, IDevice)
private
FMyEvent: TNotifyEvent;
procedure SetMyEvent(const Value: TNotifyEvent);
function GetMyEvent: TNotifyEvent;
public
function GetValue: Double;
procedure EmulChar;
end;
Then as usually call FMyEvent handler (if assigned) in the end of ComPortRxChar.
Tform1...
procedure EventHandler(Sender: TObject);
procedure TForm1.EventHandler(Sender: TObject);
var
d: Integer;
i: IDevice;
begin
i := TDevice(Sender) as IDevice;
d := Round(i.GetValue);
ShowMessage(Format('The answer is %d...', [d]));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
id: IDevice;
begin
id:= TDevice.Create;
id.MyEvent := EventHandler;
(id as TDevice).EmulChar; //emulate rxchar arrival
end;
procedure TDevice.EmulChar;
begin
if Assigned(FMyEvent) then
FMyEvent(Self);
end;
function TDevice.GetMyEvent: TNotifyEvent;
begin
Result := FMyEvent;
end;
function TDevice.GetValue: Double;
begin
Result := 42;
end;
procedure TDevice.SetMyEvent(const Value: TNotifyEvent);
begin
FMyEvent := Value;
end;
I am trying to call methods by name in a firemonkey project. But so far no luck.
Below is my code:
type
TExecute = procedure of object;
TUpdates= class(TDataModule)
procedure UpdateToVersion(Version: Integer);
private
procedure UpdateToVersion1;
procedure UpdateToVersion2;
procedure UpdateToVersion3;
procedure Call(Name: string);
public
end;
procedure TUpdates.Call(Name: String);
var
m:TMethod;
Exe:TExecute;
begin
m.Data := pointer(Self);
m.Code := Self.MethodAddress(Name);
Exe := TExecute(m);
Exe;
end;
procedure TUpdates.UpdateToVersion(Version: Integer);
begin
Call('UpdateToVersion'+version.ToString);
end;
procedure TUpdates.UpdateToVersion1;
begin
//code
end;
procedure TUpdates.UpdateToVersion2;
begin
//code
end;
procedure TUpdates.UpdateToVersion3;
begin
//code
end;
Results:
When I call for example UpdateToVersion(1) I get an access violation and procedure UpdateToVersion1 doesn't get called.
I got this code from an example from the link below:
http://www.swissdelphicenter.ch/torry/showcode.php?id=799
MethodAddress requires that the method is published, as is the method in the example code. Your methods are private. Hence MethodAddress fails and returns nil.
Solve the problem by publishing the methods.
If you wish to perform this sort of task with non-published methods then you will need to use enhanced RTTI.
In my library i'm invoking methods under specific conditions, which requires stdcall calling convention. Currently i'm using compiler static resolution, implemented as rather large list of well-known method signatures and corresponding overloaded versions of my subroutine. This works but looks quite fugly and doesnt 100% cover all possible methods. I would like to add a possibility to work with generic method pointer and assert proper calling convention by asking RTTI. And here i'm stuck, please advise.
Input: code/data pair of pointers as in TMethod
Output: boolean indicator, true if method is stdcall
I'd preferable use "classic" RTTI to create less version dependencies, however i cant find any calling convention indicator within "classic" RTTI...
NB: This question is UNRELATED to importing external functions
You can extract calling convention information from extended RTTI (available since Delphi 2010).
uses RTTI, TypInfo;
function GetMethCallConv(AMeth: TMethod; out Conv: TCallConv): Boolean;
var
Ctx: TRttiContext;
Meth: TRttiMethod;
Typ: TRttiType;
begin
Ctx:= TRttiContext.Create;
try
Typ:= Ctx.GetType(TObject(AMeth.Data).ClassType);
for Meth in Typ.GetMethods do begin
if Meth.CodeAddress = AMeth.Code then begin
Conv:= Meth.CallingConvention;
Exit(True);
end;
end;
Exit(False);
finally
Ctx.Free;
end;
end;
//test
type
TMyObj = class
public
procedure MyMeth(I: Integer); stdcall;
end;
procedure TMyObj.MyMeth(I: Integer);
begin
ShowMessage(IntToStr(I));
end;
procedure TForm2.Button2Click(Sender: TObject);
var
Conv: TCallConv;
Meth: TMethod;
MyObj: TMyObj;
begin
MyObj:= TMyObj.Create;
Meth.Code:= #TMyObj.MyMeth;
Meth.Data:= MyObj;
if GetMethCallConv(Meth, Conv) then begin
case Conv of
ccReg: ShowMessage('Register');
ccCdecl: ShowMessage('cdecl');
ccPascal: ShowMessage('Pascal');
ccStdCall: ShowMessage('StdCall');
ccSafeCall: ShowMessage('SafeCall');
end;
end;
MyObj.Free;
end;
Update
For "classic" RTTI read Sertac answer; the following works OK on Delphi 2010:
uses ObjAuto;
function GetMethCallConv2(AMeth: TMethod; out Conv: TCallingConvention): Boolean;
var
Methods: TMethodInfoArray;
I: Integer;
P: PMethodInfoHeader;
begin
Result:= False;
Methods:= GetMethods(TObject(AMeth.Data).ClassType);
if not Assigned(Methods) then Exit;
for I:= Low(Methods) to High(Methods) do begin
P:= Methods[I];
if P^.Addr = AMeth.Code then begin
Inc(Integer(P), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
Length(PMethodInfoHeader(P)^.Name));
Conv:= PReturnInfo(P).CallingConvention;
Result:= True;
Exit;
end;
end;
end;
{$TYPEINFO ON}
{$METHODINFO ON}
type
TMyObj = class
public
procedure MyMeth(I: Integer);
end;
procedure TMyObj.MyMeth(I: Integer);
begin
ShowMessage(IntToStr(I));
end;
procedure TForm2.Button3Click(Sender: TObject);
var
Conv: TCallingConvention;
Meth: TMethod;
MyObj: TMyObj;
begin
MyObj:= TMyObj.Create;
Meth.Code:= #TMyObj.MyMeth;
Meth.Data:= MyObj;
if GetMethCallConv2(Meth, Conv) then begin
case Conv of
ccRegister: ShowMessage('Register');
ccCdecl: ShowMessage('cdecl');
ccPascal: ShowMessage('Pascal');
ccStdCall: ShowMessage('StdCall');
ccSafeCall: ShowMessage('SafeCall');
end;
end;
MyObj.Free;
end;
Including Delphi 7 and up, when METHODINFO directive is on, run-time generates information about, at least having public visibility, method parameters and return types and calling convention (TYPEINFO should also be on).
Not sure if the below sample would help you directly since it works on an instance and method's name and not its address, but perhaps you can construct a look-up table for name-address of methods beforehand.
type
{$METHODINFO ON}
TSomeClass = class
public
procedure Proc1(i: Integer; d: Double); stdcall;
procedure Proc2;
end;
{$METHODINFO OFF}
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
FSomeClass: TSomeClass;
..
uses
objauto;
procedure TForm1.FormCreate(Sender: TObject);
begin
FSomeClass := TSomeClass.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Info: Pointer;
begin
Info := GetMethodInfo(FSomeClass, 'Proc1');
if Assigned(Info) then begin
Inc(Integer(Info), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
Length(PMethodInfoHeader(Info).Name));
if PReturnInfo(Info).CallingConvention = ccStdCall then
// ...
end;
Beware and do some testing though, tested on D2007 the working is somewhat unpredictable. For instance, if the above 'Proc1' is changed to procedure Proc1(i: Pointer; d: Double); no detailed RTTI is generated.
See here on how to find out:
http://rvelthuis.de/articles/articles-convert.html#cconvs
IOW, you can simply try if it works, or you take a look at the exported name (_name#17 or similar) or you take a look at a disassembly, e.g. in the CPU view.