Delphi 7 — снимок экрана без формы захвата — Windows 8 — DWM.exe

Друзья,

Нужно сделать скриншот всего рабочего стола БЕЗ МОЕЙ ФОРМЫ и загрузить в TImage. Успех в Windows XP, 7 - только с ALPHABLEEND = TRUE + ПРОЦЕДУРА СКРИНШОТА.

Но тот же код не работает в Windows 8 - захват всего экрана, ВКЛЮЧАЯ ФОРМУ.

Я знаю, что проблема связана с AERO - DWM.EXE - успешное использование pssuspend.exe (sysinternals) - приостановка winlogon.exe и уничтожение dwm.exe

Кто-нибудь может сказать мне, как захватить весь рабочий стол без моей формы также в Windows 8?

prntscr.com/314rix - УСПЕХ В WIN7

prntscr.com/314tj7 - НЕУДАЧА В WIN8

prntscr com/31502u - ПРИОСТАНОВИТЬ WINLOGON.EXE и УБИТЬ DWM.EXE В WIN8

www sendspace com/file/b5oxhb - ИСХОДНЫЙ КОД

// FORM -> ALPHABLEND -> TRUE


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    ScrollBox1: TScrollBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ScreenShot(DestBitmap: TBitmap);
var
  DC: HDC;
begin
  DC:=GetDC(GetDesktopWindow);
  try
    DestBitmap.Width:=GetDeviceCaps(DC, HORZRES);
    DestBitmap.Height:=GetDeviceCaps(DC, VERTRES);
    BitBlt(DestBitmap.Canvas.Handle,0,0,DestBitmap.Width,DestBitmap.Height,DC,0,0,SRCCOPY);
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ScreenShot(Image1.Picture.Bitmap);
end;

end.

screenshot delphi windows-8.1 dwm aero
person Community    schedule 15.03.2014    source источник
comment
Можете ли вы объяснить, какая часть кода исключает вашу форму?   -  person David Heffernan    schedule 16.03.2014
comment
Только при установке AlphaBlend = True форма уже исчезает со скриншота.   -  person    schedule 16.03.2014
comment
Это довольно слабый способ сделать это. Что, если другая форма на экране сделает то же самое? Это также приводит к бессмысленному снижению производительности вашего приложения.   -  person David Heffernan    schedule 16.03.2014

Ответы (1)


arrow_upward
2
arrow_downward

Если вы хотите сделать снимок экрана без появления окна: скройте окно перед тем, как сделать снимок экрана:

procedure TForm1.Button1Click(Sender: TObject);
var
    desktop: TGraphic;
    fDisable: BOOL;
begin
    {
        Capture a screenshot without this window showing
    }
    //Disable DWM transactions so the window hides immediately
    if DwmApi.DwmCompositionEnabled then
    begin
        fDisable := True;
        OleCheck(DwmSetWindowAttribute(Self.Handle, DWMWA_TRANSITIONS_FORCEDISABLED, @fDisable, sizeof(fDisable)));
    end;
    try
        //Hide the window
        Self.Hide;
        try
            //Capture the desktop
            desktop := CaptureDesktop;
        finally
            //Re-show our window
            Self.Show;
        end;
    finally
        //Restore animation transitions
        if DwmApi.DwmCompositionEnabled then
        begin
            fDisable := False;
            DwmSetWindowAttribute(Self.Handle, DWMWA_TRANSITIONS_FORCEDISABLED, @fDisable, sizeof(fDisable));
        end;
    end;

    //Save the screenshot somewhere
    desktop.SaveToFile('d:\temp\ss.bmp');
end;

С волшебством, происходящим в:

function CaptureDesktop: TGraphic;
const
    CAPTUREBLT = $40000000;
    SM_XVIRTUALSCREEN        = 76;
    SM_YVIRTUALSCREEN        = 77;
    SM_CXVIRTUALSCREEN       = 78;
    SM_CYVIRTUALSCREEN       = 79;
var
    nDesktopWidth, nDesktopHeight: Integer;
    tmpBmp: TBitmap;
    hwndDesktop: HWND;
    dcDesktop: HDC;
begin
    Result := nil;

    {
        GetWindowRect(GetDesktopWindow)
        is completely wrong. It will intentionally return only the rectangle of the primary monotor. See MSDN.
    }

    { Cannot handle dpi virtualization
    //Get the rect of the entire desktop; not just the primary monitor
    ZeroMemory(@desktopRect, SizeOf(desktopRect));
    for i := 0 to Screen.MonitorCount-1 do
    begin
        desktopRect.Top := Min(desktopRect.Top, Screen.Monitors[i].Top);
        desktopRect.Bottom := Max(desktopRect.Bottom, Screen.Monitors[i].Top + Screen.Monitors[i].Height);
        desktopRect.Left := Min(desktopRect.Left, Screen.Monitors[i].Left);
        desktopRect.Right := Max(desktopRect.Right, Screen.Monitors[i].Left + Screen.Monitors[i].Width);
    end;

    //Get the size of the entire desktop
    nDesktopWidth := (desktopRect.Right - desktopRect.Left);
    nDesktopHeight := (desktopRect.Bottom - desktopRect.Top);
    }

    //Also doesn't handle dpi virtualization; but is shorter and unioning rects
    nDesktopWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
    nDesktopHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);

    tmpBmp:= TBitmap.Create;
    try
        tmpBmp.Width := nDesktopWidth;
        tmpBmp.Height := nDesktopHeight;

        //dcDesktop := GetDC(0); //
        hwndDesktop := GetDesktopWindow;
        dcDesktop := GetDC(hwndDesktop); //GetWindowDC(0) returns the DC of the primary monitor (not what we want)
        if dcDesktop = 0 then
            Exit;
        try
            if not BitBlt(tmpBmp.Canvas.Handle, 0, 0, nDesktopWidth, nDesktopHeight, dcDesktop, 0, 0, SRCCOPY or CAPTUREBLT) then
                Exit;
        finally
            ReleaseDC(0, dcDesktop);
        end;
    except
        tmpBmp.Free;
        raise;
    end;
//  CaptureScreenShot(GetDesktopWindow, Image, false);

    Result := tmpBmp;
end;

Скрин с запущенным приложением:

введите здесь описание изображения

И сохраненный скриншот:

введите здесь описание изображения

Примечание. Любой код, опубликованный в открытом доступе. Атрибуция не требуется.

person Ian Boyd    schedule 01.08.2014