Visual Basic: Status bars to work with Browser

i need to know how to make a status bar with with a browser loading progress, local and server

Here is a copy of a VBScript one I used:


Dim objIE, objProgressBar, objTextLine1, objTextLine2, objQuitFlag
'Global Constants
Public Const conBarSpeed=80
Public Const conForcedTimeOut=20000

Sample

Public Sub Sample()
Dim intCount
StartIE "Ping/Pong Progress Bar"
SetLine1 "Progress Bar Line 1"
For intCount=1 To 1000
If IsQuit()=True Then
Exit For
End If
SetLine2 CStr(intCount)
Next
CloseIE
MsgBox "End of Sample"
End Sub

'****************************
'* Progress Bar Subroutines *
'****************************
Public Sub StartIE(strTitel)
Dim objDocument
Dim objWshShell
Set objIE = CreateObject("InternetExplorer.Application")
objIE.height = 230
objIE.width = 400
objIE.menubar = False
objIE.toolbar = false
objIE.statusbar = false
objIE.addressbar = false
objIE.resizable = False
objIE.navigate ("about:blank")
' wait till ie is loaded
While (objIE.busy)
wend
Set objDocument = objIE.document
' setup the dialog box
WriteHtmlToDialog objDocument, strTitel
' with ie/html loaded, define assorted objects...
Set objTextLine1 = objIE.document.all("txtMilestone")
Set objTextLine2 = objIE.document.all("txtRemarks")
Set objProgressBar = objIE.document.all("pbText")
Set objQuitFlag = objIE.document.Secret.pubFlag
objTextLine1.innerTEXT = ""
objTextLine2.innerTEXT = ""
' objIE.document.body.innerHTML = "Building Document..." + "<br>load time= " + n
objIE.visible = True
' set focus to ie
Set objWSHShell = CreateObject("WScript.Shell")
objWshShell.AppActivate("Microsoft Internet Explorer")
End Sub

Public Function CloseIE()
On Error Resume Next
objIE.quit
End Function

Public Sub SetLine1(sNewText)
On Error Resume Next
objTextLine1.innerTEXT = sNewText
End Sub

Public Sub SetLine2(sNewText)
On Error Resume Next
objTextLine2.innerTEXT = sNewText
End Sub

Public Function IsQuit()
On Error Resume Next
IsQuit=True
If objQuitFlag.Value<>"quit" Then
IsQuit=False
End If
End Function

