User dialog box showing counts

[hov333]

Hi guys,

I'm working on a form that will be used for a shipping process. Each record has a field "box" which contains the name of the box that will be used for shipping.
The form displays all the records filtered to match a status "ready to ship".

I'd like to be able to generate a pop-up window which will list all the unique "boxes" along with the respective count of each group.

It seems there may be different routes to take but still end with the same result (calculated data shown in a dialog box vs running a summarize operation then displaying that data, etc)...what would be the most efficient way to compile this data to the user without the need for writing xbasic code?

Thanks!

[hov333]

Re: User dialog box showing counts

Thinking of creating a summery report rather than a dialog box may work in this case. Let me know if there's a better option, in the meantime, I'll keep you guys posted if I run into any bumps.

[pboomwork]

Re: User dialog box showing counts

I found myself in a similar situation wanting counts of records by groups presented in a dialog. While my solution does involve xBasic, at least I've written the code for you. I've made the script rather generic and have been able to reuse it several times now.

To use this script do a query that filters the records to "ready to ship" and sorts using on the "box type". Next, call the PAT-GroupCnt Script. All this could be generated using an Action Script and run from a button on your form.

This script and the two supporting function's I've included will do group counts using the order expression as the group break, and present the results in a dialog box with using a list control.

The main code that does the counting

'Date Created: 13-Feb-2014 09:30:41 PM
'Last Updated: 03-Feb-2016 02:49:13 PM
'Created By  : verboopa2
'Updated By  : verboopa2
'-------------
'PAT-GroupCnt
'-------------
'!~~
'Do group totals based on order in current Query

'------------------------------
'// Set up for Error handler --
'------------------------------
DIM DialogTtl AS C = "Group Total on Query Order Expression  (PAT-GroupCnt)"
ON ERROR GOTO ERRORHANDLER

'--------------------------------
'// Get Sort Order Expression  --
'--------------------------------
DIM Pwin as P												'Window we are run from
DIM Tbl as P 												'top most parent table
DIm Set as P												'Set form is based on
'Specific to my installation
'zCompleteChange("PatientDemographics")						'Commit any outstanding changes
Pwin = zVerifyWnd("PatientDemographics",.T.)				'get values needed
Set = set.current()									
Tbl = Pwin.Table_Get()										'dialogs or activity

DIM Qry as P												'The current Query	
DIM QryOrder as C											'The expression for current Query Order used for group totals
Qry = Tbl.index_primary_get()
QryOrder = Qry.order_get()

IF isnull(QryOrder)
	ui_msg_box(DialogTtl,"Query with Sort Order must be in effect before running this script",UI_ATTENTION_SYMBOL+UI_OK)
	end 
end if
RecQty = Qry.records_get()									'number of records for progress bar and dialog

'-------------------------------------------
'// Set up required for processing loop ----
'-------------------------------------------
DIM PatCnt as N = 0											'Number of patients processed
DIM outline_level as N = 1									'Ignore child records (secondary IDs) fetch through parent(patients) only 
TblInf = Set.patientinfo

'--------------------------
'// go through records ----
'--------------------------
DIM LastOrdr as C = ""										'the Order expression for the last record looked at	
DIM CurOrdr as C = ""										'the order expression for the current record
DIM Results as C = ""
DIm GrpCnt as N = 0
DIM RecCnt as N = 0											'Set Up progress bar count of records processed
DIM pb as zProgress											
pb = zProgress.CreateProgressBar(DialogTtl,"Counting Groups",.T.,1,RecQty)

Set.fetch_first()												'get first record
While .not. Set.fetch_eof()										'set up loop to get next record
	
	RecCnt = RecCnt + 1
	if pb.Percent(RecCnt)										'update progress bar give user chance to abort
		error_generate(16500)									'Use number so Error handler can differentiate 
		end														'abort from other errors
	end if

	IF .NOT. eval_valid(QryOrder)
		error_generate(16501)
	end if
	CurOrdr = eval(QryOrder)
	IF CurOrdr <> LastOrdr .AND. .NOT. isnull(LastOrdr)
		Results = *concat_lines(Results, LastOrdr + "|" + str(GrpCnt,10))
		GrpCnt = 0
	end if
	GrpCnt = increment_value(GrpCnt)
	
	
	set.fetch_next(outline_level)								'next record
	LastOrdr = CurOrdr
