如何在 Delphi 中截取活动窗口的屏幕截图？答案

【问题标题】：How to take a screenshot of the Active Window in Delphi?如何在 Delphi 中截取活动窗口的屏幕截图？
【发布时间】：2009-03-19 06:42:14
【问题描述】：

对于完整的屏幕截图，我使用以下代码：

form1.Hide;
sleep(500);
bmp := TBitmap.Create;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
DCDesk := GetWindowDC(GetDesktopWindow);
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DCDesk, 0, 0, SRCCOPY);
form1.Show ;
FileName := 'Screenshot_'+FormatDateTime('mm-dd-yyyy-hhnnss',now());
bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
ReleaseDC(GetDesktopWindow, DCDesk);
bmp.Free;

如何将其转换为仅截取活动窗口的屏幕截图。

【问题讨论】：

您应该在此处，在原始示例下方发布您的改进版本，以便其他人也可以从您的“学习路径”中受益。
请澄清：您是要在同一程序中截取另一个表单的屏幕截图，还是从 Form1 隐藏时可见的任何程序截取屏幕截图？
一旦表单被隐藏，我希望它从活动窗口中获取。

标签： delphi window screenshot

【解决方案1】：

首先您必须获得正确的窗口。正如Sharptooth 已经指出的那样，您应该使用GetForegroundWindow 而不是GetDesktopWindow。你已经在你的improved version 中做对了。
但是您必须将位图的大小调整为 DC/Window 的实际大小。你还没有这样做。
然后确保您没有捕获某些全屏窗口！

当我执行您的代码时，我的 Delphi IDE 被捕获，并且默认情况下它是全屏的，它创建了全屏屏幕截图的错觉。（即使您的代码大部分是正确的）

考虑到上述步骤，我成功地使用您的代码创建了单窗口屏幕截图。

提示：如果您只对客户区感兴趣，您可以GetDC 而不是GetWindowDC。（无窗口边框）

编辑：这是我用你的代码所做的：

您不应该使用此代码！看看下面的改进版本。

procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  hWin: HWND;
  dc: HDC;
  bmp: TBitmap;
  FileName: string;
  r: TRect;
  w: Integer;
  h: Integer;
begin
  form1.Hide;
  sleep(500);
  hWin := GetForegroundWindow;

  if FullWindow then
  begin
    GetWindowRect(hWin,r);
    dc := GetWindowDC(hWin) ;
  end else
  begin
    Windows.GetClientRect(hWin, r);
    dc := GetDC(hWin) ;
  end;

  w := r.Right - r.Left;
  h := r.Bottom - r.Top;

  bmp := TBitmap.Create;
  bmp.Height := h;
  bmp.Width := w;
  BitBlt(bmp.Canvas.Handle, 0, 0, w, h, DC, 0, 0, SRCCOPY);
  form1.Show ;
  FileName := 'Screenshot_'+FormatDateTime('mm-dd-yyyy-hhnnss',now());
  bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
  ReleaseDC(hwin, DC);
  bmp.Free;
end;

编辑 2： 根据要求，我正在添加更好的代码版本，但我保留旧版本作为参考。您应该认真考虑使用它而不是您的原始代码。如果出现错误，它会表现得更好。（资源已清理，您的表单将再次可见，...）

procedure TForm1.Button1Click(Sender: TObject);
const
  FullWindow = True; // Set to false if you only want the client area.
var
  Win: HWND;
  DC: HDC;
  Bmp: TBitmap;
  FileName: string;
  WinRect: TRect;
  Width: Integer;
  Height: Integer;
