Effectuer un ScreenShot en utilisant uniquement l'API WindowsRésolu

Question

J'essaye de réaliser une petite application qui effectue une capture d'ecran en utilsant uniquement l'API  Windows (donc eviter l'utilisation de TBitmap de l'unité Graphics),   la fonction principale
 produit un  " HBitmap" mon problème est Comment Sauver ce "HBitmap" dans un fichier (*.bmp)? Merci d'avance pour vos réponses .

Cirec · Accepted Answer

Voici la solution (enfin je pense )

Testez et dites moi si ça fonctionne (normalement il n'y a plus de raisons)

procedure screenshot(shot: string);
 var
  dibH : hBitmap;
  bits : pointer;
  info : TBITMAPINFO;
  width,height : integer;
  screenDC,dibDC : hDC;
  f : fileof byte;
  FileHeader : TBITMAPFILEHEADER;
  ImgSize : Cardinal;
begin
    screenDC :=  getDC(getDeskTopWindow);
    dibDC := createCompatibleDC(screenDC);
    width := getDeviceCaps(screenDC,HORZRES);
    height := getDeviceCaps(screenDC,VERTRES);
    //info.bmiHeader.biXPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSX)*39.37);
    //info.bmiHeader.biYPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSY)*39.37);
    zeromemory(@info,sizeOf(info));
    ImgSize :=  Width * Height * 3;
    // Pour passer en 32 Bits il faut faire : ImgSize := Width * Height * 4;
    // et mettre biBitCount := 32;
     with  info.bmiHeader do
    begin
         biSize : = sizeOf(TBITMAPINFOHEADER);
         biWidth :=  width;
         biheight := height;
         biplanes := 1;
         biBitCount := 24;
         biSizeImage := ImgSize; // ceci manquait
         biCompression := BI_RGB;
     end ;
    dibH : = createDIBSection(dibDC,info,DIB_RGB_COLORS,bits,0,0);
    selectObject(dibDC,dibH);
    bitblt(
           dibDC,
           0,0,width,height,
           screenDC,
           0,0,
           SRCCOPY);
    releaseDC(getDeskTopWindow,screenDC);
    assignFile(f,shot);
    reWrite(f);


    if width and 3 <> 0 then
       width :=  4*((width  div  4)+1);


    with fileHeader do
    begin
         bfType : = ord('B')+(ord('M')shl 8);
         bfSize :=  sizeOf(TBITMAPFILEHEADER)+sizeOf(TBITMAPINFOHEADER)+ImgSize;
         //bfOffBits := sizeOf(TBITMAPINFOHEADER);
          // et la taille n'était pas correct 
         bfOffBits : = sizeOf(TBITMAPFILEHEADER)+sizeOf(TBITMAPINFOHEADER);
    end;


    blockWrite(f,fileHeader,sizeOf(TBITMAPFILEHEADER));
    blockWrite(f,info.bmiHeader,sizeOf(TBITMAPINFOHEADER));
    blockWrite(f,bits^,ImgSize);
    closeFile(f);
    deleteObject(dibH);
    deleteDC(dibDC);
end;

Voilà c'est tout 

















@+
Cirec

japee · Answer

Un HBitmap est un LongWord qui correspond à un handle de bitmap.

Pour enregistrer ta capture d'écran dans un fichier, il te faudra passer par un bitmap, que ça te plaise ou pas.

Ca serait bien de nous montrer quelques lignes de code, ça expliquerait mieux ton problème.

Il faut cliquer sur réponse acceptée quand on répond à tes
questions et que la réponse te convient, et pourquoi pas mettre un
petit mot pour dire si ça marche, sinon pourquoi ça marche pas. Comme
ça on sait si on a bien fait de te répondre, ou si on aurait mieux fait
de faire autre chose.

Je dis ça par rapport aux questions que tu as déjà posées sur ce forum,
auxquelles il a été répondu, et qui sont toutes restées sans
commentaires de ta part.

C'est qu'ici, on est une communauté de gens qui aiment programmer en
Delphi et qui aiment aussi partager leurs compétences (on touche pas
d'argent pour ça).


Y'a pas de quoi d'avance.

Caribensila · Answer

héhéhéhé...

Bien répondu et bien envoyé!
Merci Japee

cs_nader · Answer

Premièrement, un petit mot pour " Caribensila ": ya absolument rien qui faire rire !?! C débile comme réponse !

2ement : j'ai pas poster assez de message pour remarquer qu'il ya un bouton [Réponse acceptée]. d'ailleur je me suis jamais connecté en tant que membre pour lire les réponses sur le forum, je les consulte en tant que visiteur . je pense que c pour ca que j'avait pa remarqué le bouton 'rep accepté'

3ement: Pourquoi a chaque fois que quelqun pose une question il faut qu'il y est quelque membres pour les prise de tête...?!

Pour la réponse de "Japee" j'ai rien contre, et je répète, je vien pas souvent sur le forum et je savait pa pour " Réponse accepté " ( j'avait pa remarqué ce bouton) et vraiment merci pour la réponse. et le seul sujet (dont je me rappelle) que j'ai consulter pour voir les réponses et celui a propos du 'type procédure' et on peut pa vraiment juger les réponses quand on ne sait pas.

Pour la réponse de  " Caribensila " (si on peut appelé ça réponse) :tu peut la garder et en meme temp apprendre les bonne manière !

Pour ceux qui sont interréssé par le sujet : voici la fonction qui retourne le Handle du Bitmap:

function GetDesktopBitmap: HBitmap;
var
  DC, MemDC: HDC;
  Bitmap, OBitmap: HBitmap;
  BitmapWidth, BitmapHeight: integer;
begin
  DC := GetDC(GetDesktopWindow);
  MemDC := CreateCompatibleDC(DC);
  BitmapWidth := GetDeviceCaps(DC, 8);
  BitmapHeight := GetDeviceCaps(DC, 10);
  Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
  OBitmap := SelectObject(MemDC, Bitmap);
  BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
  SelectObject(MemDC, OBitmap);
  DeleteDC(MemDC);
  ReleaseDC(GetDesktopWindow, DC);
  Result := Bitmap;
end;

Pour les étapes suivante (pour enregistrer le bitmap) ya une seule facon de se passer de l'unité Graphics (On peut bien se passer TBitmap si ca nous plait !), on peut se contenter de l'API Windows en passant par les étape suivantes:

Construire l'entete du fichier bitmap contenant les informations sur les dimensions, la palette de couleur, sa taille ...: d'abord  la structure BITMAPFILEHEADER (type et taille du fichier) suivit du BITMAPINFOHEADER ( Dimension et format des couleurs)  puis la structure du RGBQUAD ( table de couleur ou lé bloc de pixels).
on note que la fonction BitBlt nous servira pour construire le RGBQUAD qui est sous formes de bloc rectangulaire contenant les pixels du bitmap, en fete la a fonction BitBlt récupère les bits de chacun de ses bloc.

Pour la totalité du code ,il faudrait que je me documente encore sur les Header des bitmap. et si je répond pas suite a ce message c'est que je vient pas fréquement sur le forum, et j'essaye de participer au maximum et j'aime bien partager mes bout de codes et mes connaissances avec les autres et j'ai rien contre, donc si votre réponse servira au membres du forum vous pouvez l'ajouter, et si c'est pour prendre la tête veuillez s'abstenir ca n'aidera aucun membre de la communauté a progresser.
Merci

Caribensila · Answer

Eh bin voilà!..


Comme ça, c'est BCP mieux pour tout le monde. 
Tes commentaires sont très intéressants, nader. Pourquoi nous en priver?

Sans rancune et bon coding!

japee · Answer

Ah oui, alors là c'est beaucoup plus clair. 



On voit nettement mieux où tu veux aller, apparemment tu as une idée
précise de ce que tu veux faire, et tu sais visiblement ce qu'est un
HBitmap...



Bon, j'admets qu'en utilisant BitmapInfo et BitmapFileHeader, on doit en effet pouvoir se passer de TBitmap (si ça nous plait, lol). 



As-tu jeté un oeil sur ce code ?



Il a l'air de correspondre à ce que tu veux obtenir, mais les couleurs sont hélas modifiées, c'est bien dommage.


Si tu peux en tirer quelque chose...



Bonne prog'

Cirec · Answer

Salut,


@ Japee : je viens de tester le code que tu donnes et chez moi il fonctionne parfaitement (sous D4 et D2005  XPPro sp2) et sans changer les couleurs 















@+
Cirec

japee · Answer

Hi,


Non, décidément, chez moi, il y a un décalage des couleur R->G, G->B, B->R.

(Je suis sous XP pro et je compile avec D4 pro)

Le DC récupéré dans un bitmap est correct, le problème semble résider
dans le traitement des infos du Header de fichier, je pense.


A+

Caribensila · Answer

Salut,

J'ai déjà remarqué des cas où l'ordre des octets est inversé. 
on a plus R,G,B  mais B,G,R ...
( Mais pas le décalage dont parle Japee. Es-tu sûr, Japee? ) 

En Delphi le color est R,G,B.
Mais parfois on trouve des bitmap dont la structures est B,G,R (toujours en byte).

Mais je ne sais pas pourquoi...  :s

japee · Answer

Salut Caribensila, J'ai vérifié. Si au départ j'ai une valeur RGB 195, 106, 29 , elle sera modifiée ainsi : 29, 195, 106. Si je recapture la capture obtenue, j'obtiens RGB 106, 29, 195. Et si je capture une troisième fois, je retombe sur les couleurs originelles, mdr... Donc, en (re)capturant 3 fois, j'obtiens un bitmap dont les couleurs correspondent aux couleurs d'origine. Je n'ai pas trop le temps de me pencher sur le problème (quoique le sujet commence à me titiller), mais la solution doit être intéressante. Alors, si quelqu'un a une idée... (les forts en graphisme, là...)

Cirec · Answer

@ Japee : Ce que je ne comprend pas c'est que j'ai aussi un D4 Pro et un XP Pro 
et je n'arrive pas a ce genre de résultat.

@ Caribensila : as-tu testé le code ? 
 si oui quel est le résultat chez toi ?

j'aimerai bien comprendre ce qui se passe !

@+
Cirec

japee · Answer

Cirec > moi aussi, j'aimerais bien comprendre. 

Au cas où le lien que je cite ne pointerait pas sur la même page (bien
qu'on ait XP tous les deux, mais j'utilise plus volontiers Firefox,
lol), je recopie ci-dessous le code que j'ai testé :

procedure screenshot(shot: string);

 var

  dibH : hBitmap;

  bits : pointer;

  info : TBITMAPINFO;

  width,height : integer;

  screenDC,dibDC : hDC;

  f : file of byte;

  FileHeader : TBITMAPFILEHEADER;

begin

    screenDC := getDC(getDeskTopWindow);

    dibDC := createCompatibleDC(screenDC);

    width := getDeviceCaps(screenDC,HORZRES);

    height := getDeviceCaps(screenDC,VERTRES);

    info.bmiHeader.biXPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSX)*39.37);

    info.bmiHeader.biYPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSY)*39.37);

    zeromemory(@info,sizeOf(info));

    with info.bmiHeader do

    begin

         biSize := sizeOf(TBITMAPINFOHEADER);

         biWidth := width;

         biheight := height;

         biplanes := 1;

         biBitCount := 24;

         biCompression := BI_RGB;

    end;

    dibH := createDIBSection(dibDC,info,DIB_RGB_COLORS,bits,0,0);

    selectObject(dibDC,dibH);

    bitblt(

           dibDC,

           0,0,width,height,

           screenDC,

           0,0,

           SRCCOPY);

    releaseDC(getDeskTopWindow,screenDC);

    assignFile(f,shot);

    reWrite(f);


    if width and 3 <> 0 then

       width := 4*((width div 4)+1);


    with fileHeader do

    begin

         bfType := ord('B')+(ord('M')shl 8);

         bfSize := sizeOf(TBITMAPFILEHEADER)+sizeOf(TBITMAPINFOHEADER)+width*height*3;

         bfOffBits := sizeOf(TBITMAPINFOHEADER);

    end;


    blockWrite(f,fileHeader,sizeOf(TBITMAPFILEHEADER));

    blockWrite(f,info.bmiHeader,sizeOf(TBITMAPINFOHEADER));

    blockWrite(f,bits^,width*height*3);

    closeFile(f);

    deleteObject(dibH);

    deleteDC(dibDC);