wend
Results = *concat_lines(Results, LastOrdr + "|" + str(GrpCnt,10))
pb.close()
Pwin.refresh_layout()

Fields =<<%txt%
Group
Count%txt%

Footer =<<%txt%
Order Expression: {QryOrder}
Total Patients: {RecCnt}
%txt%
Footer = evaluate_string(Footer)								'subsitute in values
zDisplayResults(DialogTtl,Fields,Results,80,20,Footer,2)		'Display results using function designed for this 

END


'-------------------
'// ERROR Handler --
'-------------------
ERRORHANDLER:
ON ERROR GOTO 0													'No more special error traps that continue the code

IF eval_valid("pb")												'pb is pointer used for progress bar
	pb.close()													'is save to close progress bar as long as pb is defined
end if															'this code removed in many implementations of this code block	

																'Define error message and display to user
																'Future versions call a function to log and display error.
IF error_code_get() = 16500 									'user aborted so different error message no full trap just message invoke Error_generate(16500)
	Mess =<<%txt%
User Aborted Operation:
{DialogTtl}
%txt%
ELSEIF error_code_get() = 16501									'problem with order expression
	Mess =<<%txt%
Unable to evaluate Current Query Order expression;
{QryOrder}
Note for this script all fields must be prefaced with 
the table name to differentiate them from variables.
This includes fields in the parent table for example;
Patients->Score. 
%txt%
ELSE															'code related error so add script information
	Mess =<<%txt%
ERROR: {error_text_get()}
Script: {error_script_get()}
Line: {error_line_number_get()}
%txt%
END IF
ui_msg_box(DialogTtl,Evaluate_String(Mess),UI_ATTENTION_SYMBOL+UI_OK)
END

Function that displays the resulting values. It is based on code generated by the xDialog Genie.

'Date Created: 23-Sep-2015 11:37:10 AM
'Last Updated: 02-Feb-2016 02:52:01 PM
'Created By  : verboopa2
'Updated By  : verboopa2
'---------------
'zDisplayResults
'---------------
'Displays results in a scrollable list
'list can be sorted by any column
'Columns are resizable
'Option to copy to clip board places all values as tab seperated suitable for pasting into spread sheets etc.
'
'DialogTtl	- Dialog Title 
'~~Fields		- A list of fields to display, must match number of values per line
'Values		- List of Pipe | seperated values one row per line 
'Width		- Width of List display (in characters)
'Height		- Height of list display (in lines but also related to size accross)
'Footer		- Additiona text to display at bottom of dialog between list and buttons
'Lines		- Number of lines to reserve for Footer
'Buttons	- to display in addition to Copy to Clipboard Null then just Ok
'
'Returns button selected in lower case or null if no button (upper right X)
'
FUNCTION zDisplayResults AS C (DialogTtl as C, Fields AS C, Values AS C, Width as N, Height as N, Footer AS C, Lines AS N, Buttons as C = "Ok")
'~~
DIM SHARED Result as C											'Fix up values passed in, Values displayed must be in 
Result = Values													'shared variable for function used by this function
Fields = RTRIM(Fields,crlf())									'trialing CRLF are interpeted as extra field so remove

'------------------------------------
'// Build List Control for Summary --
'------------------------------------
																'Functions for the list control in xdialog
																'This is seperate from the xdialog event code
DIM Result_FuncCode AS C = <<%Code%
FUNCTION DoSort AS C (byref CurrentSortField AS C , byref CurrentSortDirection AS C, NewSortField AS C, pTableDef AS P,  arrContents AS P )
	DIM cResult AS C
	DIM SortDirection AS C
	DIM SortField AS C

	IF NewSortField = CurrentSortField
		' clicked on same field, reverse sort
		IF CurrentSortDirection = "D"
			CurrentSortDirection = "A"
		ELSE
			CurrentSortDirection = "D"
		END IF
	ELSE
		CurrentSortField = NewSortField
		CurrentSortDirection = "A"
	END IF

	SortDirection	= CurrentSortDirection
	SortField		= CurrentSortField
	arrContents.sort(SortDirection, stritran(SortField, "->", "__"))
	cResult = DumpContents(pTableDef, arrContents)
	
	DoSort = cResult
