Search code examples
delphitwebbrowserdelphi-10.4-sydney

How to create a Bitmap from the Client area of a Web Browser created at run-time?


In a Delphi 10.4.2 Win32 VCL Application on Windows 10 x64, I need to create a Bitmap of a SPECIFIC SIZE from a web browser's client area. The web browser loads a local SVG. You can get the SVG here: 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.

This creates an image for a very short time visibly on the screen. But the Bitmap remains empty!

How can I make this work? (Possibly without any appearance of the image on the screen).


Solution

  • You have to wait until the WebBrowser has finished to work:

    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;
    

    Calling Application.ProcessMessages is not the optimal way of waiting for the browser to terminate. But this is another story :-)

    To easily view the image, I added a TImage on the form. Of course you do whatever you like with the bitmap.

    If what you need is to make a bitmap out of a SVG, there are Delphi libraries to do that. Google is your friend :-)