begin
  Form1.Hide;
  try
    Application.ProcessMessages; // Was Sleep(500);
    Win := GetForegroundWindow;

    if FullWindow then
    begin
      GetWindowRect(Win, WinRect);
      DC := GetWindowDC(Win);
    end else
    begin
      Windows.GetClientRect(Win, WinRect);
      DC := GetDC(Win);
    end;
    try
      Width := WinRect.Right - WinRect.Left;
      Height := WinRect.Bottom - WinRect.Top;

      Bmp := TBitmap.Create;
      try
        Bmp.Height := Height;
        Bmp.Width := Width;
        BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
        FileName := 'Screenshot_' + 
          FormatDateTime('mm-dd-yyyy-hhnnss', Now());
        Bmp.SaveToFile(Format('C:\Screenshots\%s.bmp', [FileName]));
      finally
        Bmp.Free;
      end;
    finally
      ReleaseDC(Win, DC);
    end;
  finally
    Form1.Show;
  end;
end;

【讨论】：

好的，这是我现在的代码：pastebin.com/m43958302 图片是这样的：i43.tinypic.com/xpcvw1.jpg 有什么建议吗？
你必须更加小心 :) 1. 你在 BitBlt 交换高度和宽度。 2. 您正在捕获客户区，但您正在根据全宽调整位图的大小。
博士，你能告诉我你用我的代码做了什么吗？我想如果我看到别人的作品，我会学得更好。
@PuppyKevin：首先向我们展示你付出了一些努力。你的代码已经完成了一半，你只需要按照 DR 告诉你的去做。并将 Sleep() 调用替换为 Application.ProcessMessages() 以让其他表单重绘自己。
您知道哪个手柄或哪种手柄泄漏了吗？也许我遗漏了一些东西，但代码似乎关闭了它创建的所有句柄......

【解决方案2】：

您的代码可能会简单得多。当您决定要保存哪个表单后，请尝试我使用的代码：

procedure SaveFormBitmapToBMPFile( AForm : TCustomForm; AFileName : string = '' );
// Copies this form's bitmap to the specified file
var
  Bitmap: TBitMap;
begin
  Bitmap := AForm.GetFormImage;
  try
    Bitmap.SaveToFile( AFileName );
  finally
    Bitmap.Free;
  end;
end;

【讨论】：

这只适用于属于同一应用程序的表单。但在这种情况下，它比使用 Windows API 要好得多。
非常好，但这只会节省表单的客户区

【解决方案3】：

这结合了迄今为止描述的所有方法。它还可以处理多显示器场景。

传入您想要的屏幕截图类型和 TJpegImage，它会将您请求的屏幕截图分配给该图像。

///////////
uses
  Jpeg;

type  //define an ENUM to describe the possible screenshot types.
  TScreenShotType = (sstActiveWindow, sstActiveClientArea,
    sstPrimaryMonitor, sstDesktop);
///////////

procedure TfrmMain.GetScreenShot(shotType: TScreenShotType;
  var img: TJpegImage);
var
  w,h: integer;
  DC: HDC;
  hWin: Cardinal;
  r: TRect;
  tmpBmp: TBitmap;