END FUNCTION

FUNCTION GetContents AS C ( pTableDef AS P, arrContents AS P, lv AS P )
	DIM cResult AS C
	arrContents.Clear()

	DIM format AS C
	format = stritran(pTableDef.FieldList, "|", crlf())			' normalize header names
	format = *for_each(x, table.name_normalize(word(x,1,":"))+iif(":"$x,":"+word(x,2,":"),""), format)
	format = alltrim(format)
	format = stritran(format, crlf(), "|")

	cResult = Result											'Values prepared by script
	
	arrContents.resize(line_count(cResult))
	arrContents.initialize_properties(format, cResult)

	cResult = DumpContents(pTableDef, arrContents)
	GetContents = cResult
END FUNCTION

FUNCTION DumpContents AS C ( pTableDef AS P, arrContents AS P )
	DIM cResult AS C
	DIM cEval AS C

	pTableDef.FieldList	= alltrim(pTableDef.FieldList)

	IF pTableDef.FieldList = ""
		EXIT FUNCTION
	END IF
	
	cEval = *for_each(x, "TrimCRLFs(x." + stritran(table.name_normalize(x),"->", "__")+")", pTableDef.FieldList)
	cEval = alltrim(cEval)
	cEval = stritran(cEval, crlf(), "+"+quote("|")+ "+")
	IF pTableDef.ReturnValueExpression <> ""
		cEval = quote("{DATA=") + " + TrimCRLFs(x." + stritran(table.name_normalize(pTableDef.ReturnValueExpression),"->", "__") + ")+" + quote("}")+ "+" + cEval
	END IF
	
	cEval = "*for_each(x, " + cEval + ", arrContents)"
	cResult = eval(cEval)
	

	DumpContents = cResult	
END FUNCTION

FUNCTION TrimCRLFs AS A ( data AS A )
	IF typeof(data) = "C"
		TrimCRLFs = stritran(data, crlf(), " ")
	ELSE
		TrimCRLFs = data
	END IF
END FUNCTION
%Code%

'----------------------------------
'// Field and column definations --
'----------------------------------
DIM Result_pTableDef AS P
DIM Result_pTableDef.FieldList AS C = Fields					'field names to assign to elements on each row

DIM TtlRow as C = ""											'Define column titles
for each Line in Fields											'format should be	
	TtlRow = TtlRow + IF(isnull(TtlRow),"","|") + Line.Value	'"Group|Count"
next
DIM Result_pTableDef.TitleRow AS C = TtlRow						

DIM TtlEvnt as C = ""											'Define events for sorting by column clicks format should be
for each Line in Fields											'"Result_Sort_Group|Result_Sort_Count|"
	TtlEvnt = TtlEvnt + IF(isnull(TtlRow),"","|") + "Result_Sort_" + Line.Value
next
Result_pLV.titleevents = TtlEvnt

'----------------------------------
'// Further definations for List --
'----------------------------------
DIM Result_Funcs AS P = compile_template(Result_FuncCode)		'Define values passed to the list control in the xdialog
DIM Result_arrContents[1] AS P									

DIM SHARED Result AS C
DIM Result_CurrentSortField AS C = ""
DIM Result_CurrentSortDirection AS C = "A"

DIM Result_pTableDef.ReturnValueExpression AS C = ""

Result_pLV.titlerow = Result_pTableDef.titlerow
Result_pLV.style = "report,singlesel,showselalways,gridlines,fullrowselect"
Result_pLV.dragbehaviour = ""
Result_pLV.dropbehaviour = ""
Result_pLV.contents = Result_Funcs.GetContents(Result_pTableDef, Result_arrContents, local_variables())
																'event code for list control
Result_pLV.events = ""											'No event code required no events processed
																'define the xdialog
