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: 7008 - Aantal punten: 2.67 (3 stemmen)




Een progressbar in IE-explorer.

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

 Stemmen
Niet ingelogd.

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