Classe pour les captures d'écran (Winapi, DirectDraw, DirectX)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 2 564 fois - Téléchargée 12 fois

Contenu du snippet

Je viens de terminer une classe pour créer des captures d'écran. Capable de tirer à travers Winapi, DirectX, DirectDraw. Écrit en Delphi XE3, testé dans Win7 x32 \ 64.
unit DTM_ImageCatcher;

interface
  uses
   System.Classes,System.SysUtils,Vcl.Controls,Vcl.Graphics,
    Vcl.Forms,Winapi.Windows,Winapi.D3DX9,Direct3D9,DirectDraw;

  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.Width, 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;
  //FreeAndNil(FBitmap);
end;

procedure TImageCatcher.GetWinapiData();
 var
 //WinRect : TRect;
 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.


Comment utiliser:
Créez une instance de classe, situé dans le TargetHandle de la propriété - HWND fenêtre désirée, régler le mode de la capture d'écran (ctWinapi, ctDDraw, ctDirectX), puis lorsque vous appuyez sur la méthode execute de ActivateClient de classe; alors eup GetScreenShot; et dans le champ Bitmap est une fenêtre de l'écran.
Remarque:
Utilisez uniquement le mode ctDDraw retirer les grilles avec les lecteurs vidéo, etc Avec des fenêtres simples, il ne fonctionne pas comme il le devrait.

A voir également

Ajouter un commentaire

Commentaires

cs_pseudo3
Messages postés
270
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
7 juin 2018
-
Bonjour,

Quelle usine à gaz pour une simple capture d'écran !!!
Pour ma part je me contente de cette fonction :

function CopierEcran(xe, ye, we, he: integer): tBitMap;
// Renvoie le BitMap d'une capture d'écran en xe,ye large de we et haute de he
// xe,ye = coordonnées-écran (ClientToScreen) de l'angle-supérieur-gauche de la capture
var HandleDC: HDC; Picture: TPicture;
begin
  HandleDC := GetDC(GetDesktopWindow);
  Picture := TPicture.Create;
  try
    Picture.Bitmap.PixelFormat := pf32bit;
    Picture.Bitmap.Width := we;
    Picture.Bitmap.Height := he;
    BitBlt(Picture.Bitmap.Canvas.Handle, 0, 0, we, he,
      HandleDC, xe, ye, SrcCopy); //recopie l'image de la région d'écran dans PictureBureau
  finally
    Result := tBitMap.create;
    Result.Assign(Picture.BitMap);
    ReleaseDC(GetDesktopWindow, HandleDC);
  end;
end; // CopierEcran


A+.
Whismeril
Messages postés
13514
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
18 juillet 2019
288 > cs_pseudo3
Messages postés
270
Date d'inscription
mardi 24 juillet 2007
Statut
Membre
Dernière intervention
7 juin 2018
-
Bonjour, je me suis permis d'éditer ton message, pour préciser à la coloration syntaxique qu'il s'agit de delphi. En effet avec la balise de code par défaut, le site choisi ce qu'il veut et le résultat n'est pas toujours au mieux.
Tu peux préciser le langage en cliquant sur la flèche descendante à droite de <>.
korgis
Messages postés
429
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
16 -
Salut,
Mais pourquoi passer par un TPicture ?
Quoique... pourquoi pas après tout.
Une autre solution étant de passer le TBitmap en variable dans une procedure.
Quoi qu'il en soit, attention à bien libérer le TPicture puisqu'il est créé dans la fonction.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.