PDA

View Full Version : How to make screenshot. The DirectX,DirectDraw,Winapi methods.



CynicRus
04-12-2014, 12:46 PM
Just finished a class for creating screenshots. Able to shoot through Winapi, DirectX, DirectDraw. Written in Delphi XE3, tested in Win7 x32 \ 64. This class I use in my new the DTM editor:)


unit DTM_ImageCatcher;

interface
uses
System.Classes,System.SysUtils,Vcl.Controls,Vcl.Gr aphics,
Vcl.Forms,Winapi.Windows,Winapi.D3DX9,Direct3D9,Di rectDraw;

type
TCatchType = (ctWinapi = 0,ctDirectX = 1,ctDDraw);
TImageCatcher = class
private
FBitmap: Vcl.Graphics.TBITMAP;
FCatchType: TCatchType;
FTargetHandle: HWND;
procedure GetTargetRect(out Rect: TRect);
procedure GetDDrawData();
procedure GetDirectXData();
procedure GetWinapiData();
procedure GetTargetDimensions(out w, h: integer);
procedure GetTargetPosition(out left, top: integer);
public
constructor Create;
procedure Reset;
destructor Destroy;override;

procedure GetScreenShot();
procedure ActivateTarget;
property Bitmap: Vcl.Graphics.TBITMAP read FBitmap write FBitmap;
property CatchType: TCatchType read FCatchType write FCatchType;
property TargetHandle: HWND read FTargetHandle write FTargetHandle;
end;
implementation

{ TImageCather }

procedure TImageCatcher.ActivateTarget;
begin
SetForegroundWindow(TargetHandle);
end;


constructor TImageCatcher.Create;
begin
Reset;
FBitmap:=Vcl.Graphics.TBitmap.Create;
FBitmap.PixelFormat:=pf24bit;
end;

destructor TImageCatcher.Destroy;
begin
FreeAndNil(FBitmap);
inherited;
end;

procedure TImageCatcher.GetDDrawData();
var
DDSCaps: TDDSCaps;
DesktopDC: HDC;
DirectDraw: IDirectDraw;
Surface: IDirectDrawSurface;
SurfaceDesc: TDDSurfaceDesc;
x, y, w, h: integer;
begin
GetTargetDimensions(w, h);
GetTargetPosition(x, y);
if DirectDrawCreate(nil, DirectDraw, nil) = DD_OK then
if DirectDraw.SetCooperativeLevel(GetDesktopWindow, DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN or DDSCL_ALLOWREBOOT) = DD_OK then
begin
FillChar(SurfaceDesc, SizeOf(SurfaceDesc), 0);
SurfaceDesc.dwSize := Sizeof(SurfaceDesc);
SurfaceDesc.dwFlags := DDSD_CAPS;
SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
SurfaceDesc.dwBackBufferCount := 0;
if DirectDraw.CreateSurface(SurfaceDesc, Surface, nil) = DD_OK then
begin
if Surface.GetDC(DesktopDC) = DD_OK then
try
Bitmap.Width := Screen.Width;
Bitmap.Height := Screen.Height;
BitBlt(Bitmap.Canvas.Handle, 0, 0, W, H, DesktopDC, x, y, SRCCOPY);
finally
Surface.ReleaseDC(DesktopDC);
end;
end;
end;
end;

procedure TImageCatcher.GetDirectXData();
var
BitsPerPixel: Byte;
pD3D: IDirect3D9;
pSurface: IDirect3DSurface9;
g_pD3DDevice: IDirect3DDevice9;
D3DPP: TD3DPresentParameters;
ARect: TRect;
LockedRect: TD3DLockedRect;
BMP: VCL.Graphics.TBitmap;
i, p: Integer;
x, y: integer;
w, h: integer;
begin
GetTargetDimensions(w, h);
GetTargetPosition(x, y);
BitsPerPixel := 32;
FillChar(d3dpp, SizeOf(d3dpp), 0);
with D3DPP do
begin
Windowed := True;
Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;
SwapEffect := D3DSWAPEFFECT_DISCARD;
BackBufferWidth := Screen.Width;
BackBufferHeight := Screen.Height;
BackBufferFormat := D3DFMT_X8R8G8B8;
end;
pD3D := Direct3DCreate9(D3D_SDK_VERSION);
pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, GetDesktopWindow, D3DCREATE_SOFTWARE_VERTEXPROCESSING, @ D3DPP, g_pD3DDevice);
g_pD3DDevice.CreateOffscreenPlainSurface(Screen.Wi dth, Screen.Height, D3DFMT_A8R8G8B8, D3DPOOL_SCRATCH, pSurface, nil);
g_pD3DDevice.GetFrontBufferData(0, pSurface);
ARect := Screen.DesktopRect;
pSurface.LockRect(LockedRect, @ ARect, D3DLOCK_NO_DIRTY_UPDATE or D3DLOCK_NOSYSLOCK or D3DLOCK_READONLY);
BMP := VCL.Graphics.TBitmap.Create;
BMP.Width := Screen.Width;
BMP.Height := Screen.Height;
case BitsPerPixel of
8: BMP.PixelFormat := pf8bit;
16: BMP.PixelFormat := pf16bit;
24: BMP.PixelFormat := pf24bit;
32: BMP.PixelFormat := pf32bit;
end;
p := Cardinal(LockedRect.pBits);
for i := 0 to Screen.Height - 1 do
begin
CopyMemory(BMP.ScanLine[i], Ptr(p), Screen.Width * BitsPerPixel div 8);
p := p + LockedRect.Pitch;
end;
Bitmap.SetSize(w, h);
BitBlt(Bitmap.Canvas.Handle, 0, 0, w, h, BMP.Canvas.Handle, x, y, SRCCOPY);
BMP.Free;
pSurface.UnlockRect;
end;

