检测可编辑的TWebBrowser中的变化。

问题描述 投票：2回答：1

我正在将一个HTML本地文件加载到 TWebBrowser 以下是：

procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate('file:///C:\Tmp\input.html');
end;

在 TWebBrowser.OnDocumentComplete 事件处理程序，我让它可以编辑。

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  (WebBrowser1.Document as IHTMLDocument2).designMode := 'on';
end;

我需要在用户进行任何修改时通过 TWebBrowser (即：他写的东西......)但我看不到任何的 OnChanged 或类似的事件处理程序。

我试过捕捉 WM_PASTE 和 WM_KEYDOWN 但我的代码从未被执行。

  TMyWebBrowser = class(TWebBrowser)
  public
    procedure WM_Paste(var Message: TWMPaste); message WM_PASTE;
    procedure WM_KeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  end;

...

procedure TMyWebBrowser.WM_Paste(var Message: TWMPaste);
begin
  inherited;
  ShowMessage('Paste');
end;

procedure TMyWebBrowser.WM_KEYDOWN(var Message: TWMKeyDown);
begin
  inherited;
  ShowMessage('KeyDown');
end;

我也试过将 WindowProc 属性，但没有成功。

delphi delphi-xe7 twebbrowser
1个回答
2
投票

要在设计模式下捕获文档的变化，你应该使用它的 IMarkupContainer2 接口来注册一个 IHTMLChangeSink 通过 RegisterForDirtyRange 方法。这个过程非常简单 - 实现 IHTMLChangeSink，获得 IMarkupContainer2 从 WebBrowser1.Document 并称其 RegisterForDirtyRange 方法，但有个问题。

当你改变 designMode 的 IHTMLDocument2, TWebBrowser 控件会重新加载当前文档，并且会丢失所有注册的变更汇。因此，您应该在将文档置于设计模式后再注册它。之后，您将通过 IHTMLChangeSink.Notify 方法。

但是还有一个问题。因为进入设计模式会导致文档的重新加载，而这反过来又会导致修改 readyState 文件的属性，以 'loading' 然后连续到 'complete'. 你的零钱槽会收到这些 readyState 变更通知。请注意 TWebBrowser.OnDocumentComplete 不是 在进入设计模式后被调用。这就是为什么你应该忽略任何通知，直到文档在设计模式下完全重新加载。

另一个小的复杂情况是 RegisterForDirtyRange 创建一个cookie，你需要维护这个cookie才能解除对变更汇的注册。因为你需要一个类来实现 IHTMLChangeSink 无论如何，它也可以封装设计模式状态和变更注册。

uses
  System.SysUtils, SHDocVw, MSHTML;

const
  DesignMode: array[Boolean] of string = ('off', 'on');

type
  TWebBrowserDesign = class(TInterfacedObject, IHTMLChangeSink)
  private
    FDirtyRangeCookie: LongWord;
    FDocumentComplete: Boolean;
    FHTMLDocument2: IHTMLDocument2;
    FMarkupContainer2: IMarkupContainer2;
    FOnChange: TProc;
    { IHTMLChangeSink }
    function Notify: HResult; stdcall;
  public
    constructor Create(WebBrowser: TWebBrowser; const AOnChange: TProc);
    destructor Destroy; override;
  end;

constructor TWebBrowserDesign.Create(WebBrowser: TWebBrowser; const AOnChange: TProc);
begin
  inherited Create;
  if not Assigned(WebBrowser) then
    raise Exception.Create('Web browser control missing.');
  if not Supports(WebBrowser.Document, IHTMLDocument2, FHTMLDocument2) then
    raise Exception.Create('No HTML document loaded.');
  FHTMLDocument2.designMode := DesignMode[True];
  if Supports(WebBrowser.Document, IMarkupContainer2, FMarkupContainer2) then
  begin
    if FMarkupContainer2.RegisterForDirtyRange(Self, FDirtyRangeCookie) <> S_OK then
      FDirtyRangeCookie := 0
    else
      _Release;
  end;
  FOnChange := AOnChange;
end;

destructor TWebBrowserDesign.Destroy;
begin
  if Assigned(FMarkupContainer2) and (FDirtyRangeCookie <> 0) then
    FMarkupContainer2.UnRegisterForDirtyRange(FDirtyRangeCookie);
  if Assigned(FHTMLDocument2) then
    FHTMLDocument2.designMode := DesignMode[False];
  inherited;
end;

function TWebBrowserDesign.Notify: HResult;
begin
  Result := S_OK;
  if not FDocumentComplete then
    FDocumentComplete := FHTMLDocument2.readyState = 'complete'
  else if Assigned(FOnChange) then
    FOnChange();
end;

请注意对 _Release 注册变更汇后。这是为了 "防止 "标记容器持有对 TWebBrowserDesign 实例。这使您可以使用生命周期的 TWebBrowserDesign 实例，或者你可以将变化汇作为一个组件来实现。

