[VBA]Image et Runtime [Résolu]

[insoo]

Bonjour,

je suis confronté au problème suivant :

Sous access 2003, j'ai une application contenant des images (gif et jpg) dans un répertoire.

Lors d'une séléction dans une liste, un champs image est mis à jour en utilisant les gif et jpg.

le code est donc tout simple est fonctionne parfaitement :

Code :

1
2
3
 
chemin = Application.CurrentProject.Path & "\Images\" & fichier
Image1.Picture = chemin

je copie ensuite mon répertoire contenant le mdb et les images sur un PC ne contenant pas office.Seul le runtime access y est installé.

Lorsque je clique sur ma liste, l'évenement mettant l'image à jour se déclenche et l'application m'affiche un message disant qu'une erreur s'est produit et l'application se ferme.

L'erreur se produit bien au moment de l'execution du code "Image1.Picture = chemin" car si je retire cette ligne, il n'y a pas de plantage.

Quelqu'un aurait-il été confronté à ce problème ? Google ne m'a été d'aucune aide pour le moment

Merci

[insoo]

Bonsoir,
Aprés quelque tests, je pense avoir trouvé d'ou vient mon problème :

Si je met des images au format BMP dans mon répértoire d'images, l'application les affiche correctement.
J'en deduis donc que le runtime seul ne permet pas d'alimenter un control Image avec des gif/jpg.

Y a t il une raison précise à cela ?
Faut-il ajouter une librairie particulière dans la liste des références, ou utiliser un autre objet ?

La difference de taille entre des images BMP et des JPG rendra le deployement de l'application un peu moins aisé, j'aimerais donc éviter l'utilisation du format BMP si cela est possible.

Merci d'avance

[Arkham46]

salut,

peut-être qu'il manque le filtre graphique dans l'installation du runtime
sur mon install il est ici :
C:\Program Files\Fichiers communs\Microsoft Shared\GRPHFLT\JPEGIM32.FLT

si ça plante sauvagement tu devrais mettre une gestion d'erreur, toute erreur non traitée ne pardonne pas en runtime

[insoo]

Merci pour ta réponse,

en faisant une recherche sur ce fichier manquant, je vois que ce dernier n'est pas redistribuable gratuitement.
On peut donc faire un runtime de notre application, mais celle ci ne peut être déployée gratuitement sur un poste ne contenant pas office sans convertir toutes les images en BMP.

Pour ceux qui aurait le même problème, j'ai peut être trouvé une solution, à tester : http://www.lebans.com/loadjpeggif.htm

PS : l'application ne plante pas violament, juste un message du runtime qui explique qu'il ne peux pas continuer et ferme l'application proprement (du fait qu'il ne peux pas afficher les Gif/Jpg)

[Arkham46]

slt,

le truc de ton lien devrait fonctionner, mais j'apporte quand même mes solutions (c'est à peu de chose près la même chose)

tu peux charger l'image avec gdiplus :
http://www.developpez.net/forums/sho...d.php?t=208634

ou te passer de gdiplus, en mettant ce code dans un module :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
Option Compare Database
Option Explicit
 
'***************************************************************************************
'*                                       API                                           *
'***************************************************************************************
' API GDI
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal Hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal Hdc 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 nSrcWidth As Long, _
                                                 ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal Hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function apiGetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal Hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function LPtoDP Lib "gdi32" (ByVal Hdc As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal Hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal Hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal Hdc As Long, ByVal nIndex As Long) As Long
' Image EMF
Private Declare Function CreateEnhMetaFile Lib "gdi32" _
                                           Alias "CreateEnhMetaFileA" _
                                           (ByVal hdcRef As Long, _
                                            ByVal lpFileName As String, _
                                            ByRef lpRect As Any, _
                                            ByVal lpDescription As String) As Long
Private Declare Function CloseEnhMetaFile Lib "gdi32" _
                                          (ByVal Hdc As Long) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
                                           (ByVal hemf As Long) As Long
Private Declare Function GetEnhMetaFileBits Lib "gdi32" _
                                            (ByVal hemf As Long, ByVal cbBuffer As Long, lpbBuffer As Byte) As Long
'***************************************************************************************
'*                                    Constantes                                       *
'***************************************************************************************
Private Const MM_HIMETRIC = 3
Private Const MM_TEXT = 1
Private Const COLORONCOLOR = 3              ' Mode pour StretchBlt
Private Const SRCCOPY = &HCC0020
Private Const CF_ENHMETAFILE = 14
Private Const HIMETRIC_INCH = 2540          ' Pour conversion Pouce<->Himetric
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88
 
'***************************************************************************************
'*                                       Types                                         *
'***************************************************************************************
' Rectangle pour API
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
' Type Point pour API
Private Type PointAPI
    X As Long
    Y As Long
End Type
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 BitmapInfoHeader
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type DIBSECTION
    dsBm As bitmap
    dsBmih As BitmapInfoHeader
    dsBitfields(2) As Long
    dshSection As Long
    dsOffset As Long
End Type
 
'***************************************************************************************
'*                                    FONCTIONS                                        *
'***************************************************************************************
 
'---------------------------------------------------------------------------------------
' Recherche la taille en coordonnées OLE_HIMETRIC
' Nécessaire pour le dimensionnement correct de l'objet Meta File
'---------------------------------------------------------------------------------------
' phDIB        : Objet Bitmap
' Renvoie un point API avec les coordonnées OLE Himetric
'---------------------------------------------------------------------------------------
Private Function GetOLEPictureSize(phDIB As Long) As PointAPI
    Static MultX As Long
    Static MultY As Long
    Dim Hdc As Long
    Dim lds As DIBSECTION
    If MultX * MultY = 0 Then
        Hdc = GetDC(0)
        MultX = HIMETRIC_INCH / GetDeviceCaps(Hdc, LOGPIXELSX)
        MultY = HIMETRIC_INCH / GetDeviceCaps(Hdc, LOGPIXELSY)
        ReleaseDC 0, Hdc
    End If
    ' Relecture de la taille de l'image
    Call apiGetObject(phDIB, Len(lds), lds)
    GetOLEPictureSize.X = lds.dsBmih.biWidth * MultX
    GetOLEPictureSize.Y = lds.dsBmih.biHeight * MultY
Gestion_Erreurs:
    If Err.number <> 0 Then Err.Raise Err.number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext  ' Propage l'erreur
End Function
 
