Cette classe permet de créer des barres de progressions dans les applications HTA . Elle est très complète et accompagnée d'une bonne documentation .
Source / Exemple :
CLASS Barre_Progression
PRIVATE uID
PRIVATE Progression
PRIVATE couleur
PRIVATE hauteur
PRIVATE boolAfficheTxt
PRIVATE style
PRIVATE function vbNomGenID()
vbNomGenID="Barre_Progression_azertyuiopqsdfghjklmwxcvbn"
END function
PRIVATE SUB CLASS_Initialize
boolAfficheTxt=false
Progression="0%"
couleur="green"
hauteur=10
uID=0
style=""
END SUB
PRIVATE FUNCTION TxtstyleProgression()
IF boolAfficheTxt=true THEN
TxtstyleProgression="block"
ELSE
TxtstyleProgression="none"
END IF
END FUNCTION
PRIVATE FUNCTION TxtStyleBarre()
IF style = "" THEN
TxtStyleBarre= ""
ELSE
TxtStyleBarre= "style=" & chr(34) & style & chr(34)
END IF
END FUNCTION
PUBLIC SUB PutInDoc(byval IdCible)
DIM tmpId
tmpId="0"
DO while not ((document.getElementById(vbNomGenID() & tmpId) Is nothing) and (document.getElementById(vbNomGenID() & tmpId & "parent") Is nothing))
tmpId=tmpId+1
LOOP
uID=vbNomGenID() & tmpId
SET objCible = document.getElementById(IdCible)
IF objCible Is Nothing THEN
THROWErrPerso 1,idCible
ELSE
objCible.innerhtml=objCible.innerhtml & "<br /><div id=" & chr(34) & uID & "parent" & chr(34) & " style=" & chr(34) & "background-color:white ;border-style : solid;border-width: 1px; " & chr(34) & "><TABLE id=" & chr(34) & uID & chr(34) & " bgColor=" & couleur & " height=" & hauteur & " width=" & Progression & "%" & " cellSpacing=0 cellPadding=0 border=0 " & TxtStyleBarre() & " ><TR><TD align=" & chr(34) & "center" & chr(34) & "><div id=" & chr(34) & uID & "txt" & chr(34) & " style=" & chr(34) & "display:" & TxtstyleProgression() & chr(34) & ">" & Progression & "%" & "</div></TD></TR></TABLE></div>"
END IF
END SUB
PUBLIC SUB SET_Progression(byval nbprct)
IF NOT (vartype(nbprct)=vbInteger OR vartype(nbprct)=vbDouble) THEN
THROWErrPerso 2,nbprct
ELSE
IF nbprct<101 and nbprct>=0 THEN
Progression=nbprct
IF NOT document.getElementById(uId) IS NOTHING THEN
document.getElementById(uId).width=Progression & "%"
document.getElementById(uId & "txt").innerhtml=Progression & "%"
END IF
ELSE
THROWErrPerso 3,nbprct
END IF
END IF
END SUB
PUBLIC SUB SET_AffichageTxt(byval boolAffiche)
IF vartype(boolAffiche)=vbBoolean THEN
boolAfficheTxt=boolAffiche
IF NOT document.getElementById(uId) IS NOTHING THEN
document.getElementById(uId & "txt").style.display=TxtstyleProgression()
END IF
ELSE
THROWErrPerso 5,boolAffiche
END IF
END SUB
PUBLIC SUB SET_couleur(byval ncouleur)
couleur=ncouleur
IF NOT document.getElementById(uId) IS NOTHING THEN
document.getElementById(uId).bgColor=couleur
END IF
END SUB
PUBLIC SUB SET_hauteur(byval nhauteur)
IF NOT vartype(nhauteur)=vbInteger THEN
THROWErrPerso 6,nhauteur
ELSE
hauteur=nhauteur
IF NOT document.getElementById(uId) IS NOTHING THEN
document.getElementById(uId).height=hauteur
END IF
END IF
END SUB
PUBLIC SUB PRESET_style(byval nstyle)
IF uID="0" THEN
style=nstyle
ELSE
THROWErrPerso 4,"4"
END IF
END SUB
PUBLIC FUNCTION GET_Progression()
GET_Progression=Progression
END FUNCTION
PUBLIC FUNCTION GET_Couleur()
GET_Couleur=couleur
END FUNCTION
PRIVATE SUB THROWErrPerso(byval numerr,byval varindic)
Select Case numerr
case 1
call Err.Raise(60001, "Barre_Progression.PutInDoc","Barre_Progression.PutInDoc:" & VbCrLf & Chr(9) & "Impossible de trouver une balise HTML ayant l'id " & chr(34) & varindic & chr(34))
case 2
call Err.Raise(60002, "Barre_Progression.SET_Progression","Barre_Progression.SET_Progression:" & VbCrLf & Chr(9) & chr(34) & varindic & chr(34) & " n'est pas un nombre")
case 3
call Err.Raise(60003, "Barre_Progression.SET_Progression","Barre_Progression.SET_Progression:" & VbCrLf & Chr(9) & chr(34) & varindic & chr(34) & " n'est pas compris entre 0 et 100")
case 4
call Err.Raise(60004, "Barre_Progression.PRESET_style","Barre_Progression.PRESET_style:" & VbCrLf & Chr(9) & chr(34) & "Impossible d'utiliser" & chr(34) &".PRESET_style()" & chr(34) & " après " & chr(34) & ".PutInDoc()" & chr(34))
case 5
call Err.Raise(60005, "Barre_Progression.SET_AffichageTxt","Barre_Progression.SET_AffichageTxt:" & VbCrLf & Chr(9) & chr(34) & varindic & chr(34) & " n'est pas de type booléen")
case 6
call Err.Raise(60006, "Barre_Progression.SET_hauteur","Barre_Progression.SET_hauteur:" & VbCrLf & Chr(9) & chr(34) & varindic & chr(34) & " n'est pas de type integer")
end select
END SUB
PUBLIC SUB Class_Terminate
document.getElementById(uID & "parent").removeNode(true)
END SUB
END CLASS
Conclusion :
Voila si vous trouvez quoi que ce soit à améliorer dans le code, postez un commentaire ou envoyez-moi un message privé !
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.