Enregistrer l'image d'un contrôle

Télécharger le projet
Commenter

Description

Cette fonction enregistre l'image d'un contrôle
(bouton, Label, MSChart ...) dans un fichier image.
J'ai fait ce script à partir d'une question sur le forum :
http://www.vbfrance.com/infomsg_EXPORTER-GRAPHE-VERS-BITMAP_1072372.aspx#1
J'ai apporté quelques modifications à mon ancien code.
La fonction localise l'objet par rapport au bord de l'écran,
et fait une capture d'écran du contrôle,
qui peut être n'importe quoi pourvu qu'il ait les
propriétés .Width, .Height, .Left et .Top qui permettent
de le localiser.

Source / Exemple : 


Option Explicit

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 GetDesktopWindow Lib _
        "user32.dll" () As Long

Private Declare Function GetDC Lib "user32.dll" ( _
        ByVal hWnd As Long) As Long

Private Const SRCCOPY As Long = &HCC0020

Public Sub SaveMSChart(ByRef Pic As PictureBox, _
        ByRef mform As Form, ByVal mObj As Object, _
        ByVal mFileName As String)
    Pic.Visible = False
    Pic.AutoRedraw = True
    Pic.Cls
    mform.ScaleMode = vbTwips
    Dim Temp As Double
    Dim XU As Double, YU As Double
    Dim XD As Double, YD As Double
    Temp = (mform.Width - mform.ScaleWidth) / 2
    XU = mform.Left + Temp + mObj.Left
    YU = mform.Top + (mform.Height - mform.ScaleHeight) - _
            Temp + mObj.Top
    XD = XU + mObj.Width
    YD = YU + mObj.Height
    Pic.Width = (XD - XU)
    Pic.Height = (YD - YU)
    XU = XU / Screen.TwipsPerPixelX
    YU = YU / Screen.TwipsPerPixelY
    XD = XD / Screen.TwipsPerPixelX
    YD = YD / Screen.TwipsPerPixelY
    BitBlt Pic.hDC, 0&, 0&, Screen.Width, _
            Screen.Height, GetDC(GetDesktopWindow()), _
            CLng(XU), CLng(YU), SRCCOPY
    SavePicture Pic.Image, mFileName
End Sub
Télécharger le projet

Codes Sources

A voir également

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 (debutant VB)