Public Sub WriteHtmlToDialog(objDocument, strTitel)
objDocument.Open
objDocument.Writeln "<title>" & strTitel & "</title> "
objDocument.Writeln "<style>"
objDocument.Writeln " BODY {background: Silver} BODY { overflow:hidden }"
objDocument.Writeln " P.txtStyle {color: Navy; font-family: Verdana; " _
& " font-size: 10pt; font-weight: bold; margin-left: 10px } "
objDocument.Writeln " input.pbStyle {color: Navy; font-family: Wingdings; " _
& " font-size: 10pt; background: Silver; height: 20px; " _
& " width: 340px } "
objDocument.Writeln "</style>"
objDocument.Writeln "<div id=""objProgress"" class=""Outer""></div>"
' write out text lines...
objDocument.Writeln "<P id=txtMilestone class='txtStyle' style='margin-left: 10px'></P>"
objDocument.Writeln "<P id=txtRemarks class='txtStyle' style='margin-left: 10px' ></P>"
objDocument.Writeln "<CENTER>"
' write progbar
objDocument.Writeln "<input type='text' id='pbText' class='pbStyle' value='' >"
objDocument.Writeln "<br><br>" ' space down a little
objDocument.Writeln "</CENTER>"
' write hidden object...
objDocument.Writeln "<form name='secret' >" _
& " <input type='hidden' name='pubFlag' value='run' >" _
& "</form>"
objDocument.Writeln "<SCRIPT LANGUAGE='VBScript' >"
' write "local script" to handle cmdCancel_Click event...
objDocument.Writeln "Sub SetReturnFlag(sFlag)"
objDocument.Writeln " secret.pubFlag.Value = sFlag"
objDocument.Writeln " txtMileStone.style.color = ""Red"" "
objDocument.Writeln " txtRemarks.style.color = ""Red"" "
objDocument.Writeln "End Sub"
' progress bar
objDocument.Writeln "Function PctComplete(nPct)"
objDocument.Writeln "pbText.Value = String(nPct,"" "") & String(4,""n"")"
objDocument.Writeln "End Function"
' calc progress bar and direction
objDocument.Writeln "Sub UpdateProgress()"
objDocument.Writeln "Dim intStep"
objDocument.Writeln "Dim intDirection"
objDocument.Writeln "If (IsNull(objProgress.getAttribute(""Step"")) = True) Then"
objDocument.Writeln "intStep = 0"
objDocument.Writeln "Else"
objDocument.Writeln "intStep = objProgress.Step"
objDocument.Writeln "End If"
objDocument.Writeln "if (IsNull(objProgress.GetAttribute(""Direction""))=True) Then"
objDocument.Writeln "intDirection = 0"
objDocument.Writeln "Else"
objDocument.Writeln "intDirection = objProgress.Direction"
objDocument.Writeln "End If"
objDocument.Writeln "if intDirection=0 then"
objDocument.Writeln "intStep = intStep + 1"
objDocument.Writeln "else"
objDocument.Writeln "intStep = intStep - 1"
objDocument.Writeln "end if"
objDocument.Writeln "Call PctComplete(intStep)"
objDocument.Writeln "if intStep>=23 then"
objDocument.Writeln "intDirection=1"
objDocument.Writeln "end if"
objDocument.Writeln "if intStep<=0 then"
objDocument.Writeln "intDirection=0"
objDocument.Writeln "end if"
objDocument.Writeln "objProgress.SetAttribute ""Step"", intStep"
objDocument.Writeln "objProgress.SetAttribute ""Direction"", intDirection"
objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
objDocument.Writeln "End Sub"
' timeout function
objDocument.Writeln "Sub DialogHardTimeout()"
objDocument.Writeln "SetReturnFlag(""quit"")"
objDocument.Writeln "End sub"
objDocument.Writeln "Sub Window_OnLoad()"
objDocument.Writeln "theleft = (screen.availWidth - document.body.clientWidth) / 2"
objDocument.Writeln "thetop = (screen.availHeight - document.body.clientHeight) / 2"
objDocument.Writeln "window.moveTo theleft,thetop"
objDocument.Writeln "Window.setTimeout GetRef(""UpdateProgress""), " & conBarSpeed
objDocument.Writeln "Window.setTimeout GetRef(""DialogHardTimeout""), " & conForcedTimeOut
objDocument.Writeln "End Sub"
objDocument.Writeln "</SCRIPT>"
objDocument.Close
End Sub
'********************************
'* End Progress Bar Subroutines *
'********************************


If you need one for a VB App, I can provide another one as well... Let me know...

HTH,

-sage-

no no no this is vb not vbscript sorry

No problem... I kinda figured you wanted one for a VB App... Here is one I used:

You have to create a PictureBox...

'UpdateStatus picBox1, X
'UpdateStatus = the call to the UpdateStatus Sub
'picBox1 = name of the Picture Box Object
'X = number to display on status bar
UpdateStatus picBox1, 0
'Do some stuff...
UpdateStatus picBox1, 5
'Do some stuff...
UpdateStatus picBox1, 10
'Do some stuff...
UpdateStatus picBox1, 15

'So forth and so on till 100...

Private Sub UpdateStatus(pic As PictureBox, ByVal sngPercent As Single)
Dim strPercent As String, intX As Integer, intY As Integer, _
intWidth As Integer, intHeight As Integer

'For this to work well, we need a white background and any color foreground (blue)
Const colBackground = &H8000000F ' white
Const colForeground = &H8000000D ' dark blue

