Discussion :

[xycoco]

Bonjour,

J'ai créé un formulaire menu avec ClImage selon la méthode d'Arkham 46. Le formulaire affiche des images issues de la tbl_Bouteille comlposé d'un champ Nom (affiche la légende de l'image), d'un champ Image (chemin d'accès où sont stockées les images), NumBouteille étant le numAuto de la table.

Le code fonctionne, les images s'affichent côte à côte dans mon formulaire mais la légende (Nom) sous la 1ère image est absente, alors que les autres sont présentes, et je ne vois pas pourquoi???

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
153
154
155
156
157
158
159
160
161
162
163
Option Compare Database
Option Explicit
'***************************************************************************************
'*                               Démo Menu avec Images                                 *
'***************************************************************************************
Private climg As ClImage    ' Classe Image
 
Private Const cEspaceX As Long = 100    ' Espacement X entre les vignettes
Private Const cEspaceY As Long = 100    ' Espacement Y entre les vignettes
 
Private gTaille As Long   ' Taille de chaque vignette
Private gImages As New Collection    ' Collection pour conserver les coordonnées de chaque image
Private gExplMAJ As Boolean     ' Flag pour réinitialisation de l'explication
Private Const cType As Integer = acOLESizeZoom    ' Type d'affichage des vignettes
Private Const cPosition As Integer = 2   ' Position des vignettes
 
Private Sub Form_Load()
    Dim lFormCadreLeftOld As Long
    Dim lCtrl As Variant
    On Error GoTo Gestion_Erreurs
    ' Initialise la classe
    Set climg = New ClImage
    ' Centre les contrôles horizontalement
    On Error Resume Next
    Me.Image0.Top = 0
    Me.Image0.Left = (Me.InsideWidth - Me.Image0.Width) / 2
    On Error GoTo Gestion_Erreurs
    ' Pas de menu sur bouton droit
    Me.ShortcutMenu = False
    ' Désactive thème XP
    If SysCmd(acSysCmdAccessVer) = "11.0" Then climg.SetXPTheme False
    ' Initialise le contrôle image
    climg.SetImgCtrl Me.Image0
    ' Remplit l'image de blanc
    climg.FillColor Me.Section(acDetail).BackColor
    ' Applique l'image (blanche) dans le contrôle
    climg.Repaint
    ' Taille Vignettes
    gTaille = climg.PixelToTwipsX("160")
    ' Affiche le menu
    DisplayMenu
    ' Applique les changements sur le contrôle image
    climg.Repaint
Gestion_Erreurs:
    If Err.Number <> 0 Then MsgBox Err.description
End Sub
 