Dialog =<<%dlg%
{region}
{listview={Insert_Width},{Insert_Height}Result^=Result_pLV};
{endregion};
{region}
{text={Insert_Width},{Insert_Lines}Footer} 
{endregion};
{line=1,0};
{region}
{Insert_Buttons}
{endregion};
%dlg%

DIM ButtonDef as C = ""
FOR each Line in Buttons
	IF ButtonDef 
		*concat(ButtonDef,space(1))
	end if
	ButtonDef = ButtonDef + "<15&" + Line.value + "!" + lower(Line.value) + ">"
next
ButtonDef = ButtonDef + " <20C&opy to Clipboard!copy>"
sr =<<%txt%
{Insert_Width} = Width
{Insert_Height} = Height
{Insert_Lines} = Lines
{Insert_Buttons} = ButtonDef 
%txt%

Dialog = stritran_multi_expressions(Dialog,sr) 					'Subsitute in selected variables only

Code =<<%code%
IF left(a_Dlg_button, len("Result_Sort_")) = "Result_Sort_"
	DIM NewSortField AS C
	NewSortField = substr(a_dlg_button, len("Result_Sort_")+1)
	Result_pLV.Contents = Result_Funcs.DoSort(Result_CurrentSortField, Result_CurrentSortDirection, NewSortField, Result_pTableDef, Result_arrContents)
	a_dlg_button = ""
END IF

IF a_dlg_button = "copy"										'copy results to the clipboard
	a_dlg_button = ""
	DIM PropIndx as N											'Index for goinmg through property array
	DIM T as C = chr(9)											'Tab character	
	DIM LineOut as C = ""										'idividual lines built for adding to clip board
	DIM ClipOut as C = ""										'value built for clip board
	
	PropertyList = properties_enum(Result_arrContents[1])
	FOR each Line in PropertyList 
		LineOut = LineOut + IF(isnull(LineOut),"",T) + Line + ""
	next
	ClipOut = ClipOut + LineOut + crlf()
	FOR PropIndx = 1 to Result_arrContents.size()
		LineOut = ""
		FOR each Line in PropertyList							'Line variable is actually a pointer with single element
			Express = "Result_arrContents[" + PropIndx + "]." + Line.Value
			LineOut = LineOut + IF(isnull(LineOut),"",T) + alltrim(eval(Express)) + ""
		next
		ClipOut = ClipOut + LineOut + crlf()
	next		
	ClipOut = *concat_lines(ClipOut," ",Footer)
	clipboard.Set_Data(ClipOut,1,.T.)	
END IF
%code%
			
'--------------------------------
'// Display results in xDialog --
'--------------------------------
Result = ui_dlg_box(DialogTtl,Dialog,Code)						'present the xdialog with the results
zDisplayResults = Result										'return the button pressed
END

END FUNCTION

The following displays a highly configurable progress bar. This code is written as a Class introduced in Alpha5 Version 10.5. I haven't seen many samples of code implemented as classes, and after working through the problems with Alpha's implementation of Classes, I can see why. Read the comments in the code if you are interested in details. However this progress bar does work quite well, and I've been able to use it dozen of times. It's used by the counting script so I've included it here.

'Date Created: 18-Apr-2015 08:54:44 AM
'Last Updated: 28-Feb-2016 11:37:35 AM
'Created By  : verboopa2
'Updated By  : verboopa2
'---------
'~zProgress
'---------
'~ typo 25
'This Class provides a Modeless Progress Dialog based on the A5 statusbar.
'A Overall progress bar is provided that tracks as a predefined number of steps.
'After 15 seconds Dialog will calculate estimated time left and the time of completetion.
'
'Function: 
'CreateProgressBar (Title as C, Message as C = "Please Wait", Cancel as L = .f., TotalSteps as N = 1, TotalCnt as N = -1, StatusAreaOn as L = .T.)
'
'Title			- Tile used for Modeless Dialog usually made the same as title of script using zProgress (DialogTtl)
'Message		- Message to display on 3rd line, discription of current step being done
'					Default message is Please Wait
'Cancel			- Place Cancel button in Status Bar area. Cancel button Status returned by .Percent method 
'				   This is the same Cancel button used by some xBasic operations that use the status bar
'TotalSteps		- Number total steps used for overall progress bar if set to one no overall status bar is displayed
'TotalCnt		- Number of iterations in current step set to -1 if unknown when initializing progress bar
'					Defaulr value is -1, unknown
'StatusAreaOn	- By default percentage bar used by internal Alpha5 functions are moved to the status dialog created
'					However some operations will not display properly in the dialog, for example reindexing progress
'					set to .T. keeps these status messages in the Alpha5 status area where they will display properly
'

