如何从 运行 时间创建的 Web 浏览器的客户区创建位图?
How to create a Bitmap from the Client area of a Web Browser created at run-time?
在 Windows 10 x64 上的 Delphi 10.4.2 Win32 VCL 应用程序中,我需要从网络浏览器的客户区创建一个特定大小的位图。 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.
这会在屏幕上创建一个非常短时间的图像。但是位图仍然是空的!
我怎样才能完成这项工作? (可能屏幕上没有任何图像)。
您必须等到 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 是你的朋友:-)
在 Windows 10 x64 上的 Delphi 10.4.2 Win32 VCL 应用程序中,我需要从网络浏览器的客户区创建一个特定大小的位图。 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.
这会在屏幕上创建一个非常短时间的图像。但是位图仍然是空的!
我怎样才能完成这项工作? (可能屏幕上没有任何图像)。
您必须等到 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 是你的朋友:-)