Delphi 7 - Screenshot without capturing form - Win

2019-03-02 16:09发布

问题:

Friends,

Need to screenshot of the all desktop WITHOUT MY FORM and load in TImage. Success in Windows XP, 7 - with just ALPHABLEND = TRUE + SCREENSHOT PROCEDURE.

But same code does not work in Windows 8 - capture all screen INCLUDING THE FORM.

I know the problem is related to AERO - DWM.EXE - success using pssuspend.exe (sysinternals) - suspending winlogon.exe and killing dwm.exe

Someone could tell me how to capture all desktop without my form also in Windows 8?

prntscr.com/314rix - SUCESS IN WIN7

prntscr.com/314tj7 - FAILED IN WIN8

prntscr com/31502u - SUSPEND WINLOGON.EXE and KILL DWM.EXE IN WIN8

www sendspace com/file/b5oxhb - SOURCE CODE

// 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.

回答1:

If you want to take a screenshot without your window appearing: hide the window before taking the screenshot:

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;

With the magic happening in:

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;

The screen with the app running:

And the saved screenshot:

Note: Any code released into public domain. No attribution required.