pic.ForeColor = colForeground
pic.BackColor = colBackground

'Format percentage and get attributes of text
Dim intPercent
intPercent = Int(100 * sngPercent + 0.5)

'Never allow the percentage to be 0 or 100 unless it is exactly that value. This
'prevents, for instance, the status bar from reaching 100% until we are entirely done.

strPercent = Format$(intPercent) & "%"
intWidth = pic.TextWidth(strPercent)
intHeight = pic.TextHeight(strPercent)

'Now set intX and intY to the starting location for printing the percentage
intX = pic.Width / 2 - intWidth / 2
intY = pic.Height / 2 - intHeight / 2

'Need to draw a filled box with the pics background color to wipe out previous
'percentage display (if any)
pic.DrawMode = 13 ' Copy Pen
pic.Line (intX, intY)-Step(intWidth, intHeight), pic.BackColor, BF

'Back to the center print position and print the text
pic.CurrentX = intX
pic.CurrentY = intY
pic.Print strPercent

'Now fill in the box with the ribbon color to the desired percentage
'If percentage is 0, fill the whole box with the background color to clear it
'Use the "Not XOR" pen so that we change the color of the text to white
'wherever we touch it, and change the color of the background to blue
'wherever we touch it.
pic.DrawMode = 10 ' Not XOR Pen
If sngPercent > 0 Then
pic.Line (0, 0)-(pic.Width * sngPercent, pic.Height), pic.ForeColor, BF
Else
pic.Line (0, 0)-(pic.Width, pic.Height), pic.BackColor, BF
End If

pic.Refresh
DoEvents
End Sub

When I used this code, in order to make the number dynamic as opposed to static, I used a counter that would count the number of objects that I was having to process... It would then segment that out and update the statusbar as each loop cycle ended until the completion of the loop... i.e.:

Set cont = GetObject("WinNT://" & strSS & ",computer")
If Err.Number <> 0 Then
MsgBox "Could not connect to " & strSS & "." & vbCrLf _
& "Verify server name and/or that you have correct permissions.", _
vbExclamation, "Could not connect!"
Else
cont.Filter = Array("PrintQueue")
'Setting up the count variable
For Each p In cont
cnt = cnt + 1
Next
'After variable is known, this next section
'takes and sets it up to where the variable
'in count is broken down to find its division
'into 100 and stores it in a variable, strCounter,
'to be used later.
If cnt < 100 Then
tcnt = 100 / cnt
tcnt = tcnt * 0.01
Else
tcnt = 0.01
End If
cnt = cnt * 0.01
cnt = Int(cnt) + 1
strCounter = cnt
For Each p In cont
Set pq = GetObject(p.ADsPath)
WritePrivateProfileString32 sTmpFile, strSS, _
pq.PrinterPath, vbNull
strTStatus = strTStatus + 0.01
strValidator = ((strTStatus * 100) Mod strCounter)
If strValidator = "0" Then
strStatus = (strStatus * 1) + (tcnt * 1)
frmPIUUpdateStatus picStatus, strStatus
End If
Next
LoadCombo cboPList, sTmpFile, strSS
End If

Private Sub frmPIUUpdateStatus(pic As PictureBox, ByVal sngPercent As Single)
Dim strPercent As String, intX As Integer, intY As Integer, _
intWidth As Integer, intHeight As Integer

'For this to work well, we need a white background and any color foreground (blue)
Const colBackground = &H8000000F ' white
Const colForeground = &H8000000D ' dark blue

pic.ForeColor = colForeground
pic.BackColor = colBackground

'Format percentage and get attributes of text
Dim intPercent
intPercent = Int(100 * sngPercent + 0.5)

'Never allow the percentage to be 0 or 100 unless it is exactly that value. This
'prevents, for instance, the status bar from reaching 100% until we are entirely done.

