Jump to content


  • Content Count

  • Joined

  • Last visited

Community Reputation

0 Neutral
  1. 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
  2. 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.
  3. 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 }