Uses a modeless dialog to circumvent any VBS loop locks in HTA so you can see values in loops, has a few styles and can cancel loops with a "button" click (in a sneaky checkbox way).
Very easy to use, just call the Pbar startup sub before your loop (with lots of options), and anywhere inside your loop simply call an update sub with the current loop index. It also automatically closes down on the penultimate value so you don't have to do any post Pbar maintenance. Works pretty good in nested loops too (if you use the title)
How you use the bar with the update is up to you, but having an update of 1 will slow down even the best PC. Updating a dialog is a massive CPU hit btw, I found 200 per cycle was a good speed all round (I own a P4 1 core). If your loop is <200 then you're going to have to juggle a bit.
Have fun!
<HTML><HEAD><TITLE>PBar</TITLE><HTA:APPLICATION SCROLL="No" /></HEAD>
<BODY STYLE="Margin:0;Border:0;BackGround-Color:ButtonFace">
<!-- '---------------- PBar GUI in a hidden div ---------------- -->
<DIV ID="divPBar" STYLE="Display:None">
<DIV ID="divBorder" STYLE="BackGround-Color:ButtonFace;Border:2 Outset;Padding:5;Height:100%;
Font-Weight:Bold; Font-Family:Arial; Font-Size:12;">
<!-- '---- Cancel ---- -->
<LABEL ID="lblCancel" FOR=chkCancel STYLE="Position:Absolute;Top:2;Border:2 Outset;
BackGround-Color:ButtonFace;Font-Size:10;"> X </LABEL>
<INPUT ID="chkCancel" TYPE="CheckBox" STYLE="Position:Absolute; Left:-1000;">
<!-- '---- Title ---- -->
<DIV ID="divAllTitle"><BR><DIV ID="divTitle" STYLE="Text-Align:Center;">Title</DIV><BR></DIV>
<!-- '---- Percent bar and value ---- -->
<DIV STYLE="Border:2 Inset; Height:25;Width:100%">
<DIV ID="divValue" STYLE="Position:Absolute;Width:100%;Text-Align:Center;Font-Size:16;Color:White;
Filter:ProgID:DXImageTransform.Microsoft.DropShadow(OffX=2,OffY=2,Color=Black)">0%</DIV>
<DIV ID="divPercent" STYLE="BackGround-Color:AppWorkspace;Height:100%;Width:0%"></DIV>
</DIV>
</DIV>
</DIV>
<!-- '---- Demo button ---- -->
<INPUT TYPE="Button" ID="cmdDemo" VALUE="Big string demo" />
<SCRIPT LANGUAGE="VBScript">
Option Explicit
'---- PBar globals ----
Dim dlgPBar 'Dialog window
Dim intPBarTime 'How long the last loop took in MS (good for debugging and tweaking Pbar's interval)
'---- Demo button click ----
Sub cmdDemo_OnClick()
Dim intDemoLoop, strDemoBigString
'---- Call PBarStart just before your loop starts.
PBarStart 8192, 200, "Large string adding, gets slower and slower", -1, -1, 700, True, 0
For intDemoLoop = 0 To 8192
'---- Update PBar with cancel
If PBarUpdate(intDemoLoop) Then Exit For
'---- Force a delay with a big string, which will get slower...
strDemoBigString = strDemoBigString & String(100, "*")
Next
'---- Pbar has auto-closed at this point
'---- Show time taken
msgbox "Time: " & intPBarTime
End Sub
'----------------------------------------- PBar subs --------------------------------------------
'---- Setup and show PBar ----
'lngMaxValue : The matched value of the following loop you want to show. If it's dynamic like a varible or
' UBound() then use that instead
'lngInterval : How often the bar updates, depends on your loop but must be smaller than lngMaxValue.
' If lngMaxValue is dynamic then use 200 which is the lowest you can go before any large CPU hits.
'strTitle : Text description of loop. Use "" for a mini bar
'intX,intY : Position on screen. Use -1 to centre either X or Y (or both)
'intWidth : The width of the bar (height is determined by content and width)
'blnCancel : Include a cancel button to break out the loop, true\false
'intStyle : Percent bar value style, 0=(%), or 1=(Value\MaxValue)
Sub PBarStart (lngMaxValue, lngInterval, strTitle, intX, intY, intWidth, blnCancel, intStyle)
'---- Create a dialog
Set dlgPBar = Window.ShowModelessDialog ("","","DialogLeft:32767PX;DialogHeight:0PX;Scroll:No;Unadorned:Yes")
With dlgPBar
'---- Dialogs have a few intergers that we can use
.DefaultStatus = lngMaxValue ' Max value is default
.Status = lngInterval 'Update interval is Status
.Name = intStyle' Bar value style is Name
'---- Transfer hidden div to dialog body
.Document.Body.InnerHTML = divPBar.InnerHTML
'---- Dialog width
If intWidth < 100 Then intWidth = 100
.DialogWidth = intWidth & "PX"
'---- Description of loop, or a mini-bar?
If strTitle = "" Then
.divAllTitle.Style.Display = "None"
Else
.divTitle.InnerText = strTitle
End If
'---- Cancel button
If blnCancel = False Then
.lblCancel.Style.Display = "None" 'No cancel
Else
If strTitle = "" Then
.lblCancel.Style.Top = 11 : .lblCancel.Style.Left = 10 'No title, move cancel inside bar
Else
.lblCancel.Style.Left = intWidth - 20 'Or cancel at top right, like a window
End If
End If
'---- Set dialog height to border's dynamic height
.DialogHeight = .divBorder.OffsetHeight & "PX"
'---- Dialog top, centred or user coord?
If intY = -1 Then
.DialogTop = (Screen.Height / 2) - (.divBorder.OffsetHeight / 2) & "PX"
Else
.DialogTop = intY & "PX"
End If
'---- Same for dialog left (last because it starts off-screen at 32767, for buffer & speed)
If intX = -1 Then
.DialogLeft = (Screen.Width / 2) - (intWidth / 2) & "PX"
Else
.DialogLeft = intX & "PX"
End If
End With
'---- Start debug timer
intPBarTime = Timer
End Sub
'---- Update PBar ----
Function PBarUpdate(lngValue)
If IsEmpty(dlgPBar) Then 'This lets you have the update anywhere in your loop
Exit Function
Else
With dlgPBar
'---- Update interval
If lngValue Mod .Status Then Exit Function
'---- Size percent bar
.divPercent.Style.Width = Int(lngValue / Int(.DefaultStatus / 100)) & "%"
'---- Update value
If .Name Then
.divValue.InnerText = lngValue & " / " & .DefaultStatus
Else
.divValue.InnerText = .divPercent.Style.Width
End If
'---- User abort
If .chkCancel.Checked Then PBarUpdate = 1 : .Close : intPBarTime = 0 : Exit function
'---- Penultimate value reached so auto close (can't use 100% for checking)
If lngValue => .DefaultStatus - .Status Then
.Close : dlgPBar = Empty
intPBarTime = Timer - intPBarTime
End If
End With
End If
End Function
</SCRIPT></BODY></HTML>