la jauge qui fait patienter

D'abord le programme principal :

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
const hkey      = "HKEY_CURRENT_USER\Volatile Environment\jauge"
       set    WShell = CreateObject("Wscript.Shell")
 
'       écriture registre pour démarrer la jauge
	WShell.RegWrite hkey,now
	WShell.run "jauge.hta",1,false  ' démarrer la jauge
	                                ' =================
'        WScript.Sleep 200
         y=y+1 : if y=10 then
                       y =0 :	
                       pc= .....    ' pourcentage à calculer
                       WShell.RegWrite hkey,pc
                 end if
.
.
.
  traitement à effectuer
.
.
.
 
        WShell.RegDelete (hkey)         ' arrêter la jauge
	                                ' =================
msgbox "Terminé"

Bien, maintenant passons à la jauge :

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
<html>
	<HEAD>
		<TITLE>Application : Patientez ... en cours</TITLE>
		<HTA:APPLICATION ID = 'jauge'
                    scroll='no'>	</HEAD>
	<script language="VBScript">
	    dim MonTimer
        hkey = "HKEY_CURRENT_USER\Volatile Environment\jauge"
        Set WshShell = CreateObject("WScript.Shell")
		Sub Window_onLoad
        	    window.resizeTo 620,70
		    tb1.width=1
	MonTimer = window.setInterval ("MonScript", 500, "VBScript")
                        'Appel de MonScript toutes les 1/2 secondes
		End sub
 
        sub MonScript
	              on error resume next
		pc = fix(WshShell.RegRead (hkey))	'    % lu		
              if     err.number <> 0   then                window.close
		 x  = 6*pc   '600*pc/100
		tb1.width =   x
		if tb1.Width > 600 then tb1.Width =1
         Self.document.title = " Patientez ... en cours "  &  pc & "% traités"
        end sub
</script>
<BODY>
<TABLE id="tb1" bgColor=green   height=10 width=0
            cellSpacing=0  cellPadding=0 border= 0>
 <TR><TD></TD></TR>
</TABLE>
	</BODY>
</html>