Снимок экрана веб-браузера

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;

Я много чего перепробовал. Но я не могу правильно рассчитать границы веб-браузера. Я только что опубликовал этот код.

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

Итак, вкратце: есть ли другой способ сделать снимок экрана TWebBrowser или Как рассчитать абсолютные границы TWebBrowser

* ОБНОВИТЬ *

На основе кода, который я получил от Далии Прасникара, я написал процедуру для захвата 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;