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
| <HEAD>
<title> Ajout dynamic d'images </title>
<HTA:APPLICATION
id="NbrImgDynamic"
applicationname="NbrImgDynamic"
<SCRIPT language="VBScript" type="text/vbscript">ResizeTo 927,196: MoveTo (Screen.Width-927)/2,(Screen.Height - 196) / 2</SCRIPT>
</HEAD>
<SCRIPT language="VBScript" type="text/vbscript">
Option Explicit
' Déclarations utilisables dans toute la partie VBScript
Dim DossierRacineDuProg
Dim MeImg, T
'----------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
'initialisation
Dim ChemNomComplet
ChemNomComplet = NbrImgDynamic.CommandLine ' ChemNomComplet = Id du programme.CommandLine
DossierRacineDuProg = Left(ChemNomComplet, (InStrRev(ChemNomComplet, "\", -1, vbTextCompare)))
DossierRacineDuProg = Replace(DossierRacineDuProg,Chr(34),"")
ImgXX.Src = DossierRacineDuProg & "MeAvatar2.jpg"
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub BtChargeImg_onClick()
Dim FSO, LeDossier, LesFichiers, LeFichier
Dim ObjImg
' recuperation des images du sous dossier "Images"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set LeDossier = fso.GetFolder(DossierRacineDuProg & "Images\") ' branchement au dossier
Set LesFichiers = LeDossier.Files ' collection des noms de fichiers
T=0
'bouclage des fichiers images
For Each LeFichier in LesFichiers
T = T + 1 ' pour création indexage
Set ObjImg = window.Document.createElement("Img") 'déclaration d'un conteneur image
'paramétrage du conteneur image
ObjImg.Src = DossierRacineDuProg & "Images\" & LeFichier.Name
ObjImg.Title = LeFichier.Name 'Alt fonctionne aussi
ObjImg.Id = "ImgDyn" & T 'indexage unique
ObjImg.Name = "ImgDynam" ' Nom identique pour toutes les immages, peut être considéré comme un tableau d'objet indexé/différencié par son Id unique
ObjImg.Border = "1" 'encadrer
'ObjImg.onClick = GetRef("AffInfos_onClick")'Bon mais pas possible de passage d'argument dans la procédure,
'si la procédure demande un argument, la procédure est ignorée
'lignes qui suivent, ATTENTION le nom de l'evenement est sensible à la casse, OnClick ne fonctionnerati pas, sans pour autant provoquer une erreur
'Déclaration des procédures évènementiels pour le conteneur
ObjImg.attachevent "onclick", GetRef("AffInfos_onClick") 'Bon, il y a bien branchement à la sub et possibilité de récupérer l'argument
ObjImg.attachevent "onmouseover", GetRef("AffInfos_onmouseover")
ObjImg.attachevent "onmouseout", GetRef("AffInfos_onmouseout")
Document.body.appendChild(ObjImg) ' création et affichage du conteneur image
Next
'nettoyage
Set ObjImg = Nothing
Set LesFichiers = Nothing
Set LeDossier = Nothing
Set FSO = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub BtDechargeImg_onClick()
Dim DocuImg, U
If Document.getElementsByTagName("Img").length > 1 Then 'vérification de l’existence de conteneur Img
Set DocuImg = Document.getElementsByTagName("Img") 'collection des conteneurs Img
U = DocuImg.length - 1 'l'indexage de la collection commencent par l'indice 0
For T = U to 0 Step - 1
If DocuImg(T).Name = "ImgDynam" Then
'je ne désire supprimer que les conteneurs Img ajoutés dynamiquement,
'en enlevant la condition If ... Then ... End IF, il est possible de supprimer aussi un conteneur inscrit en dur dans <body> ... </body> (Id ImgXX)
Document.body.removeChild(DocuImg(T))
End If
Next
Set DocuImg = Nothing
End If
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub AffInfos_onClick(ImgObj)
'l'adresse du lien qui m'a fait connaitre et comprendre l'utilisation de .srcElement
'http://arkham46.developpez.com/articles/office/officeweb/?page=page_3#L4-E
Dim MsG
'adaptation pour mon besoin de récupérer l'objet Img ajouté dynamiquement
MsG = "Sub AffInfos_onClick: "
If TypeName(ImgObj) = "DispCEventObj" Then
Set MeImg = ImgObj.srcElement
MsG = MsG & "MeImg.Id = " & MeImg.Id 'images ajoutées dynamiquement
Set MeImg = Nothing
Else 'HTMLImg
MsG = MsG & "ImgObj.Id = " & ImgObj.Id 'image inscrite dans <body> ... </body>
End If
Info.innerText = MsG
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub AffInfos_onmouseover(ImgObj)
'procédure joué une fois à chaque entrée dans l'image
'l'image inscrite dans <body> ... </body> ne fait pas appelle à cette procédure
'images ajoutées dynamiquement
Set MeImg = ImgObj.srcElement
Info.innerText = "Sub AffInfos_onmouseover: la souris commence à passer au dessus de l'objet ---> MeImg.Id = " & MeImg.Id
Set MeImg = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub AffInfos_onmouseout(ImgObj)
'l'image inscrite dans <body> ... </body> ne fait pas appelle à cette procédure
Set MeImg = ImgObj.srcElement
Info.innerText = "Sub AffInfos_onmouseout: la souris quitte l'objet ---> MeImg.Id = " & MeImg.Id
Set MeImg = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
</SCRIPT>
<body>
<Div Id="Info" > Informations </Div>
<INPUT Type="button" name="BtChargeImg" Id="BtChargeImg" value="Charger image" >
<INPUT Type="button" name="BtDechargeImg" Id="BtDechargeImg" value="Décharger les images" >
<Img Id="ImgXX" name="ImgXX" Border = "1" src="" onClick="AffInfos_onclick ImgXX" />
<Br>
</body> |