'---------------------------------------------------------------------------------------
' Transfère les données du Bitmap dans un tableau de type PictureData
'---------------------------------------------------------------------------------------
' phDIB        : Objet Bitmap
' On utilise un objet EMF car Access gère très mal les redimensionnements des Bitmaps
'---------------------------------------------------------------------------------------
Private Function DIBtoPictureData(phDIB As Long) As Variant
    Dim lhMeta As Long
    Dim lhMetaFile As Long
    Dim lhdcref As Long
    Dim lrect As Rect
    Dim lngret As Long
    Dim pt As PointAPI
    Dim lds As DIBSECTION
    Dim lhDC As Long
    Dim lOldBmp As Long
    Dim lPicData() As Byte
    On Error GoTo Gestion_Erreurs:
    ' Relecture de la taille de l'image
    Call apiGetObject(phDIB, Len(lds), lds)
    ' Récupère la taille en données de type OLE_Himetric pour la création de l'EMF
    pt = GetOLEPictureSize(phDIB)
    ' Rectangle pour création de l'EMF
    lrect.Right = pt.X
    lrect.Bottom = pt.Y
    ' Conversion de la taille en pixels
    lhdcref = GetDC(0)   ' Device contexte temporaire
    lngret = SetMapMode(lhdcref, MM_HIMETRIC)
    LPtoDP lhdcref, pt, 1
    pt.Y = Abs(pt.Y)
    SetMapMode lhdcref, lngret
    ' Création d'un contexte d'affichage EMF
    lhMeta = CreateEnhMetaFile(lhdcref, vbNullString, lrect, vbNullString)
    ' Coordonnées en pixels
    lngret = SetMapMode(lhMeta, MM_TEXT)
    ' Type de redimensionnement
    lngret = SetStretchBltMode(lhMeta, COLORONCOLOR)
    ' Crée un contexte d'affichage temporaire
    lhDC = CreateCompatibleDC(0)
    ' Affecte le bitmap au DC temporaire
    lOldBmp = SelectObject(lhDC, phDIB)
    ' Copie de l'image dans le MetaFile
    StretchBlt lhMeta, 0, 0, pt.X, pt.Y, lhDC, 0, 0, lds.dsBmih.biWidth, lds.dsBmih.biHeight, SRCCOPY
    ' Ferme le contexte d'affichage et récupère le MetaFile
    lhMetaFile = CloseEnhMetaFile(lhMeta)
    ' Récupère la taille des données Méta
    lngret = GetEnhMetaFileBits(lhMetaFile, 0, ByVal 0&)
    ' Redimensionne le tableau de données
    ReDim lPicData((lngret - 1) + 8)
    ' Récupère les données dans le tableau
    lngret = GetEnhMetaFileBits(lhMetaFile, lngret, lPicData(8))
    ' Supprime le MétaFile
    lngret = DeleteEnhMetaFile(lhMetaFile)
    ' Type de l'image dans le tableau de données
    lPicData(0) = CF_ENHMETAFILE
    ' Libère le device contexte de travail
    ReleaseDC 0&, lhdcref
    ' Supprime le DC
    DeleteObject SelectObject(lhDC, lOldBmp)
    DeleteDC lhDC
    ' Renvoie le résultat
    DIBtoPictureData = lPicData
Gestion_Erreurs:
    If Err.number <> 0 Then DIBtoPictureData = Null  ' Renvoie Null si erreur
End Function
 
'---------------------------------------------------------------------------------------
' Charge une image dans un contrôle
'---------------------------------------------------------------------------------------
' pFile        : chemin du fichier
' pCOntrol     : contrôle image
' Renvoit Faux si erreur
'---------------------------------------------------------------------------------------
Public Function LoadImageFile(pFile As String, pControl As Access.image) As Boolean
Dim lImage As Object
    On Error GoTo Gestion_Erreurs:
    Set lImage = LoadPicture(pFile)
    pControl.PictureData = DIBtoPictureData(lImage.Handle)
    Set lImage = Nothing
Gestion_Erreurs:
    If Err.number <> 0 Then LoadImageFile = False
End Function

et pour charger l'image dans le contrôle :

Code :

LoadImageFile "c:\Monfichier.JPG", Me.Image0

[insoo]

Genial, merci je vais tester ca.
Si ca marche avec gif et jpg, ca resoud tout a fait mon problème.

Merci encore

[seb92400]

Hello,

Après une petite recherche je suis tombé sur ce post très intéressant, mais par contre, j'ai une petite question :

Lorsqu'il s'agit de l'image de fond d'un formulaire, que doit-on écrire comme commande ?

J'ai essayé :

Code :

LoadImageFile "C:\Program Files\SIM_v_1.0\Images\SplashScreen.jpg", Me.Picture

(avec Forms.NomDuForm.Picture également), mais ça ne fonctionne pas...

Merci d'avance...

[Arkham46]

BJr,

C'est Me tout court qu'il faut passer en paramètre.
Mais évidemment il faut changer le type de paramètre de la fonction...
(Object au lieu de Access.Image permettera de passer au choix un contrôle image ou un formulaire)

[seb92400]

Mais évidemment il faut changer le type de paramètre de la fonction...

HONTE A MOI !!!!