Wie man das Handle von einem Screenshot entfernt

[victorlus]

Zitat von hoika:

Hello,
you need DelphiCode to get the screenshot or just want the screenshot?

If you only want to take a screenshot, move the form out of the screen und use a snipping tool to get the screenshot.
Windows has a build in snipping tool.

I do not understand the "shows it again".

I can not move the form, or hide it needs to stay, visible to the client I'm going to capture the screen that is behind him

Example:

prntscr.com/314rix - SUCESS IN WIN7

prntscr.com/314tj7 - FAILED IN WIN8

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

[Neutral General]

Okay maybe you should show us the code you are using (which seems to work on Win7 but noch on Win8).

[victorlus]

Zitat von Neutral General:

Okay maybe you should show us the code you are using (which seems to work on Win7 but noch on Win8).

Put the form in ALPHABLEND = TRUE;

Delphi-Quellcode:

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.

[Delphi.Narium]

You can get a Hardcopy using Method GetFormImage from TForm.

http://docwiki.embarcadero.com/CodeE...mImage_(Delphi)

Zitat von GetFormImage:

Description

This example uses an image, a button, and a shape component on a form. When you click the button, an image of the form is stored in the FormImage variable and copied to the Clipboard. The image of the form is then copied back to the image component, producing an interesting result, especially if the button is clicked multiple times. Add ExtCtrls, StdCtrls, and Clipbrd to the uses clause.

Delphi-Quellcode:

procedure HardCopy(sJpegFile : String; fm : TForm);
Var
          FStream   : TStream;
          FBmp      : TPicture;
          FJpeg     : TJpegImage;
begin
  if SysUtils.FileExists(sJpegFile) then SysUtils.DeleteFile(sJpegFile);
  FStream := TFileStream.Create(sJpegFile,fmCreate);
  fm.WindowState := wsNormal;
  fm.Show;
  fm.Refresh;
  FJpeg := TJpegImage.Create;
  FBmp  := TPicture.Create;
  try
    FBmp.Bitmap.Assign(fm.GetFormImage); // <- get a Hardcopy from TForm
    FJpeg.Assign(FBmp.Bitmap);
    FJpeg.SaveToStream(FStream);
  finally
    FStream.Free;
    FJpeg.Free;
    FBmp.Free;
  end;
end;

Not tested:

Delphi-Quellcode:

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; fm : TForm);
begin
  DestBitmap.Assign(fm.GetFormImage); // <- get a Hardcopy from TForm
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ScreenShot(Image1.Picture.Bitmap; Form1); // <-- or any other TForm
end;

end.

[victorlus]

Zitat von Delphi.Narium:

You can get a Hardcopy using Method GetFormImage from TForm.

http://docwiki.embarcadero.com/CodeE...mImage_(Delphi)

Zitat von GetFormImage:

Description

This example uses an image, a button, and a shape component on a form. When you click the button, an image of the form is stored in the FormImage variable and copied to the Clipboard. The image of the form is then copied back to the image component, producing an interesting result, especially if the button is clicked multiple times. Add ExtCtrls, StdCtrls, and Clipbrd to the uses clause.

Delphi-Quellcode:

procedure HardCopy(sJpegFile : String; fm : TForm);
Var
          FStream   : TStream;
          FBmp      : TPicture;
          FJpeg     : TJpegImage;
begin
  if SysUtils.FileExists(sJpegFile) then SysUtils.DeleteFile(sJpegFile);
  FStream := TFileStream.Create(sJpegFile,fmCreate);
  fm.WindowState := wsNormal;
  fm.Show;
  fm.Refresh;
  FJpeg := TJpegImage.Create;
  FBmp  := TPicture.Create;
  try
    FBmp.Bitmap.Assign(fm.GetFormImage); // <- get a Hardcopy from TForm
    FJpeg.Assign(FBmp.Bitmap);
    FJpeg.SaveToStream(FStream);
  finally
    FStream.Free;
    FJpeg.Free;
    FBmp.Free;
  end;
end;

Not tested:

Delphi-Quellcode:

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; fm : TFrom);
begin
  DestBitmap.Assign(fm.GetFormImage); // <- get a Hardcopy from TForm
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ScreenShot(Image1.Picture.Bitmap; Form1); // <-- or any other TForm
end;

end.

Do not work I need to take photo behind the form

Thank you for trying to help me.

[Uwe Raabe]

As it seems to turn out hard to make it work under the different Windows versions, can you explain what you are trying to achieve in the end? What do you need this screenshot of the area behind the form for?

[victorlus]

Zitat von Uwe Raabe:

As it seems to turn out hard to make it work under the different Windows versions, can you explain what you are trying to achieve in the end? What do you need this screenshot of the area behind the form for?

Yes, I need exactly this More really is very complicated

[Delphi.Narium]

Please remove fm.Show; from procedure HardCopy Does it work?

Sorry for my poor english.

[victorlus]

I'm trying to use it, magnification but the screen comes out all black someone has a solution
?

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.