Delphi 从所选最小化窗口捕获屏幕截图

我正在尝试从您的句柄捕获已确定最小化窗口的屏幕截图，但这只捕获所有桌面窗口。我正在尝试做一个像CodeProject这样的网站，但直到现在都没有成功。那么，我该怎么做才能让它正常工作呢

我到现在为止所做的一切>>

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.DwmApi, System.Win.ComObj,
  Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function WindowSnap(hWindow: HWND; bmp: TBitmap): boolean;
var
  user32DLLHandle: THandle;
  printWindowAPI: function(sourceHandle: HWND; destinationHandle: HDC; nFlags: UINT): BOOL; stdcall;
  R: TRect;
  wp: WINDOWPLACEMENT;
  ai: ANIMATIONINFO;
  restoreAnimation: Boolean;
  ExStyle: LONG_PTR;
begin       
  Result := False;
  ExStyle := 0;
  user32DLLHandle := GetModuleHandle(user32) ;
  if user32DLLHandle <> 0 then
  begin
    @printWindowAPI := GetProcAddress(user32DLLHandle, 'PrintWindow') ;
    if @printWindowAPI <> nil then
    begin
      if not IsWindow(hWindow) then Exit;

      ZeroMemory(@wp, SizeOf(wp));
      wp.length := SizeOf(wp);
      GetWindowPlacement(hWindow, @wp);

      ZeroMemory(@ai, SizeOf(ai));
      restoreAnimation := False;

      if wp.showCmd = SW_SHOWMINIMIZED then
      begin
        ai.cbSize := SizeOf(ai);
        SystemParametersInfo(SPI_GETANIMATION, SizeOf(ai), @ai, 0);

        if ai.iMinAnimate <> 0 then
        begin
          ai.iMinAnimate := 0;
          SystemParametersInfo(SPI_SETANIMATION, SizeOf(ai), @ai, 0);
          restoreAnimation := True;
        end;

        ExStyle := GetWindowLongPtr(hWindow, GWL_EXSTYLE);
        if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
          SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
        end;
        SetLayeredWindowAttributes(hWindow, 0, 1, LWA_ALPHA);

        ShowWindow(hWindow, SW_SHOWNOACTIVATE);
      end;

      GetWindowRect(hWindow, R) ;
      bmp.Width := R.Right - R.Left;
      bmp.Height := R.Bottom - R.Top;
      bmp.Canvas.Lock;

      try
        Result := printWindowAPI(hWindow, bmp.Canvas.Handle, 0);
      finally
        bmp.Canvas.Unlock;

        if (wp.showCmd = SW_SHOWMINIMIZED) then
        begin
          SetWindowPlacement(hWindow, @wp);

          SetLayeredWindowAttributes(hWindow, 0, 255, LWA_ALPHA);
          if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
            SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle);
          end;

          if restoreAnimation then
          begin
            ai.iMinAnimate := 1;
            SystemParametersInfo(SPI_SETANIMATION, SizeOf(ANIMATIONINFO), @ai, 0);
          end;
        end;

        Result := True;
      end;
    end;
  end;
end;

function FindHandleByTitle(WindowTitle: string): Hwnd;
var
  NextHandle: Hwnd;
  NextTitle: array[0..260] of char;
begin
  NextHandle := GetWindow(Application.Handle, GW_HWNDFIRST);
  while NextHandle > 0 do
  begin
    GetWindowText(NextHandle, NextTitle, 255);
    if Pos(WindowTitle, StrPas(NextTitle)) <> 0 then
    begin
      Result := NextHandle;
      Exit;
    end
    else
      NextHandle := GetWindow(NextHandle, GW_HWNDNEXT);
  end;
  Result := 0;
end;

function EnumWindowsProc(wHandle: HWND; lb: TListBox): Bool; stdcall; export;
var
  Title, ClassName: array[0..255] of char;
begin
  Result := True;
  GetWindowText(wHandle, Title, 255);
  GetClassName(wHandle, ClassName, 255);
  if IsWindowVisible(wHandle) then
    lb.Items.Add('Title: '+string(Title) + ' - Class: ' + string(ClassName) + ' - Handle: ' + IntToStr(FindHandleByTitle(Title)));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  EnumWindows(@EnumWindowsProc, Integer(Listbox1));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hWd: HWND;
  Bmp: TBitmap;
begin
  hWd := HWND({$IFDEF WIN64}StrToInt64{$ELSE}StrToInt{$ENDIF}(Edit1.Text));
  Bmp := TBitmap.Create;
  try
    if WindowSnap(hWd, bmp) then
      Image1.Picture.Assign(bmp);
    Image1.Refresh;
    Image1.Picture.SaveToFile('c:\screen.bmp');
  finally
    bmp.Free;
  end;
end;

end.

PS：在friend@Remy Lebeau的帮助下，完成代码并进行了更新，工作正常

捕获样本：

---

试着这样做：

function ScreenShot(hWindow: HWND; bm: TBitmap): Boolean;
var
  R: TRect;
  ScreenDc: HDC;
  lpPal: PLOGPALETTE;
  wp: WINDOWPLACEMENT;
  ai: ANIMATIONINFO;
  hWd: HWND;
  restoreAnimation: Boolean;
  ExStyle: LONG_PTR;