'---------------------------------------------------------------------------------------
' Affiche le menu
'---------------------------------------------------------------------------------------
Private Sub DisplayMenu()
    Dim rs As dao.Recordset
    Dim lX As Long
    Dim lY As Long
    Dim lTexteHeight As Long
    Dim lCalcHeight As Long
    On Error GoTo Gestion_Erreurs
    ' Désactive l'affichage du formulaire
    Me.Painting = False
    ' Curseur d'attente (horloge)
    DoCmd.Hourglass True
    ' Réduit l'image en hauteur à 1 pixel; elle sera redimensionnée autant que nécessaire
    climg.ImgResize Image0.Width, 1
    ' Rempli l'image de blanc
    climg.FillColor Me.Section(acDetail).BackColor
    ' Table des entrées de menu
    Set rs = CurrentDb.OpenRecordset("select * from tbl_Bouteille order by Nom")
    ' On se place sur le premier enregistrement
    rs.MoveFirst
    ' On laisse un tiers d'espace vertical avant de commencer à dessiner
    lY = cEspaceY / 3
    ' On parcourt la table tbl_Bouteille
    While Not rs.EOF
        ' Retour à la ligne si on dépasse l'image à droite
        If lX + cEspaceX + gTaille > Me.Image0.Width Then
            lX = 0
            lY = lY + cEspaceY + gTaille + lTexteHeight
            lTexteHeight = 0
        End If
        ' Police de caractères
        climg.DrawNewFont climg.FontSizeToHeight(10) * climg.TwipsToPixelX(gTaille) / 140, 0, 700, False, False, False, "Comic Sans MS"
        ' Taille du texte pour contenir deux lignes
        climg.GetTextLength rs!Nom, gTaille + cEspaceX, lCalcHeight, True
        If lCalcHeight > lTexteHeight Then lTexteHeight = lCalcHeight
        lX = lX + cEspaceX
        ' Agrandi l'image si nécessaire
        If lY + gTaille + lTexteHeight > Image0.Height Then
            climg.ImgResize Image0.Width, climg.fMax(lY + gTaille + lTexteHeight, Image0.Height), , , Me.Section(acDetail).BackColor
        End If
 
        ' Ajoute une image à la liste, de largeur cTaille
        climg.ImageListAdd rs!Nom, rs!image, gTaille
        ' Dessine l'image en noir et blanc
        ' et ajoute une region correspondant à l'image avec le nom du formulaire en identifiant
        climg.PaintImage rs!Nom, lX, lY, lX + gTaille, lY + gTaille, Me.Section(acDetail).BackColor, cType, cPosition, , , "GRAY", , , rs!Nom
        ' Police de caractères
        climg.DrawNewFont climg.FontSizeToHeight(10) * climg.TwipsToPixelX(gTaille) / 140, 0, 700, False, False, False, "Comic Sans MS"
        ' Affiche le texte sous l'image
        climg.DrawText rs!Nom, lX - cEspaceX / 2, lY + gTaille, lX + gTaille + cEspaceX / 2, lY + gTaille + lCalcHeight, , , , , True
        ' Stocke les coordonnées de l'image
        gImages.Add Array(lX, lY), rs!Nom
        ' On avance d'une image vers la droite
        lX = lX + gTaille
        ' Et on avance d'un enregistrement
        rs.MoveNext
    Wend
    ' Dessin définitif dans le contrôle
    climg.Repaint
    ' Conserve le menu de base avec les photos en noir et blanc
    climg.KeepImgData "Tampon"
    ' Referme le recordset
    rs.Close
    Set rs = Nothing
Gestion_Erreurs:
    ' Réactive l'affichage du formulaire
    Me.Painting = True
    ' Si l'image existe déjà dans gImages on la supprime et on recommence
    If Err.Number = 457 Then gImages.Remove rs!Nom: Resume
    DoCmd.Hourglass False    ' Réinitialisation du curseur
    If Err.Number <> 0 Then MsgBox Err.description
End Sub
 
'---------------------------------------------------------------------------------------
' Sur déplacement de la souris
'---------------------------------------------------------------------------------------
' Modifie le curseur et encadre de rouge l'image survolée par la souris
'---------------------------------------------------------------------------------------
Private Sub Image0_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sRegion As String    ' Région sous le curseur
    Static OldRegion As String    ' Région lors du précédent appel de cette fonction
    On Error GoTo Gestion_Erreurs
    If Not climg Is Nothing Then    ' On vérifie que la classe est initialisée
        sRegion = climg.GetMouseRegion(X, Y)  ' On récupère la région sous le curseur de la souris
        ' Si la souris est sur une image on affiche un curseur en forme de main
        If sRegion <> "" Then climg.SetHandCursor Else climg.ResetCursor
    Else
        ' Si la classe a été perdue (principalement si modification du code
        '  durant l'exécution, c'est normalement inutile en production) alors on la réinitialise
        ' La mémoire occupée par l'instance précédente n'est pas libérée pour autant...
        Set climg = New ClImage
        Form_Load    ' Initialise le contrôle image
    End If
    If OldRegion <> sRegion Then    ' Si on a changé de région
        If sRegion <> "" Then
            ' Récupère le menu en noir et blanc
            climg.RefreshImgData "Tampon"
            ' Dessine l'image sous la souris en couleur
            climg.FillColor Me.Section(acDetail).BackColor, CLng(gImages.Item(sRegion)(0)), CLng(gImages.Item(sRegion)(1)), CLng(gImages.Item(sRegion)(0) + gTaille), CLng(gImages.Item(sRegion)(1) + gTaille)
            climg.PaintImage sRegion, gImages.Item(sRegion)(0), gImages.Item(sRegion)(1), gImages.Item(sRegion)(0) + gTaille, gImages.Item(sRegion)(1) + gTaille, Me.Section(acDetail).BackColor, cType, cPosition
            ' Dessine un cadre autour de la region
            climg.FrameRegion sRegion, 255, 2
            ' Applique les modification au contrôle
            climg.Repaint True
        ElseIf sRegion = "" Then
            ' Si pas de région sous le curseur on rétablit le menu en noir et blanc
            climg.RefreshImgData "Tampon"
            climg.Repaint True
        End If
    End If
    OldRegion = sRegion    ' Sauvegarde la valeur de la région survolée
