login  Naam:   Wachtwoord: 
Registreer je!
 Scripts:

Scripts > Overige > VBScript > progressbar in IE

progressbar in IE

Auteur: Onbekend - 16 november 2004 - 15:55 - Gekeurd door: Dennisvb - Hits: 6988 - Aantal punten: 2.67 (3 stemmen)



Een progressbar in IE-explorer.

Code:
  1. Dim bar, i
  2. Set bar = new IEProgBar
  3. With bar
  4. .Move -1, -1, 500, -1
  5. .Units = 30
  6. .Show
  7. For i = 0 to 29
  8. WScript.Sleep 500
  9. .Advance
  10. End With
  11. Set bar = Nothing
  12.  
  13.  
  14. '-------- Start Progress bar Class ----------------------------------
  15. Class IEProgBar
  16. Private FSO, IE, BCol, TCol, ProgCol, ProgNum, ProgCaption, Pic, Q2, sTemp, iProg, ProgTitle
  17.  
  18. Private Sub Class_Initialize()
  19. On Error Resume Next
  20. Set FSO = CreateObject("Scripting.FileSystemObject")
  21. sTemp = FSO.GetSpecialFolder(2)
  22. Set IE = CreateObject("InternetExplorer.Application")
  23. With IE
  24. .AddressBar = False
  25. .menubar = False
  26. .ToolBar = False
  27. .StatusBar = False
  28. .width = 400
  29. .height = 120
  30. .resizable = True
  31. End With
  32. BCol = "E0E0E4" '--background color.
  33. TCol = "000000" '--caption text color.
  34. ProgCol = "0000A0" '--progress color.
  35. ProgNum = 20 'number of progress units.
  36. ProgCaption = "Vooruit. . ."
  37. ProgTitle = "Progress"
  38. Q2 = chr(34)
  39. iProg = 0 '--to track progress.
  40. End Sub
  41.  
  42. Private Sub Class_Terminate()
  43. On Error Resume Next
  44. IE.Quit
  45. Set IE = Nothing
  46. Set FSO = Nothing
  47. End Sub
  48.  
  49. Public Sub Show()
  50. Dim s, i, TS
  51. On Error Resume Next
  52. s = "<HTML><HEAD><TITLE>" & ProgTitle & "</TITLE></HEAD>"
  53. s = s & "<BODY SCROLL=" & Q2 & "NO" & Q2 & " BGCOLOR=" & Q2 & "#" & BCol & Q2 & " TEXT=" & Q2 & "#" & TCol & Q2 & ">"
  54. If (Pic <> "") Then
  55. s = s & "<IMG SRC=" & Q2 & Pic & Q2 & " ALIGN=" & Q2 & "Left" & Q2 & ">"
  56. End If
  57. If (ProgCaption <> "") Then
  58. s = s & "<FONT FACE=" & Q2 & "arial" & Q2 & " SIZE=2>" & ProgCaption & "</FONT><BR><BR>"
  59. Else
  60. s = s & "<BR>"
  61. End If
  62. s = s & "<TABLE BORDER=1><TR><TD><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>"
  63. For i = 1 to ProgNum
  64. s = s & "<TD WIDTH=16 HEIGHT=16 ID=" & Q2 & "P" & Q2 & ">"
  65. s = s & "</TR></TABLE></TD></TR></TABLE><BR><BR></BODY></HTML>"
  66. Set TS = FSO.CreateTextFile(sTemp & "\iebar1.html", True)
  67. TS.Write s
  68. TS.Close
  69. Set TS = Nothing
  70. IE.Navigate "file:///" & sTemp & "\iebar1.html"
  71. IE.visible = True
  72. End Sub
  73.  
  74. Public Sub Advance()
  75. On Error Resume Next
  76. If (iProg < ProgNum) and (IE.Visible = True) Then
  77. IE.Document.All.Item("P", (iProg)).bgcolor = Q2 & "#" & ProgCol & Q2
  78. iProg = iProg + 1
  79. End If
  80. End Sub
  81.  
  82. Public Sub Move(PixLeft, PixTop, PixWidth, PixHeight)
  83. On Error Resume Next
  84. If (PixLeft > -1) Then IE.Left = PixLeft
  85. If (PixTop > -1) Then IE.Top = PixTop
  86. If (PixWidth > 0) Then IE.Width = PixWidth
  87. If (PixHeight > 0) Then IE.Height = PixHeight
  88. End Sub
  89.  
  90. '--verwijder Registry settings dat advertentie in titelbar laat zien.
  91.  
  92. Public Sub CleanIETitle()
  93. Dim sR1, sR2, SH
  94. On Error Resume Next
  95. sR1 = "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title"
  96. sR2 = "HKCU\Software\Microsoft\Internet Explorer\Main\Window Title"
  97. Set SH = CreateObject("WScript.Shell")
  98. SH.RegWrite sR1, "", "REG_SZ"
  99. SH.RegWrite sR2, "", "REG_SZ"
  100. Set SH = Nothing
  101. End Sub
  102.  
  103. '------------- Set background color: ---------------------
  104.  
  105. Public Property Let BackColor(sCol)
  106. If (TestColor(sCol) = True) Then BCol = sCol
  107. End Property
  108.  
  109. '------------- Set caption color: ---------------------
  110.  
  111. Public Property Let TextColor(sCol)
  112. If (TestColor(sCol) = True) Then TCol = sCol
  113. End Property
  114.  
  115. '------------- Set progress color: ---------------------
  116.  
  117. Public Property Let ProgressColor(sCol)
  118. If (TestColor(sCol) = True) Then ProgCol = sCol
  119. End Property
  120.  
  121. '------------- Set icon: ---------------------
  122.  
  123. Public Property Let Icon(sPath)
  124. If (FSO.FileExists(sPath) = True) Then Pic = sPath
  125. End Property
  126.  
  127. '------------- Set title text: ---------------------
  128.  
  129. Public Property Let Title(sCap)
  130. ProgTitle = sCap
  131. End Property
  132.  
  133. '------------- Set caption text: ---------------------
  134.  
  135. Public Property Let Caption(sCap)
  136. ProgCaption = sCap
  137. End Property
  138.  
  139. '------------- Set number of progress units: ---------------------
  140.  
  141. Public Property Let Units(iNum)
  142. ProgNum = iNum
  143. End Property
  144.  
  145. Private Function TestColor(Col6)
  146. Dim iB, sB, iB2, Boo1
  147. On Error Resume Next
  148. TestColor = False
  149. If (Len(Col6) <> 6) Then Exit Function
  150. For iB = 1 to 6
  151. sB = Mid(Col6, iB, 1)
  152. iB2 = Asc(UCase(sB))
  153. If ((iB2 > 47) and (iB2 < 58)) or ((iB2 > 64) and (iB2 < 71)) Then
  154. Boo1 = True
  155. Else
  156. Boo1 = False
  157. Exit For
  158. End If
  159. If (Boo1 = True) Then TestColor = True
  160. End Function
  161.  
  162. End Class
Download code! Download code (.txt)

 Stemmen
Niet ingelogd.

 Reacties
Post een reactie
Geen reacties (0)
© 2002-2024 Sitemasters.be - Regels - Laadtijd: 0.03s