'Returns a pointer to ProgressBar established, pointer is then used with the Methods below.
'
'.Message(Message as C)					- sets a message in the A5 status bar area
'	Message								- Message to place in status bar area
'
'.Step(Message as C,TotalCnt as N		- increment step count and prepare for next iteration, updates overall progress bar
'	Message								- Message to place on third line should reflect activity in current step
'											Optional default leave existing message 
'	TotalCnt							- The total total counts in next iteration, used by .Percent method
'											Optional default leave existing Total Count in effect
'
'NewPercent(Message as C,TotalCnt as N)	- Optional changes Message and Total Count for percentage bar
'											Used to track iterations of new loop within currect step
'											used by CSV load during unflatten operation
'	Message								- Message to place on third line should reflect current activity
'											Optional default leave existing message 
'	TotalCnt							- The total total counts in next iteration, used by .Percent method
'											Optional default leave existing Total Count in effect
'						
'.Percent(Value)						- displays and updates A5 status bar on 4th line does Cancel button check if enabled
'									 		 closes progress dialog if Cancel is pressed 
'	Value								- The current count some part TotalCnt
'
'.close()								- close the status bar and does check on number of steps if that debug feature is enabled.

'Standard Usage
'--------------
'DIM PB as zProgress
'PB = zProgress.CreateProgressBar("Dialog Title","Please Wait",.T.,2)
'PB.Step("Phase 1",5)
'FOR X = 1 to 5
'	IF PB.Percent(x)
'		'some abort action here
'	END IF
'NEXT
'PB.Step("Phase 2",100)
'FOR X = 1 to 100
'	IF PB.Percent(x)
'		'some abort action here
'	END IF
'	sleep(.5)
'PB.Close()
'
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'! The first time a user defined class is referenced, 									!	
'!  it must be explicatly defined using the dim statement as shown above. 				!
'! It can NOT be defined via a Static function as indicated in the documentation.			!
'! Once a class is used once the a Static function can define any additional instances.	!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'Unique A5 stuff used covered in release notes for Alpha5 Version 8
'Util::Timer 				- precision timer object

'Unique A5 stuff used covered in release notes for Alpha5 Version 9
'{statusarea=width,height}	- Embeds the statusbar used by long running Xbasic scripts into a dialog. 
'								an examples is the status bar seen when reindexing.
'
'Unique A5 stuff covered in release notes for Alpha5 Version 10
'Classes 					- The progress bar is enabled as a class this differes from a script.
'{staticConditionalSection:1:(condition)}
'							-Allows section of dialog to be added based on conditions
'
'Unique A5 stuff covered in standard A5 help file
'STATUSBAR.ABORT_CHECK()	- check if status bar abort button pressed
'STATUSBAR.PERCENT()		- setup and update a status bar percentage completion 
'								same status bar used by long running built in functions
'STATUSBAR.CLEAR()			- turn off statusbar

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'! Additional things about Classes that didn't work as expected			!
'! Events in Modeless xDialogs launched from the Class.					!
'! This includes timer events.											!
'! Referencing Statusbar object from multiple functions in the class.	!
'! Therefore it only referenced in a single function					!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'! When saving Class definations they are executed this makes determining		!
'! locations of syntax errors normally reported during save operations hard.	! 
'! comment out next line to get true syntax error messages.						!
'! When all syntax errors are removed you will get following 					!
'!  resulting from final end class statement 									!				
'! Error: Mismatched end of loop or if-block									!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

define class global zProgress 