strPercent = "Querying " & strSS & " - " & Format$(intPercent) & "%"
intWidth = pic.TextWidth(strPercent)
intHeight = pic.TextHeight(strPercent)

'Now set intX and intY to the starting location for printing the percentage
intX = pic.Width / 2 - intWidth / 2
intY = pic.Height / 2 - intHeight / 2

'Need to draw a filled box with the pics background color to wipe out previous
'percentage display (if any)
pic.DrawMode = 13 ' Copy Pen
pic.Line (intX, intY)-Step(intWidth, intHeight), pic.BackColor, BF

'Back to the center print position and print the text
pic.CurrentX = intX
pic.CurrentY = intY
pic.Print strPercent

'Now fill in the box with the ribbon color to the desired percentage
'If percentage is 0, fill the whole box with the background color to clear it
'Use the "Not XOR" pen so that we change the color of the text to white
'wherever we touch it, and change the color of the background to blue
'wherever we touch it.
pic.DrawMode = 10 ' Not XOR Pen
If sngPercent > 0 Then
pic.Line (0, 0)-(pic.Width * sngPercent, pic.Height), pic.ForeColor, BF
Else
pic.Line (0, 0)-(pic.Width, pic.Height), pic.BackColor, BF
End If

pic.Refresh
DoEvents
End Sub

HTH,

-sage-

thank you. Ill try this out and let u know how it worked out for me :)

ok you said i have to use that code in a picture box...what event do i assign to the box?


Private Sub Picture1_what goes here?()

You don't actually assign an event to the box... As you control the updating of the status by making a call to the code that updates the scroll...

In other words,

When this :UpdateStatus picBox1, 0: fires, it initiates the sub named UpdateStatus... picBox1 and 0 are the variables you are passing to the code... picBox1 represents the name of the object (a picture box named picBox1) and 0 represents the number to display on the status bar...

Now this is the static way of approaching it, whereas the second revision of the code I posted showed a dynamic way of updating the status bar... In my use of the code, I did not know how many printer objects would be listed on any given server... Since querying a server took time, I initiated a status bar to display the percentage completed... I knew that the code would find the number of printer objects so I used a simple math equation to find the common denominator... And use that to control the status update iteration...

In the case of your question... Your code should read:

UpdateStatus Picture1, 0 and not Private Sub Picture1

-sage-

so it should be









UpdateStatus Picture1, 0

'UpdateStatus Picture1, X
'UpdateStatus = the call to the UpdateStatus Sub
'Picture1 = name of the Picture Box Object
'X = number to display on status bar
UpdateStatus Picture1, 0
'Do some stuff...
UpdateStatus Picture1, 5
'Do some stuff...
UpdateStatus Picture1, 10
'Do some stuff...
UpdateStatus Picture1, 15

'So forth and so on till 100...

Private Sub UpdateStatus(pic As PictureBox, ByVal sngPercent As Single)
Dim strPercent As String, intX As Integer, intY As Integer, _
intWidth As Integer, intHeight As Integer

'For this to work well, we need a white background and any color foreground (blue)
Const colBackground = &H8000000F ' white
Const colForeground = &H8000000D ' dark blue

pic.ForeColor = colForeground
pic.BackColor = colBackground

'Format percentage and get attributes of text
Dim intPercent
intPercent = Int(100 * sngPercent + 0.5)

'Never allow the percentage to be 0 or 100 unless it is exactly that value. This
'prevents, for instance, the status bar from reaching 100% until we are entirely done.

strPercent = Format$(intPercent) & "%"
intWidth = pic.TextWidth(strPercent)
intHeight = pic.TextHeight(strPercent)

'Now set intX and intY to the starting location for printing the percentage
intX = pic.Width / 2 - intWidth / 2
intY = pic.Height / 2 - intHeight / 2

'Need to draw a filled box with the pics background color to wipe out previous
'percentage display (if any)
pic.DrawMode = 13 ' Copy Pen
pic.Line (intX, intY)-Step(intWidth, intHeight), pic.BackColor, BF

