扩展 TWebBrowser 外部对象以执行 Delphi 代码:如何访问我的表单组件?

Extending the TWebBrowser external object to execute Delphi code: how to access my form components?

我正在按照 How to call Delphi code from scripts running in a TWebBrowser DelphiDabbler 教程(由 Peter Johnson 编写)允许 Delphi 收听 TWebBrowser JavaScript 事件。

直到我看到我的 Delphi 过程被调用为止,这一直有效。但是,我需要从那里更新一些表单标签,而且我看不到从这些程序访问我的表单的方法。
DelphiDabbler 示例代码通过 creating THintAction.Create(nil); 很好地规避了 'direct form access' ,它会做到这一点:

This let's us decouple our external object implementation quite nicely from the program's form

但我想访问我的表格!要传递的数据是整数和字符串。
我可以使用 PostMessage() 和 WM_COPYDATA 消息,但它们仍然需要表单句柄。难道没有 'direct' 表单的路径吗?

相关代码:

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;

窗体有个property FContainer: TExternalContainer;,我在FormCreate里做的fContainer := TExternalContainer.Create(WebBrowser);(参数是设计时的TWebBrowser),所以 TExternalContainer.fExternalObj 分配给那个。

问题:

  procedure TWebBrowserExternal.SetDistanceLabel(AValue: Integer);
  begin
     // **From here, how do I send AValue to a label caption on my form?**
  end;

我必须承认接口不是我的强项;-)

[补充:]注意:我的表单都是动态创建的,当前单元没有TForm实例。

你说你想访问你的表单,但你真的不想 - 至少不是直接。您确实希望“将我们的外部对象实现与程序的形式很好地分离”。您真正需要做的就是编写一个函数或过程来在您的程序中执行您想要的操作,然后从您的 Web 浏览器调用该函数或过程。这就是解耦和接口的意义所在。您从不 直接从另一个应用程序处理属于一个应用程序的数据。相反,您使用函数和过程作为您的界面。顺便说一下,这就是为什么接口只包含函数和过程原型(和属性——但它们只是在内部被翻译成函数和过程)——从不包含数据。

现在回答您的具体问题。当然你可以访问你的表单——它是一个全局变量。假设你的主窗体在一个叫做Main.pas的单元中是TMainForm类型的,就会有一个全局变量叫做MainForm

var
  MainForm : TMainForm;

所以在您的网络浏览器单元中,您将在实现部分放置

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;

在我所说的上下文中,SetDistanceLabel 是接口函数,只能从您的 Delphi 应用程序中直接访问表单。

采纳建议 你说你想访问你的表格,但你真的不想 - 至少不是直接从 中的 Dsm,我决定使用 PostMessage/SendMessage(正如我在问题中暗示的那样)。

首先,我在 TWebBrowserExternalTExternalContainer 的构造函数中传递了 window 句柄,并将其存储为私有 属性:

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;

在 FormCreate 中,TExternalContainer 现在创建为

fContainer := TExternalContainer.Create(WebBrowser, Self.Handle);

Set... 方法实现为:

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;

具有辅助功能:

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;

我的表单包含两个实际更新标签的消息处理程序:

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;