2014-11-19 3 views
1

Я пытаюсь захватить снимок экрана определенного свернутого окна из вашего дескриптора, но это только захватит все окна рабочего стола. Я пытаюсь сделать это в 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: Полный код и обновлен и работает нормально, после того, как помощь другу @Remy Лебо.

ОБРАЗЕЦ ЗАХВАТА:

screenshot

+1

Вы не можете захватить экран сведенного минимума окна, потому что нечего делать. Окна только видят видимую часть окна, а свернутое окно не имеет видимых частей. –

+1

@Ken Это изменилось с Vista и Aero thumbs –

+0

Возможный дубликат: http://stackoverflow.com/q/21296989/2298252 –

ответ

4

Попробуйте что-то вроде этого:

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

Я пробовал свой код выше, но без sucess :(Где я могу назвать свою процедуру скриншота в [ЭТО] (http://pastebin.com/wudGGtTy) случае? До сих пор в компоненте Image1 ничего не отображается. –

+0

Я обновил свой код Ответ: –

+0

Большое спасибо за помощь! Я внес некоторые изменения в ваш код выше, потому что 'GetLayeredWindowAttributes' не объявлен :). После моего обновления все еще продолжается, не снимая свернутое окно с помощью дескриптора :(Я обновил свой вопрос выше, см.! –

0

код выше работает только первый раз, когда он вызывается для каждого окна. Если вы дважды вызываете windowsnap для одного и того же дескриптора окна, он не обновляет растровое изображение. Попытайтесь захватить свернутую форму с меткой, которая меняется каждую секунду ....

Смежные вопросы