end;


je l'appelle ainsi :  

procedure TForm1.Button1Click(Sender: TObject);

begin

  screenshot('essai.jpg');

end;


et quand j'ouvre 'essai.jpg', j'obtiens le résultat que je cite précédemment. 

Afin quantifier le résultat obtenu (valeurs R,G,B), j'ai testé avec un petit prog' à moi qui définit et récupère les couleurs. 


Faudra-t-il en arriver à comparer la marque de nos cartes graphique ?  


A+

japee · Answer

En fait, c'est 'essai.bmp' et non pas 'essai.jpg', bien que ça ne change rien à l'affaire...


A+

Caribensila · Answer

Après essai, j'obtiens exactement le même résultat que Japee. Càd le même décalage.

J'ai  D7 et XP

Cirec · Answer

Je suppose que c'est une erreur frappe :

procedure TForm1.Button1Click(Sender: TObject);
begin
  screenshot('essai.jpg');
end;

Je vais tester ce code mais à vu d'oeil c'est le même 

@+
Cirec

Cirec · Answer

Bon alors :
j'ai effectivement réussi à ouvrir l'image avec un décalage !!!!

en fait, chez moi, tout dépend avec quel utilitaire j'ouvre l'image 
Avec "Paint" il l'ouvre correctement (sans décalage) ainsi qu'en l'ouvrant dans un TImage sous Delphi 
Avec "Aperçu des Images" (de Windows) il l'affiche avec décalage 

