Search code examples
delphidelphi-xe6twebbrowser

Screenshot of Webbrowser


I have a TwebBrowser on a form, of which I need to take a Screenshot. Some may think Isn't this a dublicate. But it's not, because the solutions in the orter answers doesn't work, thay all just gives med a black screen.

Så I try to get my pixels from DC(0)

First some source code:

Place a TWebBrowser and a TButton on a form, and add the following code to a OnCreate Event:

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;

This gives you a WebControl playing a video. There is a reason for doing it like this, but thats out of scope for this question.

Then The Screenshot stuff:

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;

I've tried a lot of stuff. But I cant get the calculation og the Webbrowser's bounds correct. Så I just posted this code.

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

So in short: Is there an other way of captureing a Screenshot of a TWebBrowser or How to calculate the abosolute boundaries of TWebBrowser

* UPDATE *

Based on the code I got from Dalija Prasnikar I wrote a procedure for captureing a 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;

Solution

  • You have to use WebBrowser.BoundsRect and then convert its TopLeft point to screen coordinates to get correct origin of your WebBrowser control.

    You have used BitBlt parameters incorrectly. Declaration is

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

    X and Y are coordinates in destination HDC, not the source.

    You also need to release captured DC after you are done with it, or you will be leaking Windows resources.

    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;