type
  TForm1 = class(TForm)
    { ... }
  private
    FWebBrowserDesign: IInterface;
    { ... }
  end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  { enter design mode }
  FWebBrowserDesign := TWebBrowserDesign.Create(WebBrowser1, procedure
    begin
      ButtonSave.Enabled := True;
    end);
end;

procedure TForm1.ButtonSave(Sender: TObject);
begin
  { exit design mode }
  FWebBrowserDesign := nil;
  ButtonSave.Enabled := False;
end;

或者你可以把变化汇作为一个组件来实现。

type
  TWebBrowserDesign = class(TComponent, IHTMLChangeSink)
  private
    FDirtyRangeCookie: LongWord;
    FDocumentComplete: Boolean;
    FHTMLDocument2: IHTMLDocument2;
    FMarkupContainer2: IMarkupContainer2;
    FOnChange: TNotifyEvent;
    FWebBrowser: TWebBrowser;
    procedure EnterDesignMode;
    procedure ExitDesignMode;
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
    procedure SetWebBrowser(const Value: TWebBrowser);
    { IHTMLChangeSink }
    function Notify: HResult; stdcall;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
  published
    property Active: Boolean read GetActive write SetActive;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property WebBrowser: TWebBrowser read FWebBrowser write SetWebBrowser;
  end;

destructor TWebBrowserDesign.Destroy;
begin
  ExitDesignMode;
  inherited;
end;

procedure TWebBrowserDesign.EnterDesignMode;
begin
  if not Assigned(FWebBrowser) then
    raise Exception.Create('Web browser control missing.');
  if not Supports(FWebBrowser.Document, IHTMLDocument2, FHTMLDocument2) then
    raise Exception.Create('No HTML document loaded.');
  try
    FHTMLDocument2.designMode := DesignMode[True];
    if Supports(FWebBrowser.Document, IMarkupContainer2, FMarkupContainer2) then
    begin
      if FMarkupContainer2.RegisterForDirtyRange(Self, FDirtyRangeCookie) <> S_OK then
        FDirtyRangeCookie := 0;
    end;
  except
    ExitDesignMode;
    raise;
  end;
end;

procedure TWebBrowserDesign.ExitDesignMode;
begin
  if Assigned(FMarkupContainer2) then
  begin
    if FDirtyRangeCookie <> 0 then
    begin
      FMarkupContainer2.UnRegisterForDirtyRange(FDirtyRangeCookie);
      FDirtyRangeCookie := 0;
    end;
    FMarkupContainer2 := nil;
  end;
  if Assigned(FHTMLDocument2) then
  begin
    FHTMLDocument2.designMode := DesignMode[False];
    if not (csDestroying in ComponentState) then
      FHTMLDocument2 := nil; { causes AV when its hosting TWebBrowser component is destroying; I didn't dig into details }
  end;
  FDocumentComplete := False;
end;

function TWebBrowserDesign.GetActive: Boolean;
begin
  Result := Assigned(FHTMLDocument2);
end;

procedure TWebBrowserDesign.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FWebBrowser) then
    WebBrowser := nil;
end;

function TWebBrowserDesign.Notify: HResult;
begin
  Result := S_OK;
  if not FDocumentComplete then
    FDocumentComplete := FHTMLDocument2.readyState = 'complete'
  else if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TWebBrowserDesign.SetActive(const Value: Boolean);
begin
  if Active <> Value then
  begin
    if Value then
      EnterDesignMode
    else
      ExitDesignMode;
  end;
end;

procedure TWebBrowserDesign.SetWebBrowser(const Value: TWebBrowser);
begin
  if Assigned(FWebBrowser) then
  begin
    ExitDesignMode;
    FWebBrowser.RemoveFreeNotification(Self);
  end;
  FWebBrowser := Value;
  if Assigned(FWebBrowser) then
    FWebBrowser.FreeNotification(Self);
end;

如果你把这样的组件放在一个设计时的包中，并在IDE中注册它，那么你将能够把这个组件与 TWebBrowser 并指派 OnChange 在表单设计器中使用事件处理程序。在表单设计器中使用 Active 属性来进入退出设计模式。

type
  TForm1 = class(TForm)
    { ... }
    WebBrowserDesign1: TWebBrowserDesign;
    { ... }
  end;

procedure WebBrowserDesign1Change(Sender: TObject);
begin
  ButtonSave.Enabled := True;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  { enter design mode }
  WebBrowserDesign1.Active := True;
end;

procedure TForm1.ButtonSave(Sender: TObject);
begin
  { exit design mode }
  WebBrowserDesign1.Active := False;
  ButtonSave.Enabled := False;
end;

NB: 类似的问题已经被问到，关于C#WinForms----。如何检测WebBrowser控件的内容何时发生变化（设计模式下）？

最后说明：我不相信在更改后启用保存按钮是最好的用户体验设计。如果你认为上面的代码值得实现你的目标，那么请继续。这只是一个概念证明，代码还没有经过彻底的测试。使用它，风险自担。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.