Screenshot de masse (api, bmp, dib, bitblt)

0/5 (6 avis)

Vue 7 554 fois - Téléchargée 813 fois

Description

Vous saviez comment faire un screenshot en vb...
Alors voila une solution pour en faire plein d'affilé à interval régulier !

"Mais à quoi bon" vous vous dites? Simple : vous pouvez ainsi enregistrer des démo d'utilisation d'une application (au hasard, vb ;) ainsi que des démos de jeux ! Quake 3 embarque cette fonctionalité, mais des jeux tel que doom ou autres, non...

Cette nouvelle version utilise l'api WriteFileEx() pour l'écriture asynchrone (non-bloquante à l'instar de Put #) des images capturé
Utilise également zlib.dll pour une compression rapide des captures.

Trève de long discours, place au code

Source / Exemple :


'Le code complet du moteur de screenshot de masse (n'utilisant pas le code-ci-dessous) est trop long : voir zip

'Juste le code pour prendre 1 screenshot avec bitblt

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Public Function TakeScreenShot(FichierSortie As String) As Single
'Sub tout en un prenant 1 screenshot et l'enregistrant dans FichierSortie
Dim TempDC As Long, TempBMP As Long, lPt As Long
Dim DefDIB As BITMAPINFO
Dim t1 As Single
    
    'capture
    DeskW = Screen.Width / 15
    DeskH = Screen.Height / 15

    TempDC = CreateCompatibleDC(GetDC(0))
    DeskDC = GetDC(GetDesktopWindow())
    
    With DefDIB
        .bmiHeader.biWidth = DeskW     'largeur
        .bmiHeader.biHeight = DeskH    'hauteur
        .bmiHeader.biBitCount = 24     'couleurs
        .bmiHeader.biPlanes = 1        'nombre de couche de travail
        .bmiHeader.biSize = Len(.bmiHeader)
    End With
    
    TempBMP = CreateDIBSection(TempDC, DefDIB, 0, lPt, 0, 0)
    TempHBITMAP = SelectObject(TempDC, TempBMP)
    
    t1 = Timer
    BitBlt TempDC, 0, 0, DeskW, DeskH, DeskDC, 0, 0, vbSrcCopy
    TakeScreenShot = Timer - t1
    
    'sauvegarde
    Dim BMPID As GUID, BMPHEAP As PicBmp, SCRPTR As IPictureDisp
    Dim exeAPI As Long
    With BMPID
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With BMPHEAP
        .SIZE = 20
        .Type = vbPicTypeBitmap
        .hBmp = TempBMP    'Handle de la bitmap
    End With
    exeAPI = OleCreatePictureIndirect(BMPHEAP, BMPID, 1, SCRPTR)

    If Dir(FichierSortie, vbNormal) <> "" Then
        t = MsgBox("Le fichier " & FichierSortie & " existe déjà. Ecraser ?", vbQuestion + vbYesNoCancel, "Capture")
        If t = vbYes Then SavePicture SCRPTR, FichierSortie
    Else
        SavePicture SCRPTR, FichierSortie
    End If
    
    DeleteObject TempBMP
    DeleteDC TempDC
    ReleaseDC GetDesktopWindow(), DeskDC
    Set SCRPTR = Nothing

End Function

Conclusion :


Mise à jour :
- pour palier au problème de taille qu'est le stockage d'une multitude de bitmap 24bit, utilise zlib.dll pour compresser le tout.
- Choix de la priorité du process

Ecriture au format bitmap manuel (voir bmpwrite.bas)

Multithreading abandonné (impossible de compilé, sinon)

bug :
- si le disque de destination est plein, plante
- si la priorité du processus-programme est supérieur à celui du bureau (ou du programme à qui ont veut prendre des screenshots), les images obtenu sont parfois partiel.
- bitblt mets plusieurs centaines de millisecondes à copier le DC du bureau vers le DC de capture, rendant impossible l'utilisation "temps réel" de ce programme avec des jeux : il faut enregistrer une "démo" d'un jeu avant.

zlib.dll inclus dans le zip

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_Ulysse3 Messages postés 100 Date d'inscription vendredi 2 juillet 2004 Statut Membre Dernière intervention 25 mai 2019
27 févr. 2005 à 18:25
Aouis t'aurai pas par hasard copier un de mes ancienne source ?

Je dois quand meme admetre que toi il est mieu fait.

8/10
cs_OphidiaN Messages postés 235 Date d'inscription mercredi 4 avril 2001 Statut Membre Dernière intervention 9 novembre 2007
23 juin 2004 à 13:36
Multithreading abandonné (impossible de compilé, sinon)
>> essaye en P-Code ça passe g testé
cs_scoubi Messages postés 5 Date d'inscription jeudi 23 janvier 2003 Statut Membre Dernière intervention 11 juin 2013
28 mars 2003 à 14:52
Y'a du mieux mais j'ai toujours pas d'image, ce code est vraiment bien tourné, je me creuse la tête pour comprendre pourquoi il n'enregistre rien alors que le test ne plante pas !!??
Proger Messages postés 248 Date d'inscription vendredi 10 novembre 2000 Statut Membre Dernière intervention 19 décembre 2008
28 mars 2003 à 14:27
Nouvelle version, devrai marcher sur n'importe quel bureau (résolution et niveau de couleur).
On a pas le choix au niveau du format BMP pour la capture. Et étrangement, ce n'est pas le BMP qui pose des problèmes de performance, mais BitBlt .
cs_scoubi Messages postés 5 Date d'inscription jeudi 23 janvier 2003 Statut Membre Dernière intervention 11 juin 2013
6 févr. 2003 à 13:35
JE ne comprends pas, ca ne fonctionne pas, ma résoltion est en 1152*864, est-ce la résolution ?
Afficher les 6 commentaires

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.