请教：如何实现这种截图？

Question

比如有个控件WebBrowser（此控件可以打开网页），如何对截取此控件里面的图片，或者是另存某图片（不要用下载功能，因为下载后就不是之前那张图片，每次图片都不一样，就想要显示的那一张）。

Answer 1

procedure ScreenShot(hWindow: HWND; bm: TBitmap);
var
  Left, Top, Width, Height: Word;
  R: TRect;
  dc: HDC;
  lpPal: PLOGPALETTE;
begin
  if not IsWindow(hWindow) then Exit;
  GetWindowRect(hWindow, R);
  Left := R.Left;
  Top := R.Top;
  Width := R.Right - R.Left;
  Height := R.Bottom - R.Top;
  bm.Width := Width;
  bm.Height := Height;
  dc := GetDc(0);
  if (dc = 0) then begin
    Exit;
  end;
  if (GetDeviceCaps(dc, RASTERCAPS) and
    RC_PALETTE = RC_PALETTE) then begin
    GetMem(lpPal, SizeOf(TLOGPALETTE) +(255 * SizeOf(TPALETTEENTRY)));
    FillChar(lpPal^,SizeOf(TLOGPALETTE) +(255 * SizeOf(TPALETTEENTRY)),#0);
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then begin
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
  end;
  BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,Left,Top,SRCCOPY);
  ReleaseDc(0, dc);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  b: TBitMap;
begin
  b := TBitmap.Create;      // 创建一个 BITMAP 来存放图象
  ScreenShot(WebBrowser1.Handle, b);
  Image1.Picture.Bitmap := b;
  b.Free;
end;

Answer 2

用procedure ScreenShot(hWindow: HWND; bm: TBitmap);可以截取指定Handle的屏只不过只能截取一屏，可能可以改进

Answer 3

谢谢楼上，正如楼上所说，只能一屏，这种方法不能截取有滚动条的屏幕所包含的所有范围（拖动滚动条后面的不能保存）
不知道楼上大侠了解WebBrowser吗？他的滚动条能不能自动滚动到指定地方？

Answer 4

把网页抓图保存成JPG文件(针对单框架网页)。procedure TForm1.Button1Click(Sender: TObject);
var
  Doc: IHTMLDocument2;
  ViewObject: IViewObject;
  sourceDrawRect: TRect;
  a, getjpg: TBitMap;
  i, m: integer;
  pdest, psour: hbitmap;
  jpg: tjpegimage;
begin
  Doc := WebBrowser.Document as IHTMLDocument2;
  if Webbrowser.Document <> nil then
  try
    webbrowser.Document.QueryInterface(IViewObject, ViewObject);
    if ViewObject <> nil then
    try
      Doc.Get_ParentWindow.Scroll(0, 0); //跳到网页头
      getjpg := TBitMap.Create();
      getjpg.PixelFormat := pf24bit;
      getjpg.Height := doc.Body.getAttribute('scrollHeight', 0);
      getjpg.Width := doc.Body.getAttribute('scrollwidth', 0);
      pdest := getjpg.Canvas.Handle;
      m := Trunc(doc.Body.getAttribute('ScrollHeight', 0) / (doc.Body.getAttribute('offsetHeight', 0) - 20));
      i := Trunc(doc.Body.getAttribute('Scrollwidth', 0) / (doc.Body.getAttribute('offsetwidth', 0) - 20));
      for i := 0 to i do
      begin
        for m := 0 to m + 1 do
        begin
          a := TBitMap.Create();
          a.Height := doc.Body.getAttribute('offsetHeight', 0);
          a.Width := doc.Body.getAttribute('offsetwidth', 0);
          psour := a.Canvas.handle;
          sourceDrawRect := Rect(0, 0, a.Width, a.Height);
          ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle, a.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
          bitblt(pdest, doc.Body.getAttribute('scrollLeft', 0), doc.Body.getAttribute('Scrolltop', 0), a.Width, a.Height, psour, 2, 2, srccopy);
          Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute('scrollLeft', 0), doc.Body.getAttribute('offsetHeight', 0) + doc.Body.getAttribute('Scrolltop', 0) - GetSystemMetrics(SM_CXVSCROLL) - 24);
          a.Free;
        end;
        Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute('offsetwidth', 0) + doc.Body.getAttribute('scrollLeft', 0) - GetSystemMetrics(SM_CXVSCROLL) - 24, 0);
      end;
      jpg := tjpegimage.Create;
      jpg.Assign(getjpg);
      getjpg.Free;
      jpg.SaveToFile('c:\test.jpg');
      jpg.Free;
    finally
      ViewObject._Release;
    end;
  except
  end;
end;http://2ccc.com/article.asp?articleid=1423
看看就知道了，要不就不理什么控件直接控制滚动条的滚动截图就行了，不过某些控件比较难

Answer 5

嗯，http://2ccc.com/article.asp?articleid=1423这个demo很好用，呵呵