'-------------------------
'// Create Progress Bar --
'-------------------------
FUNCTION [STATIC] CreateProgressBar as p(Title as C, Message as C = "Please Wait", Cancel as L = .f., TotalSteps as N = 1, TotalCnt as N = -1, StatusAreaOn as L = .T.)
	
	DIM PB AS zProgress											'Intialize DOT variable with the class structure
																'Values execessable via Method	
	DIM PB.Title as C											'Title of dialog 	
	DIM PB.Step as N											'Current step number
	DIM PB.StepTot as N											'Total steps to display
	DIM PB.StepMax as N											'maxium number of steps seen calculated value
	DIM PB.CntTot as N											'number of iterations for current step
																
																'Values keep locally not needed outside Class
																'these variables are lost once modeless dialog started by Class in closed
	DIM StepTotTime as N										'Total Time all steps done so far in seconds		
	DIM StepMess as C 											'1st text line on screen above overall progress bar  
	DIM StepPct as N											'Percantage of steps completed calculated value	
	DIM cStep AS C												'Character version of step numbers for dialog text
	DIM StatusFormat as C										'Format of status Bar
	DIM Mess as C												'Message for current iteration
	DIM InitialMess	as C										'Message sent when estblishing progress bar 
																'used for trace window message when PB.TotStep <> PB.MaxStep
																
																'Values used in calculated Estimated completion time
	DIM RefreshTime as N = 15									'seconds between recalculating completion time
	DIM SecLeftStp as N											'Calculated remaining time based on tim on current step
	DIM SecLeftTot as N											'Calc time left based on overall steps
	DIM	SecLeft as N											'Largest value of two calculation above used for estimate
	DIM	MinLeft as N											'Calculated Minutes left
	DIM TimeFin as C											'Calculate actual completion time formated as DAY HH:MM AM
	DIM OverAll as L = .T.										'Use total steps when calculating completion time											
	
	'---------------------
	'// Set Debug Flags --
	'---------------------
	DIM Debug as C = "" 										'use following statement to check for debug flag: if ("m" $ Debug)
	DbgSet("zProgress",Debug)									'set debug values in deployed enviroments
	's - write info to trace window if steps not set correctly

	PB.Title = Title											'Remember Title so we can close dialog
	PB.StatArea = StatusAreaOn
	InitialMess = Message										'rember initial message for trace window entries
	Mess = PADC(Message,70," ")									'Initial message padded and centered to window width
	PB.StepTot = TotalSteps										'Total Number of steps expected 1 indicates only one step
	IF PB.StepTot = 1											'no overall Progress Bar is displayed but 1st line
		Stepmess = ""											'is retained so time estimates can be displayed	
		PB.StepMax = 1											'it is not intialization for overall progress bar 
		PB.Step = 0
	else														'Count this interation as given
		StepMess = "Overall Progress"							'text version of steps for dialog
		cStep = evaluate_string(" (step {PB.Step} of {PB.StepTot})")	
		PB.Step = 0												'intialize step to one before first one must cal methoth step to set step one
		StepPct = PB.step / PB.StepTot * 100					'Initial percentage of steps
		PB.StepMax = 0											'used with debugging the StepTot values to use
	end if

	StepMess = PADC(StepMess,70," ")							'Message above steps padded and centered to window width
	PB.CntTot = TotalCnt										'number of interations for first step

	IF Cancel
		StatusFormat = "$b{Cancel...} $g   ($c of $o)"
	else
		StatusFormat = space(18) + "$g   ($c of $o)"
	end if		
	
	DIM tPer as Util::Timer										'Time since last status bar update
	DIM tUpd as Util::Timer										'Time since last Estimate update
	DIM tTot as Util::Timer										'Total Time so far
	DIM tStp as Util::Timer										'Total on this iteration
	tUpd.start()
	tTot.start()
																'PB.StepTot > 1 for overall progress bar to be displayed	
