Question

我在表单上有一个TwebBrowser，我需要截取一个截图。有些人可能会认为这不是一个多功能的。但事实并非如此，因为orter答案中的解决方案不起作用，所有这些都只是给了黑屏。

我试图从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;

我尝试了很多东西。但我无法计算Webbrowser的界限是否正确。我刚刚发布了这段代码。

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;

Webbrowser的屏幕截图

1 个答案: