Using listboxs to select files/fields

'********************************************************************************************************************************************
'* Script:	listbox demo with fields.iss
'* Author:	Brian Element - brian.element@ideascripting.com
'* Date:	April 4, 2014
'* Purpose:	This is a demo script to show how you can create a dialog to be able to select multiple files.  This is a working
'*		script that will allow you to select character, numeric, data, time and all fields from a selected file.  The end
'*		product is a message box with all the fields that you selected.  If you need this functionality you can use this
'*		script as the starting point for your own script.
'* This script is presented without any warranty or guarantee.  Users are encouraged to validate the effectiveness and reliability on their own.
'********************************************************************************************************************************************

Option Explicit
Public fields()
Dim sFilename As String
Dim iFieldType As Integer
Dim working_directory  As String
Dim bExitScript As Boolean 'flag in case user hits cancel, the script will be exited
Dim bFieldsSelected As Boolean 'flag to show if the fields have been selected.

Dim tempListbox1() As String 'needed for the variables for the dlgSeletFiles
Dim tempListBox2() As String 'needed for the variables for the dlgSeletFiles
Dim tempListSelect1 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered
Dim tempListSelect2 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered


Sub Main
	Dim i As Integer
	Dim sMsg As String
	Dim CrLf As String
	working_directory = Client.WorkingDirectory()
	CrLf = Chr(10) & Chr(13)
	Call menu()
	If Not bExitScript Then
		For i = 0 To UBound(tempListBox2)
			sMsg = sMsg & tempListBox2(i) & CrLf 
		Next i
		MsgBox sMsg
	End If
	

End Sub

Function funSelectFiles(ControlID$, Action%, SuppValue%)
	Dim bExitMenu As Boolean 'flag to indicate if the dialog should close or remain open
	Dim i As Integer
	Dim j As Integer
	Dim k, l As Integer 'used to update tempListbox1 and 2 array
	Dim bListBox2Set As Boolean 'flag to show item was in placed in listbox2
	Select Case action
		Case 1
			'initialize the variables
			ReDim tempListbox1(0) 
			ReDim tempListbox2(0)
			
			l = 0
			k = 0
			'takes the items from the fields array and places them in the tempListBox1 array and then place the contents in lisbox1
			For i = 0 To UBound(fields)
				ReDim Preserve tempListbox1(UBound(tempListbox1) + 1)
				If fields(i) <> "" Then
					tempListbox1(i) = fields(i) & "-" & i
				End If
			Next i
			Call sortArray(tempListbox1)
			Call removeBlanksFromArray(1)
			DlgListBoxArray "ListBox1", tempListbox1
			tempListSelect1 = 0  'set to 1st items as default
		Case 2
			Select Case ControlId$
				'this will take the item selected from listbox1 and add it to listbox2
				Case "PushButton1"
					ReDim Preserve tempListbox2(UBound(tempListbox2) + 1)
					
					tempListbox2(UBound(tempListbox2)) = tempListbox1(tempListSelect1)

					tempListbox1(tempListSelect1 ) = ""
					
					'sort and remove any blancks from the array
					Call sortArray(tempListbox1)
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(1)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					
					tempListSelect1 = 0 'set to 1st items as default
					bExitMenu = FALSE 'don't close the dialog
				'this will take an item selected from lisbox2 and add it to listbox1
				Case "PushButton2"

					ReDim Preserve tempListbox1(UBound(tempListbox1) + 1)
					
					tempListbox1(UBound(tempListbox1)) = tempListbox2(tempListSelect2)

					tempListbox2(tempListSelect2 ) = ""
					
					'sort and remove any blanks from teh array
					Call sortArray(tempListbox1)
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(1)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					
					tempListSelect2 = 0 'set to 1st items as default
					bExitMenu = FALSE 'don't close the dilaog
					
				'take all the items from listbox1 and place them in listbox2
				Case "PushButton3"
					ReDim tempListbox2(UBound(fields))
					ReDim tempListbox1(0)
					For i = 0 To UBound(fields)
						tempListbox2(i) = fields(i)
					Next i
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					bExitMenu = FALSE  'don't close the dilaog
				
				'take all the items from listbox2 and place them in listbox2
				Case "PushButton4"
					ReDim tempListbox1(UBound(fields))
					ReDim tempListbox2(0)
					For i = 0 To UBound(fields)
						tempListbox1(i) = fields(i)
					Next i
					Call sortArray(tempListbox1)
					Call removeBlanksFromArray(1)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					bExitMenu = FALSE  'don't close the dilaog
				'used to keep track of the values selected from the listbox1 and listbox2 when a button is selected
				Case "ListBox1"
					tempListSelect1 = SuppValue%
					
				Case "ListBox2"
					tempListSelect2 = SuppValue%
				
				'If okbutton is selected check to make sure one item has been selected, it no give a warning and don't close the dialog	
				Case "OKButton1"
					If  tempListbox2(0) = "" Then
						MsgBox "Please select at least one file"
						bExitMenu = FALSE
					Else
						bExitMenu = True
						bFieldsSelected = True
					End If
				'if the cancel button is selected then indicated that no fields have been selected
				Case "CancelButton1"
					bFieldsSelected = False 'no Fields selected
		End Select
	End Select
	
	'The following is used to enable the different buttons depending on the contents of the listboxes
	If tempListbox1(0) = "" Then 'firt list box is emtpy
		DlgEnable "PushButton1", 0
		DlgEnable "PushButton3", 0
		DlgEnable "PushButton2", 1
		DlgEnable "PushButton4", 1

	ElseIf tempListbox2(0) ="" Then 'second list box is empty
		DlgEnable "PushButton1", 1
		DlgEnable "PushButton3", 1
		DlgEnable "PushButton2", 0
		DlgEnable "PushButton4", 0

	Else 'something in boxes
		DlgEnable "PushButton1", 1
		DlgEnable "PushButton3", 1
		DlgEnable "PushButton2", 1
		DlgEnable "PushButton4", 1

	End If
	
	'close the dialog if bExitMenu is true
	If bExitMenu Then
		funSelectFiles = 0
	Else 
		funSelectFiles = 1
	End If
	
End Function

'funtion to call the menu.  It will check to see if a file is open, if so it will pass the file name to sFilename, if not sFilename will be blank and then open the dialog
Function menu()
	Dim dlg As mainMenu
	Dim button As Integer
	
	Dim db As database
		On Error Resume Next
		Set db = Client.CurrentDatabase()
		If err.number = 0 Then
			sFilename = db.name
		Else
			sFilename = ""
		End If
	
	Set db = Nothing
	
	button = Dialog(dlg)

End Function

'function for the mainMenu dialog
Function displayIt(ControlID$, Action%, SuppValue%)
	Dim bExitFun As Boolean
	Dim button As Integer
	Dim dlgSelectFilesDialog As dlgSelectFields
	Select Case action
		Case 1

		Case 2
		
			Select Case ControlId$
				'if PushButton1 selected then call the getFile function to obtain the filename
				Case "PushButton1"
					sFilename = getFile()
					bExitFun = false 'don't close the dialog
				'Call the dlgSelectedFields dialog.  It will first find which option was selected for the fields, then call the fields and then call the dialog
				Case "PushButton2"
					If sFilename <> "" Then
						'get the field types
						iFieldType = mainMenu.OptionButtonGroup1
						Call getFields()
						button = Dialog(dlgSelectFilesDialog)
					End If
				'if the user selected the cancel button close the dilaog and exit the script
				Case "CancelButton1"
					bExitFun = True
					bExitScript  = True
				'if the ok button is selected make sure that a file is selected and also the fields, if they aren't give an error and don't close the dialog, other wise close the dialog
				Case "OKButton1"
					If sFilename = "" Then
						MsgBox "Please select the file"
						bExitFun = FALSE
					ElseIf Not bFieldsSelected Then
						MsgBox "Please select the fields"
						bExitFun = FALSE
					Else		
						bExitFun = True
					End If

					
			End Select
		End Select
	
	'Place the filename in the Text1 textbox of give an indication that the file had not been selected	
	If sFilename = "" Then
		DlgText "Text1", "Please select a file"
	Else
		DlgText "Text1", getFileName(sFilename, 0)
	End If
	
	'Place a message in the Text2 textbox indicating if the fields have been selected or not
	If bFieldsSelected Then
		DlgText "Text2", "Fields selected"
	Else
		DlgText "Text2", "Please select the fields"
	End If
	
	'if bExitFun is true then close the dialog, otherwise keep it open
	If bExitFun Then
		displayIt = 0
	Else 
		displayIt = 1
	End If


End Function

