Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 10 of 10
  1. #1
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts

    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
    ~Designer's Toolz~

  • #2
    Super Moderator sage45's Avatar
    Join Date
    May 2002
    Posts
    1,060
    Thanks
    0
    Thanked 13 Times in 13 Posts
    Here is a copy of a VBScript one I used:

    Code:
    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-
    HTML & CSS Forum Moderator

    "If you don't know what you think you know, then what do you know."
    R.I.P. Derrick Thomas #58
    1/1/1967 - 2/8/2000

  • #3
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts
    no no no this is vb not vbscript sorry
    Last edited by DsgnrsTLZAdmin; 01-14-2004 at 11:00 PM.
    ~Designer's Toolz~

  • #4
    Super Moderator sage45's Avatar
    Join Date
    May 2002
    Posts
    1,060
    Thanks
    0
    Thanked 13 Times in 13 Posts
    No problem... I kinda figured you wanted one for a VB App... Here is one I used:

    You have to create a PictureBox...

    Code:
    '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.:

    Code:
            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-
    HTML & CSS Forum Moderator

    "If you don't know what you think you know, then what do you know."
    R.I.P. Derrick Thomas #58
    1/1/1967 - 2/8/2000

  • #5
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts
    thank you. Ill try this out and let u know how it worked out for me
    Last edited by DsgnrsTLZAdmin; 01-15-2004 at 07:12 PM.
    ~Designer's Toolz~

  • #6
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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?()
    ~Designer's Toolz~

  • #7
    Super Moderator sage45's Avatar
    Join Date
    May 2002
    Posts
    1,060
    Thanks
    0
    Thanked 13 Times in 13 Posts
    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-
    HTML & CSS Forum Moderator

    "If you don't know what you think you know, then what do you know."
    R.I.P. Derrick Thomas #58
    1/1/1967 - 2/8/2000

  • #8
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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....
    ~Designer's Toolz~

  • #9
    Super Moderator sage45's Avatar
    Join Date
    May 2002
    Posts
    1,060
    Thanks
    0
    Thanked 13 Times in 13 Posts
    My bad... I just went and looked again at the code... It should be like this...

    Code:
    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...
    HTML & CSS Forum Moderator

    "If you don't know what you think you know, then what do you know."
    R.I.P. Derrick Thomas #58
    1/1/1967 - 2/8/2000

  • #10
    Regular Coder
    Join Date
    Jan 2004
    Location
    Georgia
    Posts
    306
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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
    ~Designer's Toolz~


  •  

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •