Utilisation de WIACommonDialog

**HanGilen** · 29/08/2007, 19h26

Hello,

J'essaie de réaliser une application Access de numérisation. J'ai essayé le code suivant avec un bouton de commande et une image dans un formulaire. Je l'ai tiré d'un exemple Excel trouvé sur le site et qui lui fonctionne bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Option Explicit 
 
Private Sub Commande5_Click() 
Dim Img As ImageFile 
    Set Img = wiaCDiag.ShowAcquireImage 
    If Not (Img Is Nothing) Then 
        Image1.Picture = Img.FileData.Picture 
    End If 
End Sub

J'ai renommé CommonDialog en wiaCDiag.

L'interface de numérisation fonctionne bien mais je n'arrive pas à récupérer l'image numérisée dans mon appli. J'ai le message d'erreur suivant :

Microsoft Access ne peut ouvrir le fichier '-10901855239'.

Le chiffre entre quote change à chaque essai donc je suppose qu'il s'agit d'une référence de fichier temporaire.

D'autre part :

Image1.Picture = demande à être suivi d'une variable String.

Je ne vois pas comment résoudre mon problème.

**HanGilen** · 30/08/2007, 01h41

Je n'avais pas tout compris en ce qui concerne la rédaction de post sur ce forum.
Je crois que j'ai amélioré la présentation.

Invité · 30/08/2007, 04h52

Bonjour

Sous quel format est ton image numérisée, il se peut que celui-ci ne soit pas lisible par Access.

Starec

**Arkham46** · 30/08/2007, 10h22

Bjr,

Explciation du message :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Microsoft Access ne peut ouvrir le fichier '-10901855239'.

Ce nombre est sans doute un identifiant de l'image qui est en mémoire (je dirais même plus probablement un objet IPictureDisp)

Le contrôle Image d'Excel accepte un objet IPictureDisp en entrée, donc avec Excel c'est simple.
Par contre pour Access c'est pas la même chose.
Access demande un nom de fichier en entrée.

Question : est-ce que tu ne pourrais pas sauvegarder l'image dans un fichier temporaire pour ensuite charger ce fichier dans le contrôle??

Sinon si c'est pas possible ou trop lent, il y a une autre solution :
Convertir cet objet IPictureDisp en tableau qu'on peut ensuite injecter dans le contrôle via la propriété PictureData.
Avantage : on n'écrit pas de fichier temporaire, on fait tout en mémoire.
Inconvénient : faut que je retrouve mon code...

**HanGilen** · 30/08/2007, 14h22

Hello,

En réalité mon code d'origine était :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Private Sub Commande5_Click()
On Error GoTo Err_Commande5_Click
Dim Img As ImageFile
 
    Set Img = wiaCDiag.ShowAcquireImage
 
    If Not (Img Is Nothing) Then
        Image1.PictureData = Img.FileData.Picture
    End If
 
Exit_Commande5_Click:
    Exit Sub
 
Err_Commande5_Click:
    MsgBox Err.Description
    Resume Exit_Commande5_Click
 
End Sub

Ce qui donnait le message d'erreur cité dans le premier post à cause du traitement d'erreur.

Avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
 
Private Sub Commande5_Click()
Dim Img As ImageFile
 
    Set Img = wiaCDiag.ShowAcquireImage
 
    If Not (Img Is Nothing) Then
        Image1.PictureData = Img.FileData.Picture
    End If
 
End Sub

Le debugger donne le message suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Erreur d'exécution '2192':
 
La bitmap spécifiée ne se trouve pas au format Image indépendante
du périphérique (.DIB).

sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Image1.PictureData = Img.FileData.Picture

Je n'y connais vraiment rien en matière de formats graphiques.

**Arkham46** · 30/08/2007, 15h08

tu ne peux pas directement mettre Img.FileData.Picture dans Image1.PictureData
Il faut d'abord faire tout un tas d'opérations immondes pour formater correctement un tableau compréhensible par Access

La solution de contournement que je te proposais pour éviter ça, c'est de sauvegarder l'image puis la charger dans le contrôle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
    Set Img = wiaCDiag.ShowAcquireImage
 
    If Not (Img Is Nothing) Then
        Img.SaveFile ("c:\test.jpg")
        Image1.Picture = "c:\test.jpg"
    End If

A tester pour voir si ça marche

**HanGilen** · 30/08/2007, 17h52

Effectivement, celà fonctionne mais il faut gérer le fichier intermédiaire.
Tester son existence avant chaque numérisation et l'effacer s'il existe sinon le debugger se manifeste. Sans compter que la multiplication de cette opération ne va pas améliorer la fragmentation du disque dur.

Par ailleurs, vu la taille du fichier (plus de 9 Mo), je suppose qu'il faudrait ajouter du code pour préciser le format graphique et le taux de compression.

Récupérer l'image directement me semble plus intéressant mais je n'ai pas les connaissances suffisantes pour résoudre tous ces aspects.

Tant pis pour moi !

**Arkham46** · 30/08/2007, 22h30

Au cas où, pour éviter de passer par un fichier externe, voici le code pour pouvoir injecter directement l'image dans un contrôle Access.

Code à mettre dans un petit module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Compare Database
Option Explicit
 
'***************************************************************************************
'*                                       API                                           *
'***************************************************************************************
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 BitBlt Lib "GDI32" _
                                (ByVal destdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
                                 ByVal nHeight As Long, ByVal srcdc As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
                                 ByVal dwRop As Long) As Long
