Comment récuperer la position et les dimensions d'un HTA

**ProgElecT** · 06/01/2012, 18h41

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 :

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
<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.

**hackoofr** · 06/01/2012, 22h48

Peut-être ce Code trouvé dans un forum anglais va te donner plus des idées à propos de la sauvegarde de la taille et la position de la fenêtre.
Donc ce HTA contient simplement un textarea avec un auto-enregistrement du code qui se sauve à la sortie, il enregistre également la taille et la position de la fenêtre aussi.

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
 <HTML ID="HTMLSaveAll"><HEAD><TITLE>.</TITLE>
<HTA:APPLICATION SHOWINTASKBAR="No" SYSMENU="No" SCROLL="No" MAXIMIZEBUTTON="NO"/></HEAD>
<BODY ID="objBody" STYLE="Margin:0;Border:0" SaveX=100 SaveY=100 SaveW=220 SaveH=220 Viewed="Never" Count=0>
<TEXTAREA ID="txaPad" STYLE="Width:100%;Height:100%;Font-Family:Arial;Font-Size:12;Overflow-Y:Auto;
BackGround-Color:#FFFFA0; Scrollbar-Base-Color:#C0C050;"></TEXTAREA><SCRIPT LANGUAGE="VBScript">
 
'*****************
'-- HTA Post-It --
'By Alan Bond 2011
'*****************
 
'To take full advantage of this HTA so you can right click and "New post-it" anywhere in windows XP:-
'(Requires TweakUI)
 
'1. In Explorer goto Tools\Folder-Options\File Types and add a new one called PSI (or whatever you like)
'2. Goto Advanced and add a new action "Open" with application:- C:\WINDOWS\System32\mshta.exe "%1"
'3. Give it a description (used in New menu) and a nice icon (something yellow)
'4. Rename this HTA to "whatever.PSI" (remove any post-it text, and these comments)
'5. In TweakUI goto Templates and add the above PSI file (You can now delete whatever.PSI)
 
Option Explicit
 
Dim strPath 'Filename of this HTA
Dim intOffX,intOffY 'Size of window border and title
 
'---- Restore last size\position
With objBody
 '---- If last session was out of screen then re-position
 If Int(.SaveX)<0 Then .SaveX=0
 If Int(.SaveY)<0 Then .SaveY=0
 If Int(.SaveX)+Int(.SaveW)>Screen.Width Then .SaveX=Screen.Width-.SaveW
 If Int(.SaveY)+Int(.SaveH)>Screen.Height Then .SaveY=Screen.Height-.SaveW
 
 Self.MoveTo 9999,0 : Self.ResizeTo .SaveW,.SaveH 'Limits flicker a bit
 Self.ResizeTo .SaveW+(.SaveW-.OffsetWidth),.SaveH+(.SaveH-.OffsetHeight) 'True innersize
 Self.MoveTo 0,0 : intOffX=Window.ScreenLeft : intOffY=Window.ScreenTop 'Get title\border size
 Self.MoveTo .SaveX,.SaveY : txaPad.Title="Last viewed: " & .Viewed & VBCRLF & "View count: " & .Count
End With
 
'---- The title is the single filename with no extension
strPath = Replace(Document.Location.Pathname,"/","\") : strPath = Replace(strPath,"%20"," ")
Document.Title=Right(strPath,Len(strPath)-InstrRev(strPath,"\")) 'Filename
Document.Title=Left(Document.Title,Len(Document.Title)-4) 'Extension
txaPad.Focus
 
'---- Exit on blur
Sub txaPad_OnBlur()
 '---- Store position,size and info in body
 With objBody
 .SaveX=Window.ScreenLeft-intOffX : .SaveY=Window.ScreenTop-intOffY : .Count=.Count+1 
 .SaveW=Document.Body.offsetwidth : .SaveH=Document.Body.OffsetHeight : .Viewed=Now
 End With
 '---- Save & exit
 Dim objFile : On Error Resume Next 'For Read-only files etc.
 Set objFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(strPath, True)
 objFile.Write HTMLSaveAll.OuterHTML : objFile.Close : 
 Window.Close
End Sub
 
</SCRIPT></BODY></HTML>

**ProgElecT** · 07/01/2012, 13h47

Salut hackoofr

Merci de ton intervention.
Je n'ai pas répondu lors de la première lecture de ton post car j'ai voulu comprendre et expérimenter.
Pas convainquant comme code, cela reste une usine à gaz pour n'obtenir que 4 paramètres, de plus, même problème si l'utilisateur zoom la fenêtre.

La hauteur de la barre de titre et l'épaisseur des bord de la fenêtre HTA que j'ai obtenu (ligne 36 de mon code) est justement par déduction entre HTA non maximisé et HTA maximisé, je n'ai pas mis cette fonction car cela n'est pas visuellement joli au moment du lancement du HTA.

Reste que toutes informations, même si elles ne solutionnent pas complétement mon attente m'en apprend encore un peu plus sur VBScript/HTA

Comment récuperer la position et les dimensions d'un HTA

VBScript

Discussions similaires

Partager

Partager