procedure TImageCatcher.GetScreenShot();
begin
case CatchType of
ctWinapi: GetWinapiData();
ctDirectX: GetDirectXData();
ctDDraw: GetDDrawData();
end;
SetForegroundWindow(Application.Handle);
end;

procedure TImageCatcher.GetTargetDimensions(out w, h: integer);
var
Rect: TRect;
begin
GetTargetRect(rect);
w := Rect.Right - Rect.Left;
h := Rect.Bottom - Rect.Top;
end;

procedure TImageCatcher.GetTargetPosition(out left, top: integer);
var
Rect: TRect;
begin
GetTargetRect(rect);
left := Rect.Left;
top := Rect.Top;
end;

procedure TImageCatcher.GetTargetRect(out Rect: TRect);
begin
GetWindowRect(TargetHandle, Rect);
end;

procedure TImageCatcher.Reset;
begin
CatchType := ctWinapi;
TargetHandle := 0;
end;

procedure TImageCatcher.GetWinapiData();
var
hWinDC: THandle;
w, h: integer;
begin
GetTargetDimensions(w, h);
hWinDC := GetWindowDC(TargetHandle);
Bitmap.Width := w;
Bitmap.Height := h;
hWinDC := GetWindowDC(TargetHandle);
BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, hWinDC, 0, 0, SRCCOPY);
ReleaseDC(TargetHandle, hWinDC);
end;
end.


How to use:
Create an instance to class, set in the property TargetHandle - HWND desired window, set the mode of the screen capture (ctWinapi, ctDDraw, ctDirectX), then in the button click method of class call ActivateClient; then call GetScreenShot; and in the field will Bitmap is a screen window.
note:
Use only mode ctDDraw removing screens with video players, etc. With simple windows it will not work as it should.

Olly
04-12-2014, 02:13 PM
Make it work in ogl mode also :p

Nice though!

Brandon
04-12-2014, 03:01 PM
Nice but.. Does this leak?

http://msdn.microsoft.com/en-us/library/windows/desktop/bb219685(v=vs.85).aspx
http://msdn.microsoft.com/en-us/library/windows/desktop/bb204867(v=vs.85).aspx


A IDirect3D9 must only be created once at the start of your application and must be the last resource to be freed before the application ends..
IDirect3DDevice9 must only be allocated once after the above and freed before the above.


This class does not free either of them and creates them multiple times during calls to: `TImageCatcher.GetDirectXData();`
You should call Release on both objects. I'm aware that Delphi has a reference counter.

Still, not sure it's a good idea to create a device or interface every call. I'd hope that it doesn't leak but I don't know how Delphi handles that.. It just looks dangerous..

Other than that, nice job. +1 from me.

CynicRus
04-13-2014, 04:41 PM
Nice but.. Does this leak?

http://msdn.microsoft.com/en-us/library/windows/desktop/bb219685(v=vs.85).aspx
http://msdn.microsoft.com/en-us/library/windows/desktop/bb204867(v=vs.85).aspx


A IDirect3D9 must only be created once at the start of your application and must be the last resource to be freed before the application ends..
IDirect3DDevice9 must only be allocated once after the above and freed before the above.


This class does not free either of them and creates them multiple times during calls to: `TImageCatcher.GetDirectXData();`
You should call Release on both objects. I'm aware that Delphi has a reference counter.

Still, not sure it's a good idea to create a device or interface every call. I'd hope that it doesn't leak but I don't know how Delphi handles that.. It just looks dangerous..

Other than that, nice job. +1 from me.

As far as I remember, an interfaces in Delphi released by automatically. As I test, I don't notice any leaks.

Turpinator
04-13-2014, 05:34 PM
Robert; should take a look at this. amirite Olly;?

DatSik
06-30-2014, 01:03 AM
Thank you for this, please keep stuff coming