如何在Delphi中截取Active Window的截图?

时间:2009-03-19 06:42:14

标签: delphi window screenshot

对于完整的屏幕截图,我使用此代码:

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;

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

8 个答案:

答案 0 :(得分:17)

  1. 首先,你必须得到正确的窗口。正如尖锐的指出,你应该使用GetForegroundWindow代替GetDesktopWindow。您已在improved version
  2. 中完成了该操作
  3. 但是你必须将你的位图大小调整为DC / Window的实际大小。你还没有这样做。
  4. 然后确保你没有捕捉到一些全屏窗口!
  5. 当我执行你的代码时,我的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;
    

答案 1 :(得分:16)

您的代码可能更简单。当您决定要保存哪个表单后,请尝试使用的代码:

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;

答案 2 :(得分:7)

这结合了到目前为止所描述的所有方法。它还处理多监视器场景。

传递您想要的截图和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;

答案 3 :(得分:5)

JCL再次拯救......

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

    // use theBitmap...

答案 4 :(得分:3)

这里没有人发布了一个很好的答案。迄今为止的解决方案是建议它采取在目标窗口位置“裁剪”的屏幕截图。如果该窗口位于另一个窗口后面并且当前未由操作系统呈现,该怎么办? 这就是你需要使用Windows XP中引入的this函数的原因。

快速推出Google之后,这里有一些示例代码:http://delphi.about.com/od/delphitips2008/qt/print_window.htm

答案 5 :(得分:1)

感谢您提供这个有用的提交,我想我可能会将代码提供到一个单元中以便在我的应用程序中使用,这是我在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;

答案 6 :(得分:0)

使用GetForegroundWindow()代替GetDesktopWindow()。

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

答案 7 :(得分:-3)

Brian Frost代码的最短版本:

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

代码的一行(MDI应用程序中活动窗口的屏幕截图)。