The Dialog Editor is used to create modal and non-modal dialogs with powerful GUI controls that include some specifically for working with channels. &nbps;
The sample code and dialog file provides a good example of how to create a dialog using the NI DIAdem Dialog Editor.
Download the dialog file: training_script_Dialog.SUD
'------------------------------------------------------------------------------- '-- SUD script file '-- Author: Mechatronic Solutions LLC '-- Comment: Dialog Editor '------------------------------------------------------------------------------- Option Explicit Call LogFileWrite("Start of dialog 'training_script_Dialog.SUD'" & vbTab & Str(Now(),"#dd ttt yyyy hh:nn:ss")) Dim sLastFolder '------------------------------------------------------------------------------- 'Dialog events and OK Cancel buttons Sub Dialog_EventInitialize(ByRef This) 'Created Event Handler Dialog.Title = "Dialog Editor example" Dim i For i = 2 to TabPageCtrl1.Pages.Count TabPageCtrl1.Pages(i).Enable = False Next btn_PrevPage.Enable = False btn_NextPage.Enable = False folderContents_Lbl.Enable = False ListBoxFolderContents.Enable = False Call ListBoxFolderContents.Items.RemoveAll() btn_Done.Enable = False ' test_year_Box.Enable = False test_year_Box.Value = -1 test_loc_country_Box.Enable = False test_loc_country_Box.Value = -1 notes_Box.Enable = False notes_Box.Text = "" ' Call btn_SelectSrcFolder.SetFocus TextSourceFolder.Text = "" TabPageCtrl1.Pages(1).Enable = True TabPageCtrl1.ActivePageIndex = 1 End Sub 'Dialog_EventInitialize() Sub Dialog_EventTerminate(ByRef This) 'Created Event Handler 'Pass the source folder back to the script.. 'This.SetArgument(SourceFolder) 'The last sub called before the dialog is closed. Call LogFileWrite("End of dialog '" & This.FileName & "'" & vbTab & Str(Now(),"#dd ttt yyyy hh:nn:ss")) End Sub Sub btn_cancel_EventClick(ByRef This) 'Created Event Handler 'Use Dialog.Cancel to abort the dialog outside of this event. Dialog.Cancel End Sub Sub btn_Done_EventClick(ByRef This) 'Created Event Handler Dialog.OK End Sub Sub btn_ResetAllForms_EventClick(ByRef This) 'Created Event Handler folderContents_Lbl.Enable = False ListBoxFolderContents.Enable = False Call ListBoxFolderContents.Items.RemoveAll() btn_Done.Enable = False 'Page1 test_year_Box.Enable = False test_year_Box.Value = -1 test_loc_country_Box.Enable = False test_loc_country_Box.Value = -1 notes_Box.Enable = False notes_Box.Text = "" TextSourceFolder.Text = "" 'Page2 'Page3 ' Call btn_SelectSrcFolder.SetFocus End Sub '------------------------------------------------------------------------------- 'Tab page control / navigation ' 'TabPageCtrl1.ActivePageIndex are numbered from 1 to TabPageCtrl1.Pages.Count Sub btn_NextPage_EventClick(ByRef This) 'Created Event Handler 'Display the next TabPage 'This button is only enabled if it has passed ChkStep1, .. ChkStep2 If TabPageCtrl1.ActivePageIndex < TabPageCtrl1.Pages.Count Then 'Enable the next tab, display the next tab, hide the previous tab, disable the next button TabPageCtrl1.Pages(TabPageCtrl1.ActivePageIndex + 1).Enable = True TabPageCtrl1.ActivePageIndex = TabPageCtrl1.ActivePageIndex + 1 TabPageCtrl1.Pages(TabPageCtrl1.ActivePageIndex - 1).Enable = False btn_NextPage.Enable = False If TabPageCtrl1.ActivePageIndex < TabPageCtrl1.Pages.Count Then btn_PrevPage.Enable = True End If Select Case TabPageCtrl1.ActivePageIndex Case 1 Call ChkStep1() Case 2 Call ChkStep2() Case 3 Call ChkStep3() End Select End Sub Sub btn_PrevPage_EventClick(ByRef This) 'Created Event Handler If TabPageCtrl1.ActivePageIndex > 1 Then 'enable the previous tab, display the previous tab, disable the next tab TabPageCtrl1.Pages(TabPageCtrl1.ActivePageIndex - 1).Enable = True TabPageCtrl1.ActivePageIndex = TabPageCtrl1.ActivePageIndex - 1 TabPageCtrl1.Pages(TabPageCtrl1.ActivePageIndex + 1).Enable = False btn_NextPage.Enable = False End If If TabPageCtrl1.ActivePageIndex = 1 Then btn_PrevPage.Enable = False Select Case TabPageCtrl1.ActivePageIndex Case 1 Call ChkStep1() Case 2 Call ChkStep2() Case 3 Call ChkStep3() End Select End Sub 'btn_PrevPage_EventClick() Function ChkStep1() 'Use this function to check the values of the controls on Tab1 'and decide if the user should be allowed to continue to Tab2 ChkStep1 = False btn_NextPage.Enable = False 'Enable btn_NextPage if the user has selected a test_year and test_loc_country option in the combo box. If (Not test_year_Box.Value < 0) AND (Not test_loc_country_Box.Value < 0) Then ChkStep1 = True If TabPageCtrl1.ActivePageIndex < TabPageCtrl1.Pages.Count Then btn_NextPage.Enable = True Call btn_NextPage.SetFocus() End If End If End Function Function ChkStep2() 'Use this function to check the values of the controls on Tab2 'and decide if the user should be allowed to continue to Tab3 ChkStep2 = False btn_NextPage.Enable = False Const myTab2Conditions = True If myTab2Conditions Then ChkStep2 = True If TabPageCtrl1.ActivePageIndex < TabPageCtrl1.Pages.Count Then btn_NextPage.Enable = True End If End If End Function Function ChkStep3() 'Use this function to check the values of the controls on Tab3 'and decide if the user should be allowed to continue (Done button enabled). ChkStep3 = False Const myTab3Conditions = True If myTab3Conditions Then ChkStep3 = True btn_Done.Enable = True End If End Function '------------------------------------------------------------------------------- 'Page 1 - Data Set Sub btn_SelectSrcFolder_EventClick(ByRef This) 'Created Event Handler 'Get a folder from the user and then populate ListBoxFolderContents with 'the filenames of the files within that folder. Dim sFolder sFolder = DataReadPath If Not IsEmpty(sLastFolder) Then If FolderExist(sLastFolder) Then sFolder = sLastFolder End If End If Select Case PathDlgShow("Select a folder",sFolder) Case "IDCancel", "IDNo", "IDNoExecute" Exit Sub Case "IDOk" Call MsgLineDisp("Scanning the contents of folder '" & OutputPath & "'..") sLastFolder = OutputPath Call LogFileWrite("The user selected path was '" & OutputPath & "'") btn_SelectSrcFolder.Enable = False test_year_box.Enable = True notes_Box.Enable = True TextSourceFolder.Text = OutputPath: Call TextSourceFolder.RefreshText If Not Right(TextSourceFolder.Text,1) = "\" Then TextSourceFolder.Text = TextSourceFolder.Text & "\" If Not bPopulateListBoxFolderContents(OutputPath) Then Call Dialog.RunInitialize() btn_SelectSrcFolder.Enable = True Exit Sub End If If Not FolderExist(TextSourceFolder.Text) Then Call LogFileWrite(vbTab & "Error - the passed folder '" & TextSourceFolder.Text & "' does not exist") btn_SelectSrcFolder.Enable = True Dialog.Cancel Exit Sub End If folderContents_Lbl.Visible = True ListBoxFolderContents.Visible = True Call test_year_Box.SetFocus btn_SelectSrcFolder.Enable = True ' 'Enable the test_year, daq_device, and notes controls.. test_year_Box.Enable = True test_loc_country_Box.Enable = True notes_Box.Enable = True notes_Box.Text = "" ' 'Randomly assign a value.. 'test_year_Box.Value = Random(test_year_box.Items.Count) 'test_loc_country_Box.Value = Random(test_loc_country_Box.Items.Count) ' Call MsgLineDisp("Ready") Call ChkStep1() End Select End Sub 'btn_SelectSrcFolder_EventClick() Function bPopulateListBoxFolderContents(ByVal sFolder) 'Populate control ListBoxFolderContents with the 'contents from sFolder. bPopulateListBoxFolderContents = False ListBoxFolderContents.Enable = False folderContents_Lbl.Enable = False Dim arrFiles, sFile arrFiles = DirListGet(sFolder,"*.*", "Date/Time", "Filenames") If IsArray(arrFiles) Then For Each sFile In arrFiles Call ListBoxFolderContents.Items.Add(sFile,ListBoxFolderContents.Items.Count+1) Next End If Call ListBoxFolderContents.Refresh() folderContents_Lbl.Enable = True ListBoxFolderContents.Enable = True bPopulateListBoxFolderContents = True If IsArray(arrFiles) Then Call Erase(arrFiles) End Function 'bPopulateListBoxFolderContents() Sub test_year_Box_EventInitialize(ByRef This) 'Created Event Handler test_year_Box.Items.RemoveAll() Dim sYear For sYear = DatePart("yyyy", Now()) to 2000 Step -1 Call test_year_box.Items.Add(sYear, test_year_box.Items.Count) Next End Sub Sub test_year_Box_EventChange(ByRef This) 'Created Event Handler Call ChkStep1() End Sub Sub test_loc_country_Box_EventInitialize(ByRef This) 'Created Event Handler 'Populate test_loc_country combo box with the values returned 'from function oGetCountriesByNameAsDic() Dim oCountriesDic, sKey Set oCountriesDic = oGetCountriesByNameAsDic() For Each sKey In oCountriesDic Call test_loc_country_Box.Items.Add(sKey,oCountriesDic(sKey)) Next 'sKey Call oCountriesDic.RemoveAll(): Set oCountriesDic = Nothing End Sub 'test_loc_country_Box_EventInitialize() Sub test_loc_country_Box_EventChange(ByRef This) 'Created Event Handler If test_loc_country_Box.Value < 0 Then Exit Sub 'Do something with the user selected country.. 'The country name selected may be accessed from: test_loc_country_Box.Text notes_Box.Text = test_loc_country_Box.Text ChkStep1() End Sub 'test_loc_country_Box_EventChange() 'Call LogFileDel() 'Dim oCountriesDic, sKey 'Set oCountriesDic = oGetCountriesByNameAsDic() 'Call LogFileWrite(oCountriesDic.Count & " country names in 'oCountriesDic'") 'For Each sKey In oCountriesDic ' Call LogFileWrite(vbTab & "'" & sKey & "'" & vbTab & oCountriesDic(sKey)) 'Next 'sKey Function oGetCountriesByNameAsDic() 'Returns a dictionary object with a list of countries by name worldwide. '(done this way in order to insure portability of this example and avoid dependency on external files). Set oGetCountriesByNameAsDic = CreateObject("Scripting.Dictionary") If Not oGetCountriesByNameAsDic.Exists("Afghanistan") Then Call oGetCountriesByNameAsDic.Add("Afghanistan",1) If Not oGetCountriesByNameAsDic.Exists("Aland Islands land Islands") Then Call oGetCountriesByNameAsDic.Add("Aland Islands land Islands",2) If Not oGetCountriesByNameAsDic.Exists("Albania") Then Call oGetCountriesByNameAsDic.Add("Albania",3) If Not oGetCountriesByNameAsDic.Exists("Algeria") Then Call oGetCountriesByNameAsDic.Add("Algeria",4) If Not oGetCountriesByNameAsDic.Exists("American Samoa") Then Call oGetCountriesByNameAsDic.Add("American Samoa",5) If Not oGetCountriesByNameAsDic.Exists("Andorra") Then Call oGetCountriesByNameAsDic.Add("Andorra",6) If Not oGetCountriesByNameAsDic.Exists("Angola") Then Call oGetCountriesByNameAsDic.Add("Angola",7) If Not oGetCountriesByNameAsDic.Exists("Anguilla") Then Call oGetCountriesByNameAsDic.Add("Anguilla",8) If Not oGetCountriesByNameAsDic.Exists("Antarctica") Then Call oGetCountriesByNameAsDic.Add("Antarctica",9) If Not oGetCountriesByNameAsDic.Exists("Antigua and Barbuda") Then Call oGetCountriesByNameAsDic.Add("Antigua and Barbuda",10) If Not oGetCountriesByNameAsDic.Exists("Argentina") Then Call oGetCountriesByNameAsDic.Add("Argentina",11) If Not oGetCountriesByNameAsDic.Exists("Armenia") Then Call oGetCountriesByNameAsDic.Add("Armenia",12) If Not oGetCountriesByNameAsDic.Exists("Aruba") Then Call oGetCountriesByNameAsDic.Add("Aruba",13) If Not oGetCountriesByNameAsDic.Exists("Australia") Then Call oGetCountriesByNameAsDic.Add("Australia",14) If Not oGetCountriesByNameAsDic.Exists("Austria") Then Call oGetCountriesByNameAsDic.Add("Austria",15) If Not oGetCountriesByNameAsDic.Exists("Azerbaijan") Then Call oGetCountriesByNameAsDic.Add("Azerbaijan",16) If Not oGetCountriesByNameAsDic.Exists("Bahamas") Then Call oGetCountriesByNameAsDic.Add("Bahamas",17) If Not oGetCountriesByNameAsDic.Exists("Bahrain") Then Call oGetCountriesByNameAsDic.Add("Bahrain",18) If Not oGetCountriesByNameAsDic.Exists("Bangladesh") Then Call oGetCountriesByNameAsDic.Add("Bangladesh",19) If Not oGetCountriesByNameAsDic.Exists("Barbados") Then Call oGetCountriesByNameAsDic.Add("Barbados",20) If Not oGetCountriesByNameAsDic.Exists("Belarus") Then Call oGetCountriesByNameAsDic.Add("Belarus",21) If Not oGetCountriesByNameAsDic.Exists("Belgium") Then Call oGetCountriesByNameAsDic.Add("Belgium",22) If Not oGetCountriesByNameAsDic.Exists("Belize") Then Call oGetCountriesByNameAsDic.Add("Belize",23) If Not oGetCountriesByNameAsDic.Exists("Benin") Then Call oGetCountriesByNameAsDic.Add("Benin",24) If Not oGetCountriesByNameAsDic.Exists("Bermuda") Then Call oGetCountriesByNameAsDic.Add("Bermuda",25) If Not oGetCountriesByNameAsDic.Exists("Bhutan") Then Call oGetCountriesByNameAsDic.Add("Bhutan",26) If Not oGetCountriesByNameAsDic.Exists("Bolivia") Then Call oGetCountriesByNameAsDic.Add("Bolivia",27) If Not oGetCountriesByNameAsDic.Exists("Bosnia and Herzegovina") Then Call oGetCountriesByNameAsDic.Add("Bosnia and Herzegovina",28) If Not oGetCountriesByNameAsDic.Exists("Botswana") Then Call oGetCountriesByNameAsDic.Add("Botswana",29) If Not oGetCountriesByNameAsDic.Exists("Bouvet Island") Then Call oGetCountriesByNameAsDic.Add("Bouvet Island",30) If Not oGetCountriesByNameAsDic.Exists("Brazil") Then Call oGetCountriesByNameAsDic.Add("Brazil",31) If Not oGetCountriesByNameAsDic.Exists("British Indian Ocean Territory") Then Call oGetCountriesByNameAsDic.Add("British Indian Ocean Territory",32) If Not oGetCountriesByNameAsDic.Exists("Brunei Darussalam") Then Call oGetCountriesByNameAsDic.Add("Brunei Darussalam",33) If Not oGetCountriesByNameAsDic.Exists("Bulgaria") Then Call oGetCountriesByNameAsDic.Add("Bulgaria",34) If Not oGetCountriesByNameAsDic.Exists("Burkina Faso") Then Call oGetCountriesByNameAsDic.Add("Burkina Faso",35) If Not oGetCountriesByNameAsDic.Exists("Burundi") Then Call oGetCountriesByNameAsDic.Add("Burundi",36) If Not oGetCountriesByNameAsDic.Exists("Cambodia") Then Call oGetCountriesByNameAsDic.Add("Cambodia",37) If Not oGetCountriesByNameAsDic.Exists("Cameroon") Then Call oGetCountriesByNameAsDic.Add("Cameroon",38) If Not oGetCountriesByNameAsDic.Exists("Canada") Then Call oGetCountriesByNameAsDic.Add("Canada",39) If Not oGetCountriesByNameAsDic.Exists("Cape Verde") Then Call oGetCountriesByNameAsDic.Add("Cape Verde",40) If Not oGetCountriesByNameAsDic.Exists("Cayman Islands") Then Call oGetCountriesByNameAsDic.Add("Cayman Islands",41) If Not oGetCountriesByNameAsDic.Exists("Central African Republic") Then Call oGetCountriesByNameAsDic.Add("Central African Republic",42) If Not oGetCountriesByNameAsDic.Exists("Chad") Then Call oGetCountriesByNameAsDic.Add("Chad",43) If Not oGetCountriesByNameAsDic.Exists("Chile") Then Call oGetCountriesByNameAsDic.Add("Chile",44) If Not oGetCountriesByNameAsDic.Exists("China") Then Call oGetCountriesByNameAsDic.Add("China",45) If Not oGetCountriesByNameAsDic.Exists("Christmas Island") Then Call oGetCountriesByNameAsDic.Add("Christmas Island",46) If Not oGetCountriesByNameAsDic.Exists("Cocos (Keeling) Islands") Then Call oGetCountriesByNameAsDic.Add("Cocos (Keeling) Islands",47) If Not oGetCountriesByNameAsDic.Exists("Colombia") Then Call oGetCountriesByNameAsDic.Add("Colombia",48) If Not oGetCountriesByNameAsDic.Exists("Comoros") Then Call oGetCountriesByNameAsDic.Add("Comoros",49) If Not oGetCountriesByNameAsDic.Exists("Congo") Then Call oGetCountriesByNameAsDic.Add("Congo",50) If Not oGetCountriesByNameAsDic.Exists("Congo, Democratic Republic of the") Then Call oGetCountriesByNameAsDic.Add("Congo, Democratic Republic of the",51) If Not oGetCountriesByNameAsDic.Exists("Cook Islands") Then Call oGetCountriesByNameAsDic.Add("Cook Islands",52) If Not oGetCountriesByNameAsDic.Exists("Costa Rica") Then Call oGetCountriesByNameAsDic.Add("Costa Rica",53) If Not oGetCountriesByNameAsDic.Exists("Cote d\'Ivoire Cte d\'Ivoire") Then Call oGetCountriesByNameAsDic.Add("Cote d\'Ivoire Cte d\'Ivoire",54) If Not oGetCountriesByNameAsDic.Exists("Croatia") Then Call oGetCountriesByNameAsDic.Add("Croatia",55) If Not oGetCountriesByNameAsDic.Exists("Cuba") Then Call oGetCountriesByNameAsDic.Add("Cuba",56) If Not oGetCountriesByNameAsDic.Exists("Cyprus") Then Call oGetCountriesByNameAsDic.Add("Cyprus",57) If Not oGetCountriesByNameAsDic.Exists("Czech Republic") Then Call oGetCountriesByNameAsDic.Add("Czech Republic",58) If Not oGetCountriesByNameAsDic.Exists("Denmark") Then Call oGetCountriesByNameAsDic.Add("Denmark",59) If Not oGetCountriesByNameAsDic.Exists("Djibouti") Then Call oGetCountriesByNameAsDic.Add("Djibouti",60) If Not oGetCountriesByNameAsDic.Exists("Dominica") Then Call oGetCountriesByNameAsDic.Add("Dominica",61) If Not oGetCountriesByNameAsDic.Exists("Dominican Republic") Then Call oGetCountriesByNameAsDic.Add("Dominican Republic",62) If Not oGetCountriesByNameAsDic.Exists("Ecuador") Then Call oGetCountriesByNameAsDic.Add("Ecuador",63) If Not oGetCountriesByNameAsDic.Exists("Egypt") Then Call oGetCountriesByNameAsDic.Add("Egypt",64) If Not oGetCountriesByNameAsDic.Exists("El Salvador") Then Call oGetCountriesByNameAsDic.Add("El Salvador",65) If Not oGetCountriesByNameAsDic.Exists("Equatorial Guinea") Then Call oGetCountriesByNameAsDic.Add("Equatorial Guinea",66) If Not oGetCountriesByNameAsDic.Exists("Eritrea") Then Call oGetCountriesByNameAsDic.Add("Eritrea",67) If Not oGetCountriesByNameAsDic.Exists("Estonia") Then Call oGetCountriesByNameAsDic.Add("Estonia",68) If Not oGetCountriesByNameAsDic.Exists("Ethiopia") Then Call oGetCountriesByNameAsDic.Add("Ethiopia",69) If Not oGetCountriesByNameAsDic.Exists("Falkland Islands (Malvinas)") Then Call oGetCountriesByNameAsDic.Add("Falkland Islands (Malvinas)",70) If Not oGetCountriesByNameAsDic.Exists("Faroe Islands") Then Call oGetCountriesByNameAsDic.Add("Faroe Islands",71) If Not oGetCountriesByNameAsDic.Exists("Fiji") Then Call oGetCountriesByNameAsDic.Add("Fiji",72) If Not oGetCountriesByNameAsDic.Exists("Finland") Then Call oGetCountriesByNameAsDic.Add("Finland",73) If Not oGetCountriesByNameAsDic.Exists("France") Then Call oGetCountriesByNameAsDic.Add("France",74) If Not oGetCountriesByNameAsDic.Exists("French Guiana") Then Call oGetCountriesByNameAsDic.Add("French Guiana",75) If Not oGetCountriesByNameAsDic.Exists("French Polynesia") Then Call oGetCountriesByNameAsDic.Add("French Polynesia",76) If Not oGetCountriesByNameAsDic.Exists("French Southern Territories") Then Call oGetCountriesByNameAsDic.Add("French Southern Territories",77) If Not oGetCountriesByNameAsDic.Exists("Gabon") Then Call oGetCountriesByNameAsDic.Add("Gabon",78) If Not oGetCountriesByNameAsDic.Exists("Gambia") Then Call oGetCountriesByNameAsDic.Add("Gambia",79) If Not oGetCountriesByNameAsDic.Exists("Georgia") Then Call oGetCountriesByNameAsDic.Add("Georgia",80) If Not oGetCountriesByNameAsDic.Exists("Germany") Then Call oGetCountriesByNameAsDic.Add("Germany",81) If Not oGetCountriesByNameAsDic.Exists("Ghana") Then Call oGetCountriesByNameAsDic.Add("Ghana",82) If Not oGetCountriesByNameAsDic.Exists("Gibraltar") Then Call oGetCountriesByNameAsDic.Add("Gibraltar",83) If Not oGetCountriesByNameAsDic.Exists("Greece") Then Call oGetCountriesByNameAsDic.Add("Greece",84) If Not oGetCountriesByNameAsDic.Exists("Greenland") Then Call oGetCountriesByNameAsDic.Add("Greenland",85) If Not oGetCountriesByNameAsDic.Exists("Grenada") Then Call oGetCountriesByNameAsDic.Add("Grenada",86) If Not oGetCountriesByNameAsDic.Exists("Guadeloupe") Then Call oGetCountriesByNameAsDic.Add("Guadeloupe",87) If Not oGetCountriesByNameAsDic.Exists("Guam") Then Call oGetCountriesByNameAsDic.Add("Guam",88) If Not oGetCountriesByNameAsDic.Exists("Guatemala") Then Call oGetCountriesByNameAsDic.Add("Guatemala",89) If Not oGetCountriesByNameAsDic.Exists("Guernsey") Then Call oGetCountriesByNameAsDic.Add("Guernsey",90) If Not oGetCountriesByNameAsDic.Exists("Guinea") Then Call oGetCountriesByNameAsDic.Add("Guinea",91) If Not oGetCountriesByNameAsDic.Exists("Guinea-Bissau") Then Call oGetCountriesByNameAsDic.Add("Guinea-Bissau",92) If Not oGetCountriesByNameAsDic.Exists("Guyana") Then Call oGetCountriesByNameAsDic.Add("Guyana",93) If Not oGetCountriesByNameAsDic.Exists("Haiti") Then Call oGetCountriesByNameAsDic.Add("Haiti",94) If Not oGetCountriesByNameAsDic.Exists("Heard Island and McDonald Islands") Then Call oGetCountriesByNameAsDic.Add("Heard Island and McDonald Islands",95) If Not oGetCountriesByNameAsDic.Exists("Holy See (Vatican City State)") Then Call oGetCountriesByNameAsDic.Add("Holy See (Vatican City State)",96) If Not oGetCountriesByNameAsDic.Exists("Honduras") Then Call oGetCountriesByNameAsDic.Add("Honduras",97) If Not oGetCountriesByNameAsDic.Exists("Hong Kong") Then Call oGetCountriesByNameAsDic.Add("Hong Kong",98) If Not oGetCountriesByNameAsDic.Exists("Hungary") Then Call oGetCountriesByNameAsDic.Add("Hungary",99) If Not oGetCountriesByNameAsDic.Exists("Iceland") Then Call oGetCountriesByNameAsDic.Add("Iceland",100) If Not oGetCountriesByNameAsDic.Exists("India") Then Call oGetCountriesByNameAsDic.Add("India",101) If Not oGetCountriesByNameAsDic.Exists("Indonesia") Then Call oGetCountriesByNameAsDic.Add("Indonesia",102) If Not oGetCountriesByNameAsDic.Exists("Iran, Islamic Republic of") Then Call oGetCountriesByNameAsDic.Add("Iran, Islamic Republic of",103) If Not oGetCountriesByNameAsDic.Exists("Iraq") Then Call oGetCountriesByNameAsDic.Add("Iraq",104) If Not oGetCountriesByNameAsDic.Exists("Ireland") Then Call oGetCountriesByNameAsDic.Add("Ireland",105) If Not oGetCountriesByNameAsDic.Exists("Isle of Man") Then Call oGetCountriesByNameAsDic.Add("Isle of Man",106) If Not oGetCountriesByNameAsDic.Exists("Israel") Then Call oGetCountriesByNameAsDic.Add("Israel",107) If Not oGetCountriesByNameAsDic.Exists("Italy") Then Call oGetCountriesByNameAsDic.Add("Italy",108) If Not oGetCountriesByNameAsDic.Exists("Jamaica") Then Call oGetCountriesByNameAsDic.Add("Jamaica",109) If Not oGetCountriesByNameAsDic.Exists("Japan") Then Call oGetCountriesByNameAsDic.Add("Japan",110) If Not oGetCountriesByNameAsDic.Exists("Jersey") Then Call oGetCountriesByNameAsDic.Add("Jersey",111) If Not oGetCountriesByNameAsDic.Exists("Jordan") Then Call oGetCountriesByNameAsDic.Add("Jordan",112) If Not oGetCountriesByNameAsDic.Exists("Kazakhstan") Then Call oGetCountriesByNameAsDic.Add("Kazakhstan",113) If Not oGetCountriesByNameAsDic.Exists("Kenya") Then Call oGetCountriesByNameAsDic.Add("Kenya",114) If Not oGetCountriesByNameAsDic.Exists("Kiribati") Then Call oGetCountriesByNameAsDic.Add("Kiribati",115) If Not oGetCountriesByNameAsDic.Exists("Korea, Democratic People\'s Republic of") Then Call oGetCountriesByNameAsDic.Add("Korea, Democratic People\'s Republic of",116) If Not oGetCountriesByNameAsDic.Exists("Korea, Republic of") Then Call oGetCountriesByNameAsDic.Add("Korea, Republic of",117) If Not oGetCountriesByNameAsDic.Exists("Kuwait") Then Call oGetCountriesByNameAsDic.Add("Kuwait",118) If Not oGetCountriesByNameAsDic.Exists("Kyrgyzstan") Then Call oGetCountriesByNameAsDic.Add("Kyrgyzstan",119) If Not oGetCountriesByNameAsDic.Exists("Lao People\'s Democratic Republic") Then Call oGetCountriesByNameAsDic.Add("Lao People\'s Democratic Republic",120) If Not oGetCountriesByNameAsDic.Exists("Latvia") Then Call oGetCountriesByNameAsDic.Add("Latvia",121) If Not oGetCountriesByNameAsDic.Exists("Lebanon") Then Call oGetCountriesByNameAsDic.Add("Lebanon",122) If Not oGetCountriesByNameAsDic.Exists("Lesotho") Then Call oGetCountriesByNameAsDic.Add("Lesotho",123) If Not oGetCountriesByNameAsDic.Exists("Liberia") Then Call oGetCountriesByNameAsDic.Add("Liberia",124) If Not oGetCountriesByNameAsDic.Exists("Libyan Arab Jamahiriya") Then Call oGetCountriesByNameAsDic.Add("Libyan Arab Jamahiriya",125) If Not oGetCountriesByNameAsDic.Exists("Liechtenstein") Then Call oGetCountriesByNameAsDic.Add("Liechtenstein",126) If Not oGetCountriesByNameAsDic.Exists("Lithuania") Then Call oGetCountriesByNameAsDic.Add("Lithuania",127) If Not oGetCountriesByNameAsDic.Exists("Luxembourg") Then Call oGetCountriesByNameAsDic.Add("Luxembourg",128) If Not oGetCountriesByNameAsDic.Exists("Macao") Then Call oGetCountriesByNameAsDic.Add("Macao",129) If Not oGetCountriesByNameAsDic.Exists("Macedonia, the former Yugoslav Republic of") Then Call oGetCountriesByNameAsDic.Add("Macedonia, the former Yugoslav Republic of",130) If Not oGetCountriesByNameAsDic.Exists("Madagascar") Then Call oGetCountriesByNameAsDic.Add("Madagascar",131) If Not oGetCountriesByNameAsDic.Exists("Malawi") Then Call oGetCountriesByNameAsDic.Add("Malawi",132) If Not oGetCountriesByNameAsDic.Exists("Malaysia") Then Call oGetCountriesByNameAsDic.Add("Malaysia",133) If Not oGetCountriesByNameAsDic.Exists("Maldives") Then Call oGetCountriesByNameAsDic.Add("Maldives",134) If Not oGetCountriesByNameAsDic.Exists("Mali") Then Call oGetCountriesByNameAsDic.Add("Mali",135) If Not oGetCountriesByNameAsDic.Exists("Malta") Then Call oGetCountriesByNameAsDic.Add("Malta",136) If Not oGetCountriesByNameAsDic.Exists("Marshall Islands") Then Call oGetCountriesByNameAsDic.Add("Marshall Islands",137) If Not oGetCountriesByNameAsDic.Exists("Martinique") Then Call oGetCountriesByNameAsDic.Add("Martinique",138) If Not oGetCountriesByNameAsDic.Exists("Mauritania") Then Call oGetCountriesByNameAsDic.Add("Mauritania",139) If Not oGetCountriesByNameAsDic.Exists("Mauritius") Then Call oGetCountriesByNameAsDic.Add("Mauritius",140) If Not oGetCountriesByNameAsDic.Exists("Mayotte") Then Call oGetCountriesByNameAsDic.Add("Mayotte",141) If Not oGetCountriesByNameAsDic.Exists("Mexico") Then Call oGetCountriesByNameAsDic.Add("Mexico",142) If Not oGetCountriesByNameAsDic.Exists("Micronesia, Federated States of") Then Call oGetCountriesByNameAsDic.Add("Micronesia, Federated States of",143) If Not oGetCountriesByNameAsDic.Exists("Moldova, Republic of") Then Call oGetCountriesByNameAsDic.Add("Moldova, Republic of",144) If Not oGetCountriesByNameAsDic.Exists("Monaco") Then Call oGetCountriesByNameAsDic.Add("Monaco",145) If Not oGetCountriesByNameAsDic.Exists("Mongolia") Then Call oGetCountriesByNameAsDic.Add("Mongolia",146) If Not oGetCountriesByNameAsDic.Exists("Montenegro") Then Call oGetCountriesByNameAsDic.Add("Montenegro",147) If Not oGetCountriesByNameAsDic.Exists("Montserrat") Then Call oGetCountriesByNameAsDic.Add("Montserrat",148) If Not oGetCountriesByNameAsDic.Exists("Morocco") Then Call oGetCountriesByNameAsDic.Add("Morocco",149) If Not oGetCountriesByNameAsDic.Exists("Mozambique") Then Call oGetCountriesByNameAsDic.Add("Mozambique",150) If Not oGetCountriesByNameAsDic.Exists("Myanmar") Then Call oGetCountriesByNameAsDic.Add("Myanmar",151) If Not oGetCountriesByNameAsDic.Exists("Namibia") Then Call oGetCountriesByNameAsDic.Add("Namibia",152) If Not oGetCountriesByNameAsDic.Exists("Nauru") Then Call oGetCountriesByNameAsDic.Add("Nauru",153) If Not oGetCountriesByNameAsDic.Exists("Nepal") Then Call oGetCountriesByNameAsDic.Add("Nepal",154) If Not oGetCountriesByNameAsDic.Exists("Netherlands") Then Call oGetCountriesByNameAsDic.Add("Netherlands",155) If Not oGetCountriesByNameAsDic.Exists("Netherlands Antilles") Then Call oGetCountriesByNameAsDic.Add("Netherlands Antilles",156) If Not oGetCountriesByNameAsDic.Exists("New Caledonia") Then Call oGetCountriesByNameAsDic.Add("New Caledonia",157) If Not oGetCountriesByNameAsDic.Exists("New Zealand") Then Call oGetCountriesByNameAsDic.Add("New Zealand",158) If Not oGetCountriesByNameAsDic.Exists("Nicaragua") Then Call oGetCountriesByNameAsDic.Add("Nicaragua",159) If Not oGetCountriesByNameAsDic.Exists("Niger") Then Call oGetCountriesByNameAsDic.Add("Niger",160) If Not oGetCountriesByNameAsDic.Exists("Nigeria") Then Call oGetCountriesByNameAsDic.Add("Nigeria",161) If Not oGetCountriesByNameAsDic.Exists("Niue") Then Call oGetCountriesByNameAsDic.Add("Niue",162) If Not oGetCountriesByNameAsDic.Exists("Norfolk Island") Then Call oGetCountriesByNameAsDic.Add("Norfolk Island",163) If Not oGetCountriesByNameAsDic.Exists("Northern Mariana Islands") Then Call oGetCountriesByNameAsDic.Add("Northern Mariana Islands",164) If Not oGetCountriesByNameAsDic.Exists("Norway") Then Call oGetCountriesByNameAsDic.Add("Norway",165) If Not oGetCountriesByNameAsDic.Exists("Oman") Then Call oGetCountriesByNameAsDic.Add("Oman",166) If Not oGetCountriesByNameAsDic.Exists("Pakistan") Then Call oGetCountriesByNameAsDic.Add("Pakistan",167) If Not oGetCountriesByNameAsDic.Exists("Palau") Then Call oGetCountriesByNameAsDic.Add("Palau",168) If Not oGetCountriesByNameAsDic.Exists("Palestinian Territory, Occupied") Then Call oGetCountriesByNameAsDic.Add("Palestinian Territory, Occupied",169) If Not oGetCountriesByNameAsDic.Exists("Panama") Then Call oGetCountriesByNameAsDic.Add("Panama",170) If Not oGetCountriesByNameAsDic.Exists("Papua New Guinea") Then Call oGetCountriesByNameAsDic.Add("Papua New Guinea",171) If Not oGetCountriesByNameAsDic.Exists("Paraguay") Then Call oGetCountriesByNameAsDic.Add("Paraguay",172) If Not oGetCountriesByNameAsDic.Exists("Peru") Then Call oGetCountriesByNameAsDic.Add("Peru",173) If Not oGetCountriesByNameAsDic.Exists("Philippines") Then Call oGetCountriesByNameAsDic.Add("Philippines",174) If Not oGetCountriesByNameAsDic.Exists("Pitcairn") Then Call oGetCountriesByNameAsDic.Add("Pitcairn",175) If Not oGetCountriesByNameAsDic.Exists("Poland") Then Call oGetCountriesByNameAsDic.Add("Poland",176) If Not oGetCountriesByNameAsDic.Exists("Portugal") Then Call oGetCountriesByNameAsDic.Add("Portugal",177) If Not oGetCountriesByNameAsDic.Exists("Puerto Rico") Then Call oGetCountriesByNameAsDic.Add("Puerto Rico",178) If Not oGetCountriesByNameAsDic.Exists("Qatar") Then Call oGetCountriesByNameAsDic.Add("Qatar",179) If Not oGetCountriesByNameAsDic.Exists("Reunion Runion") Then Call oGetCountriesByNameAsDic.Add("Reunion Runion",180) If Not oGetCountriesByNameAsDic.Exists("Romania") Then Call oGetCountriesByNameAsDic.Add("Romania",181) If Not oGetCountriesByNameAsDic.Exists("Russian Federation") Then Call oGetCountriesByNameAsDic.Add("Russian Federation",182) If Not oGetCountriesByNameAsDic.Exists("Rwanda") Then Call oGetCountriesByNameAsDic.Add("Rwanda",183) If Not oGetCountriesByNameAsDic.Exists("Saint Barthlemy") Then Call oGetCountriesByNameAsDic.Add("Saint Barthlemy",184) If Not oGetCountriesByNameAsDic.Exists("Saint Helena") Then Call oGetCountriesByNameAsDic.Add("Saint Helena",185) If Not oGetCountriesByNameAsDic.Exists("Saint Kitts and Nevis") Then Call oGetCountriesByNameAsDic.Add("Saint Kitts and Nevis",186) If Not oGetCountriesByNameAsDic.Exists("Saint Lucia") Then Call oGetCountriesByNameAsDic.Add("Saint Lucia",187) If Not oGetCountriesByNameAsDic.Exists("Saint Martin (French part)") Then Call oGetCountriesByNameAsDic.Add("Saint Martin (French part)",188) If Not oGetCountriesByNameAsDic.Exists("Saint Pierre and Miquelon") Then Call oGetCountriesByNameAsDic.Add("Saint Pierre and Miquelon",189) If Not oGetCountriesByNameAsDic.Exists("Saint Vincent and the Grenadines") Then Call oGetCountriesByNameAsDic.Add("Saint Vincent and the Grenadines",190) If Not oGetCountriesByNameAsDic.Exists("Samoa") Then Call oGetCountriesByNameAsDic.Add("Samoa",191) If Not oGetCountriesByNameAsDic.Exists("San Marino") Then Call oGetCountriesByNameAsDic.Add("San Marino",192) If Not oGetCountriesByNameAsDic.Exists("Sao Tome and Principe") Then Call oGetCountriesByNameAsDic.Add("Sao Tome and Principe",193) If Not oGetCountriesByNameAsDic.Exists("Saudi Arabia") Then Call oGetCountriesByNameAsDic.Add("Saudi Arabia",194) If Not oGetCountriesByNameAsDic.Exists("Senegal") Then Call oGetCountriesByNameAsDic.Add("Senegal",195) If Not oGetCountriesByNameAsDic.Exists("Serbia") Then Call oGetCountriesByNameAsDic.Add("Serbia",196) If Not oGetCountriesByNameAsDic.Exists("Seychelles") Then Call oGetCountriesByNameAsDic.Add("Seychelles",197) If Not oGetCountriesByNameAsDic.Exists("Sierra Leone") Then Call oGetCountriesByNameAsDic.Add("Sierra Leone",198) If Not oGetCountriesByNameAsDic.Exists("Singapore") Then Call oGetCountriesByNameAsDic.Add("Singapore",199) If Not oGetCountriesByNameAsDic.Exists("Slovakia") Then Call oGetCountriesByNameAsDic.Add("Slovakia",200) If Not oGetCountriesByNameAsDic.Exists("Slovenia") Then Call oGetCountriesByNameAsDic.Add("Slovenia",201) If Not oGetCountriesByNameAsDic.Exists("Solomon Islands") Then Call oGetCountriesByNameAsDic.Add("Solomon Islands",202) If Not oGetCountriesByNameAsDic.Exists("Somalia") Then Call oGetCountriesByNameAsDic.Add("Somalia",203) If Not oGetCountriesByNameAsDic.Exists("South Africa") Then Call oGetCountriesByNameAsDic.Add("South Africa",204) If Not oGetCountriesByNameAsDic.Exists("South Georgia and the South Sandwich Islands") Then Call oGetCountriesByNameAsDic.Add("South Georgia and the South Sandwich Islands",205) If Not oGetCountriesByNameAsDic.Exists("Spain") Then Call oGetCountriesByNameAsDic.Add("Spain",206) If Not oGetCountriesByNameAsDic.Exists("Sri Lanka") Then Call oGetCountriesByNameAsDic.Add("Sri Lanka",207) If Not oGetCountriesByNameAsDic.Exists("Sudan") Then Call oGetCountriesByNameAsDic.Add("Sudan",208) If Not oGetCountriesByNameAsDic.Exists("Suriname") Then Call oGetCountriesByNameAsDic.Add("Suriname",209) If Not oGetCountriesByNameAsDic.Exists("Svalbard and Jan Mayen") Then Call oGetCountriesByNameAsDic.Add("Svalbard and Jan Mayen",210) If Not oGetCountriesByNameAsDic.Exists("Swaziland") Then Call oGetCountriesByNameAsDic.Add("Swaziland",211) If Not oGetCountriesByNameAsDic.Exists("Sweden") Then Call oGetCountriesByNameAsDic.Add("Sweden",212) If Not oGetCountriesByNameAsDic.Exists("Switzerland") Then Call oGetCountriesByNameAsDic.Add("Switzerland",213) If Not oGetCountriesByNameAsDic.Exists("Syrian Arab Republic") Then Call oGetCountriesByNameAsDic.Add("Syrian Arab Republic",214) If Not oGetCountriesByNameAsDic.Exists("Taiwan, Province of China") Then Call oGetCountriesByNameAsDic.Add("Taiwan, Province of China",215) If Not oGetCountriesByNameAsDic.Exists("Tajikistan") Then Call oGetCountriesByNameAsDic.Add("Tajikistan",216) If Not oGetCountriesByNameAsDic.Exists("Tanzania, United Republic of") Then Call oGetCountriesByNameAsDic.Add("Tanzania, United Republic of",217) If Not oGetCountriesByNameAsDic.Exists("Thailand") Then Call oGetCountriesByNameAsDic.Add("Thailand",218) If Not oGetCountriesByNameAsDic.Exists("Timor-Leste") Then Call oGetCountriesByNameAsDic.Add("Timor-Leste",219) If Not oGetCountriesByNameAsDic.Exists("Togo") Then Call oGetCountriesByNameAsDic.Add("Togo",220) If Not oGetCountriesByNameAsDic.Exists("Tokelau") Then Call oGetCountriesByNameAsDic.Add("Tokelau",221) If Not oGetCountriesByNameAsDic.Exists("Tonga") Then Call oGetCountriesByNameAsDic.Add("Tonga",222) If Not oGetCountriesByNameAsDic.Exists("Trinidad and Tobago") Then Call oGetCountriesByNameAsDic.Add("Trinidad and Tobago",223) If Not oGetCountriesByNameAsDic.Exists("Tunisia") Then Call oGetCountriesByNameAsDic.Add("Tunisia",224) If Not oGetCountriesByNameAsDic.Exists("Turkey") Then Call oGetCountriesByNameAsDic.Add("Turkey",225) If Not oGetCountriesByNameAsDic.Exists("Turkmenistan") Then Call oGetCountriesByNameAsDic.Add("Turkmenistan",226) If Not oGetCountriesByNameAsDic.Exists("Turks and Caicos Islands") Then Call oGetCountriesByNameAsDic.Add("Turks and Caicos Islands",227) If Not oGetCountriesByNameAsDic.Exists("Tuvalu") Then Call oGetCountriesByNameAsDic.Add("Tuvalu",228) If Not oGetCountriesByNameAsDic.Exists("Uganda") Then Call oGetCountriesByNameAsDic.Add("Uganda",229) If Not oGetCountriesByNameAsDic.Exists("Ukraine") Then Call oGetCountriesByNameAsDic.Add("Ukraine",230) If Not oGetCountriesByNameAsDic.Exists("United Arab Emirates") Then Call oGetCountriesByNameAsDic.Add("United Arab Emirates",231) If Not oGetCountriesByNameAsDic.Exists("United Kingdom") Then Call oGetCountriesByNameAsDic.Add("United Kingdom",232) If Not oGetCountriesByNameAsDic.Exists("United States") Then Call oGetCountriesByNameAsDic.Add("United States",233) If Not oGetCountriesByNameAsDic.Exists("United States Minor Outlying Islands") Then Call oGetCountriesByNameAsDic.Add("United States Minor Outlying Islands",234) If Not oGetCountriesByNameAsDic.Exists("Uruguay") Then Call oGetCountriesByNameAsDic.Add("Uruguay",235) If Not oGetCountriesByNameAsDic.Exists("Uzbekistan") Then Call oGetCountriesByNameAsDic.Add("Uzbekistan",236) If Not oGetCountriesByNameAsDic.Exists("Vanuatu") Then Call oGetCountriesByNameAsDic.Add("Vanuatu",237) If Not oGetCountriesByNameAsDic.Exists("Venezuela") Then Call oGetCountriesByNameAsDic.Add("Venezuela",238) If Not oGetCountriesByNameAsDic.Exists("Viet Nam") Then Call oGetCountriesByNameAsDic.Add("Viet Nam",239) If Not oGetCountriesByNameAsDic.Exists("Virgin Islands, British") Then Call oGetCountriesByNameAsDic.Add("Virgin Islands, British",240) If Not oGetCountriesByNameAsDic.Exists("Virgin Islands, U.S.") Then Call oGetCountriesByNameAsDic.Add("Virgin Islands, U.S.",241) If Not oGetCountriesByNameAsDic.Exists("Wallis and Futuna") Then Call oGetCountriesByNameAsDic.Add("Wallis and Futuna",242) If Not oGetCountriesByNameAsDic.Exists("Western Sahara") Then Call oGetCountriesByNameAsDic.Add("Western Sahara",243) If Not oGetCountriesByNameAsDic.Exists("Yemen") Then Call oGetCountriesByNameAsDic.Add("Yemen",244) If Not oGetCountriesByNameAsDic.Exists("Zambia") Then Call oGetCountriesByNameAsDic.Add("Zambia",245) If Not oGetCountriesByNameAsDic.Exists("Zimbabwe") Then Call oGetCountriesByNameAsDic.Add("Zimbabwe",246) End Function 'oGetCountriesByNameAsDic() '------------------------------------------------------------------------------- 'Page 2 - Tab2 '------------------------------------------------------------------------------- 'Page 3 - Tab3 '------------------------------------------------------------------------------- ' General control helper functions Function iComboBoxItemValueIdx(ByVal oComboBox, ByVal sItem) 'Returns the Value index of sItem if it exists in oComboBox, 'otherwise the value -1 if sItem not found. 'Note that .Value is 0 to to oComboBox.Items.Count - 1 'and .Items are from 1 to oComboBox.Items.Count iComboBoxItemValueIdx = -1 If oComboBox Is Nothing Then Exit Function Dim i For i = 1 To oComboBox.Items.Count If oComboBox.Items.Item(i).Text = sItem Then 'Call LogFileWrite(vbTab & "i = " & i & vbTab & oComboBox.Items(i).Text) iComboBoxItemValueIdx = i-1 Exit For End If Next 'i End Function 'iComboBoxItemValueIdx() Function bInitComboBox(ByVal oComboBox, ByVal sXmlFilePath, ByVal sXpath) 'Initialize the ComboBox control oComboBox using the values in file sXmlFilePath 'specified by the xPath sXpath. bInitComboBox = False If oComboBox Is Nothing Then Exit Function If Not FileExist(sXmlFilePath) Then Call LogFileWrite(" ERROR - xml file path does not exist '" & sXmlFilePath & "'") Exit Function End If If len(sXpath) = 0 Then Exit Function Dim xmlDoc, oNode, i Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.Async = "false" If Not xmlDoc.Load(sXmlFilePath) Then Call LogFileWrite(vbTab & "ERROR - Fn bInitComboBox() was unable to load file '" & sXmlFilePath & "'") Exit Function End If If xmlDoc.selectNodes(sXpath).Length = 0 Then Exit Function i = 0 For Each oNode In xmlDoc.selectNodes(sXpath) Call oComboBox.Items.Add(SF_RemoveNonPrt(oNode.firstChild.text),i) i = i + 1 Next If oComboBox.Items.Count > 0 Then bInitComboBox = True Set xmlDoc = Nothing: Set oNode = Nothing End Function 'bInitComboBox() '-------------------------------------------------------------------------------
I developed this template for a dialog with an XTable linked to class controls in order to simplify the coding. The class objects included (CheckBox, EditBox, and ComboBox) can be extended if necessary, and they provide a good model for creating other control class objects. I added a few features to this to show how to achieve the desired control behaviour within the XTable event constraints.
Download the dialog file: XTable_class-controls.SUD
'------------------------------------------------------------------------------- '-- SUD script file '-- Author: Mark W Kiehl ' www.SavvyDiademSolutions.com ' http://www.savvysolutions.info/savvycodesolutions/ ' '-- Comment: xTable with user capability to move cell contents up/down. ' ' The contents of xTable1 are retained in a dictionary object oXTableDic ' where the key corresponds to the xTable row, and each value in oXTableDic ' consists of an array holding a class object for each control (CheckBox, ' EditBox, or ComboBox). ' ' *** NOTE: a xTable never holds data, it only displays data. *** ' XTable1_EventInitialize() populates oXTableDic with initial values. ' XTable1_EventValGet() populates the XTable with the data in oXTableDic. ' XTable1_EventValChanged() and XTable1_EventValSet() updates oXTableDic with the ' changes to the XTable1. The updates to oXTableDic from these events are ' carefully engineered to achieve the desired control behaviour. ' ' The following controls are within the xTable (see also the corresponding class objects): ' Checkbox ' EditBox ' ComboBox ' ' See Sub btn_Done_EventClick() for an example on accessing the contents of oXTableDic. ' '------------------------------------------------------------------------------- Option Explicit Call LogFileDel() Dim oXTableDic, arrXTableRow, arrXTableColNames 'oXTableDic vKey = XTable row (integer); Value = arrXTableRow(oCol1, oCol2, ... oColN) Const bShowEvents = False '------------------------------------------------------------------------------- ' XTable1 Sub XTable1_EventInitialize(ByRef This) 'Created Event Handler 'Initialize oXTableDic with the initial data to be shown in 'XTable1. Event XTable1_EventValGet() will update XTable1 'with the data from oXTableDic. If bShowEvents Then Call LogFileWrite("XTable1_EventInitialize") 'Assign XTable column names to arrXTableColNames arrXTableColNames = Array("","CheckBox","EditBox","ComboBox") Set oXTableDic = CreateObject("Scripting.Dictionary") Dim oCheckBox, oEditBox, oComboBox, iRow For iRow = 1 To 3 Set oCheckBox = New c_CheckBox 'Disable CheckBox until the user makes a CombobBox selection oCheckBox.bEnable = False Set oEditBox = New c_EditBox oEditBox.sText = sStrRandomAlphaChars(5) Set oComboBox = New c_ComboBox 'NOTE: The iValue must be an integer index from 0 ...n Call oComboBox.Add(sStrRandomAlphaChars(6),0) Call oComboBox.Add(sStrRandomAlphaChars(6),1) Call oComboBox.Add(sStrRandomAlphaChars(6),2) 'arrXTableRow = Array(Col 0, Col 1, Col 2, Col 3) arrXTableRow = Array(0,oCheckBox,oEditBox,oComboBox) Call oXTableDic.Add(iRow,arrXTableRow) Set oCheckBox = Nothing: Set oEditBox = Nothing: Set oComboBox = Nothing If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) Next 'iRow 'Next line very important! XTable1.RowCount = oXTableDic.Count End Sub Sub XTable1_EventColCtrlPreset(ByRef This, Col, ByRef Cell, IsInputCell) 'Created Event Handler 'Executed after XTable1_EventInitialize(), once for each column, and for each column twice: 'once (for display mode) IsInputCell = True, and then the 2nd (for entry mode) IsInputCell = False. 'NOTE: You cannot assign unique values to each row using this event. ' Every control in a column must have the same value. ' 'Use XTable1_EventValGet() to populate XTable1 controls uniquely by row with the data from oXTableDic. ''Example below demonstrates use of this event (MUST disable code under XTable1_EventValGet() if implemented). 'Call LogFileWrite("XTable1_EventColCtrlPreset Col = " & Col & " IsInputCell = " & IsInputCell) 'Select Case Col ' Case 1 'CheckBox ' Cell.Value = 0 ' Case 2 'EditBox ' Cell.Text = Str(Now,"#dd-ttt-yyyy hh:nn:ss AMPM") ' Case 3 'ComboBox ' Call Cell.Items.RemoveAll() ' Call Cell.FillItemsByVar("xChnStyle",True) 'End Select End Sub Sub XTable1_EventValGet(ByRef This, Row, Col, ByRef Cell, IsInputCell) 'Created Event Handler 'Called by XTable1_EventInitialize(). 'Triggered by a XTable Cell click (before XTable1_EventCellClick(). 'Triggered by a XTable Cell ComboBox selection (before XTable1_EventValChanged()) 'Use XTable1_EventValGet to populate XTable1 with data from oXTableDic Dim oCheckBox, oEditBox, oComboBox, oItem 'Table column titles If Col => 0 AND Row = 0 Then Cell.Text = arrXTableColNames(Col) 'Create row index number label on the left border If Col = 0 AND Row > 0 Then Cell.Text = Str(Row) If Col > 0 AND Row > 0 Then If bShowEvents Then Call LogFileWrite("XTable1_EventValGet Col = " & Col & " Row = " & Row & " IsInputCell = " & IsInputCell) Select Case Col Case 1 'CheckBox 'arrXTableRow = Array(Col 0, Col 1, Col 2, Col 3) arrXTableRow = oXTableDic(Row) Set oCheckbox = arrXTableRow(Col) Cell.Value = oCheckBox.iValue Cell.Text = oCheckBox.sText Cell.Enable = oCheckBox.bEnable Case 2 'EditBox arrXTableRow = oXTableDic(Row) Set oEditBox = arrXTableRow(Col) Cell.Text = oEditBox.sText Cell.Enable = oEditBox.bEnable Case 3 'ComboBox arrXTableRow = oXTableDic(Row) Set oComboBox = arrXTableRow(Col) Call Cell.Items.RemoveAll() For Each oItem In oComboBox.Items Call Cell.Items.Add(oItem.sKey, oItem.iValue) Next Cell.Value = oComboBox.iValue Cell.Enable = oComboBox.bEnable End Select Set oCheckBox = Nothing: Set oEditBox = Nothing: Set oComboBox = Nothing If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) End If End Sub Sub XTable1_EventValChanged(ByRef This, Row, Col, ByRef Cell) 'Created Event Handler 'Triggered when a Cell is changed (CheckBox clicked, EditBox edited, ComboBox selection made). 'Update oXTableDic with the user changed made to XTable1 If bShowEvents Then Call LogFileWrite("XTable1_EventValChanged Col = " & Col & " Row = " & Row) If Col > 0 AND Row > 0 Then Dim oCheckBox, oEditBox, oComboBox, oItem Select Case Col Case 1 'CheckBox 'arrXTableRow = Array(Col 0, Col 1, Col 2, Col 3) arrXTableRow = oXTableDic(Row) Set oCheckbox = arrXTableRow(Col) oCheckBox.iValue = Cell.Value Set arrXTableRow(Col) = oCheckBox oXTableDic(Row) = arrXTableRow Case 2 'EditBox 'Validate the user input to the Cell. If Len(Cell.Text) > 0 Then arrXTableRow = oXTableDic(Row) Set oEditBox = arrXTableRow(Col) oEditBox.sText = Cell.Text Set arrXTableRow(Col) = oEditBox oXTableDic(Row) = arrXTableRow End If Case 3 'ComboBox arrXTableRow = oXTableDic(Row) Set oComboBox = arrXTableRow(Col) 'NOTE: New values (ComboBox editing) are processed by XTable1_EventValSet() If Cell.Items.Count = oComboBox.iCount Then 'ComboBox selection made by user oComboBox.iValue = Cell.Value End If Set arrXTableRow(Col) = oComboBox oXTableDic(Row) = arrXTableRow End Select Set oCheckBox = Nothing: Set oEditBox = Nothing: Set oComboBox = Nothing If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) End If End Sub Sub XTable1_EventValSet(ByRef This, Row, Col, ByRef Cell) 'Created Event Handler 'Use XTable1_EventValGet to populate oXTableDic with data from XTable1 'Call LogFileWrite("XTable1_EventValSet Col = " & Col & " Row = " & Row) Dim oComboBox If Col > 0 AND Row > 0 Then Select Case Col Case 1,2 'CheckBox,EditBox, 'Nothing processed here. Case 3 'ComboBox 'If the user edits the ComboBox (adds something new), then process 'the new entry here. 'NOTE: In order for the ComboBox control to accept user editing, you ' must manually edit the control properties for 'Entry Control' ' and change the default Combo Type from '2 - StaticDropDown' to ' '1 EditableDropDown'. arrXTableRow = oXTableDic(Row) Set oComboBox = arrXTableRow(Col) If Not oComboBox.Exists(Cell.Text) AND Len(Cell.Text) > 0 Then Call oComboBox.Add(Cell.Text,oComboBox.iCount) oComboBox.iValue = oComboBox.iCount - 1 End If Set arrXTableRow(Col) = oComboBox oXTableDic(Row) = arrXTableRow If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) Set oComboBox = Nothing 'EnableCheckBoxRowsIfRowContentsAreValid() is called by XTable1_EventValSet() and XTable1_EventCellClick() Call EnableCheckBoxRowsIfRowContentsAreValid() End Select End If End Sub Sub XTable1_EventToolTipShow(ByRef This, Row, Col, ByRef CellToolTip) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventToolTipShow Col = " & Col & " Row = " & Row) Dim oCheckBox If Col > 0 AND Row > 0 Then Select Case Col Case 1 arrXTableRow = oXTableDic(Row) Set oCheckBox = arrXTableRow(Col) If oCheckBox.bEnable = True Then CellToolTip = "Click to enable save for this row " & Row Else CellToolTip = "You must make a ComboBox selection in order to enable row " & Row End If End Select End If End Sub Sub EnableCheckBoxRowsIfRowContentsAreValid() 'Enable the CheckBox (Col=1) for a row if the user has made a 'selection for the ComboBox (Col=3). 'Enable btn_Done if at least one CheckBox is checked. 'EnableCheckBoxRowsIfRowContentsAreValid() is called by XTable1_EventValSet() and XTable1_EventCellClick() Dim iRow, oCheckBox, oComboBox, iCount iCount = 0 For iRow = 1 To oXTableDic.Count arrXTableRow = oXTableDic(iRow) Set oCheckBox = arrXTableRow(1) If oCheckBox.iValue = 1 Then iCount = iCount + 1 Set oComboBox = arrXTableRow(3) If Not oComboBox.iValue = -1 Then oCheckBox.bEnable = True End If Set arrXTableRow(1) = oCheckBox oXTableDic(iRow) = arrXTableRow Call XTable1.Refresh() 'This updates xTable1 with the changes to oXTableDic Next Set oCheckBox = Nothing: Set oComboBox = Nothing If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) If iCount > 0 Then btn_Done.Enable = True End Sub 'EnableCheckBoxRowsIfRowContentsAreValid() Sub XTable1_EventCellClick(ByRef This, Row, Col) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventCellClick Col = " & Col & " Row = " & Row) 'EnableCheckBoxRowsIfRowContentsAreValid() is called by XTable1_EventValSet() and XTable1_EventCellClick() Call EnableCheckBoxRowsIfRowContentsAreValid() End Sub Sub XTable1_EventContextMenuPointSelected(ByRef This, Row, Col, MenuPoint) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventContextMenuPointSelected() Col = " & Col & " Row = " & Row) End Sub Sub XTable1_EventContextMenuShowing(ByRef This, Row, Col, MenuPoints) 'Created Event Handler 'Add a new item to the context menu or submenu. 'Call MenuPoints.Add("Add Item",1) End Sub Sub XTable1_EventLostFocus(ByRef This) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventLostFocus This.ActiveCellCol = "& This.ActiveCellCol & " This.ActiveCellRow = " & This.ActiveCellRow) End Sub Sub XTable1_EventRefresh(ByRef This) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventRefresh " & This.ActiveCellCol & vbTab & This.ActiveCellRow) End Sub Sub XTable1_EventSelChanged(ByRef This) 'Created Event Handler If bShowEvents Then Call LogFileWrite("XTable1_EventSelChanged "& This.ActiveCellCol & vbTab & This.ActiveCellRow) End Sub '------------------------------------------------------------------------------- Class c_ComboBox 'An object to hold the data for a ListItem (ComboBox, ...) ' ' iCount - the number of ListItems ' iChars - the maximum number of characters for all of the sKey values. ' bEnable ' sText - sText and iValue relate the to currently selected value. ' iValue - If iValue = -1, no selection, otherwise 0 = first item, 1 = 2nd item, .. Private Sub Class_Initialize() bEnable_ = True iCount_ = 0 iChars_ = 0 iValue_ = -1 sText = "" End Sub 'Class_Initialize() Private Sub Class_Terminate() If IsArray(arrListItems) Then Call Erase(arrListItems) End Sub 'Class_Terminate '------------------------------------------------------------------------------- ' property bEnable Private bEnable_ Public Property Let bEnable(bEnable__) 'Assign a value to the property bEnable bEnable_ = bEnable__ End Property Public Property Get bEnable 'Read the property value bEnable bEnable = bEnable_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iCount Private iCount_ Public Property Get iCount 'Read the read-only property value iCount iCount = iCount_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iChars Private iChars_ Public Property Get iChars 'Read the read-only property value Chars iChars = iChars_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iValue Private iValue_ Public Property Let iValue(iValue__) 'Assign a value to the property iValue iValue_ = iValue__ Dim oListItem, i i = 0 If IsArray(arrListItems) AND bArrayIsEmpty(arrListItems) = False Then If iValue__ > uBound(arrListItems) Then Call Err.Raise(65535,,"ERROR - the iValue of " & Str(iValue__) & " exceeds the maximum index for the ListItems (0 .." & Str(iCount_ - 1) & ")") For Each oListItem In arrListItems If i = iValue_ Then sText_ = oListItem.sKey Exit For End If i = i + 1 Next Else If iValue__ => 0 Then Call Err.Raise(65535,,"ERROR - the iValue of " & Str(iValue__) & " exceeds the number of ListItems") End If End Property Public Property Get iValue 'Read the property value iValue iValue = iValue_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property sText Private sText_ Public Property Let sText(sText__) 'Assign a value to the property sText sText_ = sText__ Dim oListItem, i i = 0 If IsArray(arrListItems) AND bArrayIsEmpty(arrListItems) = False Then iValue_ = -1 For Each oListItem In arrListItems If oListItem.sKey = sText__ Then iValue_ = i Exit For End If i = i + 1 Next If iValue_ = -1 Then Call Err.Raise(65535,,"ERROR - the sText of '" & Str(sText__) & "' does not exist in ListItems") Else If Len(sText__) > 0 Then Call Err.Raise(65535,,"ERROR - the sText of '" & Str(sText__) & "' does not exist in ListItems") End If End Property Public Property Get sText 'Read the property value sText sText = sText_ End Property '------------------------------------------------------------------------------- Private arrListItems ' Methods Public Function Add(ByVal sKey, ByVal iValue) If Len(sKey) = 0 Then Exit Function If IsEmpty(iValue) Then Exit Function If Len(sKey) > iChars_ Then iChars_ = Len(sKey) Dim oListItem Set oListItem = New c_ListItem If IsArray(arrListItems) AND bArrayIsEmpty(arrListItems) = False Then If Exists(sKey) Then Call Err.Raise(65535,,"ERROR - the sText of '" & Str(sKey) & "' already exists in ListItems. Use method Exists() to test for this.") Else oListItem.sKey = sKey oListItem.iValue = iValue ReDim Preserve arrListItems(uBound(arrListItems)+1) Set arrListItems(uBound(arrListItems)) = oListItem End If Else oListItem.sKey = sKey oListItem.iValue = iValue ReDim arrListItems(0) Set arrListItems(0) = oListItem End If iCount_ = uBound(arrListItems)+1 Set oListItem = Nothing End Function 'Add() Public Function Items() Items = arrListItems End Function 'Items() Public Function Remove(ByVal sKey) If Not IsArray(arrListItems) Then Exit Function End If Dim oListItem, arrListItemsCopy, i, bKeyExists, iCharsMax iCharsMax = 0 i = 0 bKeyExists = False i = 0 For Each oListItem In arrListItems If Len(oListItem.sKey) > iCharsMax Then iCharsMax = Len(oListItem.sKey) If StrComp(oListItem.sKey,sKey,vbTextCompare) = 0 Then bKeyExists = True 'Reset iValue because it currently points to the item to be removed. If iValue_ = i Then iValue_ = -1 sText_ = "" End If End If i = i + 1 Next iChars_ = iCharsMax If bKeyExists Then i = 0 ReDim arrListItemsCopy(uBound(arrListItems)-1) For Each oListItem In arrListItems If Not oListItem.sKey = sKey Then Set arrListItemsCopy(i) = oListItem i = i + 1 End If Next arrListItems = arrListItemsCopy iCount_ = uBound(arrListItems)+1 If IsArray(arrListItemsCopy) Then Call Erase(arrListItemsCopy) End If End Function 'Remove() Public Function RemoveAll() If IsArray(arrListItems) Then Call Erase(arrListItems) iCount_ = 0 iValue_ = -1 End Function 'RemoveAll() Public Function Exists(ByVal sKey) Exists = False If Not IsArray(arrListItems) Then Exit Function End If Dim oListItem, arrListItemsCopy, bKeyExists bKeyExists = False For Each oListItem In arrListItems If StrComp(oListItem.sKey,sKey,vbTextCompare) = 0 Then bKeyExists = True End If Next If bKeyExists Then Exists = True End Function 'Exists() End Class 'c_ComboBox '------------------------------------------------------------------------------- 'Call LogFileDel() 'Call Demo_C_ListItem() ' 'Sub Demo_C_ListItem() ' Dim oListItem ' Set oListItem = New c_ListItem ' oListItem.sKey = "A" ' oListItem.iValue = 10 ' Call LogFileWrite("sKey, iVal = " & oListItem.sKey & vbTab & oListItem.iValue) ' Set oListItem = Nothing 'End Sub 'Demo_C_ListItem() Class c_ListItem 'Provides for two properties, sKey and iValue corresponding to the properties for a ListItem. Private Sub Class_Initialize() End Sub 'Class_Initialize() Private Sub Class_Terminate() End Sub 'Class_Terminate '------------------------------------------------------------------------------- ' property sKey Private sKey_ Public Property Let sKey(sKey__) 'Assign a value to the property sKey sKey_ = sKey__ End Property Public Property Get sKey 'Read the property value sKey sKey = sKey_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iValue Private iValue_ Public Property Let iValue(iValue__) 'Assign a value to the property iValue iValue_ = iValue__ End Property Public Property Get iValue 'Read the property value iValue iValue = iValue_ End Property '------------------------------------------------------------------------------- End Class 'c_ListItem Class C_EditBox ''bEnable, sText, bReadOnly Private Sub Class_Initialize() bEnable_ = True bReadOnly_ = False sText_ = "" End Sub 'Class_Initialize() Private Sub Class_Terminate() End Sub 'Class_Terminate '------------------------------------------------------------------------------- ' property sText Private sText_ Public Property Let sText(sText__) 'Assign a value to the property sText sText_ = sText__ End Property Public Property Get sText 'Read the property value sText sText = sText_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property bEnable Private bEnable_ Public Property Let bEnable(bEnable__) 'Assign a value to the property bEnable bEnable_ = bEnable__ End Property Public Property Get bEnable 'Read the property value bEnable bEnable = bEnable_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property bReadOnly Private bReadOnly_ Public Property Let bReadOnly(bReadOnly__) 'Assign a value to the property bReadOnly bReadOnly_ = bReadOnly__ End Property Public Property Get bReadOnly 'Read the property value bReadOnly bReadOnly = bReadOnly_ End Property '------------------------------------------------------------------------------- End Class 'C_EditBox Class C_Text ''bEnable, sText, iValue Private Sub Class_Initialize() bEnable_ = True iValue_ = 0 sText_ = "" End Sub 'Class_Initialize() Private Sub Class_Terminate() End Sub 'Class_Terminate '------------------------------------------------------------------------------- ' property sText Private sText_ Public Property Let sText(sText__) 'Assign a value to the property sText sText_ = sText__ End Property Public Property Get sText 'Read the property value sText sText = sText_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property bEnable Private bEnable_ Public Property Let bEnable(bEnable__) 'Assign a value to the property bEnable bEnable_ = bEnable__ End Property Public Property Get bEnable 'Read the property value bEnable bEnable = bEnable_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iValue Private iValue_ Public Property Let iValue(iValue__) 'Assign a value to the property iValue iValue_ = iValue__ End Property Public Property Get iValue 'Read the property value iValue iValue = iValue_ End Property '------------------------------------------------------------------------------- End Class 'C_Text Class C_CheckBox 'bEnable sText iValue Private Sub Class_Initialize() bEnable_ = True iValue_ = 0 sText_ = "" End Sub 'Class_Initialize() Private Sub Class_Terminate() End Sub 'Class_Terminate '------------------------------------------------------------------------------- ' property sText Private sText_ Public Property Let sText(sText__) 'Assign a value to the property sText sText_ = sText__ End Property Public Property Get sText 'Read the property value sText sText = sText_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property bEnable Private bEnable_ Public Property Let bEnable(bEnable__) 'Assign a value to the property bEnable bEnable_ = bEnable__ End Property Public Property Get bEnable 'Read the property value bEnable bEnable = bEnable_ End Property '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' property iValue Private iValue_ Public Property Let iValue(iValue__) 'Assign a value to the property iValue iValue_ = iValue__ End Property Public Property Get iValue 'Read the property value iValue iValue = iValue_ End Property '------------------------------------------------------------------------------- End Class 'C_CheckBox 'Call LogFileDel() 'Dim arrItems 'ReDim arrItems(1) 'arrItems(0) = "One" 'arrItems(1) = "Two" 'Call LogFileWrite("IsArray() = " & IsArray(arrItems)) 'Call LogFileWrite("VarType(arrItems) = vbArray + vbVariant " & (VarType(arrItems) = vbArray + vbVariant)) 'Call LogFileWrite("VarType(arrItems) = " & VarType(arrItems)) 'Call LogFileWrite("bArrayIsEmpty() = " & bArrayIsEmpty(arrItems)) 'Call LogFileWrite(vbTab) 'If IsArray(arrItems) Then Call Erase(arrItems) 'Call LogFileWrite("IsArray() = " & IsArray(arrItems)) 'Call LogFileWrite("VarType(arrItems) = vbArray + vbVariant " & (VarType(arrItems) = vbArray + vbVariant)) 'Call LogFileWrite("VarType(arrItems) = " & VarType(arrItems)) 'Call LogFileWrite("bArrayIsEmpty() = " & bArrayIsEmpty(arrItems)) Function bArrayIsEmpty(ByVal arrArray) 'Returns TRUE if arrArray is an array, but empty. 'Returns FALSE if arrArray is not empty (has one or more values). 'You cannot execute uBound(), lBound() on an array that has been erased with: Call Erase(arrArray). 'This function allows you to determine if an array has been erased. 'Usage: ReDim arrArray() If IsArray(arrListItems) AND bArrayIsEmpty(arrListItems) = False Then bArrayIsEmpty = False Dim lErr, sErr, iUbound On Error Resume Next iUbound = uBound(arrArray) lErr = Err.number: sErr = Err.Description: On Error Goto 0 If lErr = 9 Then bArrayIsEmpty = True End If End Function 'bArrayIsEmpty() '------------------------------------------------------------------------------- Function sStrRandomAlphaChars(iLength) ' This function creates a string of random characters, both numbers ' and alpha, with a length of iLength. It uses Timer to seed the Rnd ' function. sStrRandomAlphaChars = "" Dim i, strCharBase, iPos strCharBase = "01234ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz56789" Randomize (Timer) For i = 1 To iLength iPos = Int((Len(strCharBase) - 1 + 1) * Rnd + 1) 'Call LogFileWrite(iPos & vbTab & "'" & Mid(strCharBase,iPos,1) & "'" & vbTab & "'" & sStrRandomAlphaChars & "'") sStrRandomAlphaChars = sStrRandomAlphaChars & Mid(strCharBase,iPos,1) Next End Function 'sStrRandomAlphaChars() '------------------------------------------------------------------------------- Sub Dialog_EventInitialize(ByRef This) 'Created Event Handler 'btn_Done is disabled by default until at least one CheckBox 'is checked. See EnableCheckBoxRowsIfRowContentsAreValid() btn_Done.Enable = False End Sub Sub Dialog_EventTerminate(ByRef This) 'Created Event Handler Call oXTableDic.RemoveAll: Set oXTableDic = Nothing End Sub Sub btn_Done_EventClick(ByRef This) 'Created Event Handler Call LogFileWrite(vbTab) Call LogFileWrite("btn_Done_EventClick") Dim oCheckBox, oEditBox, oComboBox, iRow Call LogFileWrite("iRow" & vbTab & "oCheckBox.iValue" & vbTab & "oEditBox.sText" & vbTab & "oComboBox.sText") For Each iRow In oXTableDic arrXTableRow = oXTableDic(iRow) Set oCheckBox = arrXTableRow(1) Set oEditBox = arrXTableRow(2) Set oComboBox = arrXTableRow(3) Call LogFileWrite(iRow & vbTab & oCheckBox.iValue & vbTab & oEditBox.sText & vbTab & "'" & oComboBox.sText & "'") Set oCheckBox = Nothing: Set oEditBox = Nothing: Set oComboBox = Nothing If IsArray(arrXTableRow) Then Call Erase(arrXTableRow) Next 'iRow End Sub '-------------------------------------------------------------------------------
The script file and dialog (.sud) file demonstrate how to implement a non-modal dialog that populates the Data Portal with data, and then allows the user to interactively select a channel group, and then two Y channels to be plotted in the View panel (the x-channel is found programmatically).
Download the dialog file: non-modal_dialog.SUD
non-modal_dialog.vbs
'------------------------------------------------------------------------------- '-- VBS script file non-modal_dialog.vbs '-- Author: Mark W Kiehl ' www.SavvyDiademSolutions.com ' http://www.savvysolutions.info/savvycodesolutions/ '-- Comment: ' ' This script calls a non-modal dialog box that creates data in the Data Portal, ' and then allows the user to interactively select the channel group, and then ' two Y channels to be plotted in the View panel (the X channel is automatically ' determined). ' ' ' If you have a DIAdem script running that takes a long time to execute and you ' want a non-modal dialog to show the progress or some other action, then use ' he SUDDlgCreateEx() command to run the dialog, and set the SUDDlgkeepEnabled ' parameter to true. ' ' Note that the script that calls this non-modal dialog with SUDDlgCreate() does ' NOT contain transfer parameters that you can access in the dialog script using ' the methods GetArgument and SetArgument. '------------------------------------------------------------------------------- Option Explicit Call LogFileDel() Dim oDlg, sFilePathDlg sFilePathDlg = CurrentScriptPath & "non-modal_dialog.sud" Const sDlgName = "DlgNonModal" ', sDlgFilename = "non-modal_dialog.sud" If SudNonModalDlgLst(sDlgName) Is Nothing Then 'To speed up DIAdemn, disable refreshing with UIAutoRefreshSet(). 'Then to force refresh, call UIAutoRefreshSet to restore the refresh state in 'the dialog EventTerminate event. Call LogFileWrite("SudNonModalDlgLst is not running") Set oDlg = SUDDlgCreate(sDlgName,sFilePathDlg) 'You must call the .Show() method in order to see the dialog. Call oDlg.Show() Set oDlg = Nothing Else Call LogFileWrite("SudNonModalDlgLst is currently running") If MsgBox("Click 'Yes' to show the dialog, 'No' to close it",vbYesNo,sDlgName) = vbYes Then Set oDlg = SUDNonModalDlgLst(sDlgName) Call oDlg.Show() Set oDlg = Nothing Else Set oDlg = SUDNonModalDlgLst(sDlgName) Call LogFileWrite("oDlg.FilePath & oDlg.FileName = " & oDlg.FilePath & oDlg.FileName) Call oDlg.Cancel() Set oDlg = Nothing End If End If
non-modal_dialog.SUD
'------------------------------------------------------------------------------- '-- SUD script file non-modal_dialog.sud '-- Author: Mark W Kiehl ' www.SavvyDiademSolutions.com ' http://www.savvysolutions.info/savvycodesolutions/ '-- Comment: ' ' This non-modal dialog box creates data in the Data Portal, and then ' allows the user to interactively select the channel group, and then ' two Y channels to be plotted in the View panel (the X channel is ' automatically determined). ' ' The Dialog 'ShowTitleMenu' property has been set to No. This prevents ' the Close icon (x) from appearing in the title bar. ' ' In a non-modal user dialog box you have only restricted access to REPORT objects ' through GraphObjOpen because these objects cannot be opened simultaneously from ' different places. Use the object-oriented REPORT interface instead. ' ' Note that the script that calls this non-modal dialog with SUDDlgCreate() does ' NOT contain transfer parameters that you can access in the dialog script using ' the methods GetArgument and SetArgument. ' ' http://zone.ni.com/reference/en-XX/help/370858N-01/genscript/genscript/sud_nonmodal/ ' http://zone.ni.com/reference/en-XX/help/370858N-01/procsud/procsud/procsud_nonmodal/ '------------------------------------------------------------------------------- Option Explicit Dim oChnX, oChnY1, oChnY2 Sub Dialog_EventInitialize(ByRef This) 'Created Event Handler Call LogFileWrite("Dialog_EventInitialize") 'Call LogFileWrite("Dialog.FilePath & Dialog.FileName = " & Dialog.FilePath & Dialog.FileName) 'Clear out the View panel Call WndShow("View") Call View.NewLayout() 'Create data in the Data Portal .. Call Data.Root.Clear() Portal.Visible = True Call bCreateSampleNumericData() End Sub Sub ChnGrp_EventInitialize(ByRef This) 'Created Event Handler Dim oGrp Call ChnGrp.Items.RemoveAll() For Each oGrp In Data.Root.ChannelGroups() Call ChnGrp.Items.Add(oGrp.Name, ChnGrp.Items.Count) Next Call ChnY1.Items.RemoveAll() ChnY1.Enable = False Call ChnY2.Items.RemoveAll() ChnY2.Enable = False End Sub Sub ChnGrp_EventChange(ByRef This) 'Created Event Handler Dim oChn If ChnGrp.Value >= 0 Then Call Data.Root.ChannelGroups(ChnGrp.Text).Activate() Set oChnX = Data.Root.ChannelGroups(ChnGrp.Text).Channels("Time") ChnY1.Enable = True Call ChnY1.Items.RemoveAll() ChnY2.Enable = False Call ChnY2.Items.RemoveAll() For Each oChn In Data.Root.ChannelGroups(ChnGrp.Text).Channels() If Not oChn.Name = oChnX.Name Then Call ChnY1.Items.Add(oChn.Name,ChnY1.Items.Count) End If Next End If End Sub Sub ChnY1_EventChange(ByRef This) 'Created Event Handler Dim oChn If ChnY1.Value >= 0 Then Set oChnY1 = Data.Root.ChannelGroups(ChnGrp.Text).Channels(ChnY1.Text) ChnY2.Enable = True Call ChnY2.Items.RemoveAll() For Each oChn In Data.Root.ChannelGroups(ChnGrp.Text).Channels() If oChn.Name = oChnX.Name OR oChn.Name = oChnY1.Name Then 'ignore Else Call ChnY2.Items.Add(oChn.Name,ChnY2.Items.Count) End If Next If ChnY2.Items.Count = 1 Then ChnY2.Value = 0 ChnY2.Enable = False Call PlotXY1Y2() End If End If End Sub Sub PlotXY1Y2() Dim oGrp, oElementList Set oGrp = Data.Root.ChannelGroups(ChnGrp.Text) Set oElementList = Data.CreateElementList() Call oElementList.Add(oGrp.Channels(oChnX.Name)) Call oElementList.Add(oGrp.Channels(oChnY1.Name)) Call oElementList.Add(oGrp.Channels(oChnY2.Name)) If Not b2dPlotToViewByElementList(oElementList) Then Call LogFileWrite("ERROR - b2dPlotToViewByElementList()") Call Dialog.Cancel() End If Set oElementList = Nothing: Set oGrp = Nothing End Sub Sub ChnY2_EventChange(ByRef This) 'Created Event Handler If ChnY2.Value >= 0 Then Set oChnY2 = Data.Root.ChannelGroups(ChnGrp.Text).Channels(ChnY2.Text) Call PlotXY1Y2() End If End Sub '------------------------------------------------------------------------------- 'Call bCreateSampleNumericData() Function bCreateSampleNumericData() bCreateSampleNumericData = False Const iSamples = 25 Dim oFileProps, oGrpProps, oChnProps, sDate, dtDate Set oFileProps = CreateObject("Scripting.Dictionary") Set oGrpProps = CreateObject("Scripting.Dictionary") Set oChnProps = CreateObject("Scripting.Dictionary") dtDate = Now() sDate = str(dtDate,"#yyyymmdd-hhnnss") Call oFileProps.Add("description","simulated data created " & sDate & " 1 grps with 3 chns with " & iSamples & " samples") 'Call oFileProps.Add("title","AS_AnalyzeDataFile_ComparativeEval") Call oFileProps.Add("author", "Mark Kiehl") Call oFileProps.Add("sourceoriginalname", CurrentScriptName) Call oFileProps.Add("datetime",dtDate) Call oGrpProps.Add("description","explicit channels") Call oGrpProps.Add("sourceoriginalname","www.SavvyDiademSolutions.com") Call oChnProps.Add("description","numeric channel data") Call dCreateSampleNumericChnDataInDataPortal(iSamples, oFileProps, oGrpProps, oChnProps) Data.Root.Name = "numeric_" & sDate & "_2x3x" & Str(iSamples) Call oFileProps.RemoveAll(): Set oFileProps = Nothing Call oGrpProps.RemoveAll(): Set oGrpProps = Nothing Call oChnProps.RemoveAll(): Set oChnProps = Nothing bCreateSampleNumericData = True End Function 'bCreateSampleNumericData() Function dCreateSampleNumericChnDataInDataPortal(ByVal iSamples, ByVal oFileProps, ByVal oGrpProps, ByVal oChnProps) 'Creates simulated data in the Data Portal and returns the amount of 'time in seconds it took to do it. ' Const iGrps = 2 Call MsgLineDisp("Creating " & Str(iGrps) & " grps with 3 chns with " & iSamples & " samples") dCreateSampleNumericChnDataInDataPortal = 0.0 Call Data.Root.Clear() Const dpTimer = 25 Call StopWatchReset(dpTimer) Dim g, oGrp, oChnT, oChn, s, c, sPropName, vPropVal, dConst Dim oElementList, sChn, dValStart, dValEnd, dValStep, iRows, iRowFirst Dim bChnCommentOver bChnCommentOver = ChnCommentOver ChnCommentOver = False Call LoopInit() For g = 1 to iGrps Call Data.Root.ChannelGroups.Add("myGroup" & str(g)) Set oGrp = Data.Root.ChannelGroups(g) For Each sPropName in oGrpProps vPropVal = oGrpProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oGrpProps 'Create channels 'Create a new time channels with iSamples beginning 'from a value of 0.0 and ending with a value of 500.0 sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = iSamples / g Set oElementList = ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") Set oChnT = oGrp.Channels(oElementList.Item(1).Name) If g = 1 Then For c = 1 To 2 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 1 oChn.UnitSymbol = "bar" oChn.Name = "Pressure" Case 2 oChn.UnitSymbol = "K" oChn.Name = "Temperature" End Select Next 'c Else 'g=2 For c = 3 To 6 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 3 oChn.UnitSymbol = "mph" oChn.Name = "Speed" dConst = 1500 Case 4 oChn.UnitSymbol = "m/s^2" oChn.Name = "Acceleration" dConst = 1.5 Case 5 oChn.UnitSymbol = "ft-lb" oChn.Name = "Torque" dConst = 200 Case 6 oChn.UnitSymbol = "kW" oChn.Name = "Power" dConst = 20 End Select Next 'c End If 'g Set oGrp = Nothing: Set oChnT = Nothing: Set oChn = Nothing Call LoopInc(Fix(g/iGrps*100)) Next 'g 'Create an additional channel group with the base data. Set oGrp = Data.Root.ChannelGroups.Add("TempGroup") 'Create the time channel sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = 10 Call ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") 'Create the base data channel Set oChn = oGrp.Channels.Add("Data",DataTypeChnFloat64) dValStart = 1.0 dValEnd = 1000 sChn = oChn.GetReference(eRefTypeIndexIndex) Call ChnGeoGen(sChn,dValStart,dValEnd,iSamples) Call ChnNormalize(oChn,sChn) 'Create a noise channel Dim sFormula, arrSymbols, arrValues Set oChn = oGrp.Channels.Add("Noise",DataTypeChnFloat64) ReDim arrSymbols(1): ReDim arrValues(1) sFormula = "Noise = Sin(Time)" arrSymbols(0) = "Time" arrSymbols(1) = "Noise" Set arrValues(0) = oGrp.Channels("Time") Set arrValues(1) = oGrp.Channels("Noise") Call Calculate(sFormula, arrSymbols, arrValues) 'Combine the Data and Noise channels Call ChnSub(oGrp.Channels("Data"),oGrp.Channels("Noise"),sChn) Set oChn = oGrp.Channels("Data") Call Randomize() For s = 1 to iSamples oChn.Values(s) = oChn.Values(s) * Random(1) Next 'Offset the channel values so that they are all >= 0 Call ChnCharacter(oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(1).Channels("Pressure") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '0.9653 to 28.0 bar Call ChnLinScale(oChnT,oChnT,20,MaxV(0.9653-oChnT.Minimum,0.9653)) Set oChnT = Data.Root.ChannelGroups(1).Channels("Temperature") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '273 to 373 K Call ChnLinScale(oChnT,oChnT,10,273) Call ChnReciprocal(oChnT, oChnT) Call ChnLinScale(oChnT,oChnT,100000,0) Call ChnOffset(oChnT, oChnT, 273-oChnT.Minimum, "free offset") oChnT.UnitSymbol = "K" Set oChnT = Data.Root.ChannelGroups(2).Channels("Speed") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '300 to 2500 rpm Call ChnLinScale(oChnT,oChnT,1000,MaxV(300-oChn.Minimum,300)) Set oChnT = Data.Root.ChannelGroups(2).Channels("Torque") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,250,25) 'Modify the Data channel Call ChnLinScale(oChn, oChn, 50, 5) Call ChnReciprocal(oChn, oChn) Call ChnLinScale(oChn, oChn, 1000, 0) Set oChnT = Data.Root.ChannelGroups(2).Channels("Acceleration") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,1,0) 'Modify the Noise channel Set oChn = Data.Root.ChannelGroups("TempGroup").Channels("Noise") Call ChnReciprocal(oChn, oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(2).Channels("Power") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Set oChn = Nothing: Set oChnT = Nothing: Set oGrp = Nothing Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Noise") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Data") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Time") Call Data.Root.ChannelGroups.Remove("TempGroup") Call ChnCharacterAll() ChnCommentOver = bChnCommentOver Call LoopDeInit() 'Add the properties Call MsgLineDisp("Adding file properties..") For Each sPropName in oFileProps vPropVal = oFileProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next Call StopWatchPause(dpTimer) dCreateSampleNumericChnDataInDataPortal = Round(StopWatch(dpTimer),1) Call MsgLineDisp(vbTab) End Function 'dCreateSampleNumericChnDataInDataPortal() '------------------------------------------------------------------------------- Function b2dPlotToViewByElementList(ByVal oElementList) 'Creates a 2D plot in View of the data channels in oElementList. 'oElementList must contain at least 2 channels, and one of them 'must be a Time, DateTime, or DataType = DataTypeChnDate. 'Returns TRUE if successful. b2dPlotToViewByElementList = False If Not IsObject(oElementList) Then Exit Function If oElementList.Count = 0 Then Exit Function Dim oElement, oChnX, iChns 'Find the x-axis channel within oElementList For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then iChns = iChns + 1 If (Not IsObject(oChnX)) AND (oElement.Name = "Time" or oElement.Name = "DateTime" or oElement.DataType = DataTypeChnDate ) Then Set oChnX = oElement End If 'oElement.Name End If 'oElement.IsKindOf() Next 'oElement If Not IsObject(oChnX) Then Call LogFileWrite("ERROR - time / datetime channel not found in oElementList. Fn b2dPlotToViewByElementList()") Exit Function End If If iChns < 2 Then Call LogFileWrite("ERROR - insufficient channels passed in oElementList to Fn b2dPlotToViewByElementList()") Exit Function End If 'Delete any sheets that exist Call View.Sheets.RemoveAll() Call View.NewLayout() 'Add a single area with a 2D curve Dim oArea, oChnDateTime, oChn Set oArea = View.ActiveSheet.ActiveArea oArea.DisplayObjType = "CurveChart2D" 'Add channels to the curve For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then If Not oElement.Name = oChnX.Name Then Call oArea.DisplayObj.Curves.Add(oChnX.GetReference(eRefTypeIndexIndex),oElement.GetReference(eRefTypeIndexIndex)) End If End If 'oElement.IsKindOf() Next 'oElement oArea.DisplayObj.YScaling = "n systems [phys.]" View.ActiveSheet.ActiveArea.DisplayObj.XScalingMode = "RangeFull" View.Refresh() Set oChnX = Nothing: Set oChn = Nothing: Set oArea = Nothing b2dPlotToViewByElementList = True End Function 'b2dPlotToViewByElementList() '-------------------------------------------------------------------------------
DIAdem commands: SudNonModalDlgLst(), SUDDlgCreate()
Download the dialog file: non-modal_dialog_CallScriptControlled.SUD
'------------------------------------------------------------------------------- '-- SUD script file non-modal_dialog_CallScriptControlled.vbs '-- Author: Mechatronic Solutions LLC ' Mark W Kiehl ' www.SavvyDiademSolutions.com ' ' Demonstrates manipulation of a non-modal dialog by a script. ' ' This script creates data in the Data Portal, then calls a non-modal dialog ' and populates one combo box with the channel group names. ' When the user selects a channel group, an event within the dialog will ' enable the combobox for channels and populate it with the channel names ' for the channel groups selected by the user. ' ' ' If you have a DIAdem script running that takes a long time to execute and you ' want a non-modal dialog to show the progress or some other action, then use ' the SUDDlgCreateEx() command to run the dialog, and set the SUDDlgkeepEnabled ' parameter to true. ' ' Note that the script that calls this non-modal dialog with SUDDlgCreate() does ' NOT contain transfer parameters that you can access in the dialog script using ' the methods GetArgument and SetArgument. '------------------------------------------------------------------------------- Option Explicit Call LogFileDel() Dim oDlg, sFilePathDlg, oDlgControl, oGrp, oChn sFilePathDlg = CurrentScriptPath & "non-modal_dialog_CallScriptControlled.SUD" Const sDlgName = "DlgNonModal" Call Data.Root.Clear() Call bCreateSampleNumericData() If SudNonModalDlgLst(sDlgName) Is Nothing Then Call LogFileWrite("SudNonModalDlgLst is not running") Set oDlg = SUDDlgCreate(sDlgName,sFilePathDlg) Else Call LogFileWrite("SudNonModalDlgLst is currently running") Set oDlg = SUDNonModalDlgLst(sDlgName) End If 'You must call the .Show() method in order to see the dialog. Call oDlg.Show() 'You reference a control item by it's index or name (name = "DialogCode" in the Dialog Editor) Set oDlgControl = oDlg.Controls.Item("cbo_ChnGrps") 'Add all of the channel group names to the combobox named "cbo_ChnGrps" Call oDlgControl.Items.RemoveAll() For Each oGrp In Data.Root.ChannelGroups() Call oDlgControl.Items.Add(oGrp.Name, oDlgControl.Items.Count) Next Set oChn = Nothing: Set oGrp = Nothing: Set oDlgControl = Nothing '------------------------------------------------------------------------------- 'Call bCreateSampleNumericData() Function bCreateSampleNumericData() bCreateSampleNumericData = False Const iSamples = 25 Dim oFileProps, oGrpProps, oChnProps, sDate, dtDate, bUIAutoRefreshSet bUIAutoRefreshSet = UIAutoRefreshSet(False) Set oFileProps = CreateObject("Scripting.Dictionary") Set oGrpProps = CreateObject("Scripting.Dictionary") Set oChnProps = CreateObject("Scripting.Dictionary") dtDate = Now() sDate = str(dtDate,"#yyyymmdd-hhnnss") Call oFileProps.Add("description","simulated data created " & sDate & " 1 grps with 3 chns with " & iSamples & " samples") 'Call oFileProps.Add("title","AS_AnalyzeDataFile_ComparativeEval") Call oFileProps.Add("author", "Mark Kiehl") Call oFileProps.Add("sourceoriginalname", CurrentScriptName) Call oFileProps.Add("datetime",dtDate) Call oGrpProps.Add("description","explicit channels") Call oGrpProps.Add("sourceoriginalname","www.SavvyDiademSolutions.com") Call oChnProps.Add("description","numeric channel data") Call dCreateSampleNumericChnDataInDataPortal(iSamples, oFileProps, oGrpProps, oChnProps) Data.Root.Name = "numeric_" & sDate & "_2x3x" & Str(iSamples) Call oFileProps.RemoveAll(): Set oFileProps = Nothing Call oGrpProps.RemoveAll(): Set oGrpProps = Nothing Call oChnProps.RemoveAll(): Set oChnProps = Nothing Call UIAutoRefreshSet(bUIAutoRefreshSet) bCreateSampleNumericData = True End Function 'bCreateSampleNumericData() Function dCreateSampleNumericChnDataInDataPortal(ByVal iSamples, ByVal oFileProps, ByVal oGrpProps, ByVal oChnProps) 'Creates simulated data in the Data Portal and returns the amount of 'time in seconds it took to do it. ' Const iGrps = 2 Call MsgLineDisp("Creating " & Str(iGrps) & " grps with 3 chns with " & iSamples & " samples") dCreateSampleNumericChnDataInDataPortal = 0.0 Call Data.Root.Clear() Const dpTimer = 25 Call StopWatchReset(dpTimer) Dim g, oGrp, oChnT, oChn, s, c, sPropName, vPropVal, dConst Dim oElementList, sChn, dValStart, dValEnd, dValStep, iRows, iRowFirst Dim bChnCommentOver bChnCommentOver = ChnCommentOver ChnCommentOver = False Call LoopInit() For g = 1 to iGrps Call Data.Root.ChannelGroups.Add("myGroup" & str(g)) Set oGrp = Data.Root.ChannelGroups(g) For Each sPropName in oGrpProps vPropVal = oGrpProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oGrpProps 'Create channels 'Create a new time channels with iSamples beginning 'from a value of 0.0 and ending with a value of 500.0 sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = iSamples / g Set oElementList = ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") Set oChnT = oGrp.Channels(oElementList.Item(1).Name) If g = 1 Then For c = 1 To 2 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 1 oChn.UnitSymbol = "bar" oChn.Name = "Pressure" Case 2 oChn.UnitSymbol = "K" oChn.Name = "Temperature" End Select Next 'c Else 'g=2 For c = 3 To 6 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 3 oChn.UnitSymbol = "1/min" oChn.Name = "Speed" dConst = 1500 Case 4 oChn.UnitSymbol = "m/s^2" oChn.Name = "Acceleration" dConst = 1.5 Case 5 oChn.UnitSymbol = "ft-lb" oChn.Name = "Torque" dConst = 200 Case 6 oChn.UnitSymbol = "kW" oChn.Name = "Power" dConst = 20 End Select Next 'c End If 'g Set oGrp = Nothing: Set oChnT = Nothing: Set oChn = Nothing Call LoopInc(Fix(g/iGrps*100)) Next 'g 'Create an additional channel group with the base data. Set oGrp = Data.Root.ChannelGroups.Add("TempGroup") 'Create the time channel sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = 10 Call ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") 'Create the base data channel Set oChn = oGrp.Channels.Add("Data",DataTypeChnFloat64) dValStart = 1.0 dValEnd = 1000 sChn = oChn.GetReference(eRefTypeIndexIndex) Call ChnGeoGen(sChn,dValStart,dValEnd,iSamples) Call ChnNormalize(oChn,sChn) 'Create a noise channel Dim sFormula, arrSymbols, arrValues Set oChn = oGrp.Channels.Add("Noise",DataTypeChnFloat64) ReDim arrSymbols(1): ReDim arrValues(1) sFormula = "Noise = Sin(Time)" arrSymbols(0) = "Time" arrSymbols(1) = "Noise" Set arrValues(0) = oGrp.Channels("Time") Set arrValues(1) = oGrp.Channels("Noise") Call Calculate(sFormula, arrSymbols, arrValues) 'Combine the Data and Noise channels Call ChnSub(oGrp.Channels("Data"),oGrp.Channels("Noise"),sChn) Set oChn = oGrp.Channels("Data") Call Randomize() For s = 1 to iSamples oChn.Values(s) = oChn.Values(s) * Random(1) Next 'Offset the channel values so that they are all >= 0 Call ChnCharacter(oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(1).Channels("Pressure") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '0.9653 to 28.0 bar Call ChnLinScale(oChnT,oChnT,20,MaxV(0.9653-oChnT.Minimum,0.9653)) Set oChnT = Data.Root.ChannelGroups(1).Channels("Temperature") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '273 to 373 K Call ChnLinScale(oChnT,oChnT,10,273) Call ChnReciprocal(oChnT, oChnT) Call ChnLinScale(oChnT,oChnT,100000,0) Call ChnOffset(oChnT, oChnT, 273-oChnT.Minimum, "free offset") oChnT.UnitSymbol = "K" Set oChnT = Data.Root.ChannelGroups(2).Channels("Speed") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '300 to 2500 rpm Call ChnLinScale(oChnT,oChnT,1000,MaxV(300-oChn.Minimum,300)) Set oChnT = Data.Root.ChannelGroups(2).Channels("Torque") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,250,25) 'Modify the Data channel Call ChnLinScale(oChn, oChn, 50, 5) Call ChnReciprocal(oChn, oChn) Call ChnLinScale(oChn, oChn, 1000, 0) Set oChnT = Data.Root.ChannelGroups(2).Channels("Acceleration") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,1,0) 'Modify the Noise channel Set oChn = Data.Root.ChannelGroups("TempGroup").Channels("Noise") Call ChnReciprocal(oChn, oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(2).Channels("Power") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Set oChn = Nothing: Set oChnT = Nothing: Set oGrp = Nothing Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Noise") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Data") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Time") Call Data.Root.ChannelGroups.Remove("TempGroup") Call ChnCharacterAll() ChnCommentOver = bChnCommentOver Call LoopDeInit() 'Add the properties Call MsgLineDisp("Adding file properties..") For Each sPropName in oFileProps vPropVal = oFileProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next Call StopWatchPause(dpTimer) dCreateSampleNumericChnDataInDataPortal = Round(StopWatch(dpTimer),1) Call MsgLineDisp(vbTab) End Function 'dCreateSampleNumericChnDataInDataPortal() '------------------------------------------------------------------------------- Function b2dPlotToViewByElementList(ByVal oElementList) 'Creates a 2D plot in View of the data channels in oElementList. 'oElementList must contain at least 2 channels, and one of them 'must be a Time, DateTime, or DataType = DataTypeChnDate. 'Returns TRUE if successful. b2dPlotToViewByElementList = False If Not IsObject(oElementList) Then Exit Function If oElementList.Count = 0 Then Exit Function Dim oElement, oChnX, iChns 'Find the x-axis channel within oElementList For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then iChns = iChns + 1 If (Not IsObject(oChnX)) AND (oElement.Name = "Time" or oElement.Name = "DateTime" or oElement.DataType = DataTypeChnDate ) Then Set oChnX = oElement End If 'oElement.Name End If 'oElement.IsKindOf() Next 'oElement If Not IsObject(oChnX) Then Call LogFileWrite("ERROR - time / datetime channel not found in oElementList. Fn b2dPlotToViewByElementList()") Exit Function End If If iChns < 2 Then Call LogFileWrite("ERROR - insufficient channels passed in oElementList to Fn b2dPlotToViewByElementList()") Exit Function End If 'Delete any sheets that exist Call View.Sheets.RemoveAll() Call View.NewLayout() 'Add a single area with a 2D curve Dim oArea, oChnDateTime, oChn Set oArea = View.ActiveSheet.ActiveArea oArea.DisplayObjType = "CurveChart2D" 'Add channels to the curve For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then If Not oElement.Name = oChnX.Name Then Call oArea.DisplayObj.Curves.Add(oChnX.GetReference(eRefTypeIndexIndex),oElement.GetReference(eRefTypeIndexIndex)) End If End If 'oElement.IsKindOf() Next 'oElement oArea.DisplayObj.YScaling = "n systems [phys.]" View.ActiveSheet.ActiveArea.DisplayObj.XScalingMode = "RangeFull" View.Refresh() Set oChnX = Nothing: Set oChn = Nothing: Set oArea = Nothing b2dPlotToViewByElementList = True End Function 'b2dPlotToViewByElementList() '-------------------------------------------------------------------------------
DIAdem commands: SUDDlgCreateEx(), SudNonModalDlgLst()
Download the dialog file: non-modal_dialog_CallScriptControlled.SUD
'------------------------------------------------------------------------------- '-- SUD script file non-modal_dialog_SUDDlgCreateEx.vbs '-- Author: Mechatronic Solutions LLC ' Mark W Kiehl ' www.SavvyDiademSolutions.com ' ' Demonstrates the use of SUDDlgCreateEx() to call a non-modal dialog. ' ' This script creates data in the Data Portal, then calls a non-modal dialog ' and populates one combo box with the channel group names. ' The script that calls the dialog then waits for the user to select a channel ' from the second combo box. ' When the user selects a channel group, an event within the dialog will ' enable the combobox for channels and populate it with the channel names ' for the channel groups selected by the user. ' Once a channel is selected by the user, the script that called the dialog ' will detect this and report what channel was selected. ' ' ' Note that the script that calls this non-modal dialog with SUDDlgCreate() does ' NOT contain transfer parameters that you can access in the dialog script using ' the methods GetArgument and SetArgument. '------------------------------------------------------------------------------- Option Explicit Call LogFileDel() Dim oDlg, sFilePathDlg, oDlgControl, oGrp, oChn sFilePathDlg = CurrentScriptPath & "non-modal_dialog_CallScriptControlled.SUD" Const sDlgName = "DlgNonModal" Call Data.Root.Clear() Call bCreateSampleNumericData() If Not SudNonModalDlgLst(sDlgName) Is Nothing Then Call LogFileWrite("'" & sDlgName & "' is currently running") Set oDlg = SUDNonModalDlgLst(sDlgName) Call oDlg.Cancel() End If Set oDlg = SUDDlgCreateEx(sDlgName,sFilePathDlg,sDlgName & "_alias",True) 'You must call the .Show() method in order to see the dialog. Call oDlg.Show() 'You reference a control item by it's index or name (name = "DialogCode" in the Dialog Editor) Set oDlgControl = oDlg.Controls.Item("cbo_ChnGrps") 'Add all of the channel group names to the combobox named "cbo_ChnGrps" Call oDlgControl.Items.RemoveAll() For Each oGrp In Data.Root.ChannelGroups() Call oDlgControl.Items.Add(oGrp.Name, oDlgControl.Items.Count) Next 'Wait for the user to make a channel selection in the 2nd combo box.. Set oDlgControl = oDlg.Controls.Item("cbo_Chns") Do Call pause(1) Loop Until oDlgControl.Value >= 0 AND Len(oDlgControl.Text) > 0 Call LogFileWrite("The channel selected in the non-modal dialog is '" & oDlgControl.Text & "'") Set oChn = Nothing: Set oGrp = Nothing: Set oDlgControl = Nothing '------------------------------------------------------------------------------- 'Call bCreateSampleNumericData() Function bCreateSampleNumericData() bCreateSampleNumericData = False Const iSamples = 25 Dim oFileProps, oGrpProps, oChnProps, sDate, dtDate, bUIAutoRefreshSet bUIAutoRefreshSet = UIAutoRefreshSet(False) Set oFileProps = CreateObject("Scripting.Dictionary") Set oGrpProps = CreateObject("Scripting.Dictionary") Set oChnProps = CreateObject("Scripting.Dictionary") dtDate = Now() sDate = str(dtDate,"#yyyymmdd-hhnnss") Call oFileProps.Add("description","simulated data created " & sDate & " 1 grps with 3 chns with " & iSamples & " samples") 'Call oFileProps.Add("title","AS_AnalyzeDataFile_ComparativeEval") Call oFileProps.Add("author", "Mark Kiehl") Call oFileProps.Add("sourceoriginalname", CurrentScriptName) Call oFileProps.Add("datetime",dtDate) Call oGrpProps.Add("description","explicit channels") Call oGrpProps.Add("sourceoriginalname","www.SavvyDiademSolutions.com") Call oChnProps.Add("description","numeric channel data") Call dCreateSampleNumericChnDataInDataPortal(iSamples, oFileProps, oGrpProps, oChnProps) Data.Root.Name = "numeric_" & sDate & "_2x3x" & Str(iSamples) Call oFileProps.RemoveAll(): Set oFileProps = Nothing Call oGrpProps.RemoveAll(): Set oGrpProps = Nothing Call oChnProps.RemoveAll(): Set oChnProps = Nothing Call UIAutoRefreshSet(bUIAutoRefreshSet) bCreateSampleNumericData = True End Function 'bCreateSampleNumericData() Function dCreateSampleNumericChnDataInDataPortal(ByVal iSamples, ByVal oFileProps, ByVal oGrpProps, ByVal oChnProps) 'Creates simulated data in the Data Portal and returns the amount of 'time in seconds it took to do it. ' Const iGrps = 2 Call MsgLineDisp("Creating " & Str(iGrps) & " grps with 3 chns with " & iSamples & " samples") dCreateSampleNumericChnDataInDataPortal = 0.0 Call Data.Root.Clear() Const dpTimer = 25 Call StopWatchReset(dpTimer) Dim g, oGrp, oChnT, oChn, s, c, sPropName, vPropVal, dConst Dim oElementList, sChn, dValStart, dValEnd, dValStep, iRows, iRowFirst Dim bChnCommentOver bChnCommentOver = ChnCommentOver ChnCommentOver = False Call LoopInit() For g = 1 to iGrps Call Data.Root.ChannelGroups.Add("myGroup" & str(g)) Set oGrp = Data.Root.ChannelGroups(g) For Each sPropName in oGrpProps vPropVal = oGrpProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oGrp.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oGrpProps 'Create channels 'Create a new time channels with iSamples beginning 'from a value of 0.0 and ending with a value of 500.0 sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = iSamples / g Set oElementList = ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") Set oChnT = oGrp.Channels(oElementList.Item(1).Name) If g = 1 Then For c = 1 To 2 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 1 oChn.UnitSymbol = "bar" oChn.Name = "Pressure" Case 2 oChn.UnitSymbol = "K" oChn.Name = "Temperature" End Select Next 'c Else 'g=2 For c = 3 To 6 Set oChn = oGrp.Channels.Add("myChn" & Str(c),DataTypeChnFloat64) For Each sPropName in oChnProps vPropVal = oChnProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call oChn.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call oChn.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call oChn.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call oChn.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next 'oChnProps Select Case c Case 3 oChn.UnitSymbol = "1/min" oChn.Name = "Speed" dConst = 1500 Case 4 oChn.UnitSymbol = "m/s^2" oChn.Name = "Acceleration" dConst = 1.5 Case 5 oChn.UnitSymbol = "ft-lb" oChn.Name = "Torque" dConst = 200 Case 6 oChn.UnitSymbol = "kW" oChn.Name = "Power" dConst = 20 End Select Next 'c End If 'g Set oGrp = Nothing: Set oChnT = Nothing: Set oChn = Nothing Call LoopInc(Fix(g/iGrps*100)) Next 'g 'Create an additional channel group with the base data. Set oGrp = Data.Root.ChannelGroups.Add("TempGroup") 'Create the time channel sChn = "[" & oGrp.Properties("index").Value & "]/Time" dValStart = 0.0 dValEnd = 10 Call ChnLinGen(sChn,dValStart,dValEnd,iSamples,"s") 'Create the base data channel Set oChn = oGrp.Channels.Add("Data",DataTypeChnFloat64) dValStart = 1.0 dValEnd = 1000 sChn = oChn.GetReference(eRefTypeIndexIndex) Call ChnGeoGen(sChn,dValStart,dValEnd,iSamples) Call ChnNormalize(oChn,sChn) 'Create a noise channel Dim sFormula, arrSymbols, arrValues Set oChn = oGrp.Channels.Add("Noise",DataTypeChnFloat64) ReDim arrSymbols(1): ReDim arrValues(1) sFormula = "Noise = Sin(Time)" arrSymbols(0) = "Time" arrSymbols(1) = "Noise" Set arrValues(0) = oGrp.Channels("Time") Set arrValues(1) = oGrp.Channels("Noise") Call Calculate(sFormula, arrSymbols, arrValues) 'Combine the Data and Noise channels Call ChnSub(oGrp.Channels("Data"),oGrp.Channels("Noise"),sChn) Set oChn = oGrp.Channels("Data") Call Randomize() For s = 1 to iSamples oChn.Values(s) = oChn.Values(s) * Random(1) Next 'Offset the channel values so that they are all >= 0 Call ChnCharacter(oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(1).Channels("Pressure") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '0.9653 to 28.0 bar Call ChnLinScale(oChnT,oChnT,20,MaxV(0.9653-oChnT.Minimum,0.9653)) Set oChnT = Data.Root.ChannelGroups(1).Channels("Temperature") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '273 to 373 K Call ChnLinScale(oChnT,oChnT,10,273) Call ChnReciprocal(oChnT, oChnT) Call ChnLinScale(oChnT,oChnT,100000,0) Call ChnOffset(oChnT, oChnT, 273-oChnT.Minimum, "free offset") oChnT.UnitSymbol = "K" Set oChnT = Data.Root.ChannelGroups(2).Channels("Speed") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) '300 to 2500 rpm Call ChnLinScale(oChnT,oChnT,1000,MaxV(300-oChn.Minimum,300)) Set oChnT = Data.Root.ChannelGroups(2).Channels("Torque") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,250,25) 'Modify the Data channel Call ChnLinScale(oChn, oChn, 50, 5) Call ChnReciprocal(oChn, oChn) Call ChnLinScale(oChn, oChn, 1000, 0) Set oChnT = Data.Root.ChannelGroups(2).Channels("Acceleration") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Call ChnLinScale(oChnT,oChnT,1,0) 'Modify the Noise channel Set oChn = Data.Root.ChannelGroups("TempGroup").Channels("Noise") Call ChnReciprocal(oChn, oChn) Call ChnOffset(oChn, oChn, oChn.Size, "min. value offset") Set oChnT = Data.Root.ChannelGroups(2).Channels("Power") Call DataBlAppend(oChn,1,oChn.Size,oChnT) Call ChnCharacter(oChnT) Set oChn = Nothing: Set oChnT = Nothing: Set oGrp = Nothing Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Noise") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Data") Call Data.Root.ChannelGroups("TempGroup").Channels.Remove("Time") Call Data.Root.ChannelGroups.Remove("TempGroup") Call ChnCharacterAll() ChnCommentOver = bChnCommentOver Call LoopDeInit() 'Add the properties Call MsgLineDisp("Adding file properties..") For Each sPropName in oFileProps vPropVal = oFileProps(sPropName) Select Case VarType(vPropVal) Case vbInteger, vbLong, vbByte Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeInt32) Case vbSingle, vbDouble, vbCurrency, vbDecimal Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeFloat64) Case vbDate Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeDate) Case vbString Call Data.Root.Properties.Add(sPropName, vPropVal, DataTypeString) Case Else 'vbEmpty, vbNull, vbObject, vbError, vbVariant, vbByte, vbArray Call LogFileWrite(vbTab & "ERROR - the VarType of '" & sPropName & "' is " & VarType(vPropVal) & vbTab & "'" & vPropVal & "'") End Select Next Call StopWatchPause(dpTimer) dCreateSampleNumericChnDataInDataPortal = Round(StopWatch(dpTimer),1) Call MsgLineDisp(vbTab) End Function 'dCreateSampleNumericChnDataInDataPortal() '------------------------------------------------------------------------------- Function b2dPlotToViewByElementList(ByVal oElementList) 'Creates a 2D plot in View of the data channels in oElementList. 'oElementList must contain at least 2 channels, and one of them 'must be a Time, DateTime, or DataType = DataTypeChnDate. 'Returns TRUE if successful. b2dPlotToViewByElementList = False If Not IsObject(oElementList) Then Exit Function If oElementList.Count = 0 Then Exit Function Dim oElement, oChnX, iChns 'Find the x-axis channel within oElementList For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then iChns = iChns + 1 If (Not IsObject(oChnX)) AND (oElement.Name = "Time" or oElement.Name = "DateTime" or oElement.DataType = DataTypeChnDate ) Then Set oChnX = oElement End If 'oElement.Name End If 'oElement.IsKindOf() Next 'oElement If Not IsObject(oChnX) Then Call LogFileWrite("ERROR - time / datetime channel not found in oElementList. Fn b2dPlotToViewByElementList()") Exit Function End If If iChns < 2 Then Call LogFileWrite("ERROR - insufficient channels passed in oElementList to Fn b2dPlotToViewByElementList()") Exit Function End If 'Delete any sheets that exist Call View.Sheets.RemoveAll() Call View.NewLayout() 'Add a single area with a 2D curve Dim oArea, oChnDateTime, oChn Set oArea = View.ActiveSheet.ActiveArea oArea.DisplayObjType = "CurveChart2D" 'Add channels to the curve For Each oElement in oElementList If oElement.IsKindOf(eDataChannel) Then If Not oElement.Name = oChnX.Name Then Call oArea.DisplayObj.Curves.Add(oChnX.GetReference(eRefTypeIndexIndex),oElement.GetReference(eRefTypeIndexIndex)) End If End If 'oElement.IsKindOf() Next 'oElement oArea.DisplayObj.YScaling = "n systems [phys.]" View.ActiveSheet.ActiveArea.DisplayObj.XScalingMode = "RangeFull" View.Refresh() Set oChnX = Nothing: Set oChn = Nothing: Set oArea = Nothing b2dPlotToViewByElementList = True End Function 'b2dPlotToViewByElementList() '-------------------------------------------------------------------------------
Sometimes you have a script you need to run against multiple data files, and some of the channel groups / channel names change between the files. This script and dialog can be used as a template for resolving channel aliases. If the expected channels are not found a dialog is presented to the user requesting the channel group / channel name substitutions to be identified by dragging and dropping them from the Data Portal to an XTable in the dialog.
Download the dialog file: chn_alias_XTable.sud
The script below creates sample data in the Data Portal and then loads the custom dialog to get the alias channels from the user. The dialog file 'chn_alias_XTable.sud' should be saved in the same folder as this script.
'------------------------------------------------------------------------------- '-- SUD script file chn_alias_XTable.vbs '-- Author: Mark W Kiehl ' www.SavvyDiademSolutions.com '-- Comment: Resolve channel aliases by acquiring substitutions interactively from the user. ' ' An initial set of channels is established. ' The Data Portal is updated to simulate the situation where some of the ' expected channels now exist under a different channel name and/or a ' channel group. ' A dialog is presented to the user, allowing the channel alias to be identified ' and substituted. ' ' This script is a template and example. ' 'Some sections of the code have been commented out because they only provide 'additional or diagnostic information. ' Highlight the commented rows below and use 'Shift-Ctrl-D' to uncomment the lines. ' Highlight the rows below again and use 'Ctrl-D' to re-comment the lines. '------------------------------------------------------------------------------- Option Explicit Call LogFileDel() Dim oDlg, sFilePathDlg, oGrp, oChn, sGrp, sChn, sGrpChn, bChnsMissing Dim oChnsDic: Set oChnsDic = CreateObject("Scripting.Dictionary") 'Create sample original channels in the Data Portal Call bCreateSampleNumericDataOriginal() 'Add the expected channel group / name information to oChnsDic. 'Note that these could also be acquired and stored in an external 'file, or they could be hard coded into the script. Set oGrp = Data.Root.ChannelGroups("GroupA") For Each oChn In oGrp.Channels() Call oChnsDic.Add(oChn.GetReference(eRefTypeNameName), "") 'oChn.GetReference(eRefTypeNameName) = "channel grouup name/channel name" Next Set oGrp = Data.Root.ChannelGroups("GroupB") For Each oChn In oGrp.Channels() Call oChnsDic.Add(oChn.GetReference(eRefTypeNameName), "") Next 'Call LogFileWrite("Expected channels:") 'For Each sGrpChn In oChnsDic ' Call LogFileWrite(vbTab & sGrpChn) 'Next 'Create new sample channels in the Data Portal with a few channel aliases Call bCreateSampleNumericDataNew() 'Determine what channels in oChnsDic no longer exist in the Data Portal and assign the 'value in oChnsDic = "UNKNOWN" to indicate they are missing, otherwise assign the 'oChn.GetReference(eRefTypeNameName) {group name / channel name} to the value. bChnsMissing = False For Each sGrpChn In oChnsDic ''Method #1 try to find the channel using Data.GetChannel() 'On Error Resume Next 'Set oChn = Data.GetChannel(sGrpChn) 'If Err.number <> 0 Then ' Call LogFileWrite(sGrpChn & vbTab & "Err " & Err.number & vbTab & Err.Description) ' oChnsDic(sGrpChn) = "UNKNOWN" 'Else ' oChnsDic(sGrpChn) = oChn.GetReference(eRefTypeNameName) 'End If 'On Error Goto 0 ''Method #2 split out the group and channel names, and then check if they exist sChn = sStrSplitRight(sGrpChn,"/") sGrp = sStrSplitLeft(sGrpChn,"/") If Not Data.Root.ChannelGroups.Exists(sGrp) Then oChnsDic(sGrpChn) = "UNKNOWN" bChnsMissing = True Else Set oGrp = Data.Root.ChannelGroups(sGrp) If Not oGrp.Channels.Exists(sChn) Then oChnsDic(sGrpChn) = "UNKNOWN" bChnsMissing = True Else Set oChn = oGrp.Channels(sChn) oChnsDic(sGrpChn) = oChn.GetReference(eRefTypeNameName) End If Set oGrp = Nothing: Set oChn = Nothing End If Next 'Call LogFileWrite("oChnsDic:") 'For Each sGrpChn In oChnsDic ' Call LogFileWrite(vbTab & sGrpChn & vbTab & oChnsDic(sGrpChn)) 'Next If bChnsMissing Then 'Call the dialog that will ask the user to provide the mapping between the 'expected channels and the alias channels where required. sFilePathDlg = CurrentScriptPath & "chn_alias_XTable.sud" Const sDlgName = "ChnAliasXTable" If SUDDlgShow(sDlgName, sFilePathDlg, oChnsDic) = "IDOk" Then Call LogFileWrite("arrChnAliases returned from dialog '" & sDlgName & "':") For Each sGrpChn In oChnsDic Call LogFileWrite(vbTab & sGrpChn & " => " & oChnsDic(sGrpChn)) Next 'The dictionary object oChnsDic has the original channel group /channel names 'as the Key, and the alias channel group / channel names as the Value. Else Call LogFileWrite(vbTab & "The user clicked the 'Cancel' dialog button") End If End If 'bChnsMissing '=============================================================================== ' Helper functions Function bStrIsNothing(ByVal sHaystack) 'check if there is anything in a string (to avoid testing for 'isnull, isempty, and zero-length strings) 'bStrIsNothing(" This is my string ") returns False If sHaystack & "" = "" Then bStrIsNothing = True Else bStrIsNothing = False End If End Function 'bStrIsNothing() Function sStrSplitRight(ByVal sHaystack, ByVal sNeedle) 'return right part of sHaystack delimited by the first occurrence of sNeedle (searching from the left) 'if sNeedle is empty or not found, sHaystack is returned 'if sHaystack ends with sNeedle (or is equal to sNeedle), a zero-length string is returned 'sStrSplitRight("1122a1122","11") returns "22a1122" Dim i If bStrIsNothing(sNeedle) Then sStrSplitRight = sHaystack Else i = InStr(1, sHaystack, sNeedle, vbTextCompare) If i = 0 Then sStrSplitRight = sHaystack Else sStrSplitRight = Mid(sHaystack, i + Len(sNeedle)) End If End If End Function 'sStrSplitRight() Function sStrSplitLeft(ByVal sHaystack, ByVal sNeedle) 'return left part of sHaystack delimited by the first occurrence of sNeedle 'if sNeedle is empty or not found, sHaystack is returned 'if sHaystack starts with sNeedle (or is equal to sNeedle), a zero-length string is returned 'sStrSplitLeft(" This is my string ","s is") returns " Thi" Dim i If bStrIsNothing(sNeedle) Then sStrSplitLeft = sHaystack Else i = InStr(1, sHaystack, sNeedle, vbTextCompare) If i = 0 Then sStrSplitLeft = sHaystack Else sStrSplitLeft = Left(sHaystack, i - 1) End If End If End Function 'sStrSplitLeft() Function bCreateSampleNumericDataOriginal() bCreateSampleNumericDataOriginal = False Dim bUIAutoRefreshSet, oGrp, oChn bUIAutoRefreshSet = UIAutoRefreshSet(False) Call Data.Root.Clear() Data.Root.Name = "numeric_" & Str(Now(),"#yyyymmdd") Set oGrp = Data.Root.ChannelGroups.Add("GroupA") Set oChn = oGrp.Channels.Add("Time",DataTypeChnFloat64) oChn.UnitSymbol = "s" Set oChn = oGrp.Channels.Add("Pressure",DataTypeChnFloat64) oChn.UnitSymbol = "bar" Set oChn = oGrp.Channels.Add("Temperature",DataTypeChnFloat64) oChn.UnitSymbol = "K" Set oGrp = Data.Root.ChannelGroups.Add("GroupB") Set oChn = oGrp.Channels.Add("Time",DataTypeChnFloat64) oChn.UnitSymbol = "s" Set oChn = oGrp.Channels.Add("Speed",DataTypeChnFloat64) oChn.UnitSymbol = "1/min" Set oChn = oGrp.Channels.Add("Acceleration",DataTypeChnFloat64) oChn.UnitSymbol = "m/s^2" Set oChn = oGrp.Channels.Add("Torque",DataTypeChnFloat64) oChn.UnitSymbol = "ft-lb" Set oChn = oGrp.Channels.Add("Power",DataTypeChnFloat64) oChn.UnitSymbol = "kW" Call UIAutoRefreshSet(bUIAutoRefreshSet) Call Portal.Refresh() bCreateSampleNumericDataOriginal = True End Function 'bCreateSampleNumericDataOriginal() Function bCreateSampleNumericDataNew() bCreateSampleNumericDataNew = False Dim bUIAutoRefreshSet, oGrp, oChn bUIAutoRefreshSet = UIAutoRefreshSet(False) Call Data.Root.Clear() Data.Root.Name = "numeric_" & Str(Now(),"#yyyymmdd") Set oGrp = Data.Root.ChannelGroups.Add("GroupA") Set oChn = oGrp.Channels.Add("Time",DataTypeChnFloat64) oChn.UnitSymbol = "s" Set oChn = oGrp.Channels.Add("Pressure",DataTypeChnFloat64) oChn.UnitSymbol = "bar" Set oChn = oGrp.Channels.Add("Temp",DataTypeChnFloat64) oChn.UnitSymbol = "K" Set oGrp = Data.Root.ChannelGroups.Add("NewGrpC") Set oChn = oGrp.Channels.Add("Time",DataTypeChnFloat64) oChn.UnitSymbol = "s" Set oChn = oGrp.Channels.Add("Spd",DataTypeChnFloat64) oChn.UnitSymbol = "1/min" Set oChn = oGrp.Channels.Add("Acceleration",DataTypeChnFloat64) oChn.UnitSymbol = "m/s^2" Set oChn = oGrp.Channels.Add("Torque",DataTypeChnFloat64) oChn.UnitSymbol = "ft-lb" Set oChn = oGrp.Channels.Add("Pwr",DataTypeChnFloat64) oChn.UnitSymbol = "kW" Call UIAutoRefreshSet(bUIAutoRefreshSet) Call Portal.Refresh() bCreateSampleNumericDataNew = True End Function 'bCreateSampleNumericDataNew()
A script can run a dialog as modal or non-modal. A modal dialog will cause the script execution to pause until the dialog is closed. A non-modal dialog will allow the script execution to continue and likely finish while the non-modal dialog continues to run.
The construction of the dialog for the most part can be the same when used as a modal or non-modal dialog, although some restrictions do exist. The difference in modal vs non-modal is in the function used to call / run the dialog. The command SUDDlgCreate() will run a non-modal dialog, and the command SudDlgShow() will run a modal dialog.
If you need to pass data to a dialog, or return data from a dialog, then unless you need the special capabilities of a non-modal dialog, the best choice is to run it as a modal dialog. It is possible to pass data in the form of an array for example to a non-modal dialog, but you cannot use the dialog .GetArgument() and .SetArgument() methods available to a modal dialog.
The way you execute a script that calls a non-modal dialog can have a dramatic impact on the performance of the non-modal dialog. If you run a script normally from the script panel, or with ScriptInclude(), then DIAdem will check that every displayed non-modal dialog control is correct for every command executed in the non-modal dialog. This overhead of checking the displayed controls after every dialog command will cause the responsiveness of the dialog to be dramatically slower than if you either 1) run the script that executes the dialog with the ScriptStart() command, or 2) if you run the dialog modally. (ref NI svc req #1200351) In summary, for the best performance, use ScriptStart() to run a non-modal dialog code.
One approach is to put the dialog code that executes high performance tasks into an external script and then call it from the non-modal dialog with the ScriptStart() command. When the ScriptStart() is called, a new VBScript engine instance is launched to execute that script, and the DIAdem user interface is locked until that script is complete. In this way, the update of the dialog controls, and the heavy message traffic that is a part of the update of the controls can be avoided.
Download the .ZIP file dlg_modal_vs_non-modal.zip and extract the .zip file contents to a new folder.
From DIAdem's script panel, load the script named 'modal_dialog_test.VBS' and run it. Note the time it reports that it takes to run the dialog named 'dlg_modal_vs_non-modal.SUD'.
From DIAdem's script panel, load the script named 'non-modal_dialog_test (all code within dialog).VBS' and run it. Note the time it reports that it takes to run the dialog named 'dlg_modal_vs_non-modal.SUD'. It should take about 10x longer to run this dialog as non-modal versus modal. This is because when you click the dialog button, it executes a series of channel data manipulation and analysis commands. When the dialog is run as non-modal, every command execution is followed by an update to the dialog's controls, and this time adds up, slowing down the overall execution. In order to run the dialog as non-modal and achieve the same performance, you need to take the code for the dialog button and run it in an external script called by ScriptStart(). See the next example.
This combination of scripts and dialog is configured to run the dialog as non-modal, but achieve the same channel data manipulation performance as the modal dialog did. From DIAdem's script panel, load the script named 'non-modal_dialog_test (dlg btn code external).VBS'. The time to execute this combination of scripts and dialog (as non-modal dialog) will be the same as the script named 'modal_dialog_test.VBS'. The code for the dialog button that performs the channel data manipulation and analysis is contained within an external script 'dlg_modal_vs_non-modal_btnCodeInScript.VBS'. The dialog 'dlg_modal_vs_non-modal_btnCodeInScript.SUD' calls the external script 'dlg_modal_vs_non-modal_btnCodeInScript.VBS' using the ScriptStart() command. The ScriptStart() command initiates a new instance of the script engine, and the DIAdem user interface is locked until that script is complete. This has the effect of preventing DIAdem from updating every dialog control after each channel data manipulation and analysis command is executed, improving overall script execution performance.
A special thanks to Brad Turpin at National Instruments for acquiring and sharing this solution with me.
Do you need help with your project? Send me an email requesting a free phone / web share consultation.
Copyright © 2021,2022,2023 Mechatronic Solutions LLC, All Rights Reserved