begin
  Result := False;
  if not IsWindow(hWindow) then Exit;

  ZeroMemory(@wp, SizeOf(wp));
  wp.length := SizeOf(wp);
  GetWindowPlacement(hWindow, @wp);

  ZeroMemory(@ai, SizeOf(ai));
  restoreAnimation := False;

  if wp.showCmd = SW_SHOWMINIMIZED then
  begin
    ai.cbSize := SizeOf(ai);
    SystemParametersInfo(SPI_GETANIMATION, SizeOf(ai), @ai, 0);

    if ai.iMinAnimate <> 0 then
    begin
      ai.iMinAnimate := 0;
      SystemParametersInfo(SPI_SETANIMATION, SizeOf(ai), @ai, 0);
      restoreAnimation := True;
    end;

    ExStyle := GetWindowLongPtr(hWindow, GWL_EXSTYLE);
    if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
      SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
    end;
    SetLayeredWindowAttributes(hWindow, 0, 1, LWA_ALPHA);

    ShowWindow(hWindow, SW_SHOWNOACTIVATE);
  end;

  GetWindowRect(hWindow, R);
  bm.Width := R.Right - R.Left;
  bm.Height := R.Bottom - R.Top;

  ScreenDc := GetDC(0);

  if (GetDeviceCaps(ScreenDc, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then
  begin
    GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
    ZeroMemory(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries(ScreenDc, 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, bm.Width, bm.Height, ScreenDc, R.Left, R.Top, SRCCOPY);
  ReleaseDc(0, ScreenDc);

  if (wp.showCmd = SW_SHOWMINIMIZED) then
  begin
    SetWindowPlacement(hWindow, @wp);

    SetLayeredWindowAttributes(hWindow, 0, 255, LWA_ALPHA);
    if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
      SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle);
    end;

    if restoreAnimation then
    begin
      ai.iMinAnimate := 1;
      SystemParametersInfo(SPI_SETANIMATION, SizeOf(ANIMATIONINFO), @ai, 0);
    end;
  end;

  Result := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hWd: HWND; 
  Bmp: TBitmap;
begin
  hWd := HWND({$IFDEF WIN64}StrToInt64{$ELSE}StrToInt{$ENDIF}(Edit1.Text));
  Bmp := TBitmap.Create;
  try
    if ScreenShot(hWd, bmp) then
      Image1.Picture.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

---

试着这样做：

function ScreenShot(hWindow: HWND; bm: TBitmap): Boolean;
var
  R: TRect;
  ScreenDc: HDC;
  lpPal: PLOGPALETTE;
  wp: WINDOWPLACEMENT;
  ai: ANIMATIONINFO;
  hWd: HWND;
  restoreAnimation: Boolean;
  ExStyle: LONG_PTR;
begin
  Result := False;
  if not IsWindow(hWindow) then Exit;

  ZeroMemory(@wp, SizeOf(wp));
  wp.length := SizeOf(wp);
  GetWindowPlacement(hWindow, @wp);

  ZeroMemory(@ai, SizeOf(ai));
  restoreAnimation := False;

  if wp.showCmd = SW_SHOWMINIMIZED then
  begin
    ai.cbSize := SizeOf(ai);
    SystemParametersInfo(SPI_GETANIMATION, SizeOf(ai), @ai, 0);

    if ai.iMinAnimate <> 0 then
    begin
      ai.iMinAnimate := 0;
      SystemParametersInfo(SPI_SETANIMATION, SizeOf(ai), @ai, 0);
      restoreAnimation := True;
    end;

    ExStyle := GetWindowLongPtr(hWindow, GWL_EXSTYLE);
    if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
      SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
    end;
    SetLayeredWindowAttributes(hWindow, 0, 1, LWA_ALPHA);

    ShowWindow(hWindow, SW_SHOWNOACTIVATE);
  end;

  GetWindowRect(hWindow, R);
  bm.Width := R.Right - R.Left;
  bm.Height := R.Bottom - R.Top;

  ScreenDc := GetDC(0);

  if (GetDeviceCaps(ScreenDc, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then
  begin
    GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
    ZeroMemory(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries(ScreenDc, 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, bm.Width, bm.Height, ScreenDc, R.Left, R.Top, SRCCOPY);
  ReleaseDc(0, ScreenDc);

  if (wp.showCmd = SW_SHOWMINIMIZED) then
  begin
    SetWindowPlacement(hWindow, @wp);

    SetLayeredWindowAttributes(hWindow, 0, 255, LWA_ALPHA);
    if (ExStyle and WS_EX_LAYERED) <> WS_EX_LAYERED then begin
      SetWindowLongPtr(hWindow, GWL_EXSTYLE, ExStyle);
    end;

    if restoreAnimation then
    begin
      ai.iMinAnimate := 1;
      SystemParametersInfo(SPI_SETANIMATION, SizeOf(ANIMATIONINFO), @ai, 0);
    end;
  end;

  Result := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hWd: HWND; 
  Bmp: TBitmap;
begin
  hWd := HWND({$IFDEF WIN64}StrToInt64{$ELSE}StrToInt{$ENDIF}(Edit1.Text));
  Bmp := TBitmap.Create;
  try
    if ScreenShot(hWd, bmp) then
      Image1.Picture.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

---

上述代码仅在第一次为每个窗口调用时有效。 如果为同一个窗口句柄调用windowsnap两次，则不会更新位图。

---

尝试使用每秒更改的标签捕获最小化的表单。…

上述代码仅在第一次为每个窗口调用时有效。 如果为同一个窗口句柄调用windowsnap两次，则不会更新位图。

---

---

尝试捕获一个标签每秒都会更改的最小化窗体……

您无法捕获最小化窗口的屏幕，因为没有任何内容可捕获。Windows只绘制窗口的可见部分，最小化的窗口没有可见部分。@Ken随着Vista和Aero的变化而改变thumbs@DavidHeffernan：Vista和Aero拇指改变了这一点-你确定吗？因为我已经为Vista+编写了缩略图预览代码，而且它是捕获最小化窗口预览的PITA，所以除非您临时还原并隐藏它们，以便用户看不到它们，否则它不会工作，而windows会。如果您知道另一种方法，请详细说明。@DavisHeffernan:要为自己的窗口提供预览，应用程序必须处理WM_dwmsendiconthumbail和WM_dwmsendiconticlievepreviewbitmap消息，以提供窗口的位图。他们只需重定向绘制处理程序，将窗口绘制到此类位图上。但是如果你有一个你无法控制的窗口，或者根本无法重定向它的绘制，那么你就没有这个选项。也许你可以手动将DWM消息发送到最小化的窗口，但我从未尝试过。@Remy一个普通的Win32应用程序在最小化时会有一个aero预览，不是吗？你不能捕获最小化窗口的屏幕，因为没有什么可捕获的。Windows只绘制窗口的可见部分，最小化的窗口没有可见部分。@Ken随着Vista和Aero的变化而改变thumbs@DavidHeffernan：Vista和Aero拇指改变了这一点-你确定吗？因为我已经为Vista+编写了缩略图预览代码，而且它是捕获最小化窗口预览的PITA，所以除非您临时还原并隐藏它们，以便用户看不到它们，否则它不会工作，而windows会。如果您知道另一种方法，请详细说明。@DavisHeffernan:要为自己的窗口提供预览，应用程序必须处理WM_dwmsendiconthumbail和WM_dwmsendiconticlievepreviewbitmap消息，以提供窗口的位图。他们只需重定向绘制处理程序，将窗口绘制到此类位图上。但是如果你有一个你无法控制的窗口，或者根本无法重定向它的绘制，那么你就没有这个选项。也许你可以手动将DWM消息发送到最小化的窗口，但我从未尝试过。@Remy一个普通的Win32应用程序在最小化时会有aero预览，没有？我尝试了上面的代码，但没有成功：。在哪里我可以调用我的屏幕截图程序以防万一？到目前为止，Image1组件上没有显示任何内容。非常感谢您的帮助！我在上面的代码中做了一些更改，因为GetLayeredWindowAttributes未声明：。在我的更新之后，仍然继续不通过句柄捕获最小化的窗口：。我更新了上面的问题，请参见！GetLayeredWindowAttributes的实现和使用是错误的。首先，这些参数是输出参数，因此需要将它们声明为指针或变量，并去掉基数类型转换。第二，这段代码的目的是在显示用于捕获的窗口之前始终调用SetLayeredWindowAttributes以使窗口的alpha值为1，但是您将代码更改为仅当LayeredWindowAttributes成功时才调用SetLayeredWindowAttributes和ShowWindow。如果不这样做，您就没有对GetLayeredWindowAttributes执行正确的错误处理。我从示例中删除了GetLayeredWindowAttributes。我不会在我自己的代码中使用它。仍然像以前一样只显示整个桌面屏幕：我尝试了上面的代码，但没有成功：。在哪里我可以调用我的屏幕截图程序以防万一？到目前为止，Image1组件上没有显示任何内容。非常感谢您的帮助！我在上面的代码中做了一些更改，因为GetLayeredWindowAttributes未声明：。在我的更新之后，仍然继续不通过句柄捕获最小化的窗口：。我更新了上面的问题，请参见！GetLayeredWindowAttributes的实现和使用是错误的。首先，参数是输出参数，因此需要将它们声明为指针或v

---

ar和摆脱基数类型转换。第二，这段代码的目的是在显示用于捕获的窗口之前始终调用SetLayeredWindowAttributes以使窗口的alpha值为1，但是您将代码更改为仅当LayeredWindowAttributes成功时才调用SetLayeredWindowAttributes和ShowWindow。如果不这样做，您就没有对GetLayeredWindowAttributes执行正确的错误处理。我从示例中删除了GetLayeredWindowAttributes。我不会在自己的代码中使用它。仍然像以前一样只显示整个桌面屏幕：