VBA & GDI32Résolu

Question

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

Renfield · Accepted Answer

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

Maxtroubadour · Answer

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 -

Renfield · Answer

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

Renfield · Answer

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

VBA & GDI32

4 réponses

Votre réponse

Discussions similaires