'Back to the center print position and print the text
pic.CurrentX = intX
pic.CurrentY = intY
pic.Print strPercent

'Now fill in the box with the ribbon color to the desired percentage
'If percentage is 0, fill the whole box with the background color to clear it
'Use the "Not XOR" pen so that we change the color of the text to white
'wherever we touch it, and change the color of the background to blue
'wherever we touch it.
pic.DrawMode = 10 ' Not XOR Pen
If sngPercent > 0 Then
pic.Line (0, 0)-(pic.Width * sngPercent, pic.Height), pic.ForeColor, BF
Else
pic.Line (0, 0)-(pic.Width, pic.Height), pic.BackColor, BF
End If

pic.Refresh
DoEvents

End Sub




that doesnt work....

My bad... I just went and looked again at the code... It should be like this...

UpdateStatus Picture1, 0

'UpdateStatus Picture1, X
'UpdateStatus = the call to the UpdateStatus Sub
'Picture1 = name of the Picture Box Object
'X = number to display on status bar
UpdateStatus Picture1, 0
'Do some stuff...
UpdateStatus Picture1, .05
'Do some stuff...
UpdateStatus Picture1, .10
'Do some stuff...
UpdateStatus Picture1, .15

'So forth and so on till 1.00...

not working....I must be putting the code in the wrong place or something...VB is not recognizing the start of this code, maybe becasue its wrong but heres how its showing it start to end...














UpdateStatus Picture1, 0

'UpdateStatus Picture1, X
'UpdateStatus = the call to the UpdateStatus Sub
'Picture1 = name of the Picture Box Object
'X = number to display on status bar
UpdateStatus Picture1, 0
'Do some stuff...
UpdateStatus Picture1, 0.05
'Do some stuff...
UpdateStatus Picture1, 0.1
'Do some stuff...
UpdateStatus Picture1, 0.15
this is where the line is
'So forth and so on till 1.00...


Private Sub UpdateStatus(pic As PictureBox, ByVal sngPercent As Single)
Dim strPercent As String, intX As Integer, intY As Integer, _
intWidth As Integer, intHeight As Integer

'For this to work well, we need a white background and any color foreground (blue)
Const colBackground = &H8000000F ' white
Const colForeground = &H8000000D ' dark blue

pic.ForeColor = colForeground
pic.BackColor = colBackground

'Format percentage and get attributes of text
Dim intPercent
intPercent = Int(100 * sngPercent + 0.5)

'Never allow the percentage to be 0 or 100 unless it is exactly that value. This
'prevents, for instance, the status bar from reaching 100% until we are entirely done.

strPercent = Format$(intPercent) & "%"
intWidth = pic.TextWidth(strPercent)
intHeight = pic.TextHeight(strPercent)

'Now set intX and intY to the starting location for printing the percentage
intX = pic.Width / 2 - intWidth / 2
intY = pic.Height / 2 - intHeight / 2

'Need to draw a filled box with the pics background color to wipe out previous
'percentage display (if any)
pic.DrawMode = 13 ' Copy Pen
pic.Line (intX, intY)-Step(intWidth, intHeight), pic.BackColor, BF

'Back to the center print position and print the text
pic.CurrentX = intX
pic.CurrentY = intY
pic.Print strPercent

'Now fill in the box with the ribbon color to the desired percentage
'If percentage is 0, fill the whole box with the background color to clear it
'Use the "Not XOR" pen so that we change the color of the text to white
'wherever we touch it, and change the color of the background to blue
'wherever we touch it.
pic.DrawMode = 10 ' Not XOR Pen
If sngPercent > 0 Then
pic.Line (0, 0)-(pic.Width * sngPercent, pic.Height), pic.ForeColor, BF
Else
pic.Line (0, 0)-(pic.Width, pic.Height), pic.BackColor, BF
End If

pic.Refresh
DoEvents
End Sub
and this is the ending line





as you can see its not ending the code up above it but including the two togethor...please help

Thanks