Capture screenshot from selected minimized window

2.9k views Asked by At

I'm trying capture screenshot of determined minimized window from your handle, but this only capture all desktop window. I'm trying do like in this example of CodeProject website, but until now without sucess. So, how must I do for this works fine?

The I made until now >>

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: Complete code and updated and working fine, after help from friend @Remy Lebeau.

SAMPLE OF CAPTURE:

screenshot

2

There are 2 answers

8
Remy Lebeau On

Try something like this:

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;
0
user1566931 On

the code above works only the first time it is called for each window. If you call windowsnap twice for the same window handle it won't update the bitmap. Try to capture a minimized form with a label which changes every second ....