gpt4 book ai didi

delphi - 检测可编辑 TWebBrowser 中的更改

转载 作者:行者123 更新时间:2023-12-04 09:40:45 32 4
gpt4 key购买 nike

我正在将 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_PASTEWM_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属性(property),但没有任何成功。

最佳答案

要在设计模式中捕获对文档的更改,您应该使用它的 IMarkupContainer2 注册 IHTMLChangeSink 的界面通过 RegisterForDirtyRange 方法。这个过程非常简单——实现 IHTMLChangeSink , 获取 IMarkupContainer2来自 WebBrowser1.Document并调用其RegisterForDirtyRange方法,但有一个问题。

当您更改 designModeIHTMLDocument2 , TWebBrowser控件重新加载当前文档,它会丢失所有已注册的更改接收器。因此,您应该在将文档置于设计模式后进行注册。之后您会通过 IHTMLChangeSink.Notify 收到更改通知方法。

但还有另一个问题。由于进入设计模式会导致重新加载文档,进而导致更改 readyState文档的属性到 'loading'然后连续到'complete' .您的零钱接收器将收到这些 readyState更改通知。请注意 TWebBrowser.OnDocumentComplete 不是 进入设计模式后调用。这就是为什么您应该忽略任何通知,直到文档在设计模式下完全重新加载。

另一个小问题是 RegisterForDirtyRange创建一个您需要维护的 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;

注意:关于 C#/WinForms - How do I detect when the content of a WebBrowser control has changed (in design mode)? 已经提出了类似的问题。

最后一点:我不相信在更改后启用保存按钮是最好的 UX 设计。如果您认为上面的代码值得实现您的目标,请继续。这只是一个概念证明,代码尚未经过彻底测试。需要您自担风险使用它。

关于delphi - 检测可编辑 TWebBrowser 中的更改,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/62344444/

32 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com