1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Capture d'ecran

Capture d'ecran

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 136 fois - Téléchargée 33 fois

Commenter

Contenu du snippet

Mon code sert a faire des capture d'ecran. C'est assez basique mais ça peut servir à beaucoup de personne.

Source / Exemple : 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,Clipbrd;

type
  TForm1 = class(TForm)
    ButtonRempliBitmap: TButton;
    Image1: TImage;
    ButtonAfficheBitmap: TButton;
    ButtonSauverSurFichier: TButton;
    SaveDialog1: TSaveDialog;
    ButtonCopierVersClipBoard: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure ButtonRempliBitmapClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ButtonAfficheBitmapClick(Sender: TObject);
    procedure ButtonSauverSurFichierClick(Sender: TObject);
    procedure ButtonCopierVersClipBoardClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  ImageBureau:TPicture;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageBureau := TPicture.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ImageBureau.Free;
end;

procedure TForm1.ButtonRempliBitmapClick(Sender: TObject);
begin
  ImageBureau.Bitmap.Width := Screen.Width;
  ImageBureau.Bitmap.Height := Screen.Height
  BitBlt(ImageBureau.Bitmap.Canvas.Handle,0,0,Screen.Width,Screen.Height,
          GetDC(GetDesktopWindow),0,0,SrcCopy);//recopie l'image du desktop vers ImageBureau
end;

procedure TForm1.ButtonAfficheBitmapClick(Sender: TObject);
begin
  Image1.Picture.Bitmap:=ImageBureau.Bitmap;
end;

procedure TForm1.ButtonSauverSurFichierClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
  ImageBureau.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.ButtonCopierVersClipBoardClick(Sender: TObject);
begin
  Clipboard.Assign(ImageBureau);
end;

end.

A voir également

Ajouter un commentaire Commentaires
cs_ManChesTer Messages postés 374 Date d'inscription vendredi 20 octobre 2000 Statut Modérateur Dernière intervention 15 janvier 2021
9 juin 2005 à 20:13
Juste quelques points qui me semble etrange.

Pourquoi utilises-tu Tpicture plutot que Tbitmap qui me semblerais plus approprié ?

Tout Getdc doit etre libéré par un releasedc mais bon, pleins de coders font cette erreur (il doinvent pas avoir le meme msdn que moi, lol).

Pourquoi un bouton afficher puisque l'affichage peut etre automatisé.

donc se code me semble suffisant:

procedure TForm1.ButtonRempliBitmapClick(Sender: TObject);
var DesktopDc : hdc;
ImageBureau : Tbitmap;
begin
ImageBureau:=Tbitmap.createsized(Screen.Width,Screen.Height);
DesktopDc:=GetDC(GetDesktopWindow);
BitBlt(ImageBureau.Canvas.Handle,0,0,Screen.Width,Screen.Height,
DesktopDc,0,0,SrcCopy);
Releasedc(GetDesktopWindow,DesktopDc);
Image1.Picture.Bitmap.Assign(ImageBureau);
ImageBureau.Free;
Image1.Invalidate;
end;

procedure TForm1.ButtonSauverSurFichierClick(Sender: TObject);
begin
if SaveDialog1.Execute then
Image1.Picture.Bitmap.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm1.ButtonCopierVersClipBoardClick(Sender: TObject);
begin
Clipboard.Assign(Image1.Picture.Bitmap);
end;

Bon Coding...

ManChesTer.
Marneus Calgar Messages postés 39 Date d'inscription mardi 3 octobre 2000 Statut Membre Dernière intervention 10 juin 2005
10 juin 2005 à 07:39
Il y a déjà du progrès par rapport au pseudo-tutoriel ^^ Sinon effectivement, il ne faut pas oublier de faire un ReleaseDC. Et TBitmap est bien plus adapté au stockage que TPicture (TPicture permettant d'afficher un TBitmap).

Si tu veux une fonction pour générer le Bitmap directement :

http://www.darkskull.net/?module=viewarticle&idarticle=30

Ensuite il ne te restera plus qu'à assigner ce bitmap au TPicture...
DeltaFX Messages postés 449 Date d'inscription lundi 19 avril 2004 Statut Membre Dernière intervention 8 avril 2009 2
10 juin 2005 à 13:52
Bon ben plus qu'a ajouter la possibilité de faire une capture d'un overlay, ou d'un affichage directx. lol.
ewertheimer Messages postés 161 Date d'inscription dimanche 16 janvier 2005 Statut Membre Dernière intervention 26 janvier 2009
10 juin 2005 à 18:45
oui mais les boutons c'etait plutot pour montrer les differentes parti du code.
Debiars Messages postés 285 Date d'inscription lundi 16 juin 2003 Statut Membre Dernière intervention 11 février 2018
11 juin 2005 à 13:47
Pourquoi se compliquer la vie ?
Pour capturer l'écran dans le clipBoard, il suffit d'appuyer sur la touche Impr écran du clavier.

MonBitmap.Assign(ClipBoard) permet ensuite de récupérer l'image dans un bitmap pour en faire n'importe quoi...
comme je le fais régulèrement avec mon prog Leonardo.

jp ?o?
S'inscrire maintenant

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.

Du même auteur (ewertheimer)