'this function will ge tthe filename from a path
Function getFileName(temp_filename As String, temp_type As Boolean) '1 if get the name with any folder info, 0 if only the name
	Dim temp_length As Integer
	Dim temp_len_wd As Integer
	Dim temp_difference As Integer
	Dim temp_char As String
	Dim tempfilename As String
	
	If temp_type Then
		temp_len_wd  = Len(working_directory )  + 1'get the lenght of the working directory
		temp_length = Len(temp_filename) 'get the lenght of the file along with the working directory
		temp_difference = temp_length - temp_len_wd  + 1'get the lenght of just the filename
		getFileName = Mid(temp_filename, temp_len_wd, temp_difference)	
	Else
		temp_length  = Len(temp_filename )
		Do 
			temp_char = Mid(temp_filename, temp_length , 1)
			temp_length = temp_length  - 1 
			If temp_char <> "\" Then
				tempfilename = temp_char & tempfilename
			End If
		Loop Until temp_char = "\" Or temp_length = 0
		getFileName = tempfilename
	End If
End Function

'function to open the FileExplorer and return the name of the file selected
Function getFile()
               Dim filebar As Object
               Set filebar =CreateObject ("ideaex.FileExplorer")
               ' Display the File Explorer
               filebar.DisplayDialog
               ' Set Variable to store Select File Name
               getFile = filebar.SelectedFile
End Function

'function to sort an array
Private Function sortArray(MyArray() As String)
	Dim lLoop, lLoop2 As Integer
	Dim str1, str2 As String
	For lLoop = 0 To UBound(MyArray)
	
		For lLoop2 = lLoop To UBound(MyArray)
		
			If UCase(MyArray(lLoop2)) < UCase(MyArray(lLoop)) Then
			
				str1 = MyArray(lLoop)
				str2 = MyArray(lLoop2)
				MyArray(lLoop) = str2
				MyArray(lLoop2) = str1
			
			End If
		
		Next lLoop2
	
	Next lLoop

End Function

'function to get the fields from an IDEA file.  There are different options in that the user can selected to obtain all, char, num, date or time fields
Function getFields()
	Dim oSource As database
	Dim oTable As table
	Dim oField As field
	Dim iFields As Integer
	Dim i As Integer  
               	
	If sFilename<> "" Then
		Set oSource=client.opendatabase(sFilename)
			Set oTable=oSource.tabledef
				iFields=oTable.count
				
				ReDim fields(iFields - 1)
				
				For i=1 To iFields 
				
					Set oField=oTable.getfieldat(i)
					
					If oField.IsCharacter And iFieldType = 0 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsNumeric And iFieldType = 1 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsDate And iFieldType = 2 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsTime And iFieldType = 3 Then
						fields(i - 1)=oField.name
					ElseIf iFieldType = 4 Then
						fields(i - 1)=oField.name
					End If
				Next i
				
				
				Set oField = Nothing
			Set oTable = Nothing
		Set oSource = Nothing
	End If
End Function

'****************************************************************************************************
'	Name:		removeBlanksFromArray
'	Description:	Routine to remove blank entries to an array
'	Last Update:	
'****************************************************************************************************
Private Function removeBlanksFromArray(tempType As Integer)
	Dim tempArray() As String
	Dim i, ILoop As Integer
	ReDim tempArray(0)
	
	If tempType = 1 Then
		For ILoop = 0 To UBound(tempListbox1)
			If tempListbox1(ILoop) <> "" Then
				tempArray(UBound(tempArray)) = tempListbox1(ILoop) 
				If ILoop <> UBound(tempListBox1) Then 'don't increment on the last pass
					ReDim preserve tempArray(UBound(tempArray) + 1)
				End If
			End If
		Next ILoop
		'MsgBox UBound(MyArray)
		i = UBound(tempArray)
		Erase tempListbox1
	
		ReDim tempListbox1(i)
		For ILoop = 0 To UBound(tempArray)
			'MsgBox "i " & ILoop & " - " & tempArray(ILoop)
			tempListbox1(ILoop) = tempArray(ILoop) 
		Next ILoop
	Else
		For ILoop = 0 To UBound(tempListbox2)
			If tempListbox2(ILoop) <> "" Then
				tempArray(UBound(tempArray)) = tempListbox2(ILoop) 
				If ILoop <> UBound(tempListBox2) Then 'don't increment on the last pass
					ReDim preserve tempArray(UBound(tempArray) + 1)
				End If
			End If
		Next ILoop
		'MsgBox UBound(MyArray)
		i = UBound(tempArray)
		Erase tempListbox2
	
		ReDim tempListbox2(i)
		For ILoop = 0 To UBound(tempArray)
			'MsgBox "i " & ILoop & " - " & tempArray(ILoop)
			tempListbox2(ILoop) = tempArray(ILoop) 
		Next ILoop

	End If

End Function