En suite en faisant une comparaison entre un Screen-Shoot dans un Bitmap et cette méthode :
j'obtiens une différence de taille de 2,3 Mo

Avec cette méthode le fichier fait 3,7 Mo = 1280*1024*3
Avec un Bitmap il fait 5,0Mo = 1280*1024*4

J'ai réussi à produire un fichier de taille identique mais il y a également un décalage avec les mêmes particularités que celles cités plus haut il n'y a que le décalage en couleur qui change 

Voilà ça ne fait pas vraiment avancer la chose mais je rien trouvé d'autre pour l'instant

@+
Cirec

Caribensila · Answer

Oui, avec "Paint", c'est correct pour moi aussi, maintenant.
C'est  " l'Aperçu "  Windows qui déconne.
C'est quand même bizarre.

Moi, vue l'heure, le topic ne me "titille" pas trop pour le moment , mais enfin pour ceux que ça intéresse, regardez ça:

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=1289&lngWId=7

Cirec · Answer

J'ai oublié un petit commentaire :
    //info.bmiHeader.biXPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSX)*39.37);
    //info.bmiHeader.biYPelsPerMeter := round(getDeviceCaps(screenDC,LOGPIXELSY)*39.37);
// j'ai mis ces deux lignes en commentaire parce qu'elles ne servent à rien 
// en effet l'auteur à affecté une valeur à info.bmiHeader.biXPelsPerMeter 
// et info.bmiHeader.biYPelsPerMeter 
 //et la ligne suivante remplis de zéro la structure Info  ?????
