浏览器截图

Question

我在表单上有一个 TwebBrowser，我需要截屏。可能有人会认为这不是重复的吗。但不是，因为orter answers中的解决方案不起作用，所有这些都给了med一个黑屏。

Så 我尝试从 DC(0) 获取像素

首先是一些源代码：

在窗体上放置一个 TWebBrowser 和一个 TButton，并将以下代码添加到 OnCreate 事件中：

procedure TForm1.FormCreate(Sender: TObject);
var
  Doc: Variant;
begin
  Width := 1350;
  Height := 860;
  with WebBrowser1 do
  begin
    Left := 0;
    Top := 0;
    Width := 1330;
    Height := 760;
    Anchors := [akLeft, akTop, akRight, akBottom];
  end;

  with Button1 do
  begin
    Left := 1048;
    Top := 776;
    Width := 58;
    Height := 25;
    Anchors := [akRight, akBottom];
    Caption := 'GetDC';
    OnClick := Button1Click;
  end;


  WebBrowser1.Navigate('about:blank');
  Doc := WebBrowser1.Document;
  Doc.Clear;
  Doc.Write('<embed src="https://r1---sn-cgxqc55oqovgq-55ae.googlevideo.com/videoplayback?sver=3&requiressl=yes&itag=22&ratebypass=yes&pl=19' +
    '&upn=PRgjNIjXqZo&ipbits=0&mm=31&id=o-AFwGYl-Gni-Xv-OpmDFDHPmsirrQ-tP9XPjRwG8B7XFk&initcwndbps=2765000&signature=772D32F7C20412D37B3F23A36D262D58A34BBEF8.9A9463362C4438781A05F634DDD97A590D6EF387'
    + '&ip=77.68.203.5&mv=m&mt=1428297827&ms=au&dur=274.692&key=yt5&mime=video%2Fmp4&source=youtube&sparams=dur%2Cid%2Cinitcwndbps%2Cip%2Cipbits%2Citag%2Cmime%2Cmm%2Cms%2Cmv%2Cpl%2Cratebypass%2Crequiressl'
    + '%2Csource%2Cupn%2Cexpire&expire=1428319485&fexp=900234%2C900720%2C907263%2C917000%2C932627%2C934954%2C9406733%2C9407060%2C9408101%2C946800%2C947243%2C948124%2C948703%2C951703%2C952612%2C957201%2C961404%2C961406%2C966201"  width="1280" height="720">');
  Doc.Close;

end;

这为您提供了一个播放视频的 WebControl。这样做是有原因的，但这超出了这个问题的范围。

然后是截图内容：

procedure TForm1.Button1Click(Sender: TObject);
var
  bitmap: TBitmap;
  BrowserRect: TRect;
  DC: HDC;
  w, h: Integer;
  pt: TPoint;
begin
  bitmap := TBitmap.Create;
  BrowserRect := WebBrowser1.ClientRect;
  DC := GetDC(0);
  bitmap.Height := WebBrowser1.Height;
  bitmap.Width := WebBrowser1.Width;
  BitBlt(bitmap.Canvas.Handle, BrowserRect.Left, BrowserRect.Top, WebBrowser1.Width, WebBrowser1.Height, DC, 0, 0, SrcCopy);
  bitmap.SaveToFile('aa.bmp');
  FreeAndNil(bitmap);
end;

我已经尝试了很多东西。但我无法正确计算 Web 浏览器的边界。 Så 我刚刚发布了这段代码。

Windows : Windows 8.1 64 bit
Delphi : Delphi Xe6
Exe : 64 bit

简而言之：是否有其他方式捕获 TWebBrowser 的屏幕截图要么如何计算 TWebBrowser

的绝对边界

* 更新 *

根据我从 Dalija Prasnikar 那里得到的代码，我编写了一个捕获 WinControl 的程序

procedure PrintControl(AControl: TWinControl; var AOut: TBitmap);
var
  DC: HDC;
  pt: TPoint;
begin
  if not Assigned(AControl) then
    Exit;

  if not Assigned(AOut) then
    Exit;

  DC := GetDC(0);
  pt := AControl.ClientToScreen(AControl.BoundsRect.TopLeft);
  try
    AOut.Height := AControl.Height;
    AOut.Width := AControl.Width;
    BitBlt(AOut.Canvas.Handle, 0, 0, AControl.Width, AControl.Height, DC, pt.X, pt.Y, SRCCOPY);
  finally
    ReleaseDC(0, DC);
  end;
end;

Answer 1

您必须使用 WebBrowser.BoundsRect，然后将其 TopLeft 点转换为屏幕坐标，以获得 WebBrowser 控件的正确原点。

您错误地使用了 BitBlt 参数。声明是

function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC;
  XSrc, YSrc: Integer; Rop: DWORD): BOOL; stdcall;

X 和 Y 是目的地 HDC 中的坐标，而不是源中的坐标。

您还需要在完成后释放捕获的 DC，否则您将泄漏 Windows 资源。

var
  Bitmap: TBitmap;
  BrowserRect: TRect;
  DC: HDC;
  W, h: integer;
  pt: TPoint;
begin
  Bitmap := TBitmap.Create;
  try
    BrowserRect := WebBrowser1.BoundsRect;
    pt := ClientToScreen(BrowserRect.TopLeft);
    DC := GetDC(0);
    try
      Bitmap.Height := WebBrowser1.Height;
      Bitmap.Width := WebBrowser1.Width;
      BitBlt(Bitmap.Canvas.Handle, 0, 0, WebBrowser1.Width, WebBrowser1.Height, DC, pt.X, pt.Y, SRCCOPY);
      Bitmap.SaveToFile('c:\work\aa.bmp');
    finally
      ReleaseDC(0, DC);
    end;
  finally
    FreeAndNil(Bitmap);
  end;
end;

浏览器截图

Screenshot of Webbrowser

delphi

twebbrowser

delphi-xe6