begin
  hWin := 0;
  case shotType of
    sstActiveWindow:
      begin
        //only the active window
        hWin := GetForegroundWindow;
        dc := GetWindowDC(hWin);
        GetWindowRect(hWin,r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end;  //sstActiveWindow
    sstActiveClientArea:
      begin
        //only the active client area (active window minus title bars)
        hWin := GetForegroundWindow;
        dc := GetDC(hWin);
        GetWindowRect(hWin,r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end;  //sstActiveClientArea
    sstPrimaryMonitor:
      begin
        //only the primary monitor.  If 1 monitor, same as sstDesktop.
        hWin := GetDesktopWindow;
        dc := GetDC(hWin);
        w := GetDeviceCaps(DC,HORZRES);
        h := GetDeviceCaps(DC,VERTRES);
      end;  //sstPrimaryMonitor
    sstDesktop:
      begin
        //ENTIRE desktop (all monitors)
        dc := GetDC(GetDesktopWindow);
        w := Screen.DesktopWidth;
        h := Screen.DesktopHeight;
      end;  //sstDesktop
    else begin
      Exit;
    end;  //case else
  end;  //case

  //convert to jpg
  tmpBmp := TBitmap.Create;
  try
    tmpBmp.Width := w;
    tmpBmp.Height := h;
    BitBlt(tmpBmp.Canvas.Handle,0,0,tmpBmp.Width,
      tmpBmp.Height,DC,0,0,SRCCOPY);
    img.Assign(tmpBmp);
  finally
    ReleaseDC(hWin,DC);
    FreeAndNil(tmpBmp);
  end;  //try-finally
end;

【讨论】：

【解决方案4】：

JCL 再次来救援..

    hwnd := GetForegroundWindow;
    Windows.GetClientRect(hwnd, r);
    JclGraphics.ScreenShot(theBitmap, 0, 0, r.Right - r.Left, r.Bottom - r.Top, hwnd);

    // use theBitmap...

【讨论】：

【解决方案5】：

这里没有人发布一个好的答案。迄今为止提出的解决方案是在目标窗口的位置进行“裁剪”的屏幕截图。如果那个窗口在另一个窗口后面并且当前没有被操作系统渲染怎么办？这就是为什么你需要使用windows XP中引入的this函数。

在快速谷歌之后，这里有一些示例代码：http://delphi.about.com/od/delphitips2008/qt/print_window.htm

【讨论】：

+1 以获得更可靠的答案（处理更多案例和很好的示例链接）。我实际上一直在寻找类似的东西，并发现这个答案是最好的。

【解决方案6】：

感谢您提交的有用信息，我想我可以将提供的代码整合到一个单元中，以便在我的整个应用程序中使用，这是我在 DX10.2 Tokyo 上运行的代码。请注意示例，注意内存泄漏。

unit ScreenCapture;
interface

uses Windows, Vcl.Controls, Vcl.StdCtrls, VCL.Graphics,VCL.Imaging.JPEG, VCL.Forms;

function getScreenCapture(  FullWindow: Boolean = True ) : TBitmap;

implementation

function getScreenCapture( FullWindow: Boolean ) : TBitmap;
var
  Win: HWND;
  DC: HDC;

  WinRect: TRect;
  Width: Integer;
  Height: Integer;

begin
  Result := TBitmap.Create;

  //Application.ProcessMessages; // Was Sleep(500);
  Win := GetForegroundWindow;

  if FullWindow then
  begin
    GetWindowRect(Win, WinRect);
    DC := GetWindowDC(Win);
  end
    else
  begin
    Windows.GetClientRect(Win, WinRect);
    DC := GetDC(Win);
  end;
  try
    Width := WinRect.Right - WinRect.Left;
    Height := WinRect.Bottom - WinRect.Top;

    Result.Height := Height;
    Result.Width := Width;
    BitBlt(Result.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
  finally
    ReleaseDC(Win, DC);
  end;
end;
end.

例子：

//Any event or button click, screenCapture is a TBitmap
screenCapture := getScreenCapture();
try
  //Do some things with screen capture
  Image1.Picture.Graphic := screenCapture; 
finally 
  screenCapture.Free;
end;

【讨论】：

【解决方案7】：

使用 GetForegroundWindow() 代替 GetDesktopWindow()。

您必须保存 GetForegroundWindow() 返回的句柄并将保存的值传递给 ReleaseDC() - 以确保在活动窗口发生变化时为同一个窗口准确调用 GetWindowDC() 和 ReleaseDC()通话之间。

【讨论】：

好的，现在我有了这个：pastebin.com/m2e334a4a 不过它仍然需要全屏显示。
检查句柄值是什么。如果它为空，则没有活动窗口，您可以有效地转储整个桌面。
我很困惑。手柄值是多少？还有，怎么查？
我希望你有一个变量来分配 GetForegroundWindow() 的结果。您可以添加一个手表来查看该变量的实际值。
这里，这是我的整个过程：pastebin.com/m711bc0c4 不，我没有具有 GetForegroundWindow() 结果的变量

【解决方案8】：

Brian Frost 代码的最短版本：

Screen.ActiveForm.GetFormImage.SaveToFile(Screen.ActiveForm.Caption+'.bmp');

只需一行代码（MDI 应用程序中活动窗口的屏幕截图）。

【讨论】：