delphi - 从选定的最小化窗口捕获屏幕截图

Question

我正在尝试从您的 handle 中捕获确定的最小化窗口的屏幕截图，但这仅捕获所有桌面窗口。我正在尝试像 this example 那样做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 的帮助下，完成代码并更新并工作正常。

捕获样本:

Answer 1

尝试这样的事情:

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;