Taking screenshot behind the form using magnification

[victorlus]

I am trying to capture screen behind form, photo that was capture is black someone has a solution?

https://i.imgur.com/lBO4I3J.png

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Magnification, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    Initialized: BOOL;
    magWindowRect: TRect;
    hwndMag: HWND;
    HandleToMagnifier: HWND;
    function MyCreateDIBSection(DC: HDC; Width, Height: integer; BitCount: integer): HBITMAP;
    procedure DrawMagnifier(Width, Height: Integer);
    procedure RefreshMagnifier(rc:TRect);
   // procedure ResizeMagnifier;
    procedure InitializeMagnifier;
  public
    { Public declarations }
  end;


const
  MagFactor = 2.0;

var
  Form1: TForm1;


implementation

{$R *.dfm}


function TForm1.MyCreateDIBSection(DC: HDC; Width, Height, BitCount: integer): HBITMAP;
var
  lpbmi: TBitmapInfo;
  P: Pointer;
  AbITmAP : hbitmap;
  db : tbitmap;

begin

  Fillchar(lpbmi,  SizeOf(TBitmapInfo), 0);
  lpbmi.bmiHeader.biSize := sizeof(lpbmi.bmiHeader);
  lpbmi.bmiHeader.biHeight := - Height;
  lpbmi.bmiHeader.biWidth := width;
  lpbmi.bmiHeader.biPlanes := 1;
  lpbmi.bmiHeader.biBitCount := BitCount;
  lpbmi.bmiHeader.biCompression := BI_RGB;

  Result := CreateDIBSection(DC, lpbmi, DIB_RGB_COLORS, P, 0, 0);
end;

procedure TForm1.DrawMagnifier(Width, Height: Integer);
var
  aBitmap: HBITMAP;
  DC: HDC;
  bmp: TBitmap;
begin

  DC := GetWindowDC(HwndMag);
  bmp := TBitmap.Create;
  aBitmap := 0;
  try
    aBitmap := Form1.MyCreateDIBSection(DC, Width, Height, 32);
    SelectObject(DC, aBitmap);
    bmp.Handle := aBitmap;
    bmp.SaveToFile('Screen.bmp');
  finally
    DeleteObject(aBitmap);
    DeleteDC(DC);
    bmp.Free;
  end;
end;

procedure TForm1.RefreshMagnifier(rc: TRect);
begin

  MagSetWindowSource(hwndMag, rc);
  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

  InvalidateRect(hwndMag, rc, true);
end;


procedure TForm1.InitializeMagnifier;
var
  matrix: TMagTransform;
    desktop : hwnd;
  desktoprect, sourceRect: TRect;
  filterList: THWNDArray;
  m_ScreenX, m_ScreenY, m_ScreenT, m_ScreenL: Integer;
begin

   desktop := GetDesktopWindow;
  GetWindowRect(desktop, desktoprect);

  m_ScreenT := desktoprect.Top;
  m_ScreenL := desktoprect.Left;
  m_ScreenX := desktoprect.right;
  m_ScreenY := desktoprect.bottom;

  hwndMag := CreateWindow(WC_MAGNIFIER, 'MagnifierWindow',
    WS_CHILD or MS_SHOWMAGNIFIEDCURSOR, 0, 0, m_ScreenX,
    m_ScreenY, Form1.handle, 0, hInstance, nil);

  if hwndMag = 0 then
    close;

  FillChar(matrix, Sizeof(matrix), 0);
  matrix.v[0][0] := MagFactor;
  matrix.v[1][1] := MagFactor;
  matrix.v[2][2] := 1.0;
  if MagSetWindowTransform(hWndMag, matrix) then
//    tmr1.Enabled := true;
end;



procedure MagScreenShot;
var
  desktop : hwnd;
  desktoprect, sourceRect: TRect;
  filterList: THWNDArray;
  m_ScreenX, m_ScreenY, m_ScreenT, m_ScreenL: Integer;
begin

  Form1.WindowState := wsMaximized;

  desktop := GetDesktopWindow;
  GetWindowRect(desktop, desktoprect);

  Form1.DrawMagnifier(desktoprect.Right, desktoprect.Bottom);
  Form1.RefreshMagnifier(desktoprect);

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  MagScreenShot;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

 Initialized := MagInitialize;
  if not Initialized then
  begin
    Application.MessageBox('Init magnification failed', 'Error',
      mb_Ok + mb_IconError);
    close;
  end;

  InitializeMagnifier;


end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (initialized) then
    MagUninitialize;
end;

end.

[Luckie]

Windows doesen't render invisible parts of the screen due to performance issues. At least older Windows versions didn't render invisible parts of the screen.

[EWeiss]

Den code kenne ich irgendwo her.

gruss

[victorlus]

Zitat von EWeiss:

Den code kenne ich irgendwo her.

gruss

Yes you and the code creator, can you help me?
I'm in trouble, I want to take a photo behind the form.

[EWeiss]

what your want, that?

http://www.delphipraxis.net/1393413-post19.html

greets

[victorlus]

Zitat von EWeiss:

what your want, that?

http://www.delphipraxis.net/1393413-post19.html

greets

So in my case I can not hide the form, I need to make it visible to the client all the time

[EWeiss]

Zitat von victorlus:

Zitat von EWeiss:

what your want, that?

http://www.delphipraxis.net/1393413-post19.html

greets

So in my case I can not hide the form, I need to make it visible to the client all the time

i think that is only available with DirectX.
Magnification is not the way to do it and will not work in conjunction with DWM.

EDIT:
without hide or minimize your form.. see

Zitat:

Windows doesen't render invisible parts of the screen due to performance issues. At least older Windows versions didn't render invisible parts of the screen.

if the form hidden or minimized then a simple BitBlt Call should work on all Window Versions to


greets

[Zacherl]

Zitat von victorlus:

So in my case I can not hide the form, I need to make it visible to the client all the time

Could you please explain what EXACTLY you are trying to achieve? There might be an easy way to work around that problem. The magnification API is a hack .. I remember reading the article you linked in your original post. The author stated that it is not possible to obtain a bitmap from the maginification window and thats why he used the (deprecated) callback to manually save the bitmap.

I guess the magnification API uses DirectX to paint the screenshot, so you might be able to intercept that process by hooking some DirectX interfaces, but thats hacky as well.

[victorlus]

My goal is to be able to capture what's behind the form, which works on win7, win8, win10, if it's very difficult I can pay to do it for myself.

[Rollo62]

Are you looking for hidden changes behind the form ?
I'm afraid Windows won't update the hidden regions at all, for a good reason: Performance.
They only might get updated when these regions get visible.

Rollo