Gestion_Erreurs:
    If Err.Number <> 0 Then MsgBox Err.description
End Sub

Merci de votre aide

[xycoco]

Bonjour,

Voilà plusieurs jours que je butte dessus...et cela m'embête vraiment. Tous les intitulés de mes images sont présents sauf la 1ère...

Pouvez-vous m'aider ?
Merci

[Lou Pitchoun]

Salut,

A première vue ton code à l'air correct.

Si tu fais un debug.print, que vaut rs!Nom ?

[xycoco]

Bonjour,

Vraiment merci de vouloir m'aider, c'est vraiment sympa

Je vais paraître bête...mais qu'est ce que faire un debug.print

Je copie souvent des codes que j'essaie de comprendre et de remettre dans mon contexte, mais mes compétences en access s'arrêtent là je n'ai pas de formation de base.

Merci

PS : je ne sais si c'est cela mais j'ai mis

Code :

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

Debug.print rs!Nom

juste après la création de mon texte sous l'image.
La fenêtre exécution m'affiche l'ensemble des enregistrements de mon champ Nom, donc l'ensemble des légendes que je souhaites avoir sous mes images.

[Lou Pitchoun]

Ok, c'est ce qu'il fallait faire.

Maintenant exécute ton code en mode pas à pas en appuyant sur la touche F8 pour afficher (et avoir le temps de voir surtout) ce que vaut rst!nom à la 1ère itération (c'est à dire au 1er enregistrement).

Si rst!nom est vide : pas de soucis.
S'il y a une valeur, il va falloir décortiquer le tout pour savoir pourquoi.

[xycoco]

Malheureusement j'ai une valeur à chacune de mes itérations. Cette valeur correspondant à la 1ère valeur demon champ Nom.

Ci-joint le fichier avec codes

[Arkham46]

Bjr,

Il y a un petit bug de calcul dû à l'appel de la fonction ImgResize...

Tu peux :
- soit supprimer l'appel à cette fonction qui n'est pas indispensable
- soit changer le mode d'affichage du contrôle image => passer de Zoom à Découpage car le bug n'apparait pas en mode découpage (c'est de toute façon mieux de passer en Découpage si le Zoom n'est pas nécessaire => moins de calculs inutiles)

Désolé pour le bug...

Ps : retire la référence à MouseWheelDVP.dll (dans outils -> Références) si tu ne l'utilises plus (apparemment il y a maintenant appel à l'autre dll dans le code), ça évitera des messages d'erreurs sur d'autres PC.

[xycoco]

Bonjour Arkham,

Cela fait plaisir de parler directement au grand créateur des tutos

Il n'y a vraiment pas de quoi à être désolé au vu de ce remarquable module et à l'utilisation que l'on peut en faire.

D'ailleurs je dois retravailler avec pour créer le shéma de ma cave et ainsi y associer mes entrées/sorties
Aujourd'hui je le fais avec excel intégré à un formulaire...mais franchement pas terrible.

Merci pour tout