// en déplacant la ligne avant les deux plus haut l'information serait prise en compte mais il semblerait 
//qu'elle ne soit pas utile ... à voir 
   zeromemory(@info,sizeOf(info));

@+
Cirec

japee · Answer

Pour l'instant, je n'ai qu'une chose à dire, c'est :

  Bravo Cirec, tu es le meilleur...


Ca marche effectivement, et  il ne manque plus d'octets comme auparavant.


Du coup, le code semble correspondre à ce que demandait la personne qui
a posé sa question, qui a ouvert sa gueule pour critiquer le forum, et
qui n'a jamais participé aux échanges. Dans ces conditions, c'est
facile de critiquer l'ambiance d'un forum pour dire qu'elle est je sais
plus quoi... prise de tête, je crois, bof... 


Enfin, on s'est bien démerdés, entre nous, et on aura progressé encore
un peu dans la connaissance de la programation de l'api et de la
structure d'un fichier bmp...


A+.

Caribensila · Answer

héhéhéhé


C'est vrai qu'il est formidable, ce Cirec. Et il ne lâche jamais le morceau, quelque soit l'heure!
Ce qui m'étonne encore c'est que ça passait bien dans "Paint" et pas dans l'"Aperçu"...Ce qui démontre bien, si c'est encore nécessaire, qu'il faut toujours tester ses codes "à mort"  ;)

Bon tests!

Effectuer un ScreenShot en utilisant uniquement l'API Windows

24 réponses

Votre réponse

Discussions similaires