Private Declare Function GetMapMode Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function SetMapMode Lib "GDI32" (ByVal hDC As Long, ByVal nMapMode As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex 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 GetDC Lib "user32" (ByVal hwnd 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 DPtoLP Lib "GDI32" (ByVal hDC As Long, lpPoint As PointAPI, ByVal nCount 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 GetObjectBmp Lib "GDI32" Alias "GetObjectA" _
                              (ByVal hObject As Long, ByVal nCount As Long, lpObject As bitmap) As Long
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                                     *
'***************************************************************************************
'Format d'images
Private Const CF_ENHMETAFILE = 14
' Types pour BitBlt/StretchBlt
Private Const SRCCOPY = &HCC0020
' GetDeviceCaps
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88
' Diverses Constantes
Private Const HIMETRIC_INCH = 2540          ' Pour conversion Pouce<->Himetric
Private Const COLORONCOLOR = 3              ' Mode pour StretchBlt
Private Const HALFTONE = 4                  ' Mode pour StretchBlt avec antialiasing
Private Const MM_HIMETRIC = 3
Private Const MM_TEXT = 1
 
'***************************************************************************************
'*                                       Types                                         *
'***************************************************************************************
' 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
' Rectangle pour API
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
 
'***************************************************************************************
'*                        Fonction pour convertir l'image pour Access                  *
'***************************************************************************************
' pPicture est un identifiant d'image (ex : Img.FileData.Picture)
' la fonction renvoie un tableau formaté pour la propriété PictureData d'un contrôle Access
'***************************************************************************************
Public Function WIAtoAccess(pPicture As Long) As Variant
    On Error GoTo Gestion_Erreurs
    Dim lPictureData() As Byte
    Dim lBmp As bitmap
    Dim lhDC As Long
    Dim lOldBmp As Long
    Dim lhMeta As Long
    Dim lhMetaFile As Long
    Dim lhdcref As Long
    Dim lrect As Rect
    Dim lngret As Long
    Dim pt As PointAPI
    ' Lecture de la taille de l'image
    Call GetObjectBmp(pPicture, Len(lBmp), lBmp)
    ' Récupère la taille en données de type OLE_Himetric pour la création de l'EMF
    lhdcref = GetDC(0)   ' Device contexte temporaire
    lngret = SetMapMode(lhdcref, MM_HIMETRIC)
    ' Rectangle pour création de l'EMF
    lrect.Right = lBmp.bmWidth * (HIMETRIC_INCH / GetDeviceCaps(lhdcref, LOGPIXELSX))
    lrect.Bottom = lBmp.bmHeight * (HIMETRIC_INCH / GetDeviceCaps(lhdcref, LOGPIXELSY))
    ' Conversion de la taille en pixels
    pt.X = lrect.Right
    pt.Y = lrect.Bottom
    LPtoDP lhdcref, pt, 1
    pt.Y = Abs(pt.Y)
    ' Mode d'origine
    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)
    lngret = SetStretchBltMode(lhMeta, HALFTONE)
    ' Crée un contexte d'affichage temporaire
    lhDC = CreateCompatibleDC(0)
    ' Affecte le bitmap au DC temporaire
    lOldBmp = SelectObject(lhDC, pPicture)
    ' Mapping mode.
    SetMapMode lhMeta, GetMapMode(lhDC)
    ' Copie directe de l'image dans le MetaFile
    StretchBlt lhMeta, 0, 0, pt.X, pt.Y, lhDC, 0, 0, lBmp.bmWidth, lBmp.bmHeight, SRCCOPY
    ' Ferme le contexte d'affichage et récupère le MetaFile
    lhMetaFile = CloseEnhMetaFile(lhMeta)
    If Abs(pt.X) > 0 And Abs(pt.Y) > 0 Then
        lngret = GetEnhMetaFileBits(lhMetaFile, 0, ByVal 0&)
        If lngret > 1 Then
            ' Redimensionne le tableau de données
            ReDim lPictureData((lngret - 1) + 8)
            ' Récupère les données dans le tableau
            lngret = GetEnhMetaFileBits(lhMetaFile, lngret, lPictureData(8))
            ' Supprime le MétaFile
            lngret = DeleteEnhMetaFile(lhMetaFile)
            ' Type de l'image dans le tableau de données
            lPictureData(0) = CF_ENHMETAFILE
        End If
    Else
        ' Image invalide
        lPictureData = Null
    End If
Gestion_Erreurs:
    ' Libère le device contexte de travail
    ReleaseDC 0&, lhdcref
    ' Sélectionne l'ancien bitmap pour libérer pPicture
    SelectObject lhDC, lOldBmp
    ' Supprime le contexte d'affichage temporaire
    DeleteDC (lhDC)
    If Err.Number <> 0 Then WIAtoAccess = Null Else WIAtoAccess = lPictureData
End Function

Ensuite c'est tout simple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Image1.PictureData = WIAtoAccess(Img.FileData.Picture)

Je laisse chacun décider s'il préfère passer par un fichier temporaire ou utiliser le code qui fait peur.

**mcorvaisier** · 09/03/2009, 17h00

Bonjour,
J'utilise ton code dans un module, puis dans mon formulaire je met le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Image1.PictureData = WIAtoAccess(Img.FileData.Picture)

Cependant dans mon formulaire et dans le contrôle Image1, il n'y a rien.

Pour dans Img j'ai quelque chose : une serie de chiffre du genre: '-10901855239'

Merci.

Utilisation de WIACommonDialog

VBA Access

Discussions similaires

Partager

Partager