如何从运行时创建的 Web 浏览器的客户端区域创建位图？

Posted 2023-05-06

【中文标题】如何从运行时创建的 Web 浏览器的客户端区域创建位图？

【英文标题】：How to create a Bitmap from the Client area of a Web Browser created at run-time?

【发布时间】：2021-06-10 10:59:36

【问题描述】：

在 Windows 10 x64 上的 Delphi 10.4.2 Win32 VCL 应用程序中，我需要从 Web 浏览器的客户区创建一个特定大小的位图。 Web 浏览器加载本地 SVG。你可以在这里获取 SVG：https://svgshare.com/s/Uzf

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw,
  Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    btnDoIt: TButton;
    procedure btnDoItClick(Sender: TObject);
  private
     Private declarations 
  public
     Public declarations 
  end;

var
  Form1: TForm1;

implementation

$R *.dfm

uses
  CodeSiteLogging;

procedure PaintWebBrowserClientAreaToBitmap(AWB: TWebBrowser; AOut: Vcl.Graphics.TBitmap);
var
  DC: Winapi.Windows.HDC;
begin
  if not Assigned(AOut) then
    Exit;
  if not Assigned(AWB) then
    Exit;

  DC := GetWindowDC(AWB.Handle);
  AOut.Width := AWB.Width;
  AOut.Height := AWB.Height;
  with AOut do
    Winapi.Windows.BitBlt(Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, Winapi.Windows.SrcCopy);

  ReleaseDC(AWB.Handle, DC);
end;

procedure TForm1.btnDoItClick(Sender: TObject);
var
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    var wb2: SHDocVw.TWebBrowser;
    wb2 := SHDocVw.TWebBrowser.Create(nil);
    try
      //wb2.Name := 'wb2';
      wb2.SelectedEngine := IEOnly;
      wb2.ClientWidth := 300;
      wb2.ClientHeight := 525;
      wb2.Navigate('file:///C:\DELPHI\_test\BrowserSVGViewer\steamreactor.svg');

      PaintWebBrowserClientAreaToBitmap(wb2, B);

      CodeSite.Send('B', B);
      ShowMessage('test'); // halt here to see the nice image
    finally
      wb2.Free;
    end;
  finally
    B.Free;
  end;
end;

end.

这会在很短的时间内在屏幕上创建一个可见的图像。但是位图仍然是空的！

我怎样才能做到这一点？ （可能没有任何图像出现在屏幕上）。

【参考方案1】：

您必须等到 WebBrowser 完成工作：

procedure TForm1.btnDoItClick(Sender: TObject);
var
    B   : TBitmap;
    wb2 : SHDocVw.TWebBrowser;
begin
    B := TBitmap.Create;
    try
        wb2 := SHDocVw.TWebBrowser.Create(nil);
        try
            wb2.SelectedEngine := IEOnly;
            wb2.ClientWidth    := 300;
            wb2.ClientHeight   := 525;
            wb2.Navigate('file:///E:\TEMP\steamreactor.svg');
            repeat
                Application.ProcessMessages;
            until not wb2.Busy;

            PaintWebBrowserClientAreaToBitmapOld(wb2, B);
            Image1.Picture.Bitmap := B;
        finally
            wb2.Free;
        end;
    finally
        B.Free;
    end;
end;

调用Application.ProcessMessages 并不是等待浏览器终止的最佳方式。但这是另一个故事:-)

为了方便查看图片，我在表单上添加了TImage。当然，您可以随心所欲地使用位图。

如果您需要用 SVG 制作位图，可以使用 Delphi 库来完成。 Google 是你的朋友 :-)

【讨论】：

谢谢，这行得通。这不是“......完成”事件处理程序之一的任务吗？我试过 OnDownloadComplete、OnNavigateComplete2 和 OnDocumentComplete - 但它们都不起作用。

至于将 SVG 转换为位图的库，我尝试过 SVGMagic 和 SVGIconImageList，但两者的渲染质量都与网络浏览器不同，尤其是在处理复杂的 SVG 文档时，例如 SteamReactor .SVG。您知道可以达到与网络浏览器相同质量的库吗？

@user1580348：是的 OnDocumentComplete 是正确的处理程序，但它可能会触发多次（每个 iframe + 主文档一次）

创建的网络浏览器总是在屏幕左上角出现很短的时间。有没有办法隐藏网络浏览器？

@user1580348 你可以把它放在可视区域之外...