Dialog =<<%dlg%
{text=70StepMess};
{staticConditionalSection:1:PB.StepTot>1}
{sp=11}{progress=28StepPct}{sp=2}{text=20cStep};
{end_staticConditionalSection:1}
{staticConditionalSection:2:.NOT.isnull(Mess)}
;
{region}
{text=70Mess}
{endregion};
{end_staticConditionalSection:2}
{region}
{staticConditionalSection:3:PB.StatArea}
{statusarea=70,1}
{end_staticConditionalSection:3}
{endregion};
%dlg%
	
	PB.DialogPtr = ui_modeless_dlg_box(PB.Title,Dialog)			'display our modeless dialog
	XBASIC_WAIT_FOR_IDLE() 										'wait for this dialog to be displayed 
																'before return and start running our tight loops 
																'that don't give the ui any time to update
	CreateProgressBar = PB										'return pointer this instance of class so we access it more

end function

'--------------------------------------
'// Set a message in status bar area --
'--------------------------------------
FUNCTION Message as v(Message as C)								
	IF PB.StatArea
		StatusBar.Set_Text(Message)
	end if
end function

'------------------------
'// Bump Up step count --
'------------------------
FUNCTION Step as v(Message as C = "",TotalCntNew as N = -1)		
	IF TotalCntNew <> -1										'Message is often changed as new step is enterred
		PB.CntTot = TotalCntNew									'each step consist of a predefined loop
	end if 														'This method allows Message and Total Count to be updated
	IF .NOT. isnull(Message)									'update the message if we have one
		Mess = PADC(Message,70," ")								'pad it to window width so it centers
	end if	
	if PB.Step = PB.StepTot then								'if we have already reached max just record actual number of steps
		PB.StepMax = increment_value(PB.StepMax)				'this can be used for debugging MAx steps required latter on
	else
		PB.Step = increment_value(PB.Step)						'increase local tracking of the step we are on
		PB.StepMax = PB.Step
	end if
	StepPct = PB.step / PB.StepTot * 100						'Recalculate percentage complete for steps complete bar

	cStep = evaluate_string("(step {PB.Step} of {PB.StepTot})")	'text version of steps for dialog
																'force refresh of percentage of steps done, mesaage, text of steps.
	UI_DLG_REFRESH_TARGETED(PB.Title,*concat_lines("StepPct","Mess","cStep"))
	
	StepTotTime = StepTotTime + tStp.ElapsedSeconds				'add to total time steps done so far.
	tStp.Start()												'reset time for this step.
end function	

'--------------------------
'// Reset Percentage Bar --
'--------------------------
FUNCTION NewPercent as v(Message as C = "",TotalCntNew as N = -1)
	IF TotalCntNew <> -1										'Set new message above percentage complete bar 
		PB.CntTot = TotalCntNew									'and change percentage bar total iterations
	end if 														'used when new operation needs to be tracked within the 
	IF .NOT. isnull(Message)									'current step such as unflatten operation
		Mess = PADC(Message,70," ")								
	end if	
	UI_DLG_REFRESH_TARGETED(PB.Title,*concat_lines("StepPct","Mess"))
end function	

'-----------------------------------
'// Set Percent in progress value --
'-----------------------------------
Function Percent as L(Value as N)								'Update the percentage bar
	if tPer.ElapsedMilliseconds > 500							'following code can add significant overhead to tight loops
																'only run it every 1/2 second 	
		statusbar.Percent(Value,PB.CntTot,StatusFormat)			'update status bar for this iteration
		if tUpd.ElapsedSeconds > RefreshTime					'do we update estimate
			IF (PB.StepTot = 1) .OR. (PB.StepTot = PB.Step)		'If only one step or on last steps
																'estimated not based on steps at all
				SecLeft = (PB.CntTot - Value)/Value * tStp.ElapsedSeconds
			else												
																'Projected (estimated) Time for this step			
				EstTimeStp = tStp.ElapsedSeconds * (PB.CntTot / Value)
																'Total time for steps so far and projected time
																'for current step to calc time per step so far
				AvTimeStp = ((StepTotTime + EstTimeStp) / PB.Step)
																'Time per step so far times steps left
																'Estimated seconds left
				SecLeft =  AvTimeStp * (PB.StepTot - PB.Step)  	
			end if
			MinLeft = round((secleft / 60),2)					'Calculate Minutes left
			TimeFin = time("W 0h:0m AM",now()+Secleft)			'Calculate actual completion time
			StepMess = padc(evaluate_string("Estimated completion in {MinLeft} minutes @ {TimeFin}"),70," ")
			UI_DLG_REFRESH_TARGETED(PB.Title,"StepMess")		'force refresh of overall message .
			tUpd.Start()										'restart update timer
		end if	
		ui_yield()												'Yield to UI so progress dialog can be updated
		tPer.start()											'reset percent update timer
		IF  STATUSBAR.ABORT_CHECK()								'user has pressed abort
			StatusBar.Clear()									'clear up the dialog and return True Flag	
			ui_modeless_dlg_close(PB.Title)
			Percent = .T.
		else
			Percent = .F.										'User has not pressed Abort so return false
		end if													
	end if

