I'm blowed if I can find anything on this on t'internet.
Following the 'Progress meter or Hourglass' discussion I found a more-or-less suitable block of code that defines a class that creates an Internet Explorer object.
The trouble I'm finding, and it's a minor point I suppose, is that the IE window created doesn't always appear to the front of the screen. If it's hidden then it's not really working, the user just see the flashing icon on the Taskbar to alert them that a new app has started.
I thought that the .Activate method would be enough but apparently not.
Here's the code I'm using:
So, is it possible to ensure the progress bar appears to the front?
JJ
[small][purple]Variables won't. Constants aren't[/purple][/small]
Following the 'Progress meter or Hourglass' discussion I found a more-or-less suitable block of code that defines a class that creates an Internet Explorer object.
The trouble I'm finding, and it's a minor point I suppose, is that the IE window created doesn't always appear to the front of the screen. If it's hidden then it's not really working, the user just see the flashing icon on the Taskbar to alert them that a new app has started.
I thought that the .Activate method would be enough but apparently not.
Here's the code I'm using:
Code:
'----- //////////////////////////////////////////////////////////////////////////////////////////////
' -- Progress bar Class that can be pasted into scripts.
'-- To create Progress bar: Dim ob
' Set ob = New IEProgBar
'-- This progress bar is created with an HTML file, which is written to the Temp folder
'-- and opened from there.
'-- Methods and Properties:
' Methods -
' Show - displays progress bar by writing file, causing IE to open it and setting IE visible.
' Advance - advances progress by 1 unit.
' Move(Left, Top, Width, Height) - moves and/or resizes window. All parameters must be used.
' use -1 For any dimension Not being changed: ob.Move 10, 10, -1, -1
' default size is 400 W x 120 H. default position is Windows default.
' CleanIETitle - removes Registry settings that append advertising to the page
' title in the IE title bar so that only the specified Title Property
' will be displayed. (This is a general change to IE and is Not reversible
' with this script as written.)
' Properties -
' BackColor - 6-character hex code to specify background color. default is "E0E0E4".
' TextColor - 6-character hex code to specify caption text color. default is "000000".
' ProgressColor - 6-character hex code to specify progress color. default is "0000A0".
' Title - window title text. default is "Progress"
' Caption - text caption in window. default is "Progress. . ."
' Units - number of progress units to use. default is 20.
' Icon - path of any image file that can be used as an icon. (JPG, GIF, BMP or ICO)
' default is no icon. If an icon is specifed it appears to left of caption.
'--- ////////////////////////////////////////////////////////////////////////////////////////
'-------- Start Progress bar Class ----------------------------------
Class IEProgBar
Private FSO, IE, BCol, TCol, ProgCol, ProgNum, ProgCaption, Pic, Q2, sTemp, iProg, ProgTitle
Private Sub Class_Initialize()
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
sTemp = FSO.GetSpecialFolder(2)
Set IE = CreateObject("InternetExplorer.Application")
IE.activate
With IE
.AddressBar = False
.menubar = False
.ToolBar = False
.StatusBar = False
.width = 400
.height = 120
.resizable = True
End With
BCol = "E0E0E4" '--background color.
TCol = "000000" '--caption text color.
ProgCol = "0000A0" '--progress color.
ProgNum = 20 'number of progress units.
ProgCaption = "Interrogating " & strPCName & ". . ."
ProgTitle = "Progress"
Q2 = chr(34)
iProg = 0 '--to track progress.
End Sub
Private Sub Class_Terminate()
On Error Resume Next
IE.Quit
Set IE = Nothing
Set FSO = Nothing
End Sub
Public Sub Show()
Dim s, i, TS
On Error Resume Next
s = "<HTML><HEAD><TITLE>" & ProgTitle & "</TITLE></HEAD>"
s = s & "<BODY SCROLL=" & Q2 & "NO" & Q2 & " BGCOLOR=" & Q2 & "#" & BCol & Q2 & " TEXT=" & Q2 & "#" & TCol & Q2 & ">"
If (Pic <> "") Then
s = s & "<IMG SRC=" & Q2 & Pic & Q2 & " ALIGN=" & Q2 & "Left" & Q2 & ">"
End If
If (ProgCaption <> "") Then
s = s & "<FONT FACE=" & Q2 & "arial" & Q2 & " SIZE=2>" & ProgCaption & "</FONT><BR><BR>"
Else
s = s & "<BR>"
End If
s = s & "<TABLE BORDER=1><TR><TD><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>"
For i = 1 to ProgNum
s = s & "<TD WIDTH=16 HEIGHT=16 ID=" & Q2 & "P" & Q2 & ">"
Next
s = s & "</TR></TABLE></TD></TR></TABLE><BR><BR></BODY></HTML>"
Set TS = FSO.CreateTextFile(sTemp & "\iebar1.html", True)
TS.Write s
TS.Close
Set TS = Nothing
IE.Navigate "file:///" & sTemp & "\iebar1.html"
IE.visible = True
End Sub
'-- Advance method colors one progress unit. iProg variable tracks how many
'-- units have been colored. Each progress unit is a <TD> with ID="P". They can be
'-- accessed in sequence through Document.All.Item.
Public Sub Advance()
On Error Resume Next
If (iProg < ProgNum) and (IE.Visible = True) Then
IE.Document.All.Item("P", (iProg)).bgcolor = Q2 & "#" & ProgCol & Q2
iProg = iProg + 1
End If
End Sub
'--resize and/or position window. Use -1 For any value Not being Set.
Public Sub Move(PixLeft, PixTop, PixWidth, PixHeight)
On Error Resume Next
If (PixLeft > -1) Then IE.Left = PixLeft
If (PixTop > -1) Then IE.Top = PixTop
If (PixWidth > 0) Then IE.Width = PixWidth
If (PixHeight > 0) Then IE.Height = PixHeight
End Sub
'--remove Registry settings that display advertising in the IE title bar.
'-- This change won't show up the first time it's used because the IE
'-- instance has already been created when the method is called.
Public Sub CleanIETitle()
Dim sR1, sR2, SH
On Error Resume Next
sR1 = "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title"
sR2 = "HKCU\Software\Microsoft\Internet Explorer\Main\Window Title"
Set SH = CreateObject("WScript.Shell")
SH.RegWrite sR1, "", "REG_SZ"
SH.RegWrite sR2, "", "REG_SZ"
Set SH = Nothing
End Sub
'------------- Set background color: ---------------------
Public Property Let BackColor(sCol)
If (TestColor(sCol) = True) Then BCol = sCol
End Property
'------------- Set caption color: ---------------------
Public Property Let TextColor(sCol)
If (TestColor(sCol) = True) Then TCol = sCol
End Property
'------------- Set progress color: ---------------------
Public Property Let ProgressColor(sCol)
If (TestColor(sCol) = True) Then ProgCol = sCol
End Property
'------------- Set icon: ---------------------
Public Property Let Icon(sPath)
If (FSO.FileExists(sPath) = True) Then Pic = sPath
End Property
'------------- Set title text: ---------------------
Public Property Let Title(sCap)
ProgTitle = sCap
End Property
'------------- Set caption text: ---------------------
Public Property Let Caption(sCap)
ProgCaption = sCap
End Property
'------------- Set number of progress units: ---------------------
Public Property Let Units(iNum)
ProgNum = iNum
End Property
'--confirm that color variables are valid 6-character hex color codes:
'-- If Not 6 characters Then TestColor = False
'-- If any character is Not 0-9 or A-F Then TestColor = False
Private Function TestColor(Col6)
Dim iB, sB, iB2, Boo1
On Error Resume Next
TestColor = False
If (Len(Col6) <> 6) Then Exit Function
For iB = 1 to 6
sB = Mid(Col6, iB, 1)
iB2 = Asc(UCase(sB))
If ((iB2 > 47) and (iB2 < 58)) or ((iB2 > 64) and (iB2 < 71)) Then
Boo1 = True
Else
Boo1 = False
Exit For
End If
Next
If (Boo1 = True) Then TestColor = True
End Function
End ClassSo, is it possible to ensure the progress bar appears to the front?
JJ
[small][purple]Variables won't. Constants aren't[/purple][/small]
