Comment récuperer la position et les dimensions d'un HTA
Salut, bonne année
Je suis toujours dans l'apprentissage de l'interface VBScript/HTA. :)
j'ai un HTA qui génère un autre HTA
Je souhaiterai pouvoir positionner et dimensionner le HTA génère au même emplacement et dimensions que le HTA qui l'a créé.
Après de multiples lectures et essais, j'en suis arrivé à ce
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
| <HTML>
<HEAD>
<TITLE>Passage Position et Dimmensions</TITLE>
<HTA:APPLICATION
applicationname="PositDimm"
id ="PositDimm"
>
<SCRIPT language="VBScript" type="text/vbscript">ResizeTo 835,580: MoveTo (Screen.availWidth-835)/2,(Screen.availHeight - 580) / 2</SCRIPT>
</HEAD>
<SCRIPT language="VBScript" type="text/vbscript">
'----------------------------------------------------------------------------------------------------------------------
'*** variables public ***
Dim WshShell, ChemFichierNewPage
'------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
'*** recuperation du chemin dossier d'ou vient d'être lancé PositDimm.hta pour créer le chemin complet du fichier temporaire NewPage.hta ***
Set WshShell = CreateObject("WScript.Shell")
ChemFichierNewPage = WshShell.CurrentDirectory & "\NewPage.hta"
Set WshShell = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub NewPage()
'*** recherche du positionnement et dimmensions du présent HTA pour les passer au HTA suivant ***
Dim LargBur, LargDoc, Leftt
LargBur = Screen.availWidth '*** Largeur disponible de l'écran (sans les barres d'outils du bureau window) ***
LargDoc = document.body.offsetWidth '*** Largeur de la partie interieur de la fenêtre HTA (compris barre de défilement) ***
Leftt = screenLeft '*** Distance du bord gauche de l'écran à la partie gauche de l'interieur de la fenêtre HTA***
Dim HautDoc, Topp, HautBur
'HautBur = Screen.availHeight '*** Hauteur disponibles de l'écran (sans les barres d'outils du bureau window) *** non utilisé
HautDoc = document.body.offsetHeight '*** Hauteur de la partie interieur de la fenêtre HTA (compris barre de défilement) ***
Topp = screenTop '*** Distance du bord haut de l'écran à la partie haute de l'interieur de la fenêtre HTA ***
Dim Bord, BarT
'*** valeur empirique, je n'ai pas trouvé les propriétés pouvant me les renvoyer ***
Bord = 8: BarT = 22
Dim MsGPage
'*** création du fichier hta ***
MsGPage = "<HTML>" & vbCrLf _
& " <HEAD>" & vbCrLf _
& " <TITLE>Nouvelle page</TITLE>" & vbCrLf _
& " <HTA:APPLICATION" & vbCrLf _
& " ApplicationName=" & Chr(34) & "NewPage" & Chr(34) & vbCrLf _
& " id=" & Chr(34) & "NewPage" & Chr(34) & vbCrLf
If Leftt = 0 And LargDoc = LargBur Then
'*** il y a toutes les chances que l'utilisateur a maximizer la fenêtre, parametre NewPage.hta en maximizé ***
MsGPage = MsGPage & " WindowState = " & Chr(34) & "maximize" & Chr(34) & vbCrLf _
& " >" & vbCrLf
Else
'*** la fenêtre n'est pas maximizée, parametre NewPage.hta en dimensions et placement ***
Topp = Topp - (BarT + Bord)
HautDoc = HautDoc + BarT + (Bord * 2)
Leftt = Leftt - Bord
LargDoc = LargDoc + (Bord * 2)
MsGPage = MsGPage & " >" & vbCrLf _
& " <SCRIPT language=" & Chr(34) & "VBScript" & Chr(34) & " type=" & Chr(34) & "text/vbscript" & Chr(34) & ">" & vbCrLf _
& " ResizeTo " & LargDoc & "," & HautDoc & ": MoveTo " & Leftt & "," & Topp & vbCrLf _
& " " & Chr(60) & "/SCRIPT>" & vbCrLf
End If
MsGPage = MsGPage & " </HEAD>" & vbCrLf _
& " <body>" & vbCrLf _
& " <H5>Bon ?</H5>" & vbCrLf _
& " </body>" & vbCrLf _
& "</HTML>"
EnregJouerNewPage MsGPage
If chkClose.Checked Then window.Close
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub EnregJouerNewPage(LeMassage)
Dim Fso, Fic
Const ForWriting = 2
'*** enregistrement ***
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fic = Fso.OpenTextFile(ChemFichierNewPage, ForWriting, True)
Fic.Write LeMassage
Fic.Close: Set Fic = Nothing: Set Fso = Nothing
'*** lancement ***
Set WshShell = CreateObject("WScript.Shell")
If InStr(1, ChemFichierNewPage, Chr(32)) Then
'*** le chemin contient au moin un espace, ajout de double cote ***
WshShell.Run Chr(34) & ChemFichierNewPage & Chr(34)
Else
WshShell.Run ChemFichierNewPage
End If
Set WshShell = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub CheckCloseD
'*** bascule coché/non coché depuis la partie commentaire à droite du checkbox ***
chkClose.Checked = Not chkClose.Checked
End Sub
'----------------------------------------------------------------------------------------------------------------------
</SCRIPT>
<Body>
<INPUT Type="button" value="New page" onClick="NewPage">
<INPUT Type="checkbox" name="chkClose" CHECKED><em onClick="CheckCloseD" style="color: green">Fermer cette page</em>
</Body>
</HTML> |
N'y a t il pas de possibilité (comme en VB6) de récupérer le Top, Left, Height et Width de la fenêtre qui contient le HTA ?
Question supplémentaire mais toujours liée, si sur le premier HTA on zoom (Ctrl+roue de la souris), le bout de code ne fonctionne plus correctement, cette information de zoom est elle récupérable ?
Curiosité, si ligne 60 on ecrit </SCRIPT>, le signe < provoque une erreur, code 0, 'End' attendu, j'ai mis un moment avant de pouvoir trouver la solution du passage par Chr(60).
Merci de vos éclaircissement.
