Bet*_*eto 5 delphi focus webbrowser-control twebbrowser
我对 Delphi 和 WebBrowser 组件很着迷。
我创建了一个简单的应用程序，在备忘录中输入 HTML 并在 WebBrowser 组件中显示结果。
但是，当我在 WebBrowser 内部单击时，每个 HTML 代码更新（在备忘录中）都会导致 WebBrowser 组件窃取焦点。
以下是重现问题的分步说明：
在 Memo1.OnChange 事件上插入：
if WebBrowser1.Document = nil then
begin
WebBrowser1.Navigate('about:blank');
while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
end;
ms := TMemoryStream.Create;
try
Memo1.Lines.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
运行应用程序
在备忘录中输入 HTML
<html>
<body>
Hello WebBrowser
</body>
</html>
在 WebBrowser 内容中单击
我怎样才能解决这个问题并防止“窃取焦点”？
Ps.：唯一的解决方法是在单击WebBrowser后按 TAB 键，这可以防止 Webbrowser 通过备忘录在 html 代码中进行新更改后窃取焦点。
用这个变通方法解决了。
将 Memo1.OnChange 代码更改为：
procedure TForm1.Memo1Change(Sender: TObject);
var
ms: TMemoryStream;
begin
LockWindowUpdate(panel1.Handle); // fix: lock webbrowser parent updates
// fix: re-set the webbrowser parent to prevent focus stealing
TControl(WebBrowser1).Parent := nil;
TControl(WebBrowser1).Parent := panel1;
// fix:eof
if WebBrowser1.Document = nil then
begin
WebBrowser1.Navigate('about:blank');
while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
end;
ms := TMemoryStream.Create;
try
Memo1.Lines.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
LockWindowUpdate(0); // fix: unlock webbrowser parent updates to prevent flicking!!
end;
将一个复选框和另一个备忘录 Memo2 添加到表单中，并将其 OnChange 指向 Memo1 的处理程序。然后，如下所示更改您的处理程序。您应该发现，即使在使用 Memo1 引发焦点窃取之后，当您键入 Memo2 时也不会发生这种情况（当然，选中复选框）。
我意识到我使用 Memo2 所做的与您所做的并不完全相同，但它可能更好，因为备忘录不需要包含 HTML 文档的外部结构。根据您所做的事情，这可能是一个优势，也可能是一个劣势。
Fwiw，单击 WB 后调用 ShowCaret(Memo1.Handle) 返回 false - GetLastError/SysErrorMsg 报告 5/访问被拒绝，所以我猜测单击 WB 会以某种方式破坏 Memo1 的插入符 - 我的意思是比您预期的要多来自转移焦点。我仍在调查这一点。
procedure TForm1.Memo1Change(Sender: TObject);
var
ms : TMemoryStream;
begin
if WebBrowser1.Document = nil then
begin
WebBrowser1.Navigate('about:blank');
while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
end;
try
if CheckBox1.Checked then begin
(WebBrowser1.Document as IHtmlDocument2).Body.innerHtml := Memo2.Lines.Text;
end
else begin
ms := TMemoryStream.Create;
try
Memo1.Lines.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
finally
ms.Free;
end;
end;
except
// silence any exceptions raised when using CheckBox1.Checked = True
end;
end;
更新：
如果您更喜欢比我上面的建议更接近原始版本的内容，则以下内容更紧凑并且运行速度似乎更快一些：
procedure TForm1.HandleMemo1ChangeNew(Sender : TObject);
var
Doc : IHtmlDocument2;
V : OleVariant;
begin
if WebBrowser1.Document = nil then
WebBrowser1.Navigate('about:blank');
Doc := WebBrowser1.Document as IHTMLDocument2;
V := VarArrayCreate([0, 0], varVariant);
V[0] := Memo1.Lines.Text;
Doc.Write(PSafeArray(TVarData(v).VArray));
Doc.Close;
end;
procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
WebBrowser1.Enabled := False;
end;