Summary
This example script shows how you can use a Dialog Function to emulate a progress bar, and also how to print out status text as the script updates. The status text is a bit more user-friendly than using Debug.Print statements, since the user doesn't need to open the scripting IDE to see it.
Some screenshots:
The dialog while running:
The dialog when finished running:
The script works by repeatedly calling the 'ProcessStuff()' function (which does the real work) from inside the dialog function's 'Idle' state. A nice feature is the user can hit the Cancel button while it's running, and the next time ProcessStuff() returns the script will exit.
Code Snippets
Globals and Main()
gOutputText is a string array that holds the status text. Instead of adding text to this directly, the AddToOutputText() function should be used.
gOutputTextSize is the number of lines used in the gOutputText array.
gProgressBarWidth is the width of the text box we'll use for the progress bar. You can get this width from the coordinates in the Dialog definition:
Text 20,224,490,14,"Text1",.ProgText
The main function just calls Init() and DoDialog(); the function that does the 'real' work of the script is called from inside the dialog function.
Option Explicit Dim gOutputText() As String Dim gOutputTextSize As Long Const gProgressBarWidth = 470 Sub Main Debug.Clear Init() DoDialog() End Sub
The Dialog
In the dialog editor, looks like this:
The .OutputText box is a MultiListBox, with Scrolling but no Sorting.
The thing that says "Progress" is a GroupBox, and the progress 'bar' is a "Text" control just inside of it (says 'Text1')
Function DoDialog() On Error GoTo DLG_ERROR Begin Dialog UserDialog 530,308,"Dialog Showing Progress and Output",.MyDialogFunc ' %GRID:10,7,1,1 GroupBox 10,210,510,35,"Progress:",.GroupBox1 Text 20,224,490,14,"Text1",.ProgText OKButton 20,259,130,28,.OkButton CancelButton 360,259,140,28 MultiListBox 20,14,480,161,gOutputText(),.OutputText,1 PushButton 140,182,100,21,"Copy Text",.CopyButton PushButton 270,182,110,21,"Run Again",.RunAgain End Dialog Dim dlg As UserDialog Dialog dlg Exit Function DLG_ERROR: If Err.Number = 10031 Then Exit Function Else MsgBox ("An error occured: errNum " & Err.Number & vbCrLf & Err.Description) End If End Function
The Dialog Function
In the Dialog Init section (case 1), we:
disable the Ok button (the user can still cancel),
hide the Copy and Run Again buttons,
call GetNumThingsToProcess(), which we can use to know how much to increment the progress bar every time we call ProcessStuff()
Call ProcessStuff(true); sending it a 'true' tells it to initialize itself and exit.
To handle the two buttons "Copy" or "Run Again" in case two:
Copy calls CopyOutputTextToClipboard() which does what it sounds like (there's a nice SAX function for this.)
For Run Again, do the same things we do in the Dialog Init section.
The 'Idle' section (case 5) is where the script will repeatedly call ProcessStuff(), until it returns True (meaning it's done.)
Each time it does not return true, update the progress bar and the status text.
The progress bar is just a long string of "|". Each one takes up about 2 pixels (a pixel for the bar and another for the space.) This didn't quite work out so there's some fudge factor in that equation.
The call to DlgListBoxArray(), which updates the status text, also causes it to 'flicker' somewhat. So it's probably best not to update this too often. For example, in this script we print out all schematics/elements/parameters, but we only update the box after every schematic instead of every element.
' See DialogFunc help topic for more information. Private Function MyDialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Static dlgCounter As Long Static maxCounter As Long Dim processDone As Boolean Select Case Action% Case 1 ' Dialog box initialization DlgEnable("OkButton", False) DlgVisible("CopyButton", False) DlgVisible("RunAgain", False) DlgText("ProgText", "") dlgCounter = 0 maxCounter = GetNumThingsToProcess() 'this returns an estimate of how many times ProcessStuff() will need to be called before it's done ProcessStuff(True) 'initialize our working function processDone = False Case 2 ' Value changing or button pressed If DlgItem = "CopyButton" Then CopyOutputTextToClipboard() MyDialogFunc = True End If If DlgItem = "RunAgain" Then 'reset everything DlgEnable("OkButton", False) DlgVisible("CopyButton", False) DlgVisible("RunAgain", False) DlgText("ProgText", "") dlgCounter = 0 maxCounter = GetNumThingsToProcess() ProcessStuff(True) 'initialize our working function InitOutputText() DlgListBoxArray("OutputText", gOutputText) MyDialogFunc = True processDone = False End If Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle MyDialogFunc = True ' Continue getting idle actions processDone = ProcessStuff() 'This is the function that's doing the real work (looping over elements, parsing data, etc) If processDone Then Wait 0.1 'so we don't take up 100% cpu time getting idle events... End If If Not processDone Then dlgCounter = dlgCounter + 1 DlgListBoxArray("OutputText", gOutputText) DlgText("ProgText", String(0.4 * gProgressBarWidth * (dlgCounter/maxCounter), "|")) Else DlgEnable("OkButton", True) DlgVisible("CopyButton", True) DlgVisible("RunAgain", True) dlgCounter = maxCounter End If 'update output text and progress bar Case 6 ' Function key End Select End Function
The 'Process' Functions
The GetNumThingsToProcess() function returns an estimate of how many times ProcessStuff() will need to be called. Then every time we call ProcessStuff() from the Idle section of the dialog, we increment the progress bar by gProgWidth/GetNumThingsToProcess (+/- some fudge factor).
ProcessStuff() is where the 'real' work of the script happens. For this example, it just prints out all the schematics/elements/parameters.
In this example it uses a static variable 'curSchNum' to keep track of where it is in the schematic list. This could also be a global variable (but it's a little cleaner this way IMO).
If Init = true, the function should do any initializations it needs to, and then exit (in this case, set curSchNum = 1.)
The function should then do one 'unit' of the total work and then exit, returning True if it's done and False if not. For this case, it processes one schematic.
Function GetNumThingsToProcess() As Long GetNumThingsToProcess = Project.Schematics.Count End Function Function ProcessStuff(Optional Init As Boolean = False) As Boolean 'return true when we're done Static curSchNum As Long ProcessStuff = False If Init = True Then 'initialize and exit curSchNum = 1 Exit Function End If If curSchNum <= Project.Schematics.Count Then Dim s As Schematic Dim e As Element Dim p As Parameter Set s = Project.Schematics(curSchNum) AddToOutputText(s.Name) For Each e In s.Elements AddToOutputText(vbTab & e.Name) For Each p In e.Parameters AddToOutputText(vbTab & vbTab & p.Name & " = " & p.ValueAsString) Next p Next e curSchNum = curSchNum + 1 Else ProcessStuff = True End If End Function
Initializing
Init() is called by the Main() function; InitOutputText() is called by Init() and is also called if the user hits the "Run Again" button.
Function Init() InitOutputText() End Function Function InitOutputText() ReDim gOutputText(10) As String gOutputTextSize = 0 End Function
AddToOutputText
The way the gOutputText() array is handled is ripped off from how stl::vectors work in C++. The array is initialized to some small size (10 items, in InitOutputText()), and then when new items are added to it, the size of the array is doubled until the new items fit. That way we don't have to call Redim Preserve too often.
The global var gOutputTextSize stores how much of the array we've actually used.
The script splits the input 's' into lines, so you could read text in from a file and put it into a string, and then call this function with it. The line breaks are all converted to vbLf's, so it doesn't matter if it's Unix/dos/mac style.
Function AddToOutputText(s As String) 'puts strings into gOutputText(), which will be displayed in the dialog Dim s2() As String Dim sClean As String sClean = Replace(s, vbCrLf, vbLf) sClean = Replace(sClean, vbCr, vbLf) s2 = Split(sClean, vbLf) Dim numNewLines As Long numNewLines = UBound(s2) - LBound(s2) + 1 Dim uBoundOutputTxt As Long uBoundOutputTxt = UBound(gOutputText) If (numNewLines + gOutputTextSize) > uBoundOutputTxt Then While (numNewLines + gOutputTextSize) > uBoundOutputTxt uBoundOutputTxt = uBoundOutputTxt*2 Wend ReDim Preserve gOutputText(uBoundOutputTxt) End If Dim i As Long Dim j As Long For i = gOutputTextSize To gOutputTextSize + numNewLines-1 gOutputText(i) = s2(j) j = j + 1 gOutputTextSize = gOutputTextSize + 1 Next i End Function
Copy the Status Text to the Clipboard
There's a nice VB function for this, Clipboard(string). So we just need to make a new string array, copy gOutputText into it, Redim Preserve it so that it only includes the part of the array we used, Join() it with line breaks, and call Clipboard().
Function CopyOutputTextToClipboard() Dim sClip() As String sClip =gOutputText ReDim Preserve sClip(gOutputTextSize) Dim outTxt As String outTxt = Join(sClip, vbCrLf) Clipboard(outTxt) End Function