VBA & GDI32 [Résolu]

Maxtroubadour 4 Messages postés samedi 19 mars 2011Date d'inscription 22 mars 2011 Dernière intervention - 22 mars 2011 à 09:17 - Dernière réponse : Renfield 17308 Messages postés mercredi 2 janvier 2002Date d'inscription 22 août 2018 Dernière intervention
- 22 mars 2011 à 13:55
Bonjour à tous,
Je souhaiterai savoir si il est possible d'utiliser les objets et fonctions définies dans gdi32.dll sous vba / excel 2010?

J'ai essayé ceci (un 'code source'):

Private BMP1PATH As String
Private BMP2PATH As String
Private BMPOUTPUTPATH As String
Option Explicit
Option Base 1

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Type Pixel
Red As Byte
Green As Byte
Blue As Byte
End Type

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Dim Matrice() As Pixel
Dim NHeight, MWidth As Integer



'***************************************************************



'Procedure qui copie une image PictureBox vers une matrice de pixels
Private Sub MatrixFromImage(Picture As Image, Matrice() As Pixel)

Dim PicBits() As Byte, PicInfo As BITMAP
Dim temp As Long
Dim Size As Long
Dim i, j As Integer
Dim Z As Long

GetObject Picture.Image, Len(PicInfo), PicInfo

Size = PicInfo.bmWidth * PicInfo.bmBitsPixel * PicInfo.bmHeight / 8

ReDim PicBits(Size) As Byte
ReDim Matrice(PicInfo.bmHeight, PicInfo.bmWidth) As Pixel

GetBitmapBits Picture.Image, Size, PicBits(1)

For i = 1 To PicInfo.bmHeight
For j = 1 To PicInfo.bmWidth
Z = (i - 1) * PicInfo.bmWidth * 4 + (j - 1) * 4 + 1
Matrice(i, j).Blue = PicBits(Z)
Matrice(i, j).Green = PicBits(Z + 1)
Matrice(i, j).Red = PicBits(Z + 2)
Next j
Next i

NHeight = PicInfo.bmHeight
MWidth = PicInfo.bmWidth

End Sub

Private Sub Button2_Click()
Dim i, j As Integer

Display1.Picture = LoadPicture(BMP1PATH)

'Copie de l'image1 vers une matrice
Call MatrixFromImage(Display1, Matrice())


'Exemple d'illustration : Inversion des couleurs de l'image
'Tout les calculs se font maintenant sur la matrice

For i = 1 To NHeight
For j = 1 To MWidth
Matrice(i, j).Blue = 255 - Matrice(i, j).Blue
Matrice(i, j).Green = 255 - Matrice(i, j).Green
Matrice(i, j).Red = 255 - Matrice(i, j).Red
Next j
Next i

'Copie de la matrice vers l'image2
'Call ImageFromMatrix(Display2, Matrice())
End Sub




Et la redefinition de GetObject pose problème (fonction MatrixFromImage). J'ai l'erreur 438.

Merci d'avance pour vos idées,

Max
Afficher la suite 

Votre réponse

4 réponses

Meilleure réponse
Renfield 17308 Messages postés mercredi 2 janvier 2002Date d'inscription 22 août 2018 Dernière intervention - 22 mars 2011 à 10:51
3
Merci
nommme cette fonction autrement, ca fait un conflit avec GetObject, utilisé en VBA pour accéder à la ROT


Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp

Merci Renfield 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 98 internautes ce mois-ci

Commenter la réponse de Renfield
Maxtroubadour 4 Messages postés samedi 19 mars 2011Date d'inscription 22 mars 2011 Dernière intervention - 22 mars 2011 à 10:59
0
Merci
Bonjour,
Merci pour la réponse,
J'y ai déjà pensé et j'avais fait l'essai en la renommant :GetImgObject, et j'ai le meme souci.

On dirait que la fonction de 'gdi32.dll' n'est pas reconnue ou pas inclue dans le projet.
Faut-il faire une action quelque part dans les options de vba?

Merci d'avance,
- max -
Commenter la réponse de Maxtroubadour
Renfield 17308 Messages postés mercredi 2 janvier 2002Date d'inscription 22 août 2018 Dernière intervention - 22 mars 2011 à 13:54
0
Merci
rien de particulier.
je regarde ton code de plus pres.

NHeight est un Variant dans ton cas, pas un entier...
Dim a, b, c, d as integer
est une tromperie, seul d est un Integer...

pourquoi déclarer tes variables

Matrice, NHeight et NWidth dans la portée générale du module et non dans ta fonction ?



Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp
Commenter la réponse de Renfield
Renfield 17308 Messages postés mercredi 2 janvier 2002Date d'inscription 22 août 2018 Dernière intervention - 22 mars 2011 à 13:55
0
Merci
testé sous Excel, dans un UserForm comprenant un bouton et un ImageBox :

Option Explicit

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Type RGBPixel
    Red As Byte
    Green As Byte
    Blue As Byte
End Type

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Function PixelsFromImage(ByRef voPicture As IPictureDisp) As RGBPixel()
Dim xBits() As Byte
Dim xtPixels() As RGBPixel
Dim tBmp As BITMAP
Dim nBitCount As Long
Dim x As Long
Dim y As Long
Dim i As Long
    GetObjectAPI voPicture.Handle, LenB(tBmp), tBmp
    nBitCount = tBmp.bmWidth * tBmp.bmBitsPixel * tBmp.bmHeight \ 4
    ReDim xtPixels(tBmp.bmHeight, tBmp.bmWidth)

    If tBmp.bmBitsPixel = 24 Then
        GetBitmapBits voPicture.Handle, nBitCount, xtPixels(0, 0)
    ElseIf tBmp.bmBitsPixel = 32 Then
        ReDim xBits(nBitCount - 1) As Byte

        GetBitmapBits voPicture.Handle, nBitCount, xBits(0)
        For y = 0 To tBmp.bmHeight - 1
        For x = 0 To tBmp.bmWidth - 1
            With xtPixels(y, x)
                .Blue = xBits(i)
                .Green = xBits(i + 1)
                .Red = xBits(i + 2)
            End With
            i = i + 4
        Next x, y
    End If
    PixelsFromImage = xtPixels
End Function

Private Sub CommandButton1_Click()
Dim x As Long
Dim y As Long
Dim xtPixels() As RGBPixel
Dim oPic As IPictureDisp
    Set oPic = LoadPicture("D:\Documents and Settings\THOM31R.DOM\Mes documents\Mes images\2359.jpg")
    xtPixels = PixelsFromImage(oPic)

    For y = 0 To UBound(xtPixels, 1)
    For x = 0 To UBound(xtPixels, 2)
        With xtPixels(y, x)
            .Blue = 255 - .Blue
            .Green = 255 - .Green
            .Red = 255 - .Red
        End With
    Next x, y
    
    SetBitmapBits oPic.Handle, UBound(xtPixels, 1) * UBound(xtPixels, 2) * 3, xtPixels(0, 0)
    Set Image1.Picture = oPic
End Sub



Renfield - Admin CodeS-SourceS - MVP Visual Basic & Spécialiste des RegExp
Commenter la réponse de Renfield

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.