flashcoder

59 minutes ago, Микола Петрівський said:

If I had to interact with another desktop, I would start separate process there. Probably even separate EXE-file. Then i would send it commands somehow (tethering ?) and get results back.

Then not exist a solution to make screenshot continuously in a new desktop (behind fullscreen Form) on Win 10 with Magnification api + SetThreadDesktop? only because is created a window "Magnification Host".

I also tried create this "Magnification Host" window in a separated thread, and make the screenshots in other thread, but this also not worked

@Sherlock, done.

I have a normal application example (the code is this, but not is a service) that make screenshots of a non secure active desktop created by a 3rd's application.

For example:

https://i.stack.imgur.com/NJoOG.jpg

This 3rd application is a "browser application" that uses CEF to render the websites.

My goal is open a fullscreen form in foreground (covering all screen above) and be able to make screenshot of the content behind of this fullscreen form (the 3rd application).

I searched by some hint about this and found these similar discussions:

• How do I capture desktop screenshot behind full screen form?
• Screenshot using Magnification API: SetThreadDesktop fails when alternates to a new desktop

I also had tested using PrintWindow api (to capture only the 3rd's application), but this results in a black screen (in chromium content) because probably the 3rd's application uses CEF with hardware acceleration resource active.

For example:

https://i.stack.imgur.com/taMdX.png

All works fine in Windows XP, 7 (disabling Aero theme) - with ALPHABLEND = TRUE on fullscreen Form.

• The second discussion found seems more near of solution to my trouble, because this uses a api apparently able to remove a determinated window of screencapture.

I tested this example left by author, works only if call ConfigMag() prodecure after routine that contains SetThreadDesktop api. 

Eg:

if InputDesktopSelected then
      xGetScreenToBmp(idx)
    else if SelectDesktop(nil) then // result of SelectDesktop() is a routine that calls SetThreadDesktop 
    begin
      ConfigMag;
      xGetScreenToBmp(idx);
    end;
except
  on E: Exception do
    Writeln(E.ClassName, ': ', E.Message);
end;
Readln;

Already if i want make screenshots periodically, this will fails like was said by author. Then my trouble still not was solved.

This already was solved! thank you.

My project is a remote administration tool where i have a same Form in client and server. The form on server side is a "mirror" that is useful to i draw two aligned holes in client side, this Form is centralized according client screen resolution. These holes in client side are made: one in a "locker form" in fullscreen (that have a screenshot of desktop in grayscale) and other made on Form that is the same that have on server (like said above, the "mirror"), the owner of this Form is the "locker form".

This explanation above can be better expressed by image attached.

Then my trouble here not is to align these holes (in client and server) and yes align the Forms ("mirror" Form of server side and your clone in client side), like you can see on image above, the "mirror" Form (on server side) is showed more to top of screen while your clone (on client side) is showed more below when both are compared.

Like you also saw on image above, exists a ScrollBox component on server, then in my tests if i adjust scrolling (manually) to down this can align both Forms ("mirror" Form on server and your clone on client). But will be that exists something that can align automatcally using Delphi code?

Code example to better understand this trouble:

SERVER SIDE:

• "Form2" (where is displayed the remote screen in a Image component) =>

unit Unit2;

interface

uses
  Unit3;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

// Button1 can stay on Panel1
procedure TForm2.Button1Click(Sender: TObject);
begin
  Form3 := TForm3.Create(Self);
  Form3.AlphaBlendValue := 127;
  Form3.Show;
end;

.DFM:

object Panel1: TPanel
    Left = -1
    Top = 0
    Width = 773
    Height = 89
    Anchors = [akTop]
    BevelEdges = [beLeft, beRight]
    ParentDoubleBuffered = False
    TabOrder = 0
    end

object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 765
    Height = 472
    HorzScrollBar.Smooth = True
    HorzScrollBar.Tracking = True
    VertScrollBar.Smooth = True
    VertScrollBar.Tracking = True
    Align = alClient
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 1362
      Height = 621
      AutoSize = True
    end

• "Form3" (the "mirror Form" semitransparent to be possible see remote screen behind) =>

unit Unit3;

interface

uses .. .

  type TForm3 = class
  (TForm) procedure FormCreate(Sender: TObject);
private
  { Private declarations }
  procedure CreateParams(var pr: TCreateParams);
  override;
public
  { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses
  Unit1, Unit2;

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
var
  MyString: String;
  Splitted: TArray<String>;
begin
  MyString := Form1.ListView1.Selected.SubItems[6]; // Resolution of remote screen
  Splitted := MyString.Split(['x']);

  Left := (Integer(Splitted[0]) - Width) div 2;
  Top := (Integer(Splitted[1]) - Height) div 2;
end;

procedure TForm3.CreateParams(var pr: TCreateParams);
begin
  inherited;
  pr.WndParent := Form2.Handle;
  pr.ExStyle := pr.ExStyle or WS_EX_TOPMOST or WS_EX_TRANSPARENT;
  pr.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;

.DFM:

object Form3: TForm3
  Left = 328
  Top = 143
  BorderStyle = bsNone
  ClientHeight = 567
  ClientWidth = 526
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13

CLIENT SIDE:

• "Form2" (Form "locker screen") =>

unit Unit2;

interface

uses
 ...

type
  TForm2 = class(TForm)
  Image1: TImage;
  procedure FormShow(Sender: TObject);

  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure GetGrayscaleOf(ASrc, AGray: TBitmap);
var
  x, y: Integer;
  vLineSrc: PRGBTriple;
  vLineGray: PRGBTriple;
  vGrayValue: Byte;
begin

  ASrc.PixelFormat := pf24bit;
  AGray.PixelFormat := pf24bit;

  AGray.Width := ASrc.Width;
  AGray.Height := ASrc.Height;

  for y := 0 to AGray.Height - 1 do
  begin

    vLineSrc := ASrc.ScanLine[y];
    vLineGray := AGray.ScanLine[y];

    for x := 0 to AGray.Width - 1 do
    begin

      vGrayValue := Round(0.3 * vLineSrc^.rgbtRed + 0.59 * vLineSrc^.rgbtGreen +
        0.11 * vLineSrc^.rgbtBlue);

      vLineGray^.rgbtRed := vGrayValue;
      vLineGray^.rgbtGreen := vGrayValue;
      vLineGray^.rgbtBlue := vGrayValue;

      Inc(vLineSrc);
      Inc(vLineGray);
    end;
  end;
end;

procedure ColorGray;
var
  vSrc: TBitmap;
  vGray: TBitmap;
begin
  if Image1.Picture.Graphic = nil then
    Exit;

  vSrc := TBitmap.Create;
  try

    vSrc.PixelFormat := pf24bit;

    vSrc.Width := Image1.Picture.Graphic.Width;
    vSrc.Height := Image1.Picture.Graphic.Height;
    vSrc.Canvas.Draw(0, 0, Image1.Picture.Graphic);

    vGray := TBitmap.Create;
    try
      GetGrayscaleOf(vSrc, vGray);

      Image1.Picture.Graphic := vGray;
    finally
      vGray.Free;
    end;
  finally
    vSrc.Free;
  end;
end;

function CaptureScreen: TBitmap;
var
  dc: HDC;
  BMP: TBitmap;
  cv: TCanvas;
begin
   BMP:= TBitmap.Create;
   BMP.Width:= Screen.Width;
   BMP.Height:= Screen.Height;
   dc:= GetDC(0);
   cv:= TCanvas.Create;
   cv.Handle:= dc;
   BMP.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),
   cv,Rect(0,0,Screen.Width,Screen.Height));
   Result:= BMP;
   cv.Free;
   ReleaseDC(0,dc);
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  Image1.Picture.Assign(CaptureScreen);
  ColorGray;
end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := Application.Handle;
  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST or WS_EX_TRANSPARENT;
  Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;

{

Properties of Form2:

Align => alNone
AlphaBlend => True
BorderStyle => BsNone
WindowState => wsmaximized

---------------------------

Image1:

Align => alNone
AutoSize => True

}

• "Form3" (the same "Form3" of server) =>

unit Unit3;

interface

uses
 ...

type
  TForm3 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure CreateParams(var pr: TCreateParams); override;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses 
  Unit2;

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  Left := (GetSystemMetrics(SM_CXSCREEN) - Width) div 2;
  Top := (GetSystemMetrics(SM_CYSCREEN) - Height) div 2;
end;

procedure TForm3.CreateParams(var pr: TCreateParams);
begin
  inherited;
  pr.WndParent := Form2.Handle;
end;

{

Properties of Form3:

Align => alNone
BorderStyle => BsNone

}