Créer une ipicture, ipicturedisp, picturebox, stdpicture depuis un tableau de données

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 679 fois - Téléchargée 35 fois

Contenu du snippet

C'est une question qui revient souvent sur le forum et pourtant la reponse est simple quand on la connais ;). Donc voici une routine pour créer un objet image depuis des donnéessous forme de chaine de caractere ou d'un tableau d'octet (Marche avec BMP DIB GIF JPG ICO CUR)

Source / Exemple :


Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long

'//------------------------------------------------------//
'// Create an IPicture from a byte array with win32 API  //
'//------------------------------------------------------//
Function PictureFromBits(Bits() As Byte) As IPicture
'//------------------------------------------------------//
    Dim vStream  As IUnknown
    Dim vIID(15) As Byte
    Dim vSize    As Long
    Dim vMem     As Long
    Dim vPtr     As Long
    vSize = 1 + UBound(Bits)
    vMem = GlobalAlloc(2, vSize)
    If (vMem = 0) Then Exit Function
    vPtr = GlobalLock(vMem)
    If vPtr Then
        RtlMoveMemory ByVal vPtr, Bits(0), vSize
        GlobalUnlock vMem
        If (CreateStreamOnHGlobal(vMem, 1, vStream) = 0) Then
            If (CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), vIID(0)) = 0) Then
                OleLoadPicture ByVal ObjPtr(vStream), vSize, 0, vIID(0), PictureFromBits
            End If
        End If
    End If
    GlobalFree vMem
End Function

Private Sub Command1_Click()
    Dim Data() As Byte
    Open App.Path & "\screen.jpg" For Binary As #1
    ReDim Data(LOF(1) - 1)
    Get #1, , Data
    Close #1
    Set Picture = PictureFromBits(Data)
End Sub

Conclusion :


On dit merci qui ? merci vbAccelerator ;)

Bonne pr@g a tous

A voir également

Ajouter un commentaire

Commentaires

Messages postés
174
Date d'inscription
samedi 10 mai 2003
Statut
Membre
Dernière intervention
18 février 2006

20/10, vraiment génial !!!

Est-ce que c'est faisable de faire la même chose avec les fichiers audio vers le contrôle MediaPlayer ?
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007

Oh j'ai déja vu ça qq part ;)
Tient, à ce propos, est-il possible de mettre une image par dessus celle que l'on a dans notre variable (var qu'on transmet à ta fonction) ? Je m'explique un peu mieux, faire un bitblt/stretchblt ou ce que tu veux sans utiliser de picturebox a part celle qui affichera le résultat final.
Messages postés
17
Date d'inscription
samedi 16 février 2002
Statut
Membre
Dernière intervention
1 mars 2007

@EBArtSoft

C'est tres bien car ca repond + ou - à mon probleme

Par contre je ne parviens pas à le faire fonctionner lorsque je recupere les data d'une image provenant d'un controle.

Est il possible de faire de genre de chose entre mon controle et un picturebox sans passer par l'ecriture d'un fichier sur le dique ??

@++
Messages postés
4531
Date d'inscription
dimanche 29 septembre 2002
Statut
Modérateur
Dernière intervention
22 avril 2019
8
FeelCode> c'est la clef unique qui identifie le type d'objet OLE a créer dans notre cas c'est la constante IID_IPICTURE

@+
Messages postés
278
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
27 avril 2006
1
Hello :))

chitite question sa ser a quoi ça --> 7BF80980-BF32-101A-8BBB-00AA00300CAB ?

sinon on va mettre un 10 comme d'hab lol
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.