unit1.pas

截图代码 利用RPINTFROM 截取被遮挡的窗体的图片

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    ImgTum: TImage;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

//  function PrintWindow(hWnd: HWND; hDCBlt: HWND; nFlags: Word): Bool; stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//  function PrintWindow; external 'user32.dll' name 'PrintWindow';
function PrintWindow(hWnd: HWND; hDCBlt: HWND; nFlags: Word): Bool; stdcall; external 'user32.dll';

procedure TForm1.Button2Click(Sender: TObject);
var
  lHwnd: HWND;
  lhDC, lhBmp, lhMemDC: Integer;
  lRect: TRect;
  lBmp: TBitmap;
begin
  lHwnd:=FindWindow(nil,'Dephix Sample');

  //lHwnd:=FindWindow(nil,'斗地主角色版');
  { 用了一个 ListView 保存当前窗口的句柄 }
  //if lHwnd=0 then ShowMessage('0');
  lhDC := GetWindowDC(lHwnd);
  if lhDC <> 0 then
  begin
    lhMemDC := CreateCompatibleDC(lhDC);
    if lhMemDC <> 0 then
    begin
      GetWindowRect(lHwnd, lRect);
      lhBmp := CreateCompatibleBitmap(lhDC, lRect.Right-lRect.Left, lRect.Bottom-lRect.Top);
      if lhBmp <> 0 then
      begin
        SelectObject(lhMemDC, lhBmp);
        if not PrintWindow(lHwnd, lhMemDC, 0) then
          ShowMessage('不成功！'); { 老是提示不成功 }
        lBmp := TBitmap.Create;
        lBmp.Handle := lhBmp;
        lBmp.PixelFormat:=pf24bit;
        lBmp.SaveToFile('c:\abc.bmp');
        //ImgTum.Picture.Bitmap:=lBmp;
        lBmp.Free;
        DeleteObject(lhBmp);
      end;
      DeleteObject(lhMemDC);
    end;
    ReleaseDC(lHwnd, lhDC);
  end;
end;

end.