end function

'----------------------------
'// Close the Progress Bar --
'----------------------------
FUNCTION Close as v()
	StatusBar.Clear()											'we can clear status bar even if it doesn't exist
	IF eval_valid("PB.Title")									'verify we have Title defined before using it
		IF UI_MODELESS_DLG_EXIST(PB.Title)						'verify dialog is there before attempting to close it
			IF PB.StepTot <> PB.StepMax .AND. ("s" $ Debug)		'dialog closed normally and debug flag set
				zTraceStamp()									'add debug info if steps set incorrectly
				Mess =<<%txt%
Script: zProgress 
Condition: Incorrect Step Count
Initial Message where Total Steps set: {InitialMess}
Total Steps: {PB.StepTot}
Maxium Step seen: {PB.StepMax}
%txt%
				trace.WriteLn(Evaluate_String(Mess))
			end if												'once Modeless Dialog is closed all variable defined with it are lost
			ui_modeless_dlg_close(PB.Title)						'so clear dialog after trace entries are created
		end if
	end if
end function

end class

Finally a function used get a pointer to the current form and verify script is run from correct form.

'Date Created: 04-Apr-2014 01:45:40 PM
'Last Updated: 16-Jul-2014 07:54:02 PM
'Created By  : verboopa2
'Updated By  : verboopa2
'----------
'zVerifyWnd
'----------
'Determine if specified Window is active
'if it is return pointer to the window
'if not generate error and abort script
' or return Logical False 
'action depends on Error flag passed to function 
'Script will return pointer to currently active form
' if multiple copies of form are open
'Parameters sent in
'WindowTitle	- Title of window with no trailing instance numbers
'Error			- display error if not found optional .T. = yes(default) .F. just exit
'				  use .F. if calling function has no error trap set
'				  as error trap required to display error message
'				  function will return logical False in these cases
'				  this can be checked for by following sequence
'DIM Pwin as A									'Get pointer to Window
'Pwin = zVerifyWnd("User Duplicate Check",.F.)	'No error handler therefore no error message
'IF TypeOf(Pwin) <> "P" 	 					'Window lookup failed
'	end
'end if


FUNCTION zVerifyWnd AS A (WindowTitle AS C, ErrorMess as L = .T.)

	DIM WndPtr as P
	DIM WndFnd as L = .F.

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'! Orginal code used but this would identify window script was run from			!
'! this was not nessasarily the currently active window							!
'!	IF is_object(topparent.this) THEN											!
'!		IF topparent.Class() = "form" .OR. topparent.Class() = "browse" THEN	!
'!			WndPtr = topparent.this												!
'!			WindowTitle = stritran(WindowTitle,space(1),"_")					!
'!			IF (WindowTitle $ WndPtr.Name())									!
'!				WndFnd = .T.													!
'!			end if																!
'!		END IF																	!
'!	END IF																		!	
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

	DIM ActWnd as C
	ActWnd = tagged_pattern("$1$2","2",A5.active(.T.))
	WindowTitle = stritran(WindowTitle,space(1),"_")
	IF (WindowTitle $ ActWnd)
		WndFnd = .T.
		WndPtr = obj(ActWnd)
	end if
	IF .NOT. WndFnd
		IF ErrorMess
			error_generate("Script Must be run from Form: " + WindowTitle)
			end
		else
			zVerifyWnd = .F. 
		end if
	else
		zVerifyWnd = WndPtr
	END IF

END FUNCTION