diff --git a/.gitignore b/.gitignore index 855e1ada570..1da612d1fff 100644 --- a/.gitignore +++ b/.gitignore @@ -240,5 +240,13 @@ installer/Output/ /instat/dlgFrequency.resx /instat/dlgFrequency.Designer.vb +# PR #7853 adds a feature to display html in the output window. +# This requires the cef packages. These packages are more than 0.4 GB. +# We want to prevent these packages from being stored in the R-Instat GitHub repository. +/packages/cef.redist.*/ +/packages/CefSharp.Common.*/ +/packages/CefSharp.WinForms.*/ + # Package used by script window /packages/jacobslusser.ScintillaNET.*/ + diff --git a/instat/DlgDefineClimaticData.Designer.vb b/instat/DlgDefineClimaticData.Designer.vb index 51e43bf17a1..ca677ad2038 100644 --- a/instat/DlgDefineClimaticData.Designer.vb +++ b/instat/DlgDefineClimaticData.Designer.vb @@ -39,20 +39,12 @@ Partial Class DlgDefineClimaticData Private Sub InitializeComponent() Me.grpElements = New System.Windows.Forms.GroupBox() - Me.ucrReceiverWindDirection = New instat.ucrReceiverSingle() - Me.ucrReceiverRain = New instat.ucrReceiverSingle() - Me.ucrReceiverSunshine = New instat.ucrReceiverSingle() Me.lblRain = New System.Windows.Forms.Label() - Me.ucrReceiverRadiation = New instat.ucrReceiverSingle() - Me.ucrReceiverMaxTemp = New instat.ucrReceiverSingle() - Me.ucrReceiverCloudCover = New instat.ucrReceiverSingle() Me.lblMaxTemp = New System.Windows.Forms.Label() Me.lblCloudCover = New System.Windows.Forms.Label() Me.lblMinTemp = New System.Windows.Forms.Label() Me.lblRadiation = New System.Windows.Forms.Label() - Me.ucrReceiverWindSpeed = New instat.ucrReceiverSingle() Me.lblSunshine = New System.Windows.Forms.Label() - Me.ucrReceiverMinTemp = New instat.ucrReceiverSingle() Me.lblWindSpeed = New System.Windows.Forms.Label() Me.lblWindDirection = New System.Windows.Forms.Label() Me.lblStationName = New System.Windows.Forms.Label() @@ -62,15 +54,27 @@ Partial Class DlgDefineClimaticData Me.lblYear = New System.Windows.Forms.Label() Me.lblDate = New System.Windows.Forms.Label() Me.grpDateTime = New System.Windows.Forms.GroupBox() + Me.grpStation = New System.Windows.Forms.GroupBox() + Me.cmdCheckUnique = New System.Windows.Forms.Button() + Me.lblMinimumRH = New System.Windows.Forms.Label() + Me.lblMaxRH = New System.Windows.Forms.Label() + Me.ucrInputCheckInput = New instat.ucrInputTextBox() + Me.ucrReceiverStationName = New instat.ucrReceiverSingle() Me.ucrReceiverYear = New instat.ucrReceiverSingle() Me.ucrReceiverDOY = New instat.ucrReceiverSingle() Me.ucrReceiverDate = New instat.ucrReceiverSingle() Me.ucrReceiverMonth = New instat.ucrReceiverSingle() Me.ucrReceiverDay = New instat.ucrReceiverSingle() - Me.grpStation = New System.Windows.Forms.GroupBox() - Me.ucrReceiverStationName = New instat.ucrReceiverSingle() - Me.cmdCheckUnique = New System.Windows.Forms.Button() - Me.ucrInputCheckInput = New instat.ucrInputTextBox() + Me.ucrReceiverMaxRH = New instat.ucrReceiverSingle() + Me.ucrReceiverMinRH = New instat.ucrReceiverSingle() + Me.ucrReceiverWindDirection = New instat.ucrReceiverSingle() + Me.ucrReceiverRain = New instat.ucrReceiverSingle() + Me.ucrReceiverSunshine = New instat.ucrReceiverSingle() + Me.ucrReceiverRadiation = New instat.ucrReceiverSingle() + Me.ucrReceiverMaxTemp = New instat.ucrReceiverSingle() + Me.ucrReceiverCloudCover = New instat.ucrReceiverSingle() + Me.ucrReceiverWindSpeed = New instat.ucrReceiverSingle() + Me.ucrReceiverMinTemp = New instat.ucrReceiverSingle() Me.ucrBase = New instat.ucrButtons() Me.ucrSelectorDefineClimaticData = New instat.ucrSelectorByDataFrameAddRemove() Me.grpElements.SuspendLayout() @@ -80,6 +84,10 @@ Partial Class DlgDefineClimaticData ' 'grpElements ' + Me.grpElements.Controls.Add(Me.ucrReceiverMaxRH) + Me.grpElements.Controls.Add(Me.lblMaxRH) + Me.grpElements.Controls.Add(Me.ucrReceiverMinRH) + Me.grpElements.Controls.Add(Me.lblMinimumRH) Me.grpElements.Controls.Add(Me.ucrReceiverWindDirection) Me.grpElements.Controls.Add(Me.ucrReceiverRain) Me.grpElements.Controls.Add(Me.ucrReceiverSunshine) @@ -96,106 +104,28 @@ Partial Class DlgDefineClimaticData Me.grpElements.Controls.Add(Me.ucrReceiverMinTemp) Me.grpElements.Controls.Add(Me.lblWindSpeed) Me.grpElements.Controls.Add(Me.lblWindDirection) - Me.grpElements.Location = New System.Drawing.Point(306, 71) + Me.grpElements.Location = New System.Drawing.Point(306, 6) Me.grpElements.Name = "grpElements" - Me.grpElements.Size = New System.Drawing.Size(146, 344) + Me.grpElements.Size = New System.Drawing.Size(146, 424) Me.grpElements.TabIndex = 3 Me.grpElements.TabStop = False Me.grpElements.Text = "Elements" ' - 'ucrReceiverWindDirection - ' - Me.ucrReceiverWindDirection.AutoSize = True - Me.ucrReceiverWindDirection.frmParent = Me - Me.ucrReceiverWindDirection.Location = New System.Drawing.Point(16, 197) - Me.ucrReceiverWindDirection.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverWindDirection.Name = "ucrReceiverWindDirection" - Me.ucrReceiverWindDirection.Selector = Nothing - Me.ucrReceiverWindDirection.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverWindDirection.strNcFilePath = "" - Me.ucrReceiverWindDirection.TabIndex = 9 - Me.ucrReceiverWindDirection.ucrSelector = Nothing - ' - 'ucrReceiverRain - ' - Me.ucrReceiverRain.AutoSize = True - Me.ucrReceiverRain.frmParent = Me - Me.ucrReceiverRain.Location = New System.Drawing.Point(16, 33) - Me.ucrReceiverRain.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverRain.Name = "ucrReceiverRain" - Me.ucrReceiverRain.Selector = Nothing - Me.ucrReceiverRain.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverRain.strNcFilePath = "" - Me.ucrReceiverRain.TabIndex = 1 - Me.ucrReceiverRain.ucrSelector = Nothing - ' - 'ucrReceiverSunshine - ' - Me.ucrReceiverSunshine.AutoSize = True - Me.ucrReceiverSunshine.frmParent = Me - Me.ucrReceiverSunshine.Location = New System.Drawing.Point(16, 238) - Me.ucrReceiverSunshine.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverSunshine.Name = "ucrReceiverSunshine" - Me.ucrReceiverSunshine.Selector = Nothing - Me.ucrReceiverSunshine.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverSunshine.strNcFilePath = "" - Me.ucrReceiverSunshine.TabIndex = 11 - Me.ucrReceiverSunshine.ucrSelector = Nothing - ' 'lblRain ' Me.lblRain.AutoSize = True Me.lblRain.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblRain.Location = New System.Drawing.Point(16, 18) + Me.lblRain.Location = New System.Drawing.Point(16, 16) Me.lblRain.Name = "lblRain" Me.lblRain.Size = New System.Drawing.Size(32, 13) Me.lblRain.TabIndex = 0 Me.lblRain.Text = "Rain:" ' - 'ucrReceiverRadiation - ' - Me.ucrReceiverRadiation.AutoSize = True - Me.ucrReceiverRadiation.frmParent = Me - Me.ucrReceiverRadiation.Location = New System.Drawing.Point(16, 279) - Me.ucrReceiverRadiation.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverRadiation.Name = "ucrReceiverRadiation" - Me.ucrReceiverRadiation.Selector = Nothing - Me.ucrReceiverRadiation.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverRadiation.strNcFilePath = "" - Me.ucrReceiverRadiation.TabIndex = 13 - Me.ucrReceiverRadiation.ucrSelector = Nothing - ' - 'ucrReceiverMaxTemp - ' - Me.ucrReceiverMaxTemp.AutoSize = True - Me.ucrReceiverMaxTemp.frmParent = Me - Me.ucrReceiverMaxTemp.Location = New System.Drawing.Point(16, 115) - Me.ucrReceiverMaxTemp.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverMaxTemp.Name = "ucrReceiverMaxTemp" - Me.ucrReceiverMaxTemp.Selector = Nothing - Me.ucrReceiverMaxTemp.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverMaxTemp.strNcFilePath = "" - Me.ucrReceiverMaxTemp.TabIndex = 5 - Me.ucrReceiverMaxTemp.ucrSelector = Nothing - ' - 'ucrReceiverCloudCover - ' - Me.ucrReceiverCloudCover.AutoSize = True - Me.ucrReceiverCloudCover.frmParent = Me - Me.ucrReceiverCloudCover.Location = New System.Drawing.Point(16, 320) - Me.ucrReceiverCloudCover.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverCloudCover.Name = "ucrReceiverCloudCover" - Me.ucrReceiverCloudCover.Selector = Nothing - Me.ucrReceiverCloudCover.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverCloudCover.strNcFilePath = "" - Me.ucrReceiverCloudCover.TabIndex = 15 - Me.ucrReceiverCloudCover.ucrSelector = Nothing - ' 'lblMaxTemp ' Me.lblMaxTemp.AutoSize = True Me.lblMaxTemp.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblMaxTemp.Location = New System.Drawing.Point(16, 100) + Me.lblMaxTemp.Location = New System.Drawing.Point(16, 96) Me.lblMaxTemp.Name = "lblMaxTemp" Me.lblMaxTemp.Size = New System.Drawing.Size(117, 13) Me.lblMaxTemp.TabIndex = 4 @@ -205,7 +135,7 @@ Partial Class DlgDefineClimaticData ' Me.lblCloudCover.AutoSize = True Me.lblCloudCover.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblCloudCover.Location = New System.Drawing.Point(16, 305) + Me.lblCloudCover.Location = New System.Drawing.Point(16, 297) Me.lblCloudCover.Name = "lblCloudCover" Me.lblCloudCover.Size = New System.Drawing.Size(68, 13) Me.lblCloudCover.TabIndex = 14 @@ -215,7 +145,7 @@ Partial Class DlgDefineClimaticData ' Me.lblMinTemp.AutoSize = True Me.lblMinTemp.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblMinTemp.Location = New System.Drawing.Point(16, 59) + Me.lblMinTemp.Location = New System.Drawing.Point(16, 55) Me.lblMinTemp.Name = "lblMinTemp" Me.lblMinTemp.Size = New System.Drawing.Size(111, 13) Me.lblMinTemp.TabIndex = 2 @@ -225,53 +155,27 @@ Partial Class DlgDefineClimaticData ' Me.lblRadiation.AutoSize = True Me.lblRadiation.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblRadiation.Location = New System.Drawing.Point(16, 264) + Me.lblRadiation.Location = New System.Drawing.Point(16, 257) Me.lblRadiation.Name = "lblRadiation" Me.lblRadiation.Size = New System.Drawing.Size(55, 13) Me.lblRadiation.TabIndex = 12 Me.lblRadiation.Text = "Radiation:" ' - 'ucrReceiverWindSpeed - ' - Me.ucrReceiverWindSpeed.AutoSize = True - Me.ucrReceiverWindSpeed.frmParent = Me - Me.ucrReceiverWindSpeed.Location = New System.Drawing.Point(16, 156) - Me.ucrReceiverWindSpeed.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverWindSpeed.Name = "ucrReceiverWindSpeed" - Me.ucrReceiverWindSpeed.Selector = Nothing - Me.ucrReceiverWindSpeed.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverWindSpeed.strNcFilePath = "" - Me.ucrReceiverWindSpeed.TabIndex = 7 - Me.ucrReceiverWindSpeed.ucrSelector = Nothing - ' 'lblSunshine ' Me.lblSunshine.AutoSize = True Me.lblSunshine.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSunshine.Location = New System.Drawing.Point(16, 223) + Me.lblSunshine.Location = New System.Drawing.Point(16, 217) Me.lblSunshine.Name = "lblSunshine" Me.lblSunshine.Size = New System.Drawing.Size(85, 13) Me.lblSunshine.TabIndex = 10 Me.lblSunshine.Text = "Sunshine Hours:" ' - 'ucrReceiverMinTemp - ' - Me.ucrReceiverMinTemp.AutoSize = True - Me.ucrReceiverMinTemp.frmParent = Me - Me.ucrReceiverMinTemp.Location = New System.Drawing.Point(16, 74) - Me.ucrReceiverMinTemp.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverMinTemp.Name = "ucrReceiverMinTemp" - Me.ucrReceiverMinTemp.Selector = Nothing - Me.ucrReceiverMinTemp.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverMinTemp.strNcFilePath = "" - Me.ucrReceiverMinTemp.TabIndex = 3 - Me.ucrReceiverMinTemp.ucrSelector = Nothing - ' 'lblWindSpeed ' Me.lblWindSpeed.AutoSize = True Me.lblWindSpeed.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblWindSpeed.Location = New System.Drawing.Point(16, 141) + Me.lblWindSpeed.Location = New System.Drawing.Point(16, 137) Me.lblWindSpeed.Name = "lblWindSpeed" Me.lblWindSpeed.Size = New System.Drawing.Size(69, 13) Me.lblWindSpeed.TabIndex = 6 @@ -281,7 +185,7 @@ Partial Class DlgDefineClimaticData ' Me.lblWindDirection.AutoSize = True Me.lblWindDirection.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblWindDirection.Location = New System.Drawing.Point(16, 182) + Me.lblWindDirection.Location = New System.Drawing.Point(16, 178) Me.lblWindDirection.Name = "lblWindDirection" Me.lblWindDirection.Size = New System.Drawing.Size(80, 13) Me.lblWindDirection.TabIndex = 8 @@ -291,7 +195,7 @@ Partial Class DlgDefineClimaticData ' Me.lblStationName.AutoSize = True Me.lblStationName.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblStationName.Location = New System.Drawing.Point(7, 22) + Me.lblStationName.Location = New System.Drawing.Point(7, 16) Me.lblStationName.Name = "lblStationName" Me.lblStationName.Size = New System.Drawing.Size(38, 13) Me.lblStationName.TabIndex = 0 @@ -301,7 +205,7 @@ Partial Class DlgDefineClimaticData ' Me.lblDOY.AutoSize = True Me.lblDOY.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblDOY.Location = New System.Drawing.Point(15, 181) + Me.lblDOY.Location = New System.Drawing.Point(15, 180) Me.lblDOY.Name = "lblDOY" Me.lblDOY.Size = New System.Drawing.Size(66, 13) Me.lblDOY.TabIndex = 8 @@ -311,7 +215,7 @@ Partial Class DlgDefineClimaticData ' Me.lblDay.AutoSize = True Me.lblDay.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblDay.Location = New System.Drawing.Point(15, 140) + Me.lblDay.Location = New System.Drawing.Point(15, 139) Me.lblDay.Name = "lblDay" Me.lblDay.Size = New System.Drawing.Size(29, 13) Me.lblDay.TabIndex = 6 @@ -321,7 +225,7 @@ Partial Class DlgDefineClimaticData ' Me.lblMonth.AutoSize = True Me.lblMonth.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblMonth.Location = New System.Drawing.Point(15, 99) + Me.lblMonth.Location = New System.Drawing.Point(15, 98) Me.lblMonth.Name = "lblMonth" Me.lblMonth.Size = New System.Drawing.Size(40, 13) Me.lblMonth.TabIndex = 4 @@ -331,7 +235,7 @@ Partial Class DlgDefineClimaticData ' Me.lblYear.AutoSize = True Me.lblYear.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblYear.Location = New System.Drawing.Point(15, 58) + Me.lblYear.Location = New System.Drawing.Point(15, 57) Me.lblYear.Name = "lblYear" Me.lblYear.Size = New System.Drawing.Size(32, 13) Me.lblYear.TabIndex = 2 @@ -359,19 +263,85 @@ Partial Class DlgDefineClimaticData Me.grpDateTime.Controls.Add(Me.ucrReceiverMonth) Me.grpDateTime.Controls.Add(Me.ucrReceiverDay) Me.grpDateTime.Controls.Add(Me.lblDay) - Me.grpDateTime.Location = New System.Drawing.Point(154, 193) + Me.grpDateTime.Location = New System.Drawing.Point(154, 207) Me.grpDateTime.Name = "grpDateTime" - Me.grpDateTime.Size = New System.Drawing.Size(148, 222) + Me.grpDateTime.Size = New System.Drawing.Size(148, 223) Me.grpDateTime.TabIndex = 2 Me.grpDateTime.TabStop = False Me.grpDateTime.Tag = "" Me.grpDateTime.Text = "Date and Time" ' + 'grpStation + ' + Me.grpStation.Controls.Add(Me.lblStationName) + Me.grpStation.Controls.Add(Me.ucrReceiverStationName) + Me.grpStation.Location = New System.Drawing.Point(13, 208) + Me.grpStation.Name = "grpStation" + Me.grpStation.Size = New System.Drawing.Size(135, 57) + Me.grpStation.TabIndex = 1 + Me.grpStation.TabStop = False + Me.grpStation.Tag = "" + Me.grpStation.Text = "Station" + ' + 'cmdCheckUnique + ' + Me.cmdCheckUnique.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.cmdCheckUnique.Location = New System.Drawing.Point(9, 435) + Me.cmdCheckUnique.Name = "cmdCheckUnique" + Me.cmdCheckUnique.Size = New System.Drawing.Size(139, 23) + Me.cmdCheckUnique.TabIndex = 4 + Me.cmdCheckUnique.Text = "Check Duplicates" + Me.cmdCheckUnique.UseVisualStyleBackColor = True + ' + 'lblMinimumRH + ' + Me.lblMinimumRH.AutoSize = True + Me.lblMinimumRH.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.lblMinimumRH.Location = New System.Drawing.Point(16, 338) + Me.lblMinimumRH.Name = "lblMinimumRH" + Me.lblMinimumRH.Size = New System.Drawing.Size(87, 13) + Me.lblMinimumRH.TabIndex = 16 + Me.lblMinimumRH.Text = "Minimum RH (%):" + ' + 'lblMaxRH + ' + Me.lblMaxRH.AutoSize = True + Me.lblMaxRH.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.lblMaxRH.Location = New System.Drawing.Point(16, 379) + Me.lblMaxRH.Name = "lblMaxRH" + Me.lblMaxRH.Size = New System.Drawing.Size(90, 13) + Me.lblMaxRH.TabIndex = 18 + Me.lblMaxRH.Text = "Maximum RH (%):" + ' + 'ucrInputCheckInput + ' + Me.ucrInputCheckInput.AddQuotesIfUnrecognised = True + Me.ucrInputCheckInput.AutoSize = True + Me.ucrInputCheckInput.IsMultiline = False + Me.ucrInputCheckInput.IsReadOnly = False + Me.ucrInputCheckInput.Location = New System.Drawing.Point(154, 437) + Me.ucrInputCheckInput.Name = "ucrInputCheckInput" + Me.ucrInputCheckInput.Size = New System.Drawing.Size(253, 21) + Me.ucrInputCheckInput.TabIndex = 5 + ' + 'ucrReceiverStationName + ' + Me.ucrReceiverStationName.AutoSize = True + Me.ucrReceiverStationName.frmParent = Nothing + Me.ucrReceiverStationName.Location = New System.Drawing.Point(7, 31) + Me.ucrReceiverStationName.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverStationName.Name = "ucrReceiverStationName" + Me.ucrReceiverStationName.Selector = Nothing + Me.ucrReceiverStationName.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverStationName.strNcFilePath = "" + Me.ucrReceiverStationName.TabIndex = 1 + Me.ucrReceiverStationName.ucrSelector = Nothing + ' 'ucrReceiverYear ' Me.ucrReceiverYear.AutoSize = True - Me.ucrReceiverYear.frmParent = Me - Me.ucrReceiverYear.Location = New System.Drawing.Point(15, 75) + Me.ucrReceiverYear.frmParent = Nothing + Me.ucrReceiverYear.Location = New System.Drawing.Point(15, 72) Me.ucrReceiverYear.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverYear.Name = "ucrReceiverYear" Me.ucrReceiverYear.Selector = Nothing @@ -383,8 +353,8 @@ Partial Class DlgDefineClimaticData 'ucrReceiverDOY ' Me.ucrReceiverDOY.AutoSize = True - Me.ucrReceiverDOY.frmParent = Me - Me.ucrReceiverDOY.Location = New System.Drawing.Point(15, 198) + Me.ucrReceiverDOY.frmParent = Nothing + Me.ucrReceiverDOY.Location = New System.Drawing.Point(15, 195) Me.ucrReceiverDOY.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverDOY.Name = "ucrReceiverDOY" Me.ucrReceiverDOY.Selector = Nothing @@ -396,8 +366,8 @@ Partial Class DlgDefineClimaticData 'ucrReceiverDate ' Me.ucrReceiverDate.AutoSize = True - Me.ucrReceiverDate.frmParent = Me - Me.ucrReceiverDate.Location = New System.Drawing.Point(15, 34) + Me.ucrReceiverDate.frmParent = Nothing + Me.ucrReceiverDate.Location = New System.Drawing.Point(15, 31) Me.ucrReceiverDate.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverDate.Name = "ucrReceiverDate" Me.ucrReceiverDate.Selector = Nothing @@ -409,8 +379,8 @@ Partial Class DlgDefineClimaticData 'ucrReceiverMonth ' Me.ucrReceiverMonth.AutoSize = True - Me.ucrReceiverMonth.frmParent = Me - Me.ucrReceiverMonth.Location = New System.Drawing.Point(15, 116) + Me.ucrReceiverMonth.frmParent = Nothing + Me.ucrReceiverMonth.Location = New System.Drawing.Point(15, 113) Me.ucrReceiverMonth.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverMonth.Name = "ucrReceiverMonth" Me.ucrReceiverMonth.Selector = Nothing @@ -422,8 +392,8 @@ Partial Class DlgDefineClimaticData 'ucrReceiverDay ' Me.ucrReceiverDay.AutoSize = True - Me.ucrReceiverDay.frmParent = Me - Me.ucrReceiverDay.Location = New System.Drawing.Point(15, 157) + Me.ucrReceiverDay.frmParent = Nothing + Me.ucrReceiverDay.Location = New System.Drawing.Point(15, 154) Me.ucrReceiverDay.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverDay.Name = "ucrReceiverDay" Me.ucrReceiverDay.Selector = Nothing @@ -432,57 +402,141 @@ Partial Class DlgDefineClimaticData Me.ucrReceiverDay.TabIndex = 7 Me.ucrReceiverDay.ucrSelector = Nothing ' - 'grpStation + 'ucrReceiverMaxRH + ' + Me.ucrReceiverMaxRH.AutoSize = True + Me.ucrReceiverMaxRH.frmParent = Nothing + Me.ucrReceiverMaxRH.Location = New System.Drawing.Point(16, 395) + Me.ucrReceiverMaxRH.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMaxRH.Name = "ucrReceiverMaxRH" + Me.ucrReceiverMaxRH.Selector = Nothing + Me.ucrReceiverMaxRH.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverMaxRH.strNcFilePath = "" + Me.ucrReceiverMaxRH.TabIndex = 19 + Me.ucrReceiverMaxRH.ucrSelector = Nothing + ' + 'ucrReceiverMinRH + ' + Me.ucrReceiverMinRH.AutoSize = True + Me.ucrReceiverMinRH.frmParent = Nothing + Me.ucrReceiverMinRH.Location = New System.Drawing.Point(16, 354) + Me.ucrReceiverMinRH.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMinRH.Name = "ucrReceiverMinRH" + Me.ucrReceiverMinRH.Selector = Nothing + Me.ucrReceiverMinRH.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverMinRH.strNcFilePath = "" + Me.ucrReceiverMinRH.TabIndex = 17 + Me.ucrReceiverMinRH.ucrSelector = Nothing ' - Me.grpStation.Controls.Add(Me.lblStationName) - Me.grpStation.Controls.Add(Me.ucrReceiverStationName) - Me.grpStation.Location = New System.Drawing.Point(13, 193) - Me.grpStation.Name = "grpStation" - Me.grpStation.Size = New System.Drawing.Size(135, 61) - Me.grpStation.TabIndex = 1 - Me.grpStation.TabStop = False - Me.grpStation.Tag = "" - Me.grpStation.Text = "Station" + 'ucrReceiverWindDirection ' - 'ucrReceiverStationName + Me.ucrReceiverWindDirection.AutoSize = True + Me.ucrReceiverWindDirection.frmParent = Nothing + Me.ucrReceiverWindDirection.Location = New System.Drawing.Point(16, 193) + Me.ucrReceiverWindDirection.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverWindDirection.Name = "ucrReceiverWindDirection" + Me.ucrReceiverWindDirection.Selector = Nothing + Me.ucrReceiverWindDirection.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverWindDirection.strNcFilePath = "" + Me.ucrReceiverWindDirection.TabIndex = 9 + Me.ucrReceiverWindDirection.ucrSelector = Nothing ' - Me.ucrReceiverStationName.AutoSize = True - Me.ucrReceiverStationName.frmParent = Me - Me.ucrReceiverStationName.Location = New System.Drawing.Point(7, 37) - Me.ucrReceiverStationName.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverStationName.Name = "ucrReceiverStationName" - Me.ucrReceiverStationName.Selector = Nothing - Me.ucrReceiverStationName.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverStationName.strNcFilePath = "" - Me.ucrReceiverStationName.TabIndex = 1 - Me.ucrReceiverStationName.ucrSelector = Nothing + 'ucrReceiverRain ' - 'cmdCheckUnique + Me.ucrReceiverRain.AutoSize = True + Me.ucrReceiverRain.frmParent = Nothing + Me.ucrReceiverRain.Location = New System.Drawing.Point(16, 31) + Me.ucrReceiverRain.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverRain.Name = "ucrReceiverRain" + Me.ucrReceiverRain.Selector = Nothing + Me.ucrReceiverRain.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverRain.strNcFilePath = "" + Me.ucrReceiverRain.TabIndex = 1 + Me.ucrReceiverRain.ucrSelector = Nothing ' - Me.cmdCheckUnique.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.cmdCheckUnique.Location = New System.Drawing.Point(9, 423) - Me.cmdCheckUnique.Name = "cmdCheckUnique" - Me.cmdCheckUnique.Size = New System.Drawing.Size(139, 23) - Me.cmdCheckUnique.TabIndex = 4 - Me.cmdCheckUnique.Text = "Check Duplicates" - Me.cmdCheckUnique.UseVisualStyleBackColor = True + 'ucrReceiverSunshine ' - 'ucrInputCheckInput + Me.ucrReceiverSunshine.AutoSize = True + Me.ucrReceiverSunshine.frmParent = Nothing + Me.ucrReceiverSunshine.Location = New System.Drawing.Point(16, 231) + Me.ucrReceiverSunshine.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverSunshine.Name = "ucrReceiverSunshine" + Me.ucrReceiverSunshine.Selector = Nothing + Me.ucrReceiverSunshine.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverSunshine.strNcFilePath = "" + Me.ucrReceiverSunshine.TabIndex = 11 + Me.ucrReceiverSunshine.ucrSelector = Nothing ' - Me.ucrInputCheckInput.AddQuotesIfUnrecognised = True - Me.ucrInputCheckInput.AutoSize = True - Me.ucrInputCheckInput.IsMultiline = False - Me.ucrInputCheckInput.IsReadOnly = False - Me.ucrInputCheckInput.Location = New System.Drawing.Point(154, 425) - Me.ucrInputCheckInput.Name = "ucrInputCheckInput" - Me.ucrInputCheckInput.Size = New System.Drawing.Size(253, 21) - Me.ucrInputCheckInput.TabIndex = 5 + 'ucrReceiverRadiation + ' + Me.ucrReceiverRadiation.AutoSize = True + Me.ucrReceiverRadiation.frmParent = Nothing + Me.ucrReceiverRadiation.Location = New System.Drawing.Point(16, 272) + Me.ucrReceiverRadiation.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverRadiation.Name = "ucrReceiverRadiation" + Me.ucrReceiverRadiation.Selector = Nothing + Me.ucrReceiverRadiation.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverRadiation.strNcFilePath = "" + Me.ucrReceiverRadiation.TabIndex = 13 + Me.ucrReceiverRadiation.ucrSelector = Nothing + ' + 'ucrReceiverMaxTemp + ' + Me.ucrReceiverMaxTemp.AutoSize = True + Me.ucrReceiverMaxTemp.frmParent = Nothing + Me.ucrReceiverMaxTemp.Location = New System.Drawing.Point(16, 111) + Me.ucrReceiverMaxTemp.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMaxTemp.Name = "ucrReceiverMaxTemp" + Me.ucrReceiverMaxTemp.Selector = Nothing + Me.ucrReceiverMaxTemp.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverMaxTemp.strNcFilePath = "" + Me.ucrReceiverMaxTemp.TabIndex = 5 + Me.ucrReceiverMaxTemp.ucrSelector = Nothing + ' + 'ucrReceiverCloudCover + ' + Me.ucrReceiverCloudCover.AutoSize = True + Me.ucrReceiverCloudCover.frmParent = Nothing + Me.ucrReceiverCloudCover.Location = New System.Drawing.Point(16, 313) + Me.ucrReceiverCloudCover.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverCloudCover.Name = "ucrReceiverCloudCover" + Me.ucrReceiverCloudCover.Selector = Nothing + Me.ucrReceiverCloudCover.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverCloudCover.strNcFilePath = "" + Me.ucrReceiverCloudCover.TabIndex = 15 + Me.ucrReceiverCloudCover.ucrSelector = Nothing + ' + 'ucrReceiverWindSpeed + ' + Me.ucrReceiverWindSpeed.AutoSize = True + Me.ucrReceiverWindSpeed.frmParent = Nothing + Me.ucrReceiverWindSpeed.Location = New System.Drawing.Point(16, 152) + Me.ucrReceiverWindSpeed.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverWindSpeed.Name = "ucrReceiverWindSpeed" + Me.ucrReceiverWindSpeed.Selector = Nothing + Me.ucrReceiverWindSpeed.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverWindSpeed.strNcFilePath = "" + Me.ucrReceiverWindSpeed.TabIndex = 7 + Me.ucrReceiverWindSpeed.ucrSelector = Nothing + ' + 'ucrReceiverMinTemp + ' + Me.ucrReceiverMinTemp.AutoSize = True + Me.ucrReceiverMinTemp.frmParent = Nothing + Me.ucrReceiverMinTemp.Location = New System.Drawing.Point(16, 70) + Me.ucrReceiverMinTemp.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMinTemp.Name = "ucrReceiverMinTemp" + Me.ucrReceiverMinTemp.Selector = Nothing + Me.ucrReceiverMinTemp.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverMinTemp.strNcFilePath = "" + Me.ucrReceiverMinTemp.TabIndex = 3 + Me.ucrReceiverMinTemp.ucrSelector = Nothing ' 'ucrBase ' Me.ucrBase.AutoSize = True Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(13, 452) + Me.ucrBase.Location = New System.Drawing.Point(13, 464) Me.ucrBase.Name = "ucrBase" Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 6 @@ -493,7 +547,7 @@ Partial Class DlgDefineClimaticData Me.ucrSelectorDefineClimaticData.bDropUnusedFilterLevels = False Me.ucrSelectorDefineClimaticData.bShowHiddenColumns = False Me.ucrSelectorDefineClimaticData.bUseCurrentFilter = True - Me.ucrSelectorDefineClimaticData.Location = New System.Drawing.Point(13, 2) + Me.ucrSelectorDefineClimaticData.Location = New System.Drawing.Point(13, 14) Me.ucrSelectorDefineClimaticData.Margin = New System.Windows.Forms.Padding(0) Me.ucrSelectorDefineClimaticData.Name = "ucrSelectorDefineClimaticData" Me.ucrSelectorDefineClimaticData.Size = New System.Drawing.Size(213, 183) @@ -504,7 +558,7 @@ Partial Class DlgDefineClimaticData Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True - Me.ClientSize = New System.Drawing.Size(464, 510) + Me.ClientSize = New System.Drawing.Size(464, 522) Me.Controls.Add(Me.ucrInputCheckInput) Me.Controls.Add(Me.cmdCheckUnique) Me.Controls.Add(Me.grpStation) @@ -564,4 +618,8 @@ Partial Class DlgDefineClimaticData Friend WithEvents grpStation As GroupBox Friend WithEvents ucrInputCheckInput As ucrInputTextBox Friend WithEvents cmdCheckUnique As Button + Friend WithEvents ucrReceiverMinRH As ucrReceiverSingle + Friend WithEvents lblMinimumRH As Label + Friend WithEvents ucrReceiverMaxRH As ucrReceiverSingle + Friend WithEvents lblMaxRH As Label End Class diff --git a/instat/DlgDefineClimaticData.vb b/instat/DlgDefineClimaticData.vb index d26e669169f..d49f5e88bef 100644 --- a/instat/DlgDefineClimaticData.vb +++ b/instat/DlgDefineClimaticData.vb @@ -49,19 +49,25 @@ Public Class DlgDefineClimaticData Dim kvpDate As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("date", {"date", "record"}.ToList()) Dim kvpStation As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("station", {"station", "id", "name"}.ToList()) Dim kvpCloudCover As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("cloud_cover", {"cloud"}.ToList()) - Dim kvpTempMax As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("temp_max", {"tmax", "tx", "max", "tempmax"}.ToList()) - Dim kvpTempMin As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("temp_min", {"tmin", "tn", "min", "tempmin"}.ToList()) + Dim kvpTempMax As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("temp_max", {"tmax", "tx", "tempmax", "tmp_max"}.ToList()) + Dim kvpTempMin As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("temp_min", {"tmin", "tn", "tempmin", "tmp_min"}.ToList()) Dim kvpRadiation As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("radiation", {"radiation", "rad"}.ToList()) - Dim kvpSunshineHours As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("sunshine_hours", {"sunshine", "sunh"}.ToList()) + Dim kvpSunshineHours As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("sunshine_hours", {"sunshine", "sunh", "sunhrs"}.ToList()) Dim kvpWindDirection As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("wind_direction", {"winddirection"}.ToList()) Dim kvpWindSpeed As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("wind_speed", {"windspeed"}.ToList()) Dim kvpYear As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("year", {"year"}.ToList()) Dim kvpMonth As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("month", {"month"}.ToList()) Dim kvpDay As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("day", {"day"}.ToList()) Dim kvpDOY As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("doy", {"doy", "doy_366"}.ToList()) + Dim kvpMinRH As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("hum_min", {"minhum", "hmin", "hn"}.ToList()) + Dim kvpMaxRH As KeyValuePair(Of String, List(Of String)) = New KeyValuePair(Of String, List(Of String))("hum_max", {"maxhum", "hmax", "hx"}.ToList()) - lstRecognisedTypes.AddRange({kvpRain, kvpStation, kvpCloudCover, kvpTempMax, kvpTempMin, kvpRadiation, kvpSunshineHours, kvpWindDirection, kvpWindSpeed, kvpYear, kvpMonth, kvpDay, kvpDOY, kvpDate}) - lstReceivers.AddRange({ucrReceiverCloudCover, ucrReceiverDay, ucrReceiverMaxTemp, ucrReceiverMinTemp, ucrReceiverMonth, ucrReceiverRadiation, ucrReceiverRain, ucrReceiverStationName, ucrReceiverSunshine, ucrReceiverWindDirection, ucrReceiverWindSpeed, ucrReceiverYear, ucrReceiverDOY, ucrReceiverDate}) + + lstRecognisedTypes.AddRange({kvpRain, kvpStation, kvpCloudCover, kvpTempMax, kvpTempMin, kvpRadiation, kvpSunshineHours, + kvpWindDirection, kvpWindSpeed, kvpYear, kvpMonth, kvpDay, kvpDOY, kvpDate, kvpMinRH, kvpMaxRH}) + lstReceivers.AddRange({ucrReceiverCloudCover, ucrReceiverDay, ucrReceiverMaxTemp, ucrReceiverMinTemp, ucrReceiverMonth, ucrReceiverRadiation, + ucrReceiverRain, ucrReceiverStationName, ucrReceiverSunshine, ucrReceiverWindDirection, ucrReceiverWindSpeed, + ucrReceiverYear, ucrReceiverDOY, ucrReceiverDate, ucrReceiverMinRH, ucrReceiverMaxRH}) ucrSelectorDefineClimaticData.SetParameter(New RParameter("data_name", 0)) ucrSelectorDefineClimaticData.SetParameterIsString() @@ -79,6 +85,8 @@ Public Class DlgDefineClimaticData ucrReceiverMonth.Tag = "month" ucrReceiverDay.Tag = "day" ucrReceiverDOY.Tag = "doy" + ucrReceiverMinRH.Tag = "hum_min" + ucrReceiverMaxRH.Tag = "hum_max" ucrInputCheckInput.IsReadOnly = True ucrReceiverDate.SetIncludedDataTypes({"Date"}) @@ -204,16 +212,16 @@ Public Class DlgDefineClimaticData Private Sub cmdCheckUnique_Click(sender As Object, e As EventArgs) Handles cmdCheckUnique.Click Dim iAnyDuplicated As Integer - Try - iAnyDuplicated = frmMain.clsRLink.RunInternalScriptGetValue(clsAnyDuplicatesFunction.ToScript()).AsInteger(0) - Catch ex As Exception - iAnyDuplicated = -1 + Try + iAnyDuplicated = frmMain.clsRLink.RunInternalScriptGetValue(clsAnyDuplicatesFunction.ToScript()).AsInteger(0) + Catch ex As Exception + iAnyDuplicated = -1 End Try - If iAnyDuplicated = -1 Then - ucrInputCheckInput.SetName("Developer error! Could not check uniqueness.") + If iAnyDuplicated = -1 Then + ucrInputCheckInput.SetName("Developer error! Could not check uniqueness.") ucrInputCheckInput.txtInput.BackColor = Color.Yellow - bIsUnique = False + bIsUnique = False ElseIf iAnyDuplicated > 0 Then ucrInputCheckInput.SetName("") ucrInputCheckInput.txtInput.BackColor = Color.LightCoral @@ -226,18 +234,18 @@ Public Class DlgDefineClimaticData MsgBox("You have multiple rows with the same dates for one or more stations. Use the Climatic > Tidy and Examine > Duplicates dialog to investigate these issues.", MsgBoxStyle.Information, Title:="Duplicates") End If Else - ucrInputCheckInput.SetName("No duplicate dates.") + ucrInputCheckInput.SetName("No duplicate dates.") ucrInputCheckInput.txtInput.BackColor = Color.LightGreen - bIsUnique = True + bIsUnique = True End If TestOKEnabled() End Sub Private Sub EnableDisableCheckUniqueBtn() - If ucrReceiverDate.IsEmpty Then - cmdCheckUnique.Enabled = False - Else - cmdCheckUnique.Enabled = True + If ucrReceiverDate.IsEmpty Then + cmdCheckUnique.Enabled = False + Else + cmdCheckUnique.Enabled = True End If ucrInputCheckInput.SetName("") ucrInputCheckInput.txtInput.BackColor = SystemColors.Window diff --git a/instat/Enum/OutputType.vb b/instat/Enum/OutputType.vb index bb68b2c3b9d..f362d168b44 100644 --- a/instat/Enum/OutputType.vb +++ b/instat/Enum/OutputType.vb @@ -1,6 +1,8 @@ - -Public Enum OutputType +Public Enum OutputType Script = 1 TextOutput = 2 ImageOutput = 4 -End Enum + HtmlOutput = 8 + 'the other reserved numbers are for for bitwise operations + 'todo. add the attribute? +End Enum \ No newline at end of file diff --git a/instat/Enum/RObjectFormat.vb b/instat/Enum/RObjectFormat.vb new file mode 100644 index 00000000000..20c73c16cbc --- /dev/null +++ b/instat/Enum/RObjectFormat.vb @@ -0,0 +1,12 @@ +''' +''' represents display formats for R objects that are internally supported by R-Instat +''' at both R and .Net level +''' +Public Structure RObjectFormat + '------------------- + 'note an Enum would have been ideal, but VB.Net does not support String Enums + '------------------ + Public Const Image As String = "image" + Public Const Text As String = "text" 'e.g objects of type "table" + Public Const Html As String = "html" 'e.g objects of type "htmlwidget", "sjTable", "gt_tbl" +End Structure \ No newline at end of file diff --git a/instat/Enum/RObjectTypeLabel.vb b/instat/Enum/RObjectTypeLabel.vb new file mode 100644 index 00000000000..4b187786b15 --- /dev/null +++ b/instat/Enum/RObjectTypeLabel.vb @@ -0,0 +1,17 @@ +''' +''' Represents R object types that are internally supported by R-Instat +''' at both R and .Net level. +''' They correspond to the object labels at R level +''' +Public Structure RObjectTypeLabel + '------------------- + 'note an Enum would have been ideal, but VB.Net does not support String Enums + '------------------ + Public Const Dataframe As String = "dataframe" + Public Const Column As String = "column" + Public Const Graph As String = "graph" + Public Const Table As String = "table" + Public Const Model As String = "model" + Public Const StructureLabel As String = "structure" ' e.g Survival objects + Public Const Summary As String = "summary" ' e.g objects of text formats +End Structure \ No newline at end of file diff --git a/instat/Model/Output/clsOutputElement.vb b/instat/Model/Output/clsOutputElement.vb index 098f881d24f..c182d21128a 100644 --- a/instat/Model/Output/clsOutputElement.vb +++ b/instat/Model/Output/clsOutputElement.vb @@ -13,36 +13,37 @@ ' ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . - Imports RScript - ''' ''' Output element for a r command, the output element could be just the script or the script with ''' an image or output text ''' Public Class clsOutputElement - Private _formattedRScript As List(Of clsRScriptElement) Private _id As Integer - Private _lstBmpImage As List(Of Bitmap) - Private _lstStringOutput As List(Of String) + 'hold the script elements that form the R script that produced the output + Private _lstRScriptElements As New List(Of clsRScriptElement) + Private _outputType As OutputType - ''' - ''' Constructor - ''' - Public Sub New() - _formattedRScript = New List(Of clsRScriptElement) - _lstStringOutput = New List(Of String) - _lstBmpImage = New List(Of Bitmap) - End Sub + 'todo. deprecate this list with _lstTextOutput ? + Private _lstStringOutput As New List(Of String) + + 'holds the file paths to the text outputs + Private _lstTextOutput As New List(Of String) + + 'holds the file paths to the image outputs + Private _lstImageOutput As New List(Of String) + + 'holds the file paths to the html outputs + Private _lstHtmlOutput As New List(Of String) ''' ''' Holds formated R Script, split into R Script Elements ''' ''' - Public ReadOnly Property FormatedRScript As List(Of clsRScriptElement) + Public ReadOnly Property FormattedRScript As List(Of clsRScriptElement) Get - Return _formattedRScript + Return _lstRScriptElements End Get End Property @@ -59,13 +60,25 @@ Public Class clsOutputElement End Set End Property + Public ReadOnly Property TextOutput As String + Get + Return _lstTextOutput.FirstOrDefault() + End Get + End Property + ''' - ''' Holds image if outputType is image + ''' Holds image file path if outputType is image file ''' ''' - Public ReadOnly Property ImageOutput As Bitmap + Public ReadOnly Property ImageOutput As String + Get + Return _lstImageOutput.FirstOrDefault() + End Get + End Property + + Public ReadOnly Property HtmlOutput As String Get - Return _lstBmpImage.FirstOrDefault() + Return _lstHtmlOutput.FirstOrDefault() End Get End Property @@ -89,20 +102,35 @@ Public Class clsOutputElement End Get End Property + 'this does a shallow clone + 'todo. add a deep clone implementation Public Function Clone() As clsOutputElement Return Me.MemberwiseClone End Function + Public Sub AddTextOutput(strFileName As String, script As List(Of clsRScriptElement)) + _lstTextOutput.Add(strFileName) + _lstRScriptElements = script + _outputType = OutputType.TextOutput + End Sub + ''' ''' When adding Output the script must always be added too ''' - ''' - Public Sub AddImageOutputFromR(image As Bitmap, script As List(Of clsRScriptElement)) - _lstBmpImage.Add(image) - _formattedRScript = script + ''' + ''' + Public Sub AddImageOutput(strFileName As String, script As List(Of clsRScriptElement)) + _lstImageOutput.Add(strFileName) + _lstRScriptElements = script _outputType = OutputType.ImageOutput End Sub + Public Sub AddHtmlOutput(strFileName As String, script As List(Of clsRScriptElement)) + _lstHtmlOutput.Add(strFileName) + _lstRScriptElements = script + _outputType = OutputType.HtmlOutput + End Sub + ''' ''' Adds script and passes through RScript to split into elements ''' @@ -111,10 +139,9 @@ Public Class clsOutputElement Try Dim rScript As New clsRScript(strScript) Dim lstTokens As List(Of clsRToken) = rScript.GetLstTokens(rScript.GetLstLexemes(strScript)) 'rScript.lstTokens - If lstTokens IsNot Nothing Then For Each rToken In lstTokens - _formattedRScript.Add(New clsRScriptElement With + _lstRScriptElements.Add(New clsRScriptElement With { .Text = rToken.strTxt, .Type = rToken.enuToken @@ -135,9 +162,9 @@ Public Class clsOutputElement ''' When adding Output the script must always be added too ''' ''' - Public Sub AddStringOutputFromR(strOutput As String, script As List(Of clsRScriptElement)) + Public Sub AddStringOutput(strOutput As String, script As List(Of clsRScriptElement)) _lstStringOutput.Add(strOutput) - _formattedRScript = script + _lstRScriptElements = script _outputType = OutputType.TextOutput End Sub diff --git a/instat/Model/Output/clsOutputLogger.vb b/instat/Model/Output/clsOutputLogger.vb index ce018f48496..a303773f9eb 100644 --- a/instat/Model/Output/clsOutputLogger.vb +++ b/instat/Model/Output/clsOutputLogger.vb @@ -13,7 +13,7 @@ ' ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . - +Imports System.IO ''' ''' Logging class to hold all scripts and outputs ran. ''' Holds multiple lists of outputs @@ -22,6 +22,7 @@ Public Class clsOutputLogger Private _filteredOutputs As List(Of clsOutputList) Private _lastScriptElement As clsOutputElement Private _output As List(Of clsOutputElement) + ''Output not used externally at the moment but will this will need to ''change if we are to remove from the output list. Public ReadOnly Property Output As List(Of clsOutputElement) @@ -69,25 +70,86 @@ Public Class clsOutputLogger _filteredOutputs = value End Set End Property + + Public Sub AddFileOutput(strFileName As String) + Dim strFileExtension As String = Path.GetExtension(strFileName).ToLower + Select Case strFileExtension + Case ".png" + AddImageOutput(strFileName) + Case ".html" + AddHtmlOutput(strFileName) + Case ".txt" + AddTextOutput(strFileName) + Case Else + MessageBox.Show("The file type to be added is currently not suported", + "Developer Error", + MessageBoxButtons.OK, + MessageBoxIcon.Error) + End Select + End Sub + + ''' + ''' Adds string output to be displayed within the output + ''' + ''' + Public Sub AddStringOutput(strOutput As String) + 'Note this is always takes the last script added as corresponding script + If _lastScriptElement Is Nothing Then + Throw New Exception("Cannot find script to attach output to.") + Else + Dim outputElement As New clsOutputElement + outputElement.AddStringOutput(strOutput, _lastScriptElement.FormattedRScript) + _output.Add(outputElement) + RaiseEvent NewOutputAdded(outputElement) + End If + End Sub + + ''' + ''' Adds text file to be displayed within the output + ''' + ''' + Public Sub AddTextOutput(strFilename As String) + 'Note this always takes the last script added as corresponding script + If _lastScriptElement Is Nothing Then + Throw New Exception("Cannot find script to attach output to.") + Else + Dim outputElement As New clsOutputElement + outputElement.AddTextOutput(strFilename, _lastScriptElement.FormattedRScript) + _output.Add(outputElement) + RaiseEvent NewOutputAdded(outputElement) + End If + End Sub + ''' - ''' Adds image to be displayed within the output + ''' Adds image file to be displayed within the output ''' ''' Public Sub AddImageOutput(strFilename As String) - Dim image As Bitmap - 'Note this is always takes the last script added as corresponding script + 'Note this always takes the last script added as corresponding script If _lastScriptElement Is Nothing Then Throw New Exception("Cannot find script to attach output to.") Else - Using fs As New IO.FileStream(strFilename, IO.FileMode.Open) - image = New Bitmap(Drawing.Image.FromStream(fs)) - End Using Dim outputElement As New clsOutputElement - outputElement.AddImageOutputFromR(image, _lastScriptElement.FormatedRScript) + outputElement.AddImageOutput(strFilename, _lastScriptElement.FormattedRScript) _output.Add(outputElement) RaiseEvent NewOutputAdded(outputElement) End If + End Sub + ''' + ''' Adds html output to be displayed within the output + ''' + ''' + Public Sub AddHtmlOutput(strFilename As String) + 'Note this always takes the last script added as corresponding script + If _lastScriptElement Is Nothing Then + Throw New Exception("Cannot find script to attach output to.") + Else + Dim outputElement As New clsOutputElement + outputElement.AddHtmlOutput(strFilename, _lastScriptElement.FormattedRScript) + _output.Add(outputElement) + RaiseEvent NewOutputAdded(outputElement) + End If End Sub ''' @@ -116,22 +178,6 @@ Public Class clsOutputLogger RaiseEvent NewOutputAdded(_lastScriptElement) End Sub - ''' - ''' Adds text output to be displayed within the output - ''' - ''' - Public Sub AddStringOutput(strOutput As String) - 'Note this is always takes the last script added as corresponding script - If _lastScriptElement Is Nothing Then - Throw New Exception("Cannot find script to attach output to.") - Else - Dim outputElement As New clsOutputElement - outputElement.AddStringOutputFromR(strOutput, _lastScriptElement.FormatedRScript) - _output.Add(outputElement) - RaiseEvent NewOutputAdded(outputElement) - End If - End Sub - ''' ''' Deletes output from a filtered list ''' @@ -184,4 +230,5 @@ Public Class clsOutputLogger End If Return True End Function + End Class \ No newline at end of file diff --git a/instat/UserControl/ucrOutputPage.vb b/instat/UserControl/ucrOutputPage.vb index f8ff320d6f0..5972b2b9fba 100644 --- a/instat/UserControl/ucrOutputPage.vb +++ b/instat/UserControl/ucrOutputPage.vb @@ -11,7 +11,7 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . Imports System.Runtime.InteropServices @@ -23,6 +23,7 @@ Public Class ucrOutputPage Private _bCanReOrder As Boolean Private _bCanRename As Boolean Private _bCanDelete As Boolean + Private _clsInstatOptions As InstatOptions ''' ''' Returns all the selected elements @@ -79,6 +80,8 @@ Public Class ucrOutputPage End Set End Property + + Public Event RefreshContextButtons() Public Sub New() @@ -90,6 +93,17 @@ Public Class ucrOutputPage _checkBoxes = New List(Of CheckBox) End Sub + + ''' + ''' Holds options. + ''' TODO InstatOptions should have bindable objects as it's options + ''' + Public WriteOnly Property clsInstatOptions() As InstatOptions + Set(value As InstatOptions) + _clsInstatOptions = value + End Set + End Property + ''' ''' Clears all check boxes on the page ''' @@ -121,6 +135,8 @@ Public Class ucrOutputPage AddNewTextOutput(outputElement) Case OutputType.ImageOutput AddNewImageOutput(outputElement) + Case OutputType.HtmlOutput + AddNewHtmlOutput(outputElement) End Select pnlMain.VerticalScroll.Value = pnlMain.VerticalScroll.Maximum pnlMain.PerformLayout() @@ -155,15 +171,22 @@ Public Class ucrOutputPage End Sub Private Function AddElementPanel(outputElement As clsOutputElement) As Panel - If outputElement Is Nothing OrElse outputElement.FormatedRScript Is Nothing Then + If outputElement Is Nothing OrElse outputElement.FormattedRScript Is Nothing Then Return Nothing End If Dim panel As New Panel With { - .Height = 10, ' = 10 'small height as panel will grow - .AutoSize = True, - .Dock = DockStyle.Top + .Dock = DockStyle.Top, + .Height = 10, + .AutoSize = True } + + 'if maximum height of outputs provided provided set it as the maximum height of panel + If frmMain.clsInstatOptions IsNot Nothing AndAlso Not frmMain.clsInstatOptions.iMaxOutputsHeight <= 0 Then + panel.MaximumSize = New Size(Integer.MaxValue, + frmMain.clsInstatOptions.iMaxOutputsHeight) + panel.AutoScroll = True + End If pnlMain.Controls.Add(panel) pnlMain.Controls.SetChildIndex(panel, 0) AddCheckBoxToElementPanel(panel, outputElement) @@ -173,11 +196,11 @@ Public Class ucrOutputPage Private Sub AddCheckBoxToElementPanel(panel As Panel, outputElement As clsOutputElement) Dim checkBox As New CheckBox With { - .Text = "", - .CheckAlign = ContentAlignment.TopLeft, - .Dock = DockStyle.Left, - .AutoSize = True, - .Tag = outputElement + .Text = "", + .CheckAlign = ContentAlignment.TopLeft, + .Dock = DockStyle.Left, + .AutoSize = True, + .Tag = outputElement } panel.Controls.Add(checkBox) _checkBoxes.Add(checkBox) @@ -187,10 +210,10 @@ Public Class ucrOutputPage Private Sub AddNewScript(outputElement As clsOutputElement) Dim richTextBox As New RichTextBox With { - .Dock = DockStyle.Top, - .BorderStyle = BorderStyle.None + .Dock = DockStyle.Top, + .BorderStyle = BorderStyle.None } - FillRichTextBoxWithFormatedRScript(richTextBox, outputElement.FormatedRScript) + FillRichTextBoxWithFormatedRScript(richTextBox, outputElement.FormattedRScript) Dim panel As Panel = AddElementPanel(outputElement) panel.Controls.Add(richTextBox) panel.Controls.SetChildIndex(richTextBox, 0) @@ -203,7 +226,7 @@ Public Class ucrOutputPage If SelectedElements.Count = 1 AndAlso SelectedElements(0).OutputType = OutputType.ImageOutput Then Dim element As clsOutputElement = SelectedElements(0) Clipboard.Clear() - Clipboard.SetImage(element.ImageOutput) + Clipboard.SetImage(GetBitmapFromFile(element.ImageOutput)) Return True End If Return False @@ -212,18 +235,27 @@ Public Class ucrOutputPage Private Sub AddElementToRichTextBox(element As clsOutputElement, richText As RichTextBox) Select Case element.OutputType Case OutputType.Script - FillRichTextBoxWithFormatedRScript(richText, element.FormatedRScript) + FillRichTextBoxWithFormatedRScript(richText, element.FormattedRScript) Case OutputType.TextOutput AddFormatedTextToRichTextBox(richText, element.StringOutput, OutputFont.ROutputFont, OutputFont.ROutputColour) Case OutputType.ImageOutput Clipboard.Clear() - Clipboard.SetImage(element.ImageOutput) + 'todo. instead of copy paste, add image to rtf directly from file? + Clipboard.SetImage(GetBitmapFromFile(element.ImageOutput)) richText.Paste() End Select richText.AppendText(Environment.NewLine) richText.AppendText(Environment.NewLine) End Sub + Private Function GetBitmapFromFile(strFilename As String) As Bitmap + Dim image As Bitmap + Using fs As New IO.FileStream(strFilename, IO.FileMode.Open) + image = New Bitmap(Drawing.Image.FromStream(fs)) + End Using + Return image + End Function + Private Sub AddFormatedTextToRichTextBox(richTextBox As RichTextBox, text As String, font As Font, colour As Color) Dim intStartSelection As Integer = richTextBox.Text.Length richTextBox.AppendText(text) @@ -248,28 +280,108 @@ Public Class ucrOutputPage End Sub Private Sub AddNewTextOutput(outputElement As clsOutputElement) - Dim richTextBox As New RichTextBox With { - .Dock = DockStyle.Top, - .BorderStyle = BorderStyle.None - } - AddFormatedTextToRichTextBox(richTextBox, outputElement.StringOutput, OutputFont.ROutputFont, OutputFont.ROutputColour) Dim panel As Panel = AddElementPanel(outputElement) - panel.Controls.Add(richTextBox) - panel.Controls.SetChildIndex(richTextBox, 0) - SetRichTextBoxHeight(richTextBox) - AddHandler richTextBox.KeyUp, AddressOf richTextBox_CopySelectedText - AddHandler richTextBox.MouseLeave, AddressOf panelContents_MouseLeave + + If outputElement.StringOutput IsNot Nothing Then + Dim richTextBox As New RichTextBox With { + .Dock = DockStyle.Top, + .BorderStyle = BorderStyle.None + } + AddFormatedTextToRichTextBox(richTextBox, outputElement.StringOutput, OutputFont.ROutputFont, OutputFont.ROutputColour) + panel.Controls.Add(richTextBox) + panel.Controls.SetChildIndex(richTextBox, 0) + SetRichTextBoxHeight(richTextBox) + AddHandler richTextBox.KeyUp, AddressOf richTextBox_CopySelectedText + AddHandler richTextBox.MouseLeave, AddressOf panelContents_MouseLeave + Else + Dim linkLabel As New LinkLabel + Dim ucrTextViewer As New ucrTextViewer + + linkLabel.Text = "Maximise" + AddHandler linkLabel.Click, Sub() + Dim frmMaximiseOutput As New frmMaximiseOutput + frmMaximiseOutput.Show(strFileName:=outputElement.TextOutput) + End Sub + + ucrTextViewer.LoadTextFile(strFileName:=outputElement.TextOutput) + ucrTextViewer.FormatText(OutputFont.ROutputFont, OutputFont.ROutputColour) + + AddHandler ucrTextViewer.richTextBox.MouseLeave, AddressOf panelContents_MouseLeave + + panel.Controls.Add(linkLabel) + panel.Controls.Add(ucrTextViewer) + panel.Controls.SetChildIndex(linkLabel, 0) + panel.Controls.SetChildIndex(ucrTextViewer, 0) + linkLabel.Dock = DockStyle.Top + ucrTextViewer.Dock = DockStyle.Top + End If End Sub Private Sub AddNewImageOutput(outputElement As clsOutputElement) - Dim pictureBox As New PictureBox - pictureBox.Image = outputElement.ImageOutput Dim panel As Panel = AddElementPanel(outputElement) + Dim linkLabel As New LinkLabel + Dim pictureBox As New PictureBox + + linkLabel.Text = "Maximise" + + pictureBox.Load(outputElement.ImageOutput) + panel.Controls.Add(linkLabel) panel.Controls.Add(pictureBox) + panel.Controls.SetChildIndex(linkLabel, 0) panel.Controls.SetChildIndex(pictureBox, 0) + linkLabel.Dock = DockStyle.Top pictureBox.Dock = DockStyle.Top pictureBox.SizeMode = PictureBoxSizeMode.Zoom SetPictureBoxHeight(pictureBox) + + AddHandler linkLabel.Click, Sub() + Dim frmMaximiseOutput As New frmMaximiseOutput + frmMaximiseOutput.Show(strFileName:=outputElement.ImageOutput) + End Sub + End Sub + + Private Sub AddNewHtmlOutput(outputElement As clsOutputElement) + Dim panel As Panel = AddElementPanel(outputElement) + Dim linkLabel As New LinkLabel + + If RuntimeInformation.IsOSPlatform(OSPlatform.Windows) AndAlso CefRuntimeWrapper.isCefInitilised Then + Dim ucrWebview As New ucrWebViewer() + linkLabel.Text = "Maximise" + AddHandler linkLabel.Click, Sub() + Dim frmMaximiseOutput As New frmMaximiseOutput + frmMaximiseOutput.Show(strFileName:=outputElement.HtmlOutput) + End Sub + + ucrWebview.LoadHtmlFile(outputElement.HtmlOutput) + + panel.Controls.Add(linkLabel) + panel.Controls.Add(ucrWebview) + panel.Controls.SetChildIndex(linkLabel, 0) + panel.Controls.SetChildIndex(ucrWebview, 0) + + linkLabel.Dock = DockStyle.Top + ucrWebview.Dock = DockStyle.Top + Else + + linkLabel.Text = "View html file" + AddHandler linkLabel.Click, Sub() + 'display the html output in default browser + Cursor = Cursors.WaitCursor + Process.Start(outputElement.HtmlOutput) + Cursor = Cursors.Default + End Sub + + panel.Controls.Add(linkLabel) + panel.Controls.SetChildIndex(linkLabel, 0) + + linkLabel.Dock = DockStyle.Top + + 'display the html output in default browser + Cursor = Cursors.WaitCursor + Process.Start(outputElement.HtmlOutput) + Cursor = Cursors.Default + End If + End Sub Private Sub SetRichTextBoxHeight(richTextBox As RichTextBox) @@ -326,4 +438,4 @@ Public Class ucrOutputPage Next End Sub -End Class +End Class \ No newline at end of file diff --git a/instat/UserControl/ucrOutputPages.vb b/instat/UserControl/ucrOutputPages.vb index 5e6730bbd5f..bb94d673be4 100644 --- a/instat/UserControl/ucrOutputPages.vb +++ b/instat/UserControl/ucrOutputPages.vb @@ -30,6 +30,8 @@ Public Class ucrOutputPages InitializeComponent() ' Add any initialization after the InitializeComponent() call. + + ucrMainOutputPage.clsInstatOptions = _clsInstatOptions _selectedOutputPage = ucrMainOutputPage _allOutputPages = New List(Of ucrOutputPage) EnableDisableTopButtons() @@ -42,6 +44,7 @@ Public Class ucrOutputPages Public WriteOnly Property clsInstatOptions() As InstatOptions Set(value As InstatOptions) _clsInstatOptions = value + '_selectedOutputPage.clsInstatOptions = value End Set End Property @@ -99,7 +102,8 @@ Public Class ucrOutputPages .Tag = tabName, .BCanReOrder = True, .BCanDelete = True, - .BCanRename = True + .BCanRename = True, + .clsInstatOptions = _clsInstatOptions } tabPage.Controls.Add(outputPage) tabControl.TabPages.Add(tabPage) diff --git a/instat/UserControls/DataGrid/ReoGrid/ucrDataViewReoGrid.vb b/instat/UserControls/DataGrid/ReoGrid/ucrDataViewReoGrid.vb index eb2156058ca..62fedf7e6cd 100644 --- a/instat/UserControls/DataGrid/ReoGrid/ucrDataViewReoGrid.vb +++ b/instat/UserControls/DataGrid/ReoGrid/ucrDataViewReoGrid.vb @@ -174,8 +174,8 @@ Public Class ucrDataViewReoGrid End Sub Private Sub Worksheet_BeforeCellsKeyDown(sender As Object, e As BeforeCellKeyDownEventArgs) - e.IsCancelled = True If e.KeyCode = unvell.ReoGrid.Interaction.KeyCode.Delete OrElse e.KeyCode = unvell.ReoGrid.Interaction.KeyCode.Back Then + e.IsCancelled = True RaiseEvent DeleteValueToDataframe() End If End Sub diff --git a/instat/UserControls/Webview/Windows/CefRuntimeWrapper.vb b/instat/UserControls/Webview/Windows/CefRuntimeWrapper.vb new file mode 100644 index 00000000000..313f3307ac0 --- /dev/null +++ b/instat/UserControls/Webview/Windows/CefRuntimeWrapper.vb @@ -0,0 +1,134 @@ +' R- Instat +' Copyright (C) 2015-2017 +' +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program. If not, see . +Imports System.IO +Imports CefSharp +Imports CefSharp.SchemeHandler +Imports CefSharp.WinForms +'''------------------------------------------------------------------------------------------------ +''' +''' +''' Note: This class is intended to be used solely as a 'static' class (i.e. contains only shared +''' members, cannot be instantiated and cannot be inherited from). +''' In order to enforce this (and prevent developers from using this class in an unintended way), +''' the class is declared as 'NotInheritable` and the constructor is declared as 'Private'. +''' +''' +''' '''--------------------------------------------------------------------------------------------- +Public NotInheritable Class CefRuntimeWrapper + + '''-------------------------------------------------------------------------------------------- + ''' + ''' Declare constructor 'Private' to prevent instantiation of this class (see class comments + ''' for more details). + ''' + '''-------------------------------------------------------------------------------------------- + Private Sub New() + End Sub + + '''-------------------------------------------------------------------------------------------- + ''' + ''' Initialises the Cef Runtime that runs the Cef browser processes. + ''' + ''' True if successful else false + '''-------------------------------------------------------------------------------------------- + Public Shared Function InitialiseCefRuntime() As Boolean + Try + + If IsCefInitilised() Then + Return False + End If + + + 'If ANYCPU Then + CefRuntime.SubscribeAnyCpuAssemblyResolver() + 'End If + + 'Programmatically enable DPI Aweness + 'Can also be done via app.manifest Or app.config + 'https://github.com/cefsharp/CefSharp/wiki/General-Usage#high-dpi-displayssupport + 'If set via app.manifest this call will have no effect. + 'Cef.EnableHighDPISupport() + + 'By default CefSharp will use an in-memory cache, you need to specify a Cache Folder to persist data + Dim settings As New CefSettings With { + .CachePath = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "CefSharp\\Cache") + } + + 'Example of setting a command line argument + 'Enables WebRTC + ' - CEF Doesn't currently support permissions on a per browser basis see https://bitbucket.org/chromiumembedded/cef/issues/2582/allow-run-time-handling-of-media-access + ' - CEF Doesn't currently support displaying a UI for media access permissions + ' + 'NOTE: WebRTC Device Id's aren't persisted as they are in Chrome see https://bitbucket.org/chromiumembedded/cef/issues/2064/persist-webrtc-deviceids-across-restart + settings.CefCommandLineArgs.Add("enable-media-stream") + 'https://peter.sh/experiments/chromium-command-line-switches/#use-fake-ui-for-media-stream + settings.CefCommandLineArgs.Add("use-fake-ui-for-media-stream") + 'For screen sharing add (see https://bitbucket.org/chromiumembedded/cef/issues/2582/allow-run-time-handling-of-media-access#comment-58677180) + settings.CefCommandLineArgs.Add("enable-usermedia-screen-capturing") + + 'todo. explore this further once we find the limitations of File:/// + 'settings.RegisterScheme(GetCustomSheme()) + + 'Perform dependency check to make sure all relevant resources are in our output directory then initialise cef + Return Cef.Initialize(settings, performDependencyCheck:=True, browserProcessHandler:=Nothing) + + Catch ex As Exception + 'An exception "Could not load file or assembly 'CefSharp.Core.Runtime.dll' or one of its dependencies. The specified module could not be found.":"CefSharp.Core.Runtime.dll" + 'could be thrown. + Return False + End Try + End Function + + ''' + ''' Checks if Cef runtime is initialised + ''' + ''' true if already initialised else false + Public Shared Function IsCefInitilised() As Boolean + Try + 'An excpetion "Could not load file or assembly 'CefSharp.Core.Runtime.dll' or one of its dependencies. The specified module could not be found.":"CefSharp.Core.Runtime.dll" + 'could be thrown. + Return Cef.IsInitialized + Catch ex As Exception + Return False + End Try + End Function + + ''' + ''' Stops the Cef runtime + ''' + Public Shared Sub ShutDownCef() + If IsCefInitilised() Then + Cef.Shutdown() + End If + End Sub + + 'todo. left here for future reference + 'Private Shared Function GetCustomSheme() As CefCustomScheme + ' Dim cefCustomScheme As New CefCustomScheme + ' cefCustomScheme.SchemeName = "rinstat_temp_local_folder" + ' cefCustomScheme.DomainName = "rinstat_output" + ' cefCustomScheme.SchemeHandlerFactory = New FolderSchemeHandlerFactory( + ' rootFolder:="C:\RInstatInstallationFolder\tempfiles", + ' hostName:="rinstat_output", + ' defaultPage:="rinstat_default_page.html") + + ' 'usage example; strUrl = "rinstat_temp_local_folder://rinstat_output/anyFileDisplayable" + ' 'browser.LoadUrl(strUrl) + ' Return cefCustomScheme + + 'End Function + +End Class \ No newline at end of file diff --git a/instat/UserControls/Webview/Windows/ucrWebViewer.vb b/instat/UserControls/Webview/Windows/ucrWebViewer.vb new file mode 100644 index 00000000000..1b299cca687 --- /dev/null +++ b/instat/UserControls/Webview/Windows/ucrWebViewer.vb @@ -0,0 +1,98 @@ +' R- Instat +' Copyright (C) 2015-2017 +' +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program. If not, see . + +Imports CefSharp.WinForms +Imports CefSharp +Imports CefSharp.DevTools.DOM + +'''-------------------------------------------------------------------------------------------- +''' +''' Control for viewing html output content +''' +'''-------------------------------------------------------------------------------------------- +Public Class ucrWebViewer + Inherits Panel + + Private ReadOnly _browser As ChromiumWebBrowser + + Public Sub New() + Me.Margin = New Padding(0) + _browser = New ChromiumWebBrowser() + AddHandler _browser.LoadingStateChanged, AddressOf OnLoadingStateChanged + Me.Controls.Add(_browser) + End Sub + + Public Sub LoadHtmlFile(strFileName As String) + If _browser Is Nothing Then + Return + End If + 'todo. this implementation may need to be changed if we face it's limitations + 'the use of file:/// is not preferred + 'see reason in https://github.com/cefsharp/CefSharp/wiki/General-Usage#file-uri-file + 'it's not yet clear how we can implement a custom schema at this point, + 'not unless we specify R-Instat temp output folder in the R commands. + 'that should be the first step + + Dim strUrl As String = "file:///" + strFileName.Replace("\", "/") + _browser.LoadUrl(strUrl) + _browser.Dock = DockStyle.Fill + End Sub + + Private Sub OnLoadingStateChanged(sender As Object, e As LoadingStateChangedEventArgs) + 'by default always set the height of this control to correspond to the html document after loading. + If Not e.IsLoading Then + 'Get the height of the html document and set it as the controls height + Dim task2 As Task(Of Rect) = _browser.GetContentSizeAsync() + task2.ContinueWith(Sub(t) + If Not t.IsFaulted Then + Dim response As Rect = t.Result + If response IsNot Nothing Then + Me.Invoke(Sub() + Me.Height = response.Height + End Sub) + End If + + End If + End Sub) + End If + End Sub + + Protected Overrides Sub Dispose(bDisposing As Boolean) + If _browser IsNot Nothing Then + _browser.Dispose() + End If + MyBase.Dispose(bDisposing) + End Sub + + 'Private Sub InitializeComponent() + ' Me.SuspendLayout() + ' Me.ResumeLayout(False) + + 'End Sub + + + 'Public Sub LoadUrl(strUrl As String) + ' 'todo. left here for reference + ' 'example; www.google.com + ' ' browser.LoadUrl(strUrl) + 'End Sub + + 'Public Sub LoadHtml(strHtml As String) + ' 'todo. left here for reference + ' 'browser.LoadHtml(strHtml) + 'End Sub + +End Class \ No newline at end of file diff --git a/instat/UserControls/frmMaximiseOutput.Designer.vb b/instat/UserControls/frmMaximiseOutput.Designer.vb new file mode 100644 index 00000000000..d6f8f4268c3 --- /dev/null +++ b/instat/UserControls/frmMaximiseOutput.Designer.vb @@ -0,0 +1,89 @@ + +Partial Class frmMaximiseOutput + Inherits System.Windows.Forms.Form + + 'Form overrides dispose to clean up the component list. + + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + Try + If disposing AndAlso components IsNot Nothing Then + components.Dispose() + End If + Finally + MyBase.Dispose(disposing) + End Try + End Sub + + 'Required by the Windows Form Designer + Private components As System.ComponentModel.IContainer + + 'NOTE: The following procedure is required by the Windows Form Designer + 'It can be modified using the Windows Form Designer. + 'Do not modify it using the code editor. + + Private Sub InitializeComponent() + Me.MenuStrip1 = New System.Windows.Forms.MenuStrip() + Me.FileToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem() + Me.mnuSave = New System.Windows.Forms.ToolStripMenuItem() + Me.panelControl = New System.Windows.Forms.Panel() + Me.MenuStrip1.SuspendLayout() + Me.SuspendLayout() + ' + 'MenuStrip1 + ' + Me.MenuStrip1.ImageScalingSize = New System.Drawing.Size(24, 24) + Me.MenuStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.FileToolStripMenuItem}) + Me.MenuStrip1.Location = New System.Drawing.Point(0, 0) + Me.MenuStrip1.Name = "MenuStrip1" + Me.MenuStrip1.Padding = New System.Windows.Forms.Padding(4, 1, 0, 1) + Me.MenuStrip1.Size = New System.Drawing.Size(533, 24) + Me.MenuStrip1.TabIndex = 0 + Me.MenuStrip1.Text = "MenuStrip1" + ' + 'FileToolStripMenuItem + ' + Me.FileToolStripMenuItem.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuSave}) + Me.FileToolStripMenuItem.Name = "FileToolStripMenuItem" + Me.FileToolStripMenuItem.Size = New System.Drawing.Size(37, 22) + Me.FileToolStripMenuItem.Text = "File" + ' + 'mnuSave + ' + Me.mnuSave.Name = "mnuSave" + Me.mnuSave.Size = New System.Drawing.Size(98, 22) + Me.mnuSave.Text = "Save" + ' + 'panelControl + ' + Me.panelControl.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _ + Or System.Windows.Forms.AnchorStyles.Left) _ + Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) + Me.panelControl.Location = New System.Drawing.Point(3, 27) + Me.panelControl.Name = "panelControl" + Me.panelControl.Size = New System.Drawing.Size(528, 262) + Me.panelControl.TabIndex = 1 + ' + 'frmMaximiseOutput + ' + Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) + Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font + Me.ClientSize = New System.Drawing.Size(533, 292) + Me.Controls.Add(Me.panelControl) + Me.Controls.Add(Me.MenuStrip1) + Me.MainMenuStrip = Me.MenuStrip1 + Me.Margin = New System.Windows.Forms.Padding(2) + Me.Name = "frmMaximiseOutput" + Me.Text = "Output" + Me.WindowState = System.Windows.Forms.FormWindowState.Maximized + Me.MenuStrip1.ResumeLayout(False) + Me.MenuStrip1.PerformLayout() + Me.ResumeLayout(False) + Me.PerformLayout() + + End Sub + + Friend WithEvents MenuStrip1 As MenuStrip + Friend WithEvents FileToolStripMenuItem As ToolStripMenuItem + Friend WithEvents mnuSave As ToolStripMenuItem + Friend WithEvents panelControl As Panel +End Class \ No newline at end of file diff --git a/instat/frmScript.resx b/instat/UserControls/frmMaximiseOutput.resx similarity index 96% rename from instat/frmScript.resx rename to instat/UserControls/frmMaximiseOutput.resx index 29dcb1b3a35..bb703611734 100644 --- a/instat/frmScript.resx +++ b/instat/UserControls/frmMaximiseOutput.resx @@ -1,120 +1,123 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 2.0 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + 17, 17 + \ No newline at end of file diff --git a/instat/UserControls/frmMaximiseOutput.vb b/instat/UserControls/frmMaximiseOutput.vb new file mode 100644 index 00000000000..dcb0253abe3 --- /dev/null +++ b/instat/UserControls/frmMaximiseOutput.vb @@ -0,0 +1,104 @@ +' R- Instat +' Copyright (C) 2015-2017 +' +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program. If not, see . +Imports System.IO +Imports System.Runtime.InteropServices + +'''-------------------------------------------------------------------------------------------- +''' +''' Form for viewing maximised output content +''' +'''-------------------------------------------------------------------------------------------- +Public Class frmMaximiseOutput + Private _strDisplayedFileName As String = "" + Private _strFileFilter As String = "" + 'todo. to be used by the output page to remember paths selected by user when saving outputs + Public _strFileDestinationDirectory As String = "" + + Public Overloads Sub Show(strFileName As String) + Me._strDisplayedFileName = strFileName + Dim strFileExtension As String = Path.GetExtension(_strDisplayedFileName).ToLower + Me.panelControl.Controls.Clear() + + Select Case strFileExtension + Case ".txt" + _strFileFilter = "txt (*.txt)|*.txt" + Dim ucrTextViewer As New ucrTextViewer + ucrTextViewer.LoadTextFile(strFileName) + ucrTextViewer.FormatText(OutputFont.ROutputFont, OutputFont.ROutputColour) + Me.panelControl.Controls.Add(ucrTextViewer) + ucrTextViewer.Dock = DockStyle.Fill + Case ".png" + _strFileFilter = "png (*.png)|*.png" + Dim pictureBox As New PictureBox + pictureBox.Load(_strDisplayedFileName) + pictureBox.SizeMode = PictureBoxSizeMode.Zoom + Me.panelControl.Controls.Add(pictureBox) + pictureBox.Dock = DockStyle.Fill + Case ".html" + If RuntimeInformation.IsOSPlatform(OSPlatform.Windows) AndAlso CefRuntimeWrapper.IsCefInitilised Then + _strFileFilter = "html (*.html)|*.html" + Dim ucrWebView As New ucrWebViewer + ucrWebView.LoadHtmlFile(_strDisplayedFileName) + Me.panelControl.Controls.Add(ucrWebView) + ucrWebView.Dock = DockStyle.Fill + Else + 'display the html output in default browser + Cursor = Cursors.WaitCursor + Process.Start(_strDisplayedFileName) + Cursor = Cursors.Default + 'important. just return don't show the form + Return + End If + Case Else + MessageBox.Show(Me, "The file type to be viewed is currently not suported", + "Developer Error", + MessageBoxButtons.OK, + MessageBoxIcon.Error) + Return + End Select + + MyBase.Show() + End Sub + + Private Sub mnuSave_Click(sender As Object, e As EventArgs) Handles mnuSave.Click + Using dlgSaveFile As New SaveFileDialog + dlgSaveFile.Title = "Save Output" + dlgSaveFile.Filter = _strFileFilter + dlgSaveFile.InitialDirectory = If(String.IsNullOrEmpty(_strFileDestinationDirectory), + frmMain.clsInstatOptions.strWorkingDirectory, _strFileDestinationDirectory) + If DialogResult.OK = dlgSaveFile.ShowDialog() Then + + _strFileDestinationDirectory = Path.GetDirectoryName(dlgSaveFile.FileName) + + 'for htmls copy the html file with it's associated directory; css, javascript files etc + If Path.GetExtension(_strDisplayedFileName).ToLower = ".html" Then + For Each foundDirectory As String In My.Computer.FileSystem.GetDirectories( + Path.GetDirectoryName(_strDisplayedFileName), + FileIO.SearchOption.SearchTopLevelOnly, + "*" & Path.GetFileNameWithoutExtension(_strDisplayedFileName) & "*") + My.Computer.FileSystem.CopyDirectory(foundDirectory, _strFileDestinationDirectory, True) + Next + Else + My.Computer.FileSystem.CopyFile(_strDisplayedFileName, dlgSaveFile.FileName, True) + End If + End If + + + End Using + + End Sub + +End Class \ No newline at end of file diff --git a/instat/UserControls/ucrTextViewer.vb b/instat/UserControls/ucrTextViewer.vb new file mode 100644 index 00000000000..f51b2663ff0 --- /dev/null +++ b/instat/UserControls/ucrTextViewer.vb @@ -0,0 +1,114 @@ +' R- Instat +' Copyright (C) 2015-2017 +' +' This program is free software: you can redistribute it and/or modify +' it under the terms of the GNU General Public License as published by +' the Free Software Foundation, either version 3 of the License, or +' (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program. If not, see . +Imports System.IO +Imports System.Runtime.InteropServices + +'''-------------------------------------------------------------------------------------------- +''' +''' Control for viewing text output content +''' +'''-------------------------------------------------------------------------------------------- +Public Class ucrTextViewer + Inherits Panel + + Public ReadOnly richTextBox As RichTextBox + + Public Sub New() + richTextBox = New RichTextBox + richTextBox.BorderStyle = BorderStyle.None + Me.Controls.Add(richTextBox) + richTextBox.Dock = DockStyle.Fill + AddHandler richTextBox.KeyUp, AddressOf richTextBox_CopySelectedText + End Sub + + Public ReadOnly Property TextLength As Integer + Get + Return richTextBox.Text.Length + End Get + End Property + + Public Sub LoadTextFile(strFileName As String) + Dim strOutput As String = "" + For Each strLine As String In File.ReadLines(strFileName) + strOutput = strOutput & strLine & Environment.NewLine + Next strLine + AddText(strOutput) + End Sub + + Public Sub AddText(text As String) + richTextBox.AppendText(text) + 'by default always set the height of this control to correspond to the height of the rich text box contents + 'todo. what happens when the rich text box has multiple fonts? + Me.Height = (richTextBox.GetLineFromCharIndex(richTextBox.Text.Length) + 1) * (richTextBox.Font.Height + richTextBox.Margin.Vertical) + 5 + End Sub + + Public Sub AddTextAndFormat(text As String, font As Font, color As Color) + Dim intStartSelection As Integer = richTextBox.Text.Length + AddText(text) + FormatText(font, color, intStartSelection, text.Length) + End Sub + + Public Sub FormatText(font As Font, color As Color, + Optional iSelectionStart As Integer = 0, + Optional iSelectionLength As Integer = -1) + + If iSelectionLength = -1 Then + iSelectionLength = richTextBox.Text.Length + End If + + If RuntimeInformation.IsOSPlatform(OSPlatform.Linux) Then + 'Mono cannot have multiple fonts and colours within RichTextBox + richTextBox.SelectAll() + richTextBox.Font = font + richTextBox.ForeColor = color + richTextBox.SelectionLength = 0 + Else + richTextBox.SelectionStart = iSelectionStart + richTextBox.SelectionLength = iSelectionLength + richTextBox.SelectionFont = font + richTextBox.SelectionColor = color + richTextBox.SelectionLength = 0 + End If + End Sub + + Private Sub richTextBox_CopySelectedText(sender As Object, e As KeyEventArgs) + If e.KeyData = Keys.Control + Keys.C Then + Try + Dim richText As RichTextBox = CType(sender, RichTextBox) + Dim richSelectedText As New RichTextBox + richSelectedText.AppendText(richText.SelectedText) + CopySelectedTextToClipBoard(richSelectedText, richText.SelectedRtf) + Catch ex As Exception + MsgBox(ex.Message) + End Try + End If + End Sub + + Private Sub CopySelectedTextToClipBoard(richText As RichTextBox, richTextFormat As String) + Dim strClip As String = String.Empty + Dim dto As New DataObject() + + For Each Line As String In richText.Lines + strClip &= Line & Environment.NewLine + Next + + dto.SetText(richTextFormat, TextDataFormat.Rtf) + dto.SetText(strClip, TextDataFormat.UnicodeText) + Clipboard.Clear() + Clipboard.SetDataObject(dto) + End Sub + +End Class \ No newline at end of file diff --git a/instat/app.manifest b/instat/app.manifest new file mode 100644 index 00000000000..99ca084ee50 --- /dev/null +++ b/instat/app.manifest @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/instat/clsInstatOptions.vb b/instat/clsInstatOptions.vb index 934b3737ef6..563a5bce9e4 100644 --- a/instat/clsInstatOptions.vb +++ b/instat/clsInstatOptions.vb @@ -51,6 +51,7 @@ Imports RDotNet Public strClimsoftHost As String Public strClimsoftPort As String Public strClimsoftUsername As String + Public iMaxOutputsHeight As Nullable(Of Integer) Public Sub New(Optional bSetOptions As Boolean = True) 'TODO Is this sensible to do in constructor? @@ -89,6 +90,7 @@ Imports RDotNet strClimsoftHost = clsInstatOptionsDefaults.DEFAULTstrClimsoftHost strClimsoftPort = clsInstatOptionsDefaults.DEFAULTstrClimsoftPort strClimsoftUsername = clsInstatOptionsDefaults.DEFAULTstrClimsoftUsername + iMaxOutputsHeight = clsInstatOptionsDefaults.DEFAULTiMaxOutputsHeight If bSetOptions Then SetOptions() End If @@ -278,6 +280,13 @@ Imports RDotNet Else SetClimsoftUsername(clsInstatOptionsDefaults.DEFAULTstrClimsoftUsername) End If + + + If iMaxOutputsHeight IsNot Nothing Then + SetMaximumOutputsHeight(iMaxOutputsHeight) + Else + SetMaximumOutputsHeight(clsInstatOptionsDefaults.DEFAULTiMaxOutputsHeight) + End If End Sub Public Sub SetMaxRows(iRows As Integer) @@ -515,4 +524,9 @@ Imports RDotNet Public Sub SetClimsoftUsername(strNewClimsoftUsername As String) strClimsoftUsername = strNewClimsoftUsername End Sub + + Public Sub SetMaximumOutputsHeight(iNewMaxOutputsHeight As Integer) + iMaxOutputsHeight = iNewMaxOutputsHeight + End Sub + End Class \ No newline at end of file diff --git a/instat/clsInstatOptionsDefaults.vb b/instat/clsInstatOptionsDefaults.vb index 2550cec04f3..cf6f04d66a1 100644 --- a/instat/clsInstatOptionsDefaults.vb +++ b/instat/clsInstatOptionsDefaults.vb @@ -53,4 +53,5 @@ Public Class clsInstatOptionsDefaults Public Shared ReadOnly DEFAULTstrClimsoftHost As String = "127.0.0.1" Public Shared ReadOnly DEFAULTstrClimsoftPort As String = "3308" Public Shared ReadOnly DEFAULTstrClimsoftUsername As String = "root" + Public Shared ReadOnly DEFAULTiMaxOutputsHeight As Integer = 300 End Class diff --git a/instat/clsRCodeStructure.vb b/instat/clsRCodeStructure.vb index 4aed3b6dcdc..ae8a393323e 100644 --- a/instat/clsRCodeStructure.vb +++ b/instat/clsRCodeStructure.vb @@ -38,86 +38,28 @@ ''' '''-------------------------------------------------------------------------------------------- Public Class RCodeStructure - ''' If the output from the R command needs to be assigned, then this string is - ''' the part of the script to the left of the assignment operator ('<-'). - ''' This could be a data frame, data frame colmun, model, graph, surv or table. - ''' If the output from the R command doesn't to be assigned, then this string is - ''' empty. - Public strAssignTo As String - - ''' The name of the data frame to assign to - ''' (i.e. the data frame name associated with the R "data_name" parameter). - ''' - Public strAssignToDataFrame As String - ''' The name of the column to assign to - ''' (i.e. the column name associated with the R "col_name" or "col_names" - ''' parameters). - ''' - Public strAssignToColumn As String + '-------------------------------------------------------------- + 'todo. the properties in this block should eventually be private + 'start block - ''' The name of the model to assign to - ''' (i.e. the model name associated with the R "model_name" parameter). - ''' - Public strAssignToModel As String - - ''' The name of the graph to assign to - ''' (i.e. the graph name associated with the R "graph_name" parameter). - ''' - Public strAssignToGraph As String - - ''' The name of the surv to assign to - ''' (i.e. the surv name associated with the R "surv_name" parameter). - ''' - Public strAssignToSurv As String - - ''' The name of the table to assign to - ''' (i.e. the table name associated with the R "table_name" parameter). - ''' - Public strAssignToTable As String - - ''' If true then a list of data frames is assigned (i.e. the R "data_names" - ''' parameter needs to be set). - ''' - Public bDataFrameList As Boolean = False - - ''' The names of the new data frames (i.e. the data frame names associated with - ''' the R "data_names" parameter). Only used if 'bDataFrameList' is true. - ''' - Public strDataFrameNames As String - - ''' If true then, at the current stage of running code within R, the output of - ''' the R command needs to be assigned to: - ''' - ''' - ''' The variable defined by 'strAssignTo' - ''' - ''' R elements such as data frame, columns, graphs, models etc. (only if - ''' specified by the 'AssignTo...' variables). - ''' - ''' + ''' + ''' If the output from the R command needs to be assigned, then this string is + ''' the part of the script to the left of the assignment operator ('<-'). + ''' This could be a data frame, data frame colmun, model, graph etc. + ''' If the output from the R command doesn't to be assigned, then this string is null or empty. ''' - Public bToBeAssigned As Boolean = False - - ''' If true then the output of the R-command has been assigned to: - ''' - ''' - ''' The variable defined by 'strAssignTo' - ''' - ''' R elements such as data frame, columns, graphs, models etc. (only if - ''' specified by the 'AssignTo...' variables). - ''' - ''' - ''' This variable is only relevant in the string case, as RFunction and - ''' ROperator have internal equivalents. - ''' - ''' Note: Both bToBeAssigned and bIsAssigned are needed. - ''' bToBeAssigned defines if the R command actually needs to be defined. - ''' bIsAssigned defines if the R command has already been defined (only relevent - ''' if bToBeAssigned is true). - ''' + Public _strAssignToObject As String + Public _strAssignToName As String + Public _strAssignToObjectTypeLabel As String + Public _strAssignToObjectFormat As String + Public _strDataFrameNameToAddAssignToObject As String + + ''' + ''' If true then a list of data frames is assigned (i.e. the R "_strAssignToName" + ''' parameter needs to be an R string list). ''' - Public bIsAssigned As Boolean = False + Private bDataFrameList As Boolean = False ''' If true then the R parameter "use_col_name_as_prefix" is set to true, ''' else the parameter is set to false. @@ -145,6 +87,9 @@ Public Class RCodeStructure ''' Public bRequireCorrectLength As Boolean = True + 'end block + '--------------------------------------------------------------------- + ''' The list of parameters associated with this R code. Public clsParameters As New List(Of RParameter) @@ -158,7 +103,7 @@ Public Class RCodeStructure Public iPosition = -1 ' TODO SJL 03/04/20 This seems to be a constant, should we declare it with 'const'? 'TODO SJL 03/04/20 - Also, it only seems to be used by RSyntax. Move the constant to that class and give it a less confusing name? - ''' What to do with the result returned by executing the R code: + ''' Deprecated. What to do with the result returned by executing the R code: ''' ''' ''' 0 Ignore the result of the R code. @@ -186,11 +131,11 @@ Public Class RCodeStructure ''' If true then potentially exclude the assignment part of the script from the R ''' command. - ''' Normally, the assignment part of the script should only be excluded if the - ''' output has already been assigned. + ''' Normally, the assignment part of the script should only be excluded if the assignement + ''' has been set. ''' For example: ''' - ''' If bExcludeAssignedFunctionOutput AndAlso bIsAssigned Then + ''' If bExcludeAssignedFunctionOutput AndAlso IsAssigned Then ''' 'process script without assignment part ''' Else ''' 'process script with assignment part @@ -230,8 +175,18 @@ Public Class RCodeStructure ' bExcludeAssignedFunctionOutput which it uses for the base code. Eventually migrate these out of RSyntax. End Sub + Public Function GetRObjectToAssignTo() As String + Return _strAssignToObject + End Function + + Public Function IsAssigned() + Return Not String.IsNullOrEmpty(_strAssignToObject) + End Function + '''-------------------------------------------------------------------------------------------- - ''' Sets the 'assignTo' variables. + ''' Deprecated. + ''' Sets the 'assignTo' variables. + ''' ''' ''' The new value for the assignment string. ''' (Optional) The new value for the dataframe. @@ -251,36 +206,136 @@ Public Class RCodeStructure ''' not named. ''' (Optional) The new value for strAdjacentColumn. '''-------------------------------------------------------------------------------------------- - Public Sub SetAssignTo(strTemp As String, Optional strTempDataframe As String = "", Optional strTempColumn As String = "", Optional strTempModel As String = "", Optional strTempGraph As String = "", Optional strTempSurv As String = "", Optional strTempTable As String = "", Optional bAssignToIsPrefix As Boolean = False, Optional bAssignToColumnWithoutNames As Boolean = False, Optional bInsertColumnBefore As Boolean = False, Optional bRequireCorrectLength As Boolean = True, Optional bDataFrameList As Boolean = False, Optional strDataFrameNames As String = "", Optional strAdjacentColumn As String = "") - strAssignTo = strTemp + Public Sub SetAssignTo(strTemp As String, + Optional strTempDataframe As String = "", + Optional strTempColumn As String = "", + Optional strTempModel As String = "", + Optional strTempGraph As String = "", + Optional strTempSurv As String = "", + Optional strTempTable As String = "", + Optional bAssignToIsPrefix As Boolean = False, + Optional bAssignToColumnWithoutNames As Boolean = False, + Optional bInsertColumnBefore As Boolean = False, + Optional bRequireCorrectLength As Boolean = True, + Optional bDataFrameList As Boolean = False, + Optional strDataFrameNames As String = "", + Optional strAdjacentColumn As String = "") + + _strAssignToObject = strTemp + + If Not strTempDataframe = "" AndAlso Not strTempColumn = "" Then + SetAssignToColumnObject(strColToAssignTo:=strTemp, + strColName:=strTempColumn, + strRDataFrameNameToAddObjectTo:=strTempDataframe, + bAssignToIsPrefix:=bAssignToIsPrefix, + bAssignToColumnWithoutNames:=bAssignToColumnWithoutNames, + bRequireCorrectLength:=bRequireCorrectLength, + bInsertColumnBefore:=bInsertColumnBefore, + strAdjacentColumn:=strAdjacentColumn) + Return + End If + + If Not strTempDataframe = "" Then - strAssignToDataFrame = strTempDataframe - If Not strTempColumn = "" Then - strAssignToColumn = strTempColumn + If bDataFrameList Then + SetAssignToDataFrameObject(strDataFrameToAssignTo:=strTemp, + strDataFrameName:=strDataFrameNames, + bDataFrameList:=True) + Else + SetAssignToDataFrameObject(strDataFrameToAssignTo:=strTemp, + strDataFrameName:=strTempDataframe, + bDataFrameList:=False) End If + Return End If + + + 'for dialogs that produce objects shown to the output viewer + 'using this deprecated subroutine. call the SetAssignToRObject subroutine + 'this part can be deleted once all the dialogs that have these types of outputs are refactored + Dim strNewRObjectTypeToAssignTo As String = "" + Dim strNewRObjectTypeLabelToAssignTo As String = "" + Dim strNewRObjectFormatToAssignTo As String = "" + + If Not strTempGraph = "" Then + strNewRObjectTypeToAssignTo = strTempGraph + strNewRObjectTypeLabelToAssignTo = RObjectTypeLabel.Graph + strNewRObjectFormatToAssignTo = RObjectFormat.Image + End If + If Not strTempModel = "" Then - strAssignToModel = strTempModel + strNewRObjectTypeToAssignTo = strTempModel + strNewRObjectTypeLabelToAssignTo = RObjectTypeLabel.Model + 'assumption is, by default a model is in text format + strNewRObjectFormatToAssignTo = RObjectFormat.Text End If - If Not strTempGraph = "" Then - strAssignToGraph = strTempGraph + + If Not strTempTable = "" Then + strNewRObjectTypeToAssignTo = strTempTable + strNewRObjectTypeLabelToAssignTo = RObjectTypeLabel.Table + 'assumption is, by default a table is in text format + strNewRObjectFormatToAssignTo = RObjectFormat.Text End If + If Not strTempSurv = "" Then - strAssignToSurv = strTempSurv + strNewRObjectTypeToAssignTo = strTempSurv + strNewRObjectTypeLabelToAssignTo = RObjectTypeLabel.StructureLabel + 'assumption is, by default a survival is in text format + strNewRObjectFormatToAssignTo = RObjectFormat.Text End If - If Not strTempTable = "" Then - strAssignToTable = strTempTable + If Not strNewRObjectTypeToAssignTo = "" Then + SetAssignToOutputObject(strRObjectToAssignTo:=strNewRObjectTypeToAssignTo, + strRObjectTypeLabelToAssignTo:=strNewRObjectTypeLabelToAssignTo, + strRObjectFormatToAssignTo:=strNewRObjectFormatToAssignTo, + strRDataFrameNameToAddObjectTo:=strTempDataframe, + strObjectName:=strNewRObjectTypeToAssignTo) End If - bToBeAssigned = True - bIsAssigned = False + + End Sub + + Public Sub SetAssignToOutputObject(strRObjectToAssignTo As String, + strRObjectTypeLabelToAssignTo As String, + strRObjectFormatToAssignTo As String, + Optional strRDataFrameNameToAddObjectTo As String = "", + Optional strObjectName As String = "") + + Me._strAssignToObject = strRObjectToAssignTo + Me._strAssignToObjectTypeLabel = strRObjectTypeLabelToAssignTo + Me._strAssignToObjectFormat = strRObjectFormatToAssignTo + Me._strDataFrameNameToAddAssignToObject = strRDataFrameNameToAddObjectTo + Me._strAssignToName = strObjectName + End Sub + + Public Sub SetAssignToColumnObject(strColToAssignTo As String, + strColName As String, + strRDataFrameNameToAddObjectTo As String, + Optional bAssignToIsPrefix As Boolean = False, + Optional bAssignToColumnWithoutNames As Boolean = False, + Optional bRequireCorrectLength As Boolean = True, + Optional bInsertColumnBefore As Boolean = False, + Optional strAdjacentColumn As String = "") + + Me._strAssignToObject = strColToAssignTo + Me._strAssignToObjectTypeLabel = RObjectTypeLabel.Column + Me._strDataFrameNameToAddAssignToObject = strRDataFrameNameToAddObjectTo + Me._strAssignToName = strColName Me.bAssignToIsPrefix = bAssignToIsPrefix + Me.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames Me.bInsertColumnBefore = bInsertColumnBefore Me.strAdjacentColumn = strAdjacentColumn Me.bRequireCorrectLength = bRequireCorrectLength + End Sub + + Public Sub SetAssignToDataFrameObject(strDataFrameToAssignTo As String, + strDataFrameName As String, + Optional bDataFrameList As Boolean = False) + + Me._strAssignToObject = strDataFrameToAssignTo + Me._strAssignToObjectTypeLabel = RObjectTypeLabel.Dataframe + Me._strAssignToName = strDataFrameName Me.bDataFrameList = bDataFrameList - Me.strDataFrameNames = strDataFrameNames End Sub '''-------------------------------------------------------------------------------------------- @@ -291,18 +346,15 @@ Public Class RCodeStructure '''-------------------------------------------------------------------------------------------- Public Sub RemoveAssignTo() ' TODO SJL 03/04/20 should bRequireCorrectLength, bDataFrameList, strDataFrameNames also be reset? - strAssignTo = "" - strAssignToDataFrame = "" - strAssignToColumn = "" - strAssignToModel = "" - strAssignToGraph = "" - strAssignToSurv = "" - strAssignToTable = "" - bToBeAssigned = False - bIsAssigned = False + bAssignToIsPrefix = False bAssignToColumnWithoutNames = False bInsertColumnBefore = False + + Me._strAssignToObject = "" + Me._strAssignToName = "" + Me._strAssignToObjectTypeLabel = "" + Me._strAssignToObjectFormat = "" End Sub '''-------------------------------------------------------------------------------------------- @@ -365,151 +417,110 @@ Public Class RCodeStructure ''' Else returns . '''-------------------------------------------------------------------------------------------- Public Overridable Function ToScript(Optional ByRef strScript As String = "", Optional strTemp As String = "") As String - Dim clsAddColumns As New RFunction - Dim clsGetColumns As New RFunction - Dim clsAddData As New RFunction - Dim clsGetData As New RFunction - Dim clsAddModels As New RFunction - Dim clsGetModels As New RFunction - Dim clsAddGraphs As New RFunction - Dim clsGetGraphs As New RFunction - Dim clsAddSurv As New RFunction - Dim clsGetSurv As New RFunction - Dim clsAddTables As New RFunction - Dim clsGetTables As New RFunction - Dim clsDataList As New RFunction - - ' if R script already assigned for this object then return the existing assign script - If bIsAssigned Then - Return (strAssignTo) - End If ' if R script still needs to be assigned to this object - If bToBeAssigned Then + If Not String.IsNullOrEmpty(_strAssignToObject) Then + + Dim clsAddRObject As New RFunction + Dim clsGetRObject As New RFunction + Dim strRObject As String = _strAssignToObject 'Append the new script (including the intial assignment part) to 'strScript', e.g. ' 'my_stations <- rio::import(file=""C:/myDir/my_stations.csv"", stringsAsFactors=TRUE)" & vbCrLf' 'Note1: The append allows 'strScript' to be built up into a multi-line string through successive calls of 'ToScript' 'Note2: Initially, 'strAssignTo' is typically the name of the variable to assign the result of 'strTemp' to, e.g. ' 'guinea_two_stations'. - strScript = strScript & ConstructAssignTo(strAssignTo, strTemp) & Environment.NewLine - 'if we need to assign to a column in a data frame - If Not strAssignToDataFrame = "" AndAlso (Not strAssignToColumn = "" OrElse bAssignToColumnWithoutNames) Then - clsAddColumns.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_columns_to_data") - clsAddColumns.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) + strScript = strScript & ConstructAssignTo(_strAssignToObject, strTemp) & Environment.NewLine + + If _strAssignToObjectTypeLabel = RObjectTypeLabel.Column Then + 'for column object + clsAddRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_columns_to_data") + clsAddRObject.AddParameter("data_name", Chr(34) & _strDataFrameNameToAddAssignToObject & Chr(34)) 'if we need to assign to a named column If Not bAssignToColumnWithoutNames Then - clsAddColumns.AddParameter("col_name", Chr(34) & strAssignToColumn & Chr(34)) + clsAddRObject.AddParameter("col_name", Chr(34) & _strAssignToName & Chr(34)) End If - clsAddColumns.AddParameter("col_data", strAssignTo) + clsAddRObject.AddParameter("col_data", _strAssignToObject) If bAssignToIsPrefix Then - clsAddColumns.AddParameter("use_col_name_as_prefix", "TRUE") + clsAddRObject.AddParameter("use_col_name_as_prefix", "TRUE") Else If frmMain.clsInstatOptions.bIncludeRDefaultParameters Then - clsAddColumns.AddParameter("use_col_name_as_prefix", "FALSE") + clsAddRObject.AddParameter("use_col_name_as_prefix", "FALSE") End If End If - clsAddColumns.AddParameter("before", If(bInsertColumnBefore, "TRUE", "FALSE")) + clsAddRObject.AddParameter("before", If(bInsertColumnBefore, "TRUE", "FALSE")) If Not String.IsNullOrEmpty(strAdjacentColumn) Then - clsAddColumns.AddParameter("adjacent_column", strAdjacentColumn) + clsAddRObject.AddParameter("adjacent_column", strAdjacentColumn) End If If Not bRequireCorrectLength Then - clsAddColumns.AddParameter("require_correct_length", "FALSE") + clsAddRObject.AddParameter("require_correct_length", "FALSE") End If - ' add '$add-columns_to_data' parameters to 'strScript' + ' add '$add_columns_to_data' parameters to 'strScript' ' e.g. "row_names1 <- data_book$get_row_names(data_name=""survey"")" & vbCrLf & "data_book$add_columns_to_data(data_name=""survey"", col_name=""row_names1"", col_data=row_names1, before=TRUE)" & vbCrLf - strScript = strScript & clsAddColumns.ToScript() & Environment.NewLine + strScript = strScript & clsAddRObject.ToScript() & Environment.NewLine - clsGetColumns.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_columns_from_data") - clsGetColumns.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - clsGetColumns.AddParameter("col_names", Chr(34) & strAssignToColumn & Chr(34)) + 'todo. when is this ever used? as of 11/11/2022, this code is not used during execution + clsGetRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_columns_from_data") + clsGetRObject.AddParameter("data_name", Chr(34) & _strDataFrameNameToAddAssignToObject & Chr(34)) + clsGetRObject.AddParameter("col_names", Chr(34) & _strAssignToName & Chr(34)) ' set 'strAssignTo' to e.g. "data_book$get_columns_from_data(data_name=""survey"", col_names=""row_names1"")" - strAssignTo = clsGetColumns.ToScript() - ElseIf Not strAssignToModel = "" Then 'else if we need to assign to a model - clsAddModels.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_model") - clsAddModels.AddParameter("model_name", Chr(34) & strAssignToModel & Chr(34)) - clsAddModels.AddParameter("model", strAssignTo) - clsAddModels.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - If Not strAssignToDataFrame = "" Then - clsAddModels.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - clsGetModels.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - End If - strScript = strScript & clsAddModels.ToScript() & Environment.NewLine - - clsGetModels.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_models") - clsGetModels.AddParameter("model_name", Chr(34) & strAssignToModel & Chr(34)) - strAssignTo = clsGetModels.ToScript() - ElseIf Not strAssignToGraph = "" Then 'else if we need to assign to a graph - clsAddGraphs.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_graph") - clsAddGraphs.AddParameter("graph_name", Chr(34) & strAssignToGraph & Chr(34)) - clsAddGraphs.AddParameter("graph", strAssignTo) - If Not strAssignToDataFrame = "" Then - clsAddGraphs.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - clsGetGraphs.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - End If - strScript = strScript & clsAddGraphs.ToScript() & Environment.NewLine - - clsGetGraphs.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_graphs") - clsGetGraphs.AddParameter("graph_name", Chr(34) & strAssignToGraph & Chr(34)) - strAssignTo = clsGetGraphs.ToScript() - ElseIf Not strAssignToSurv = "" Then 'else if we need to assign to a surv - clsAddSurv.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_surv") - clsAddSurv.AddParameter("surv_name", Chr(34) & strAssignToSurv & Chr(34)) - clsAddSurv.AddParameter("surv", strAssignTo) - If Not strAssignToDataFrame = "" Then - clsAddSurv.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - clsGetSurv.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - End If - strScript = strScript & clsAddSurv.ToScript() & Environment.NewLine - - clsGetSurv.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_surv") - clsGetSurv.AddParameter("surv_name", Chr(34) & strAssignToSurv & Chr(34)) - strAssignTo = clsGetSurv.ToScript() - - ElseIf Not strAssignToTable = "" Then 'else if we need to assign to a table - clsAddTables.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_table") - clsAddTables.AddParameter("table_name", Chr(34) & strAssignToTable & Chr(34)) - clsAddTables.AddParameter("table", strAssignTo) - If Not strAssignToDataFrame = "" Then - clsAddTables.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - clsGetTables.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) - End If - strScript = strScript & clsAddTables.ToScript() & Environment.NewLine + strRObject = clsGetRObject.ToScript() - clsGetTables.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_tables") - clsGetTables.AddParameter("table_name", Chr(34) & strAssignToTable & Chr(34)) - strAssignTo = clsGetTables.ToScript() - ElseIf Not strAssignToDataFrame = "" Then 'else if we need to assign to a data frame - clsAddData.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$import_data") + ElseIf _strAssignToObjectTypeLabel = RObjectTypeLabel.Dataframe Then + 'for data frame object + clsAddRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$import_data") If bDataFrameList Then - clsAddData.AddParameter("data_tables", strAssignTo, iPosition:=0) - If strDataFrameNames <> "" Then - clsAddData.AddParameter("data_names", strDataFrameNames, iPosition:=5) + clsAddRObject.AddParameter("data_tables", _strAssignToObject, iPosition:=0) + If _strAssignToName <> "" Then + clsAddRObject.AddParameter("data_names", _strAssignToName, iPosition:=5) End If Else + Dim clsDataList As New RFunction clsDataList.SetRCommand("list") - clsDataList.AddParameter(strAssignToDataFrame, strAssignTo) - clsAddData.AddParameter("data_tables", clsRFunctionParameter:=clsDataList, iPosition:=0) + clsDataList.AddParameter(_strAssignToName, _strAssignToObject) + clsAddRObject.AddParameter("data_tables", clsRFunctionParameter:=clsDataList, iPosition:=0) End If 'append the next line of script to 'strScript' e.g. ' "my_stations <- rio::import(file=""C:/myFolder/my_stations.csv"", stringsAsFactors=TRUE)" & vbCrLf ' & "data_book$import_data(data_tables=list(my_stations=my_stations))" & vbCrLf - strScript = strScript & clsAddData.ToScript() & Environment.NewLine + strScript = strScript & clsAddRObject.ToScript() & Environment.NewLine - clsGetData.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame") - clsGetData.AddParameter("data_name", Chr(34) & strAssignToDataFrame & Chr(34)) + 'todo. when is this ever used? as of 11/11/2022, this code is not used during execution + clsGetRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_data_frame") + clsGetRObject.AddParameter("data_name", Chr(34) & _strAssignToName & Chr(34)) 'Set 'strAssignTo' to final assign-to script ' e.g. "data_book$get_columns_from_data(data_name=""my_stations"", col_names=""Calc1"")" - strAssignTo = clsGetData.ToScript() + strRObject = clsGetRObject.ToScript() + + ElseIf Not String.IsNullOrEmpty(_strAssignToObjectFormat) Then + 'for output objects like graphs, texts, table + 'set the R command and parameters for the add object R function. This is used for adding the object in the data book + 'set the R command and parameters for the get object R function. This is used for viewing the object. + clsAddRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_object") + clsGetRObject.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_object") + + If Not String.IsNullOrEmpty(_strDataFrameNameToAddAssignToObject) Then + clsAddRObject.AddParameter("data_name", Chr(34) & _strDataFrameNameToAddAssignToObject & Chr(34)) + clsGetRObject.AddParameter("data_name", Chr(34) & _strDataFrameNameToAddAssignToObject & Chr(34)) + End If + + clsAddRObject.AddParameter("object_name", Chr(34) & _strAssignToName & Chr(34)) + clsAddRObject.AddParameter("object_type_label", Chr(34) & _strAssignToObjectTypeLabel & Chr(34)) + clsAddRObject.AddParameter("object_format", Chr(34) & _strAssignToObjectFormat & Chr(34)) + clsAddRObject.AddParameter("object", _strAssignToObject) + + clsGetRObject.AddParameter("object_name", Chr(34) & _strAssignToName & Chr(34)) + + 'construct the scripts + strScript = strScript & clsAddRObject.ToScript() & Environment.NewLine + strRObject = clsGetRObject.ToScript() + End If - bIsAssigned = True - bToBeAssigned = False - 'return the final assign-to script - Return strAssignTo + Return strRObject Else 'else if R script doesn't need to be assigned to this object ' just return the right side of the assignment Return strTemp @@ -534,6 +545,7 @@ Public Class RCodeStructure ''' The constructed assignment statement. '''-------------------------------------------------------------------------------------------- Private Function ConstructAssignTo(strAssignTo As String, strTemp As String) As String + 'todo. Use the R script library or move this function to a module Dim strReconstructed As String = "" Dim arrScriptParts As String() If Not String.IsNullOrEmpty(strTemp) Then @@ -691,7 +703,7 @@ Public Class RCodeStructure Else 'TODO SJL 03/04/20 Do something here? End If - bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned + 'bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned iNumberOfAddedParameters = iNumberOfAddedParameters + 1 OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -792,7 +804,7 @@ Public Class RCodeStructure clsParam = clsParameters.Find(Function(x) x.Position = -1) clsParameters.Remove(clsParam) End If - bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned + 'bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -812,7 +824,7 @@ Public Class RCodeStructure clsParam = clsParameters.Find(Function(x) x.strArgumentName = strArgName) clsParameters.Remove(clsParam) ' End If - bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned + 'bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -832,7 +844,7 @@ Public Class RCodeStructure clsParam = clsParameters.Find(Function(x) x.Position = iPosition) clsParameters.Remove(clsParam) End If - bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned + 'bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -846,7 +858,7 @@ Public Class RCodeStructure If Not clsParameters Is Nothing Then clsParameters.Remove(clsParam) End If - bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned + ' bIsAssigned = False 'parameters have changed so the output of the R command needs to be reassigned OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -890,7 +902,7 @@ Public Class RCodeStructure Public Overridable Sub ClearParameters() clsParameters.Clear() iNumberOfAddedParameters = 0 - bIsAssigned = False + 'bIsAssigned = False OnParametersChanged() 'TODO SJL 03/04/20 can this line be removed? End Sub @@ -903,17 +915,13 @@ Public Class RCodeStructure Dim clsTempCode As New RCodeStructure Dim clsRParam As RParameter - clsTempCode.strAssignTo = strAssignTo - clsTempCode.strAssignToDataFrame = strAssignToDataFrame - clsTempCode.strAssignToColumn = strAssignToColumn - clsTempCode.strAssignToModel = strAssignToModel - clsTempCode.strAssignToGraph = strAssignToGraph - clsTempCode.strAssignToSurv = strAssignToSurv - clsTempCode.strAssignToTable = strAssignToTable + clsTempCode._strAssignToObject = Me._strAssignToObject + clsTempCode._strAssignToName = Me._strAssignToName + clsTempCode._strAssignToObjectTypeLabel = Me._strAssignToObjectTypeLabel + clsTempCode._strAssignToObjectFormat = Me._strAssignToObjectFormat + clsTempCode._strDataFrameNameToAddAssignToObject = Me._strDataFrameNameToAddAssignToObject + clsTempCode.bDataFrameList = bDataFrameList - clsTempCode.strDataFrameNames = strDataFrameNames - clsTempCode.bToBeAssigned = bToBeAssigned - clsTempCode.bIsAssigned = bIsAssigned clsTempCode.bAssignToIsPrefix = bAssignToIsPrefix clsTempCode.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames clsTempCode.bInsertColumnBefore = bInsertColumnBefore @@ -945,10 +953,10 @@ Public Class RCodeStructure 'TBD SJL 06/04/20 This is a 'get' function but it does not return any value! Rename? SortParameters() ' if this object is to be assigned, but is not yet in the lists - If bToBeAssigned AndAlso Not lstCodes.Contains(Me) Then + If Not String.IsNullOrEmpty(_strAssignToObject) AndAlso Not lstCodes.Contains(Me) Then 'add this object and its assign script to the respective lists lstCodes.Add(Me) - lstValues.Add(strAssignTo) + lstValues.Add(_strAssignToObject) End If For Each clsTempParam As RParameter In clsParameters ' if parameter is a function or operator then also add its respective RCodeStructure @@ -956,4 +964,4 @@ Public Class RCodeStructure clsTempParam.GetAllAssignTo(lstCodes, lstValues) Next End Sub -End Class +End Class \ No newline at end of file diff --git a/instat/clsRFunction.vb b/instat/clsRFunction.vb index 6dda2ff23ab..a38465061d8 100644 --- a/instat/clsRFunction.vb +++ b/instat/clsRFunction.vb @@ -11,7 +11,7 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . '''-------------------------------------------------------------------------------------------- @@ -47,14 +47,13 @@ Public Class RFunction End Sub '''-------------------------------------------------------------------------------------------- - ''' Sets the R command's name (e.g. "facet_grid") and flags that the R script + ''' Sets the R command's name (e.g. "facet_grid") and flags that the R script ''' associated with this object is no longer correctly assigned. ''' ''' Name of the R command. '''-------------------------------------------------------------------------------------------- Public Sub SetRCommand(strTemp As String) strRCommand = strTemp - bIsAssigned = False End Sub '''-------------------------------------------------------------------------------------------- @@ -68,7 +67,7 @@ Public Class RFunction '''-------------------------------------------------------------------------------------------- ''' - ''' Creates, updates and returns the script that generates the expected output for this + ''' Creates, updates and returns the script that generates the expected output for this ''' object. This script will have the form 'RCommand(param1=param1Val, param2=param2Val, ...)'. ''' ''' @@ -77,7 +76,7 @@ Public Class RFunction ''' This script is passed to the 'ToScript' function of the base ''' class. This script is also passed to the 'ToScript' function ''' of the operator's parameters. - ''' (Optional) Ignored, only included so that this function overrides + ''' (Optional) Ignored, only included so that this function overrides ''' its parent function. ''' ''' The script that generates the expected output for this object. @@ -111,13 +110,13 @@ Public Class RFunction 'if string is intended to be assigned to a script then raise error (because modified script will no longer suitable for this) 'TODO SJL if we only allow these 3 flags to be accessed through 'set/get' functions then we can guarantee that this error situation doesn't occur 'TODO legacy comment:'should also check assignment of parameters' - If bToBeAssigned OrElse bIsAssigned Then + If IsAssigned() Then MsgBox("Developer error: Using bToScriptAsRString = True when RFunction is assigned will not produce the correct script. Remove assignment to use this options correctly.") End If 'replace double quotes with single quotes - ' Note : Can't have double quotes ("") in the string because strTemp will be wrapped - ' with "". In most cases single quotes (') will give the same functionality, + ' Note : Can't have double quotes ("") in the string because strTemp will be wrapped + ' with "". In most cases single quotes (') will give the same functionality, ' though it's preferable to avoid this when constructing the RFunction. strTemp = strTemp.Replace(Chr(34), Chr(39)) @@ -125,7 +124,7 @@ Public Class RFunction strTemp = Chr(34) & strTemp & Chr(34) End If - 'if object needs to be assigned to then create/update the assignment script (if needed) + 'if object needs to be assigned to then create/update the assignment script (if needed) ' and return the assignment script. Otherwise just return 'strTemp'. Return MyBase.ToScript(strScript, strTemp) End Function @@ -178,7 +177,7 @@ Public Class RFunction ''' ''' The name of the parameter to return. ''' - ''' The parameter object named . If the parameter + ''' The parameter object named . If the parameter ''' doesn't exist then returns 'Nothing'. '''-------------------------------------------------------------------------------------------- Public Overrides Function GetParameter(strName As String) As RParameter @@ -215,14 +214,13 @@ Public Class RFunction Dim clsRParam As RParameter 'RCode properties - clsRFunction.strAssignTo = strAssignTo - clsRFunction.strAssignToDataFrame = strAssignToDataFrame - clsRFunction.strAssignToColumn = strAssignToColumn - clsRFunction.strAssignToModel = strAssignToModel - clsRFunction.strAssignToGraph = strAssignToGraph - clsRFunction.strAssignToTable = strAssignToTable - clsRFunction.bToBeAssigned = bToBeAssigned - clsRFunction.bIsAssigned = bIsAssigned + 'todo. why not use the MyBase.Clone() for some of these inherited from the parent properties? + clsRFunction._strAssignToObject = _strAssignToObject + clsRFunction._strAssignToName = _strAssignToName + clsRFunction._strAssignToObjectTypeLabel = _strAssignToObjectTypeLabel + clsRFunction._strAssignToObjectFormat = _strAssignToObjectFormat + clsRFunction._strDataFrameNameToAddAssignToObject = _strDataFrameNameToAddAssignToObject + clsRFunction.bAssignToIsPrefix = bAssignToIsPrefix clsRFunction.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames clsRFunction.bInsertColumnBefore = bInsertColumnBefore diff --git a/instat/clsRLink.vb b/instat/clsRLink.vb index 47cc3710ad3..63f60c48dfb 100644 --- a/instat/clsRLink.vb +++ b/instat/clsRLink.vb @@ -101,11 +101,17 @@ Public Class RLink ''' The log window. Public txtLog As New TextBox - ''' True if the log window is defined - Public bLog As Boolean = False + ''' + ''' Is set to True when the log window is defined. + ''' If set to False, R scripts will not be logged. + ''' + Public bLogRScripts As Boolean = False - ''' True if the R output window is defined. - Public bOutput As Boolean = True + ''' + ''' Is set to True when the R output window is defined. + ''' If set to False, R scripts will not be shouwn in the output viewer + ''' + Public bOutputRscripts As Boolean = True ''' True to climate object exists. @@ -312,80 +318,6 @@ Public Class RLink Return bClose End Function - '''-------------------------------------------------------------------------------------------- - ''' This method executes the R script and displays - ''' the output as text or graph (determined by ). - ''' R commands may be split over multiple lines. This is only allowed if the - ''' non-final line ends with '+', ',', or '%>%'; or there are one or more '{' - ''' brackets that have not been closed with an equivalent '}' bracket. - ''' This function is named '...FromWindow' because it's designed to execute scripts - ''' entered by a human from a dialog window (e.g. a script window). These scripts - ''' may contain R commands split over multiple lines to make the commands more - ''' readable. - ''' - ''' The R script to execute. - ''' Shown as a comment. If this parameter is "" then shows - ''' as the comment. - ''' - ''' Any text at the end of that was not executed. - ''' If all the text in was executed then returns "". - ''' - '''-------------------------------------------------------------------------------------------- - Public Function RunScriptFromWindow(strNewScript As String, strNewComment As String) As String - Dim strScriptCmd As String = "" - - - 'for each line in script - For Each strScriptLine As String In strNewScript.Split(Environment.NewLine) - 'remove any comments (character '#' and anything after) - Dim iCommentPos As Integer = strScriptLine.IndexOf("#") - Select Case iCommentPos - Case 0 'a normal comment line (starts with '#') - Continue For - Case Is > 0 ' a line with an appended comment (e.g. 'x <- 1 # generate data' converted to 'x <- 1 ') - strScriptLine = strScriptLine.Substring(0, iCommentPos - 1) - End Select - - 'if line is empty or only whitespace then ignore line - Dim strTrimmedLine As String = strScriptLine.Trim(vbLf).Trim() - If strTrimmedLine.Length <= 0 Then - Continue For - End If - - 'else append line of script to command - strScriptCmd &= strScriptLine - - 'if line ends in a '+', ',', or '%>%'; or there are open curly braces; or open quotations, - ' then assume command is not complete - Dim cLastChar As Char = strTrimmedLine.Last - Dim strLast3Chars As String = "" - Dim iNumOpenRound As Integer = strScriptCmd.Where(Function(c) c = "("c).Count - Dim iNumClosedRound As Integer = strScriptCmd.Where(Function(c) c = ")"c).Count - Dim iNumOpenCurlies As Integer = strScriptCmd.Where(Function(c) c = "{"c).Count - Dim iNumClosedCurlies As Integer = strScriptCmd.Where(Function(c) c = "}"c).Count - Dim iNumDoubleQuotes As Integer = strScriptCmd.Where(Function(c) c = """"c).Count - If strTrimmedLine.Length >= 3 Then - strLast3Chars = strTrimmedLine.Substring(strTrimmedLine.Length - 3) - End If - If cLastChar = "+" OrElse cLastChar = "," OrElse strLast3Chars = "%>%" _ - OrElse iNumOpenRound <> iNumClosedRound _ - OrElse iNumOpenCurlies <> iNumClosedCurlies _ - OrElse iNumDoubleQuotes Mod 2 Then - Continue For - End If - - 'else execute command - Dim iCallType As Integer = 5 - If strScriptCmd.Contains(strInstatDataObject & "$get_graphs") Then - iCallType = 3 - End If - RunScript(strScriptCmd.Trim(vbLf), iCallType:=iCallType, strComment:=strNewComment, bSeparateThread:=False, bSilent:=False) - strScriptCmd = "" - strNewComment = "" - Next - Return strScriptCmd - End Function - ''' ''' Extracts all the complete runnable R commands from . ''' The command lines returned are re-formatted in a format that the R.Net engine can execute. @@ -393,6 +325,7 @@ Public Class RLink ''' R script command. Can be a multiline script command ''' an array that contains individual complete runnable R scripts Public Function GetRunnableCommandLines(strScript As String) As String() + 'todo. move this implementation to another module or class or R script library? Dim lstRunnableCommandLines As New List(Of String) Dim arrScriptCommands As String() = strScript.Split(New String() {Environment.NewLine, vbLf}, StringSplitOptions.RemoveEmptyEntries) Dim strSplitScriptCmd As String = "" @@ -553,7 +486,7 @@ Public Class RLink '''-------------------------------------------------------------------------------------------- Public Sub SetLog(tempLog As TextBox) txtLog = tempLog - bLog = True + bLogRScripts = True End Sub '''-------------------------------------------------------------------------------------------- @@ -768,13 +701,55 @@ Public Class RLink End Try End Sub + '''-------------------------------------------------------------------------------------------- + ''' Returns an assignment statement of the form: + ''' + ''' <- + ''' + ''' If is multiple lines then the assignment is done + ''' on 's last line. All previous lines are returned + ''' unchanged. + ''' + ''' + ''' The variable to assign to (i.e. the left side of the + ''' assignment). + ''' The script command(s) that contains the command to assign (i.e. the right side of the + ''' assignment). + ''' + ''' The constructed assignment statement. + ''' + '''-------------------------------------------------------------------------------------------- + Public Function ConstructAssignTo(strAssignTo As String, strScripts As String) As String + + 'todo. move to another class or module or in R script library? + If String.IsNullOrEmpty(strScripts) Then + Return "" + Else + Dim strReconstructed As String = "" + Dim arrScriptParts As String() + 'if string contains more than one line, assign the last line of the multi-line string + arrScriptParts = GetRunnableCommandLines(strScripts) + If arrScriptParts.Length > 1 Then + 're-assemble the string, apart from the last line + strReconstructed = String.Join(Environment.NewLine, arrScriptParts, 0, arrScriptParts.Length - 1) + 'assign the last line of the multi-line string + strReconstructed = strReconstructed & Environment.NewLine & strAssignTo & " <- " & arrScriptParts.Last + Else + 'else if string has only one line, then assign to the whole string + strReconstructed = strAssignTo & " <- " & strScripts + End If + Return strReconstructed + End If + + End Function + '''-------------------------------------------------------------------------------------------- ''' ''' This method executes the R script and displays the output. The - ''' output may be displayed as text, graph or in a web browser (see ). + ''' output may be displayed as text, graph or html (see ). ''' ''' is the R script to execute. - ''' defines how to display the R output. + ''' defines how to display the R output. todo deprecate this. ''' ''' ''' 0 Executes and ignores the result. @@ -812,12 +787,22 @@ Public Class RLink ''' . ''' if false and an exception is raised then open a message box that ''' displays the exception message. + ''' if true and the script produces and output, the output will be added + ''' in the output viewer, if false, the output will be displayed in a different viewer. + ''' displays the exception message. '''-------------------------------------------------------------------------------------------- - Public Sub RunScript(strScript As String, Optional iCallType As Integer = 0, Optional strComment As String = "", Optional bSeparateThread As Boolean = True, Optional bShowWaitDialogOverride As Nullable(Of Boolean) = Nothing, Optional bUpdateGrids As Boolean = True, Optional bSilent As Boolean = False) + Public Sub RunScript(strScript As String, + Optional iCallType As Integer = 0, + Optional strComment As String = "", + Optional bSeparateThread As Boolean = True, + Optional bShowWaitDialogOverride As Nullable(Of Boolean) = Nothing, + Optional bUpdateGrids As Boolean = True, + Optional bSilent As Boolean = False, + Optional bAddOutputInViewer As Boolean = True) Dim strCapturedScript As String Dim expTemp As RDotNet.SymbolicExpression Dim strTemp As String = "" - Dim strOutput As String + Dim strOutput As String = "" Dim strScriptWithComment As String Dim strSplitScript As String Dim strTempGraphsDirectory As String @@ -833,21 +818,19 @@ Public Class RLink Directory.CreateDirectory(strTempGraphsDirectory) End If - strOutput = "" - ' if comment provided If strComment <> "" Then ' Prefix comment to script, e.g. "# Code generated by the dialog, Import Dataset" & vbCrLf & "new_RDS <- readRDS(file=""C:/Users/myName ... - strComment = GetFormattedComment(strComment) - strScriptWithComment = strComment & Environment.NewLine & strScript + strScriptWithComment = GetFormattedComment(strComment) & Environment.NewLine & strScript Else strScriptWithComment = strScript End If - If bLog Then + + If bLogRScripts Then txtLog.Text = txtLog.Text & strScriptWithComment & Environment.NewLine End If ' if the output window is defined then output comments (if exists) and script (if 'bShowCommands' is true). - If bOutput Then + If bOutputRscripts Then clsOutputLogger.AddRScript(strScriptWithComment) End If @@ -855,40 +838,59 @@ Public Class RLink 'If strScript.Length > 2000 Then ' MsgBox("The following command cannot be run because it exceeds the character limit of 2000 characters for a command in R-Instat." & Environment.NewLine & strScript & Environment.NewLine & Environment.NewLine & "It may be possible to run the command directly in R.", MsgBoxStyle.Critical, "Cannot run command") - ' if script output should be ignored, or returned as a graph - If iCallType = 0 OrElse iCallType = 3 Then - Try - 'if output should be returned as a graph - If iCallType = 3 Then - If strGraphDisplayOption = "view_output_window" OrElse strGraphDisplayOption = "view_separate_window" Then - clsPNGFunction.SetPackageName("grDevices") - clsPNGFunction.SetRCommand("png") - clsPNGFunction.AddParameter("filename", Chr(34) & System.IO.Path.Combine(strTempGraphsDirectory & "/Graph.png").Replace("\", "/") & Chr(34)) - 'TODO make these options - clsPNGFunction.AddParameter("width", 4000) - clsPNGFunction.AddParameter("height", 4000) - clsPNGFunction.AddParameter("res", 500) - bSuccess = Evaluate(clsPNGFunction.ToScript(), bSilent:=True, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) - ' Temporary solution to being unable to save graphs in a temporary location for display. - ' This can occur if System.IO.Path.GetTempPath() returns a path that is not writable. - If Not bSuccess Then - Evaluate("graphics.off()", bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) - strGraphDisplayOption = "view_R_viewer" - MsgBox("A problem occured saving graphs in the temporary location " & strTempGraphsDirectory & vbNewLine & vbNewLine & "To ensure graphs can still be viewed, graphs will now appear in a pop up R viewer." & vbNewLine & "Restarting R-Instat and/or your machine usually resolves this. You can change this setting back in Tools > Options: 'Graph Display' if this later becomes resolved.", MsgBoxStyle.Exclamation) + Try + 'get the last R script command + Dim strLastScript As String = GetRunnableCommandLines(strScript).LastOrDefault + If strLastScript IsNot Nothing AndAlso strLastScript.Contains("get_object") Then + Try + 'if object output should be returned as a file do the following. + Dim strNewAssignedToScript As String = ConstructAssignTo(strTempAssignTo, strScript) + Evaluate(strNewAssignedToScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + expTemp = GetSymbol(strTempAssignTo) + If expTemp IsNot Nothing Then + 'get the file path name + strTemp = String.Join(Environment.NewLine, expTemp.AsCharacter()) + If File.Exists(strTemp) Then + If bAddOutputInViewer Then + clsOutputLogger.AddFileOutput(strTemp) + Else + Dim frmMaximiseOutput As New frmMaximiseOutput + frmMaximiseOutput.Show(strFileName:=strTemp) + End If End If - 'need to boost resolution of the devices, it's not as good as with ggsave. End If - End If - If iCallType = 3 AndAlso strGraphDisplayOption = "view_R_viewer" Then - Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=False, bShowWaitDialogOverride:=bShowWaitDialogOverride) - Else 'TODO SJL this is the only line executed if iCallType is 0. Move outside if block to simplify logic? - Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) - End If - If iCallType = 3 Then - If strGraphDisplayOption = "view_output_window" OrElse strGraphDisplayOption = "view_separate_window" Then + Catch e As Exception + MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") + End Try + ElseIf iCallType = 0 Then 'if script output should be ignored. to do. deprecated + Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + ElseIf iCallType = 3 Then + 'else if output should be returned as a graph. + 'todo. deprecate this block. currently used view last graph mainly and viewing graph objects dialog + + If strGraphDisplayOption = "view_output_window" OrElse strGraphDisplayOption = "view_separate_window" Then + 'run R command for taking a snapshot of the graph image + clsPNGFunction.SetPackageName("grDevices") + clsPNGFunction.SetRCommand("png") + clsPNGFunction.AddParameter("filename", Chr(34) & System.IO.Path.Combine(strTempGraphsDirectory & "/Graph.png").Replace("\", "/") & Chr(34)) + 'TODO make these options + clsPNGFunction.AddParameter("width", 4000) + clsPNGFunction.AddParameter("height", 4000) + clsPNGFunction.AddParameter("res", 500) + ' temporary solution to being unable to save graphs in a temporary location for display. + ' this can occur if System.IO.Path.GetTempPath() returns a path that is not writable. + bSuccess = Evaluate(clsPNGFunction.ToScript(), bSilent:=True, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + If bSuccess Then + 'need to boost resolution of the devices, it's not as good as with ggsave. + Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + 'switch of taking of graph snapshots + 'todo. not quite sure if this would work, otherwise find the right way to close the appropriate devices. + Evaluate("graphics.off()", bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + + 'Get the graph images for display. + 'todo in future do the following 'add an R script (maybe in the form of one of our methods) that copies divices to the temp directory, using the default device production... use dev.list() and dev.copy() with arguments device = the devices in the list and which = jpeg devices with different paths leading to the temp directory, using a paste() method to find different names for the files - Evaluate("graphics.off()", bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) 'not quite sure if this would work, otherwise find the right way to close the appropriate devices. 'clsEngine.Evaluate("ggsave(" & Chr(34) & strTempGraphsDirectory.Replace("\", "/") & "Graph.jpg" & Chr(34) & ")") 'This sub is used to display graphics in the output window when necessary. 'This sub is checking the temp directory "R_Instat_Temp_Graphs", created during setup to see if there are any graphs to display. If there are some, then it sends them to the output window, and removes them from the directory. @@ -902,15 +904,13 @@ Public Class RLink lstTempGraphFiles = Nothing MsgBox(e.Message & Environment.NewLine & "A problem occured in getting the content of the temporary graphs directory: " & strTempGraphsDirectory & " Possible exceptions are described here: https://msdn.microsoft.com/en-us/library/kf41fdf4.aspx", MsgBoxStyle.Critical) End Try - If lstTempGraphFiles IsNot Nothing Then - iNumberOfFiles = CStr(lstTempGraphFiles.Count) - End If - If iNumberOfFiles > 0 Then + If lstTempGraphFiles IsNot Nothing AndAlso lstTempGraphFiles.Count > 0 Then For Each strFileName As String In lstTempGraphFiles If strGraphDisplayOption = "view_output_window" Then clsOutputLogger.AddImageOutput(strFileName) ElseIf strGraphDisplayOption = "view_separate_window" Then - frmMain.AddGraphForm(strFileName) + Dim frmMaximiseOutput As New frmMaximiseOutput + frmMaximiseOutput.Show(strTemp) End If Try My.Computer.FileSystem.DeleteFile(strFileName) @@ -919,76 +919,90 @@ Public Class RLink End Try Next End If + Else + 'switch of taking of graph snapshots + 'todo. not quite sure if this would work, otherwise find the right way to close the appropriate devices. + Evaluate("graphics.off()", bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + strGraphDisplayOption = "view_R_viewer" + MsgBox("A problem occured saving graphs in the temporary location " & strTempGraphsDirectory & vbNewLine & vbNewLine & "To ensure graphs can still be viewed, graphs will now appear in a pop up R viewer." & vbNewLine & "Restarting R-Instat and/or your machine usually resolves this. You can change this setting back in Tools > Options: 'Graph Display' if this later becomes resolved.", MsgBoxStyle.Exclamation) + 'will launch the R viewer + Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=False, bShowWaitDialogOverride:=bShowWaitDialogOverride) End If + + ElseIf strGraphDisplayOption = "view_R_viewer" Then + Evaluate(strScript, bSilent:=bSilent, bSeparateThread:=False, bShowWaitDialogOverride:=bShowWaitDialogOverride) End If - Catch e As Exception - MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") - End Try - ElseIf iCallType = 1 OrElse iCallType = 4 Then 'else if script output should be stored in a temp variable - ' TODO SJL In RInstat, iCallType only seems to be 0, 2 or 3. Are call types 1 and 4 used? - Try - 'TODO check this is valid syntax in all cases - ' i.e. this is potentially: x <- y <- 1 - Evaluate(strTempAssignTo & " <- " & strScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) - expTemp = GetSymbol(strTempAssignTo) - If expTemp IsNot Nothing Then - strTemp = String.Join(Environment.NewLine, expTemp.AsCharacter()) - strOutput = strOutput & strTemp & Environment.NewLine - End If - Catch e As Exception - MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") - End Try - Else ' else if script output should not be ignored, not stored in a graph and not stored in a variable - 'if script comes from script window, or else script is a single line - If iCallType = 5 OrElse strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray) = -1 Then - 'wrap the whole script in 'capture.output' - ' 'capture.output' returns the result of the R command as a string. - ' This string can be displayed later in the output window. - strCapturedScript = "capture.output(" & strScript & ")" - Else 'else if script is multi-line - 'execute all lines apart from the final line - strSplitScript = Left(strScript, strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray)) - If strSplitScript <> "" Then - Try - bError = Not Evaluate(strSplitScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) - Catch e As Exception - MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") - End Try + + ElseIf iCallType = 1 OrElse iCallType = 4 Then 'else if script output should be stored in a temp variable + ' TODO SJL In RInstat, iCallType only seems to be 0, 2 or 3. Are call types 1 and 4 used? + Try + 'TODO check this is valid syntax in all cases + ' i.e. this is potentially: x <- y <- 1 + Evaluate(strTempAssignTo & " <- " & strScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + expTemp = GetSymbol(strTempAssignTo) + If expTemp IsNot Nothing Then + strTemp = String.Join(Environment.NewLine, expTemp.AsCharacter()) + strOutput = strOutput & strTemp & Environment.NewLine + End If + Catch e As Exception + MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") + End Try + Else ' else if script output should not be ignored, not stored in a graph and not stored in a variable + 'if script comes from script window, or else script is a single line + If iCallType = 5 OrElse strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray) = -1 Then + 'wrap the whole script in 'capture.output' + ' 'capture.output' returns the result of the R command as a string. + ' This string can be displayed later in the output window. + strCapturedScript = "capture.output(" & strScript & ")" + Else 'else if script is multi-line + 'execute all lines apart from the final line + strSplitScript = Left(strScript, strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray)) + If strSplitScript <> "" Then + Try + bError = Not Evaluate(strSplitScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) + Catch e As Exception + MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") + End Try + End If + 'ensure that the final line of the script will be executed next + strSplitScript = Right(strScript, strScript.Length - strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray) - 2) + 'wrap the final line in 'capture.output' so that when it's executed, the result can be displayed in the output window + strCapturedScript = "capture.output(" & strSplitScript & ")" End If - 'ensure that the final line of the script will be executed next - strSplitScript = Right(strScript, strScript.Length - strScript.Trim(Environment.NewLine.ToCharArray).LastIndexOf(Environment.NewLine.ToCharArray) - 2) - 'wrap the final line in 'capture.output' so that when it's executed, the result can be displayed in the output window - strCapturedScript = "capture.output(" & strSplitScript & ")" - End If - Try - If Not bError Then - 'execute the script and assign the result to a temporary variable - If Evaluate(strTempAssignTo & " <- " & strCapturedScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) Then - expTemp = GetSymbol(strTempAssignTo) - Evaluate("rm(" & strTempAssignTo & ")", bSilent:=True) - If expTemp IsNot Nothing Then - strTemp = String.Join(Environment.NewLine, expTemp.AsCharacter()) - If strTemp <> "" Then - 'ensure that the data returned from the script will be displayed in the output window - strOutput = strOutput & strTemp & Environment.NewLine + Try + If Not bError Then + 'execute the script and assign the result to a temporary variable + If Evaluate(strTempAssignTo & " <- " & strCapturedScript, bSilent:=bSilent, bSeparateThread:=bSeparateThread, bShowWaitDialogOverride:=bShowWaitDialogOverride) Then + expTemp = GetSymbol(strTempAssignTo) + Evaluate("rm(" & strTempAssignTo & ")", bSilent:=True) + If expTemp IsNot Nothing Then + strTemp = String.Join(Environment.NewLine, expTemp.AsCharacter()) + If strTemp <> "" Then + 'ensure that the data returned from the script will be displayed in the output window + strOutput = strOutput & strTemp & Environment.NewLine + End If End If End If End If - End If - Catch e As Exception - MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") - End Try - End If + Catch e As Exception + MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") + End Try + End If + + Catch e As Exception + MsgBox(e.Message & Environment.NewLine & "The error occurred in attempting to run the following R command(s):" & Environment.NewLine & strScript, MsgBoxStyle.Critical, "Error running R command(s)") + End Try ' if output window is defined, and there's something to output - If bOutput AndAlso strOutput IsNot Nothing AndAlso strOutput <> "" Then + If bOutputRscripts AndAlso strOutput IsNot Nothing AndAlso strOutput <> "" Then ' if output should be sent to web browser - If iCallType = 4 Then - ' rtbOutput.AddIntoWebBrowser(strHtmlCode:=strOutput) - 'TODO Add to web browser - Else - clsOutputLogger.AddStringOutput(strOutput) - End If + 'If iCallType = 4 Then + ' ' rtbOutput.AddIntoWebBrowser(strHtmlCode:=strOutput) + ' 'TODO Add to web browser + 'Else + ' clsOutputLogger.AddStringOutput(strOutput) + 'End If + clsOutputLogger.AddStringOutput(strOutput) End If AppendToAutoSaveLog(strScriptWithComment & Environment.NewLine) If bUpdateGrids Then @@ -996,6 +1010,125 @@ Public Class RLink End If End Sub + '''-------------------------------------------------------------------------------------------- + ''' This method executes the R script and displays + ''' the output as text or graph (determined by ). + ''' R commands may be split over multiple lines. This is only allowed if the + ''' non-final line ends with '+', ',', or '%>%'; or there are one or more '{' + ''' brackets that have not been closed with an equivalent '}' bracket. + ''' This function is named '...FromWindow' because it's designed to execute scripts + ''' entered by a human from a dialog window (e.g. a script window). These scripts + ''' may contain R commands split over multiple lines to make the commands more + ''' readable. + ''' + ''' The R script to execute. + ''' Shown as a comment. If this parameter is "" then shows + ''' as the comment. + ''' + ''' Any text at the end of that was not executed. + ''' If all the text in was executed then returns "". + ''' + '''-------------------------------------------------------------------------------------------- + Public Function RunScriptFromWindow(strNewScript As String, strNewComment As String) As String + Dim strScriptCmd As String = "" + + + 'for each line in script + For Each strScriptLine As String In strNewScript.Split(Environment.NewLine) + 'remove any comments (character '#' and anything after) + Dim iCommentPos As Integer = strScriptLine.IndexOf("#") + Select Case iCommentPos + Case 0 'a normal comment line (starts with '#') + Continue For + Case Is > 0 ' a line with an appended comment (e.g. 'x <- 1 # generate data' converted to 'x <- 1 ') + strScriptLine = strScriptLine.Substring(0, iCommentPos - 1) + End Select + + 'if line is empty or only whitespace then ignore line + Dim strTrimmedLine As String = strScriptLine.Trim(vbLf).Trim() + If strTrimmedLine.Length <= 0 Then + Continue For + End If + + 'else append line of script to command + strScriptCmd &= strScriptLine + + 'if line ends in a '+', ',', or '%>%'; or there are open curly braces; or open quotations, + ' then assume command is not complete + Dim cLastChar As Char = strTrimmedLine.Last + Dim strLast3Chars As String = "" + Dim iNumOpenRound As Integer = strScriptCmd.Where(Function(c) c = "("c).Count + Dim iNumClosedRound As Integer = strScriptCmd.Where(Function(c) c = ")"c).Count + Dim iNumOpenCurlies As Integer = strScriptCmd.Where(Function(c) c = "{"c).Count + Dim iNumClosedCurlies As Integer = strScriptCmd.Where(Function(c) c = "}"c).Count + Dim iNumDoubleQuotes As Integer = strScriptCmd.Where(Function(c) c = """"c).Count + If strTrimmedLine.Length >= 3 Then + strLast3Chars = strTrimmedLine.Substring(strTrimmedLine.Length - 3) + End If + If cLastChar = "+" OrElse cLastChar = "," OrElse strLast3Chars = "%>%" _ + OrElse iNumOpenRound <> iNumClosedRound _ + OrElse iNumOpenCurlies <> iNumClosedCurlies _ + OrElse iNumDoubleQuotes Mod 2 Then + Continue For + End If + + 'else execute command + Dim iCallType As Integer = 5 + If strScriptCmd.Contains(strInstatDataObject & "$get_graphs") Then + iCallType = 3 + End If + RunScript(strScriptCmd.Trim(vbLf), iCallType:=iCallType, strComment:=strNewComment, bSeparateThread:=False, bSilent:=False) + strScriptCmd = "" + strNewComment = "" + Next + Return strScriptCmd + End Function + + + '''-------------------------------------------------------------------------------------------- + ''' View last graph. + ''' + ''' (Optional) If true then view last graph as plotly. + '''-------------------------------------------------------------------------------------------- + Public Sub ViewLastGraph(Optional bAsPlotly As Boolean = False, + Optional bInRViewer As Boolean = False) + Dim clsLastGraph As New RFunction + clsLastGraph.SetRCommand(strInstatDataObject & "$get_last_graph") + clsLastGraph.AddParameter("print_graph", "FALSE", iPosition:=0) + If bAsPlotly Then + Dim clsViewObjectFunction As New RFunction + Dim clsInteractivePlot As New RFunction + + clsInteractivePlot.SetPackageName("plotly") + clsInteractivePlot.SetRCommand("ggplotly") + clsInteractivePlot.AddParameter("p", clsRFunctionParameter:=clsLastGraph, iPosition:=0) + + clsViewObjectFunction.SetRCommand("view_object") + clsViewObjectFunction.AddParameter(strParameterName:="object", + clsRFunctionParameter:=clsInteractivePlot) + clsViewObjectFunction.AddParameter(strParameterName:="object_format", + strParameterValue:=Chr(34) & RObjectFormat.Html & Chr(34)) + + RunScript(clsViewObjectFunction.ToScript(), bAddOutputInViewer:=False, strComment:="View last graph as Plotly", bSeparateThread:=False) + ElseIf bInRViewer Then + Dim strGlobalGraphDisplayOption As String + 'store the current set graph display option, to restore after display + strGlobalGraphDisplayOption = Me.strGraphDisplayOption + Me.strGraphDisplayOption = "view_R_viewer" + clsLastGraph.AddParameter("print_graph", "TRUE", iPosition:=0) + RunScript(clsLastGraph.ToScript(), iCallType:=3, bAddOutputInViewer:=False, strComment:="View last graph", bSeparateThread:=False) + 'restore the graph display option + Me.strGraphDisplayOption = strGlobalGraphDisplayOption + Else + Dim clsViewObjectFunction As New RFunction + clsViewObjectFunction.SetRCommand("view_object") + clsViewObjectFunction.AddParameter(strParameterName:="object", clsRFunctionParameter:=clsLastGraph) + clsViewObjectFunction.AddParameter(strParameterName:="object_format", + strParameterValue:=Chr(34) & RObjectFormat.Image & Chr(34)) + RunScript(clsViewObjectFunction.ToScript(), bAddOutputInViewer:=False, strComment:="View last graph", bSeparateThread:=False) + End If + End Sub + '''-------------------------------------------------------------------------------------------- ''' Executes the the R script and returns the result ''' as a 'SymbolicExpression' object. @@ -1232,7 +1365,7 @@ Public Class RLink frmSetupLoading.Show() End If End If - While thrRScript.IsAlive + While thrRScript.IsAlive If bErrorMessageOpen Then If Not RuntimeInformation.IsOSPlatform(OSPlatform.Linux) Then frmSetupLoading.Close() @@ -1748,27 +1881,6 @@ Public Class RLink Return iColumnCount End Function - '''-------------------------------------------------------------------------------------------- - ''' Gets the names of the data frame's models. - ''' - ''' (Optional) The data frame name. - ''' - ''' The names of the data frame's models. - '''-------------------------------------------------------------------------------------------- - Public Function GetModelNames(Optional strDataFrameName As String = "") As List(Of String) - Return GetNames(strDataFrameName, "$get_model_names") - End Function - - '''-------------------------------------------------------------------------------------------- - ''' Gets the names of the data frame's tables. - ''' - ''' (Optional) The data frame name. - ''' - ''' The names of the data frame's tables. - '''-------------------------------------------------------------------------------------------- - Public Function GetTableNames(Optional strDataFrameName As String = "") As List(Of String) - Return GetNames(strDataFrameName, "$get_table_names") - End Function '''-------------------------------------------------------------------------------------------- ''' Gets the names of the data frame's filters. @@ -1791,27 +1903,7 @@ Public Class RLink Public Function GetColumnSelectionNames(strDataFrameName As String) As List(Of String) Return GetNames(strDataFrameName, "$get_column_selection_names") End Function - '''-------------------------------------------------------------------------------------------- - ''' Gets the names of the data frame's graphs. - ''' - ''' (Optional) The data frame name. - ''' - ''' The names of the data frame's graphs. - '''-------------------------------------------------------------------------------------------- - Public Function GetGraphNames(Optional strDataFrameName As String = "") As List(Of String) - Return GetNames(strDataFrameName, "$get_graph_names") - End Function - '''-------------------------------------------------------------------------------------------- - ''' Gets the names of the data frame's survs. - ''' - ''' (Optional) The data frame name. - ''' - ''' The names of the data frame's survs. - '''-------------------------------------------------------------------------------------------- - Public Function GetSurvNames(Optional strDataFrameName As String = "") As List(Of String) - Return GetNames(strDataFrameName, "$get_surv_names") - End Function '''-------------------------------------------------------------------------------------------- ''' Gets the names of the data frame's keys. @@ -1863,6 +1955,35 @@ Public Class RLink End Function + '''-------------------------------------------------------------------------------------------- + ''' + ''' Gets the names of the data frame's objects. + ''' + ''' (Optional) The data frame name. + ''' (Optional) The object type label to get. + ''' + '''-------------------------------------------------------------------------------------------- + Public Function GetObjectNames(Optional strDataFrameName As String = "", + Optional strRObjectTypeLabel As String = "") As List(Of String) + Dim lstObjectNames As New List(Of String) + Dim clsGetObjectNamesRFunction As New RFunction + Dim expNames As SymbolicExpression + + clsGetObjectNamesRFunction.SetRCommand(strInstatDataObject & "$get_object_names") + If Not String.IsNullOrEmpty(strDataFrameName) Then + clsGetObjectNamesRFunction.AddParameter("data_name", Chr(34) & strDataFrameName & Chr(34)) + End If + If Not String.IsNullOrEmpty(strRObjectTypeLabel) Then + clsGetObjectNamesRFunction.AddParameter("object_type_label", Chr(34) & strRObjectTypeLabel & Chr(34)) + End If + expNames = RunInternalScriptGetValue(clsGetObjectNamesRFunction.ToScript(), bSilent:=True) + If expNames IsNot Nothing AndAlso Not expNames.Type = Internals.SymbolicExpressionType.Null Then + lstObjectNames = expNames.AsCharacter.ToArray.ToList + End If + Return lstObjectNames + End Function + + '''-------------------------------------------------------------------------------------------- ''' Gets the data type of the column in the ''' data frame. @@ -2203,34 +2324,6 @@ Public Class RLink RunScript(clsCreateIO.ToScript(), strComment:="Creating New Instat Object") End Sub - '''-------------------------------------------------------------------------------------------- - ''' View last graph. - ''' - ''' (Optional) If true then view last graph as plotly. - '''-------------------------------------------------------------------------------------------- - Public Sub ViewLastGraph(Optional bAsPlotly As Boolean = False) - Dim clsLastGraph As New RFunction - clsLastGraph.SetRCommand(strInstatDataObject & "$get_last_graph") - - If bAsPlotly Then - Dim clsInteractivePlot As New RFunction - clsLastGraph.AddParameter("print_graph", "FALSE", iPosition:=0) - clsInteractivePlot.SetPackageName("plotly") - clsInteractivePlot.SetRCommand("ggplotly") - clsInteractivePlot.AddParameter("p", clsRFunctionParameter:=clsLastGraph, iPosition:=0) - 'Need to set iCallType = 2 to obtain a graph in an interactive viewer. - RunScript(clsInteractivePlot.ToScript(), iCallType:=2, strComment:="View last graph as Plotly", bSeparateThread:=False) - Else - Dim strGlobalGraphDisplayOption As String - 'store the current set graph display option, to restore after display - strGlobalGraphDisplayOption = Me.strGraphDisplayOption - Me.strGraphDisplayOption = "view_R_viewer" - RunScript(clsLastGraph.ToScript(), iCallType:=3, strComment:="View last graph", bSeparateThread:=False) - 'restore the graph display option - Me.strGraphDisplayOption = strGlobalGraphDisplayOption - End If - End Sub - '''-------------------------------------------------------------------------------------------- ''' Prefixes each line of text in with '# '. ''' @@ -2280,7 +2373,7 @@ Public Class RLink 'Note: this function is not currently called but it will be used in future ' functionality to populate dialogs from script. ' Please do not delete this function. (@lloyddewit 24/11/21) - + 'temporary object that retrieves the output from the environment Dim strTempAssignTo As String = ".temp_func" Dim expTemp As SymbolicExpression @@ -2354,4 +2447,4 @@ Public Class RLink Return lstRParameters End Function -End Class +End Class \ No newline at end of file diff --git a/instat/clsROperator.vb b/instat/clsROperator.vb index e6a8e14501d..6286b4ae5c2 100644 --- a/instat/clsROperator.vb +++ b/instat/clsROperator.vb @@ -11,7 +11,7 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . '''-------------------------------------------------------------------------------------------- @@ -28,304 +28,302 @@ ''' ''' '''-------------------------------------------------------------------------------------------- -Public Class ROperator - Inherits RCodeStructure - - 'TODO Danny Parsons 15/04/20: - ' There is some tidying of the code that can be done around this class relating to its - ' inheritance from RCodeStructure. - ' - ' There are a number of functions which have both an RFunction And an ROperator as optional - ' parameters, with the idea that you usually pass in one or the other. These could be - ' replaced with a single RCodeStructure parameter. There are also classes which may store both - ' an RFunction and an ROperator but only ever expect one, so this may be able to be replaced - ' by an RCodeStructure. - ' - ' There may be some functions within the RFunction And ROperator classes which could be pushed - ' down to the RCodeStructure because they actually do the same thing regardless of which one it - ' is. I think this has mostly already been done but I think I remember seeing one example of - ' this recently. <-- Note from Lloyd - GetParameter? - ' - ' Both of these things exist because originally these two classes were separate before we - ' realised they should inherit from a common class. So RCodeStructure was created later as the - ' parent class, so I think you can see the remains of this sort of being done backwards. - ' - ' Another reason this hasn't been done is that much of this tidying up could affect every single - ' dialog so it's not clear how we coordinate this with all developers so that it doesn't cause a - ' huge number of conflicts. But it's something we should do at some point to improve the code. - - ''' If true then include the operation symbol in the script even if there's - ''' only a single parameter (e.g. to create a script such as '!x'). - ''' Else don't include the operation symbol in a script with only one parameter. - ''' - Public bForceIncludeOperation As Boolean = False - - ''' The operation symbol (e.g. "+"). - Public strOperation As String - - ''' If true then enclose first parameter in brackets. - Public bBrackets As Boolean = True - - ''' If true then enclose second, and any subsequent parameters, in brackets. - Public bAllBrackets As Boolean = False - - ''' If true then put spaces around operator e.g. " + ". - Public bSpaceAroundOperation As Boolean = True - - '''-------------------------------------------------------------------------------------------- - ''' Constructor. - ''' - ''' (Optional) The operation symbol (e.g. "+"). - ''' (Optional) If true then enclose first parameter in brackets. - ''' - '''-------------------------------------------------------------------------------------------- - Public Sub New(Optional strOp As String = "", Optional bBracketsTemp As Boolean = True) - SetOperation(strOp, bBracketsTemp) - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' Sets the operation's symbol (e.g. "+") and defines whether to include the first - ''' operation parameter in brackets. - ''' - ''' The operation symbol (e.g. "+"). - ''' (Optional) If true then enclose first parameter in brackets. - ''' - '''-------------------------------------------------------------------------------------------- - Public Sub SetOperation(strTemp As String, Optional bBracketsTemp As Boolean = True) - strOperation = strTemp - bBrackets = bBracketsTemp - bIsAssigned = False - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' - ''' Creates, updates and returns the script that generates the expected output for this - ''' operation. An operation will have an operation symbol (e.g. '+') and parameters. - ''' - ''' This function aims to create a human-readable script. It appends the first parameter - ''' to and then appends the operation symbol (e.g. appends'x+'). - ''' It then appends the remaining parameters using the same symbol (e.g. 'x+y+z'). - ''' Finally it calls the 'ToScript' function of the base class. This completes the script - ''' by adding the assignment part. - ''' - ''' Additional options: - ''' - ''' - ''' If there's only one parameter, then the operation symbol may be put first (e.g. '!x'). - ''' - ''' The operation symbol may be surrounded by spaces (e.g. '+' becomes ' + '). - ''' - ''' Each parameter may be surrounded by brackets '()'. - ''' - ''' "There is one further use of the operator which has proved really useful. That - ''' is the use of the ',' operator to define additional optional parameters. This Is - ''' sort of a cheat because of course it is not an operator in R but there are a number - ''' of cases where it has been useful to manage a set of parameters together. This also - ''' provides the reason why in that context it can make sense for that operator to have - ''' no operator symbols and no parameters!" - David Stern 15/04/20 - ''' - ''' - ''' [in,out] (Optional) The existing script including any - ''' assignment part. - ''' This script is passed to the 'ToScript' function of the base - ''' class. This script is also passed to the 'ToScript' function - ''' of the operator's parameters. - ''' (Optional) The current expression to assign. The script for - ''' this operation is appended to this parameter and then passed - ''' to the 'ToScript' function of the base class. - ''' - ''' If object needs to be assigned to, then returns the complete assign-to script. - ''' Else returns the script without an assignment part. - '''-------------------------------------------------------------------------------------------- - Public Overrides Function ToScript(Optional ByRef strScript As String = "", Optional strTemp As String = "") As String - Dim strAdjustedOperation As String - 'TODO SJL 03/04/20 Parts of this function seem to duplicate the ToScript function in RFunction. Refactor? - - SortParameters() - - 'if needed, put spaces around operator e.g. " <- " - If bSpaceAroundOperation Then - strAdjustedOperation = Chr(32) & strOperation & Chr(32) - Else - strAdjustedOperation = strOperation - End If - - 'if operator has parameters - If clsParameters.Count > 0 Then - - 'process first parameter - If clsParameters(0) IsNot Nothing Then - 'if first parameter needs brackets, then append the first parameter inside brackets - If clsParameters(0).bIsOperator AndAlso bBrackets Then - strTemp = strTemp & "(" & clsParameters(0).ToScript(strScript) & ")" - Else 'else just append the parameter without brackets - strTemp = strTemp & clsParameters(0).ToScript(strScript) - End If - - 'if there is only one parameter, and we need to include the operation symbol - If bForceIncludeOperation AndAlso clsParameters.Count = 1 Then - 'if parameter's position is 0 then put parameter's script on left side - If clsParameters(0).Position = 0 Then - strTemp = strTemp & strAdjustedOperation - Else 'else put parameter's script on right side - strTemp = strAdjustedOperation & strTemp - End If - End If - Else - 'TODO message - End If - - 'for each remaining parameter (starting from 2nd parameter) - 'Note: an operation may have >2 parameters (e.g. x+y+z ...) - For Each clsParam In clsParameters.GetRange(1, clsParameters.Count - 1) - 'append the operator to the script - strTemp = strTemp & strAdjustedOperation - - 'if parameter needs brackets, then append the parameter inside brackets - 'TODO SJL 03/04/20 repeats code above. Refactor? - If bAllBrackets AndAlso (clsParam.bIsFunction OrElse clsParam.bIsOperator) Then - strTemp = strTemp & "(" & clsParam.ToScript(strScript) & ")" - Else 'else just append the parameter without brackets - strTemp = strTemp & clsParam.ToScript(strScript) - End If - Next - - 'if the string needs to be passed directly to R - ' TODO SJL 15/04/20 This functionality is duplicated in RFunction. Move this functionality to a shared function in RCodeStructure? - If bToScriptAsRString Then - 'if string is intended to be assigned to a script then raise error (because modified script will no longer suitable for this) - 'TODO SJL 03/04/20 if we only allow these 3 flags to be accessed through 'set/get' functions then we can guarantee that this error situation doesn't occur - 'TODO Legacy comment:'should also check assignment of parameters' - If bToBeAssigned OrElse bIsAssigned Then - MsgBox("Developer error: Using bToScriptAsRString = True when RFunction is assigned will not produce the correct script. Remove assignment to use this options correctly.") - End If - - 'replace double quotes with single quotes - ' Note : Can't have double quotes ("") in the string because strTemp will be wrapped - ' with "". In most cases single quotes (') will give the same functionality, - ' though it's preferable to avoid this when constructing the RFunction. - strTemp = strTemp.Replace(Chr(34), Chr(39)) - - 'wrap the entire string in double quotes - strTemp = Chr(34) & strTemp & Chr(34) - End If - End If - - 'if object needs to be assigned to, then create/update the assignment script (if needed) - ' and return the assignment script. Otherwise just return 'strTemp'. - Return MyBase.ToScript(strScript, strTemp) - End Function - - '''-------------------------------------------------------------------------------------------- - ''' - ''' If the object already has a parameter with the same name then changes the parameter's - ''' value to the value in . Else adds - ''' to the object as a new parameter. - ''' - ''' This function also ensures that there is no existing parameter with the same position as - ''' the newly added/updated parameter. - ''' - ''' Note about parameter names for operators: They are not named in the display when you do - ''' ToScript() on an ROperator compared to an RFunction, but they are named within this - ''' class since the naming is used to be able to identify them for the purpose of adding - ''' and removing. We usually use the naming convention "0", "1", "2"... for ROperator - ''' parameters so that there is no confusion about the order. - ''' - ''' Note about parameter position for operators: By default, when the script for this - ''' operator is created then the operator is placed after the parameter (e.g. 'x + '). - ''' However, if an operator has only one parameter, and that parameter's position is 0, - ''' then this parameter will be put on the left side of the operation symbol (e.g. '!x'). - ''' - ''' - ''' The new parameter to add. - '''-------------------------------------------------------------------------------------------- - Public Overrides Sub AddParameter(clsParam As RParameter) - clsParam.bIncludeArgumentName = False 'an operator parameter shouldn't be named in the script - MyBase.AddParameter(clsParam) - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' - ''' Returns the parameter object named . - ''' - ''' - ''' The name of the parameter to return. - ''' - ''' A new RParameter object. - '''-------------------------------------------------------------------------------------------- - Public Overrides Function GetParameter(strName As String) As RParameter - Dim iTempIndex As Integer = -1 - If Not clsParameters Is Nothing Then - iTempIndex = clsParameters.FindIndex(Function(x) x.strArgumentName = strName) - If iTempIndex <> -1 Then - Return clsParameters(iTempIndex) - End If - End If - Return Nothing - End Function - - ''' Removes all additional parameters. - Public Sub RemoveAllAdditionalParameters() - 'TODO SJL 03/04/20 this function is only used by 1 dialog. This hints that there may be an alternative way of doing the same thing. - ' It's also suspicious that the other RCodeStructure classes don't have such a function. Why is it only needed for an operator? - ' Can this function be removed? - SortParameters() 'This is used to bring the parameter with position 0 to the front if it exists, then clear all the others using range. - If clsParameters(0).Position = 0 Then - If clsParameters.Count > 1 Then - clsParameters.RemoveRange(1, clsParameters.Count - 1) - End If - Else - clsParameters.Clear() - End If - OnParametersChanged() - End Sub - - ''' Clears this object to its blank/initial state. - Public Overrides Sub Clear() - SetOperation("") - bForceIncludeOperation = False - MyBase.Clear() - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' Makes a deep copy of this object. - ''' - ''' A copy of this object. - '''-------------------------------------------------------------------------------------------- - Public Overrides Function Clone() As RCodeStructure - Dim clsTempROperator As New ROperator - Dim clsRParam As RParameter - - 'RCode properties - clsTempROperator.strAssignTo = strAssignTo - clsTempROperator.strAssignToDataFrame = strAssignToDataFrame - clsTempROperator.strAssignToColumn = strAssignToColumn - clsTempROperator.strAssignToModel = strAssignToModel - clsTempROperator.strAssignToGraph = strAssignToGraph - clsTempROperator.strAssignToTable = strAssignToTable - clsTempROperator.bToBeAssigned = bToBeAssigned - clsTempROperator.bIsAssigned = bIsAssigned - clsTempROperator.bAssignToIsPrefix = bAssignToIsPrefix - clsTempROperator.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames - clsTempROperator.bInsertColumnBefore = bInsertColumnBefore - clsTempROperator.iNumberOfAddedParameters = iNumberOfAddedParameters - clsTempROperator.iPosition = iPosition - clsTempROperator.iCallType = iCallType - clsTempROperator.bExcludeAssignedFunctionOutput = bExcludeAssignedFunctionOutput - clsTempROperator.bClearFromGlobal = bClearFromGlobal - clsTempROperator.bToScriptAsRString = bToScriptAsRString - clsTempROperator.Tag = Tag - For Each clsRParam In clsParameters - clsTempROperator.AddParameter(clsRParam.Clone()) - Next - - 'ROperator specific properties - clsTempROperator.bForceIncludeOperation = bForceIncludeOperation - clsTempROperator.strOperation = strOperation - clsTempROperator.bBrackets = bBrackets - clsTempROperator.bAllBrackets = bAllBrackets - clsTempROperator.bSpaceAroundOperation = bSpaceAroundOperation - - Return clsTempROperator - End Function +Public Class ROperator + Inherits RCodeStructure + + 'TODO Danny Parsons 15/04/20: + ' There is some tidying of the code that can be done around this class relating to its + ' inheritance from RCodeStructure. + ' + ' There are a number of functions which have both an RFunction And an ROperator as optional + ' parameters, with the idea that you usually pass in one or the other. These could be + ' replaced with a single RCodeStructure parameter. There are also classes which may store both + ' an RFunction and an ROperator but only ever expect one, so this may be able to be replaced + ' by an RCodeStructure. + ' + ' There may be some functions within the RFunction And ROperator classes which could be pushed + ' down to the RCodeStructure because they actually do the same thing regardless of which one it + ' is. I think this has mostly already been done but I think I remember seeing one example of + ' this recently. <-- Note from Lloyd - GetParameter? + ' + ' Both of these things exist because originally these two classes were separate before we + ' realised they should inherit from a common class. So RCodeStructure was created later as the + ' parent class, so I think you can see the remains of this sort of being done backwards. + ' + ' Another reason this hasn't been done is that much of this tidying up could affect every single + ' dialog so it's not clear how we coordinate this with all developers so that it doesn't cause a + ' huge number of conflicts. But it's something we should do at some point to improve the code. + + ''' If true then include the operation symbol in the script even if there's + ''' only a single parameter (e.g. to create a script such as '!x'). + ''' Else don't include the operation symbol in a script with only one parameter. + ''' + Public bForceIncludeOperation As Boolean = False + + ''' The operation symbol (e.g. "+"). + Public strOperation As String + + ''' If true then enclose first parameter in brackets. + Public bBrackets As Boolean = True + + ''' If true then enclose second, and any subsequent parameters, in brackets. + Public bAllBrackets As Boolean = False + + ''' If true then put spaces around operator e.g. " + ". + Public bSpaceAroundOperation As Boolean = True + + '''-------------------------------------------------------------------------------------------- + ''' Constructor. + ''' + ''' (Optional) The operation symbol (e.g. "+"). + ''' (Optional) If true then enclose first parameter in brackets. + ''' + '''-------------------------------------------------------------------------------------------- + Public Sub New(Optional strOp As String = "", Optional bBracketsTemp As Boolean = True) + SetOperation(strOp, bBracketsTemp) + End Sub + + '''-------------------------------------------------------------------------------------------- + ''' Sets the operation's symbol (e.g. "+") and defines whether to include the first + ''' operation parameter in brackets. + ''' + ''' The operation symbol (e.g. "+"). + ''' (Optional) If true then enclose first parameter in brackets. + ''' + '''-------------------------------------------------------------------------------------------- + Public Sub SetOperation(strTemp As String, Optional bBracketsTemp As Boolean = True) + strOperation = strTemp + bBrackets = bBracketsTemp + 'bIsAssigned = False + End Sub + + '''-------------------------------------------------------------------------------------------- + ''' + ''' Creates, updates and returns the script that generates the expected output for this + ''' operation. An operation will have an operation symbol (e.g. '+') and parameters. + ''' + ''' This function aims to create a human-readable script. It appends the first parameter + ''' to and then appends the operation symbol (e.g. appends'x+'). + ''' It then appends the remaining parameters using the same symbol (e.g. 'x+y+z'). + ''' Finally it calls the 'ToScript' function of the base class. This completes the script + ''' by adding the assignment part. + ''' + ''' Additional options: + ''' + ''' + ''' If there's only one parameter, then the operation symbol may be put first (e.g. '!x'). + ''' + ''' The operation symbol may be surrounded by spaces (e.g. '+' becomes ' + '). + ''' + ''' Each parameter may be surrounded by brackets '()'. + ''' + ''' "There is one further use of the operator which has proved really useful. That + ''' is the use of the ',' operator to define additional optional parameters. This Is + ''' sort of a cheat because of course it is not an operator in R but there are a number + ''' of cases where it has been useful to manage a set of parameters together. This also + ''' provides the reason why in that context it can make sense for that operator to have + ''' no operator symbols and no parameters!" - David Stern 15/04/20 + ''' + ''' + ''' [in,out] (Optional) The existing script including any + ''' assignment part. + ''' This script is passed to the 'ToScript' function of the base + ''' class. This script is also passed to the 'ToScript' function + ''' of the operator's parameters. + ''' (Optional) The current expression to assign. The script for + ''' this operation is appended to this parameter and then passed + ''' to the 'ToScript' function of the base class. + ''' + ''' If object needs to be assigned to, then returns the complete assign-to script. + ''' Else returns the script without an assignment part. + '''-------------------------------------------------------------------------------------------- + Public Overrides Function ToScript(Optional ByRef strScript As String = "", Optional strTemp As String = "") As String + Dim strAdjustedOperation As String + 'TODO SJL 03/04/20 Parts of this function seem to duplicate the ToScript function in RFunction. Refactor? + + SortParameters() + + 'if needed, put spaces around operator e.g. " <- " + If bSpaceAroundOperation Then + strAdjustedOperation = Chr(32) & strOperation & Chr(32) + Else + strAdjustedOperation = strOperation + End If + + 'if operator has parameters + If clsParameters.Count > 0 Then + + 'process first parameter + If clsParameters(0) IsNot Nothing Then + 'if first parameter needs brackets, then append the first parameter inside brackets + If clsParameters(0).bIsOperator AndAlso bBrackets Then + strTemp = strTemp & "(" & clsParameters(0).ToScript(strScript) & ")" + Else 'else just append the parameter without brackets + strTemp = strTemp & clsParameters(0).ToScript(strScript) + End If + + 'if there is only one parameter, and we need to include the operation symbol + If bForceIncludeOperation AndAlso clsParameters.Count = 1 Then + 'if parameter's position is 0 then put parameter's script on left side + If clsParameters(0).Position = 0 Then + strTemp = strTemp & strAdjustedOperation + Else 'else put parameter's script on right side + strTemp = strAdjustedOperation & strTemp + End If + End If + Else + 'TODO message + End If + + 'for each remaining parameter (starting from 2nd parameter) + 'Note: an operation may have >2 parameters (e.g. x+y+z ...) + For Each clsParam In clsParameters.GetRange(1, clsParameters.Count - 1) + 'append the operator to the script + strTemp = strTemp & strAdjustedOperation + + 'if parameter needs brackets, then append the parameter inside brackets + 'TODO SJL 03/04/20 repeats code above. Refactor? + If bAllBrackets AndAlso (clsParam.bIsFunction OrElse clsParam.bIsOperator) Then + strTemp = strTemp & "(" & clsParam.ToScript(strScript) & ")" + Else 'else just append the parameter without brackets + strTemp = strTemp & clsParam.ToScript(strScript) + End If + Next + + 'if the string needs to be passed directly to R + ' TODO SJL 15/04/20 This functionality is duplicated in RFunction. Move this functionality to a shared function in RCodeStructure? + If bToScriptAsRString Then + 'if string is intended to be assigned to a script then raise error (because modified script will no longer suitable for this) + 'TODO SJL 03/04/20 if we only allow these 3 flags to be accessed through 'set/get' functions then we can guarantee that this error situation doesn't occur + 'TODO Legacy comment:'should also check assignment of parameters' + If IsAssigned() Then + MsgBox("Developer error: Using bToScriptAsRString = True when RFunction is assigned will not produce the correct script. Remove assignment to use this options correctly.") + End If + + 'replace double quotes with single quotes + ' Note : Can't have double quotes ("") in the string because strTemp will be wrapped + ' with "". In most cases single quotes (') will give the same functionality, + ' though it's preferable to avoid this when constructing the RFunction. + strTemp = strTemp.Replace(Chr(34), Chr(39)) + + 'wrap the entire string in double quotes + strTemp = Chr(34) & strTemp & Chr(34) + End If + End If + + 'if object needs to be assigned to, then create/update the assignment script (if needed) + ' and return the assignment script. Otherwise just return 'strTemp'. + Return MyBase.ToScript(strScript, strTemp) + End Function + + '''-------------------------------------------------------------------------------------------- + ''' + ''' If the object already has a parameter with the same name then changes the parameter's + ''' value to the value in . Else adds + ''' to the object as a new parameter. + ''' + ''' This function also ensures that there is no existing parameter with the same position as + ''' the newly added/updated parameter. + ''' + ''' Note about parameter names for operators: They are not named in the display when you do + ''' ToScript() on an ROperator compared to an RFunction, but they are named within this + ''' class since the naming is used to be able to identify them for the purpose of adding + ''' and removing. We usually use the naming convention "0", "1", "2"... for ROperator + ''' parameters so that there is no confusion about the order. + ''' + ''' Note about parameter position for operators: By default, when the script for this + ''' operator is created then the operator is placed after the parameter (e.g. 'x + '). + ''' However, if an operator has only one parameter, and that parameter's position is 0, + ''' then this parameter will be put on the left side of the operation symbol (e.g. '!x'). + ''' + ''' + ''' The new parameter to add. + '''-------------------------------------------------------------------------------------------- + Public Overrides Sub AddParameter(clsParam As RParameter) + clsParam.bIncludeArgumentName = False 'an operator parameter shouldn't be named in the script + MyBase.AddParameter(clsParam) + End Sub + + '''-------------------------------------------------------------------------------------------- + ''' + ''' Returns the parameter object named . + ''' + ''' + ''' The name of the parameter to return. + ''' + ''' A new RParameter object. + '''-------------------------------------------------------------------------------------------- + Public Overrides Function GetParameter(strName As String) As RParameter + Dim iTempIndex As Integer = -1 + If Not clsParameters Is Nothing Then + iTempIndex = clsParameters.FindIndex(Function(x) x.strArgumentName = strName) + If iTempIndex <> -1 Then + Return clsParameters(iTempIndex) + End If + End If + Return Nothing + End Function + + ''' Removes all additional parameters. + Public Sub RemoveAllAdditionalParameters() + 'TODO SJL 03/04/20 this function is only used by 1 dialog. This hints that there may be an alternative way of doing the same thing. + ' It's also suspicious that the other RCodeStructure classes don't have such a function. Why is it only needed for an operator? + ' Can this function be removed? + SortParameters() 'This is used to bring the parameter with position 0 to the front if it exists, then clear all the others using range. + If clsParameters(0).Position = 0 Then + If clsParameters.Count > 1 Then + clsParameters.RemoveRange(1, clsParameters.Count - 1) + End If + Else + clsParameters.Clear() + End If + OnParametersChanged() + End Sub + + ''' Clears this object to its blank/initial state. + Public Overrides Sub Clear() + SetOperation("") + bForceIncludeOperation = False + MyBase.Clear() + End Sub + + '''-------------------------------------------------------------------------------------------- + ''' Makes a deep copy of this object. + ''' + ''' A copy of this object. + '''-------------------------------------------------------------------------------------------- + Public Overrides Function Clone() As RCodeStructure + Dim clsTempROperator As New ROperator + Dim clsRParam As RParameter + + 'RCode properties + 'todo. why not use the MyBase.Clone() for some of these inherited from the parent properties? + clsTempROperator._strAssignToObject = _strAssignToObject + clsTempROperator._strAssignToName = _strAssignToName + clsTempROperator._strAssignToObjectTypeLabel = _strAssignToObjectTypeLabel + clsTempROperator._strAssignToObjectFormat = _strAssignToObjectFormat + clsTempROperator._strDataFrameNameToAddAssignToObject = _strDataFrameNameToAddAssignToObject + clsTempROperator.bAssignToIsPrefix = bAssignToIsPrefix + clsTempROperator.bAssignToColumnWithoutNames = bAssignToColumnWithoutNames + clsTempROperator.bInsertColumnBefore = bInsertColumnBefore + clsTempROperator.iNumberOfAddedParameters = iNumberOfAddedParameters + clsTempROperator.iPosition = iPosition + clsTempROperator.iCallType = iCallType + clsTempROperator.bExcludeAssignedFunctionOutput = bExcludeAssignedFunctionOutput + clsTempROperator.bClearFromGlobal = bClearFromGlobal + clsTempROperator.bToScriptAsRString = bToScriptAsRString + clsTempROperator.Tag = Tag + For Each clsRParam In clsParameters + clsTempROperator.AddParameter(clsRParam.Clone()) + Next + + 'ROperator specific properties + clsTempROperator.bForceIncludeOperation = bForceIncludeOperation + clsTempROperator.strOperation = strOperation + clsTempROperator.bBrackets = bBrackets + clsTempROperator.bAllBrackets = bAllBrackets + clsTempROperator.bSpaceAroundOperation = bSpaceAroundOperation + + Return clsTempROperator + End Function End Class \ No newline at end of file diff --git a/instat/clsRSyntax.vb b/instat/clsRSyntax.vb index 439d889405d..90b4913385d 100644 --- a/instat/clsRSyntax.vb +++ b/instat/clsRSyntax.vb @@ -94,8 +94,6 @@ Public Class RSyntax ''' Public iCallType As Integer = 0 'TODO SJL 07/04/20 Use enumeration? - ''' TODO SJL 07/04/20 Not used. Remove? - Public bHTMLOutput As Boolean = False ''' The script associated with the base R code. Public strScript As String 'TODO SJL This is only used in the RSyntax.GetScript function. Also cleared once in ucrButtons. Refactor? @@ -415,10 +413,13 @@ Public Class RSyntax ElseIf bUseCommandString Then strTemp = clsBaseCommandString.ToScript(strScript, strCommandString) End If + If bExcludeAssignedFunctionOutput Then - 'Sometimes the output of the R-command we deal with should not be part of the script... - ' That's only the case when this output has already been assigned. - If (bUseBaseFunction AndAlso clsBaseFunction.bIsAssigned) OrElse (bUseBaseOperator AndAlso clsBaseOperator.bIsAssigned) OrElse (bUseCommandString AndAlso clsBaseCommandString.bIsAssigned) Then + 'Sometimes the output of the R-command we deal with should not be part of the script... + 'That's only the case when this output has already been assigned. + If (bUseBaseFunction AndAlso clsBaseFunction.IsAssigned()) OrElse + (bUseBaseOperator AndAlso clsBaseFunction.IsAssigned()) OrElse + (bUseCommandString AndAlso clsBaseFunction.IsAssigned()) Then Return strScript End If End If @@ -445,8 +446,8 @@ Public Class RSyntax For Each clsTempCode In lstCodes strScript = "" strTemp = clsTempCode.ToScript(strScript) - 'Sometimes the output of the R-command we deal with should not be part of the script... That's only the case when this output has already been assigned. - If clsTempCode.bExcludeAssignedFunctionOutput AndAlso clsTempCode.bIsAssigned Then + 'Sometimes the output of the R-command we deal with should not be part of the script... + If clsTempCode.bExcludeAssignedFunctionOutput AndAlso Not String.IsNullOrEmpty(clsTempCode.GetRObjectToAssignTo) Then lstScripts.Add(strScript) Else lstScripts.Add(strScript & strTemp) @@ -576,40 +577,6 @@ Public Class RSyntax End If End Function - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' True if it succeeds, false if it fails. - '''-------------------------------------------------------------------------------------------- - Public Function GetbIsAssigned() As Boolean - If bUseBaseFunction Then - Return clsBaseFunction.bIsAssigned - ElseIf bUseBaseOperator Then - Return clsBaseOperator.bIsAssigned - ElseIf bUseCommandString Then - Return clsBaseCommandString.bIsAssigned - Else - Return False - End If - End Function - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' True if it succeeds, false if it fails. - '''-------------------------------------------------------------------------------------------- - Public Function GetbToBeAssigned() As Boolean - If bUseBaseFunction Then - Return clsBaseFunction.bToBeAssigned - ElseIf bUseBaseOperator Then - Return clsBaseOperator.bToBeAssigned - ElseIf bUseCommandString Then - Return clsBaseCommandString.bToBeAssigned - Else - Return False - End If - End Function - '''-------------------------------------------------------------------------------------------- ''' If the output from the R command needs to be assigned, then returns ''' the part of the script to the left of the assignment operator ('<-'). @@ -623,125 +590,16 @@ Public Class RSyntax '''-------------------------------------------------------------------------------------------- Public Function GetstrAssignTo() As String If bUseBaseFunction Then - Return clsBaseFunction.strAssignTo - ElseIf bUseBaseOperator Then - Return clsBaseOperator.strAssignTo - ElseIf bUseCommandString Then - Return clsBaseCommandString.strAssignTo - Else - Return "" - End If - End Function - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' A String. - '''-------------------------------------------------------------------------------------------- - Public Function GetstrAssignToColumn() As String - If bUseBaseFunction Then - Return clsBaseFunction.strAssignToColumn - ElseIf bUseBaseOperator Then - Return clsBaseOperator.strAssignToColumn - ElseIf bUseCommandString Then - Return clsBaseCommandString.strAssignToColumn - Else - Return "" - End If - End Function - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' A String. - '''-------------------------------------------------------------------------------------------- - Public Function GetstrAssignToDataFrame() As String - If bUseBaseFunction Then - Return clsBaseFunction.strAssignToDataFrame + Return clsBaseFunction.GetRObjectToAssignTo() ElseIf bUseBaseOperator Then - Return clsBaseOperator.strAssignToDataFrame + Return clsBaseOperator.GetRObjectToAssignTo() ElseIf bUseCommandString Then - Return clsBaseCommandString.strAssignToDataFrame + Return clsBaseCommandString.GetRObjectToAssignTo() Else Return "" End If End Function - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' True to new. - '''-------------------------------------------------------------------------------------------- - Public Sub SetbIsAssigned(bNew As Boolean) - If bUseBaseFunction Then - clsBaseFunction.bIsAssigned = bNew - ElseIf bUseBaseOperator Then - clsBaseOperator.bIsAssigned = bNew - ElseIf bUseCommandString Then - clsBaseCommandString.bIsAssigned = bNew - End If - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' True to new. - '''-------------------------------------------------------------------------------------------- - Public Sub SetbToBeAssigned(bNew As Boolean) - If bUseBaseFunction Then - clsBaseFunction.bToBeAssigned = bNew - ElseIf bUseBaseOperator Then - clsBaseOperator.bToBeAssigned = bNew - ElseIf bUseCommandString Then - clsBaseCommandString.bToBeAssigned = bNew - End If - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' The new. - '''-------------------------------------------------------------------------------------------- - Public Sub SetstrAssignTo(strNew As String) - If bUseBaseFunction Then - clsBaseFunction.strAssignTo = strNew - ElseIf bUseBaseOperator Then - clsBaseOperator.strAssignTo = strNew - ElseIf bUseCommandString Then - clsBaseCommandString.strAssignTo = strNew - End If - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' The new. - '''-------------------------------------------------------------------------------------------- - Public Sub SetstrAssignToColumn(strNew As String) - If bUseBaseFunction Then - clsBaseFunction.strAssignToColumn = strNew - ElseIf bUseBaseOperator Then - clsBaseOperator.strAssignToColumn = strNew - ElseIf bUseCommandString Then - clsBaseCommandString.strAssignToColumn = strNew - End If - End Sub - - '''-------------------------------------------------------------------------------------------- - ''' TODO SJL 04/04/20 This function is not used, remove? - ''' - ''' The new. - '''-------------------------------------------------------------------------------------------- - Public Sub SetstrAssignToDataFrame(strNew As String) - If bUseBaseFunction Then - clsBaseFunction.strAssignToDataFrame = strNew - ElseIf bUseBaseOperator Then - clsBaseOperator.strAssignToDataFrame = strNew - ElseIf bUseCommandString Then - clsBaseCommandString.strAssignToDataFrame = strNew - End If - End Sub - '''-------------------------------------------------------------------------------------------- ''' Returns true if is in the list of 'before' R ''' functions/operators/commands (i.e. the ones that run before the base R code), diff --git a/instat/dlgBarAndPieChart.Designer.vb b/instat/dlgBarAndPieChart.Designer.vb index 8ea11695b1a..c848bcde7b1 100644 --- a/instat/dlgBarAndPieChart.Designer.vb +++ b/instat/dlgBarAndPieChart.Designer.vb @@ -54,7 +54,6 @@ Partial Class dlgBarAndPieChart Me.lblLollipopSize = New System.Windows.Forms.Label() Me.lblLollipopColour = New System.Windows.Forms.Label() Me.lblReorder = New System.Windows.Forms.Label() - Me.lblReorderX = New System.Windows.Forms.Label() Me.rdoTreeMap = New System.Windows.Forms.RadioButton() Me.lblFill = New System.Windows.Forms.Label() Me.lblArea = New System.Windows.Forms.Label() @@ -67,6 +66,7 @@ Partial Class dlgBarAndPieChart Me.lblWordcloudSize = New System.Windows.Forms.Label() Me.lblWordcloudColor = New System.Windows.Forms.Label() Me.lblWordcloudAngle = New System.Windows.Forms.Label() + Me.ucrChkReorderFrequency = New instat.ucrCheck() Me.ucrChkReorderValue = New instat.ucrCheck() Me.ucrInputPlace = New instat.ucrInputComboBox() Me.ucrInputLayout = New instat.ucrInputComboBox() @@ -91,7 +91,6 @@ Partial Class dlgBarAndPieChart Me.ucrReceiverWordcloudColor = New instat.ucrReceiverSingle() Me.ucrReceiverX = New instat.ucrReceiverSingle() Me.ucrInputReorderX = New instat.ucrInputComboBox() - Me.ucrReceiverWordcloudAngle = New instat.ucrReceiverSingle() Me.ucrChkIncreaseSize = New instat.ucrCheck() Me.ucrInputAddReorder = New instat.ucrInputComboBox() Me.ucrChkAddLabelsText = New instat.ucrCheck() @@ -105,6 +104,7 @@ Partial Class dlgBarAndPieChart Me.ucrChkBacktoback = New instat.ucrCheck() Me.ucrChkPolarCoordinates = New instat.ucrCheck() Me.ucrVariablesAsFactorForBarChart = New instat.ucrVariablesAsFactor() + Me.ucrReceiverWordcloudAngle = New instat.ucrReceiverSingle() Me.SuspendLayout() ' 'lblByFactor @@ -282,16 +282,6 @@ Partial Class dlgBarAndPieChart Me.lblReorder.TabIndex = 36 Me.lblReorder.Text = "Reorder:" ' - 'lblReorderX - ' - Me.lblReorderX.AutoSize = True - Me.lblReorderX.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblReorderX.Location = New System.Drawing.Point(255, 196) - Me.lblReorderX.Name = "lblReorderX" - Me.lblReorderX.Size = New System.Drawing.Size(48, 13) - Me.lblReorderX.TabIndex = 11 - Me.lblReorderX.Text = "Reorder:" - ' 'rdoTreeMap ' Me.rdoTreeMap.Appearance = System.Windows.Forms.Appearance.Button @@ -410,13 +400,22 @@ Partial Class dlgBarAndPieChart Me.lblWordcloudAngle.TabIndex = 21 Me.lblWordcloudAngle.Text = "Angle:" ' + 'ucrChkReorderFrequency + ' + Me.ucrChkReorderFrequency.AutoSize = True + Me.ucrChkReorderFrequency.Checked = False + Me.ucrChkReorderFrequency.Location = New System.Drawing.Point(252, 189) + Me.ucrChkReorderFrequency.Name = "ucrChkReorderFrequency" + Me.ucrChkReorderFrequency.Size = New System.Drawing.Size(125, 23) + Me.ucrChkReorderFrequency.TabIndex = 66 + ' 'ucrChkReorderValue ' Me.ucrChkReorderValue.AutoSize = True Me.ucrChkReorderValue.Checked = False Me.ucrChkReorderValue.Location = New System.Drawing.Point(253, 236) Me.ucrChkReorderValue.Name = "ucrChkReorderValue" - Me.ucrChkReorderValue.Size = New System.Drawing.Size(93, 23) + Me.ucrChkReorderValue.Size = New System.Drawing.Size(119, 23) Me.ucrChkReorderValue.TabIndex = 65 ' 'ucrInputPlace @@ -573,7 +572,7 @@ Partial Class dlgBarAndPieChart Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink Me.ucrBase.Location = New System.Drawing.Point(7, 491) Me.ucrBase.Name = "ucrBase" - Me.ucrBase.Size = New System.Drawing.Size(405, 52) + Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 60 ' 'ucrPnlOptions @@ -684,19 +683,6 @@ Partial Class dlgBarAndPieChart Me.ucrInputReorderX.Size = New System.Drawing.Size(93, 21) Me.ucrInputReorderX.TabIndex = 12 ' - 'ucrReceiverWordcloudAngle - ' - Me.ucrReceiverWordcloudAngle.AutoSize = True - Me.ucrReceiverWordcloudAngle.frmParent = Me - Me.ucrReceiverWordcloudAngle.Location = New System.Drawing.Point(252, 191) - Me.ucrReceiverWordcloudAngle.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverWordcloudAngle.Name = "ucrReceiverWordcloudAngle" - Me.ucrReceiverWordcloudAngle.Selector = Nothing - Me.ucrReceiverWordcloudAngle.Size = New System.Drawing.Size(120, 21) - Me.ucrReceiverWordcloudAngle.strNcFilePath = "" - Me.ucrReceiverWordcloudAngle.TabIndex = 20 - Me.ucrReceiverWordcloudAngle.ucrSelector = Nothing - ' 'ucrChkIncreaseSize ' Me.ucrChkIncreaseSize.AutoSize = True @@ -823,6 +809,19 @@ Partial Class dlgBarAndPieChart Me.ucrVariablesAsFactorForBarChart.ucrSelector = Nothing Me.ucrVariablesAsFactorForBarChart.ucrVariableSelector = Nothing ' + 'ucrReceiverWordcloudAngle + ' + Me.ucrReceiverWordcloudAngle.AutoSize = True + Me.ucrReceiverWordcloudAngle.frmParent = Me + Me.ucrReceiverWordcloudAngle.Location = New System.Drawing.Point(252, 191) + Me.ucrReceiverWordcloudAngle.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverWordcloudAngle.Name = "ucrReceiverWordcloudAngle" + Me.ucrReceiverWordcloudAngle.Selector = Nothing + Me.ucrReceiverWordcloudAngle.Size = New System.Drawing.Size(120, 21) + Me.ucrReceiverWordcloudAngle.strNcFilePath = "" + Me.ucrReceiverWordcloudAngle.TabIndex = 20 + Me.ucrReceiverWordcloudAngle.ucrSelector = Nothing + ' 'dlgBarAndPieChart ' Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) @@ -830,6 +829,7 @@ Partial Class dlgBarAndPieChart Me.AutoSize = True Me.ClientSize = New System.Drawing.Size(415, 547) Me.Controls.Add(Me.ucrChkReorderValue) + Me.Controls.Add(Me.ucrChkReorderFrequency) Me.Controls.Add(Me.ucrInputPlace) Me.Controls.Add(Me.lblPlace) Me.Controls.Add(Me.ucrInputLayout) @@ -874,9 +874,6 @@ Partial Class dlgBarAndPieChart Me.Controls.Add(Me.lblWordcloudAngle) Me.Controls.Add(Me.ucrInputReorderX) Me.Controls.Add(Me.cmdBarChartOptions) - Me.Controls.Add(Me.lblXvariable) - Me.Controls.Add(Me.ucrReceiverWordcloudAngle) - Me.Controls.Add(Me.lblReorderX) Me.Controls.Add(Me.ucrChkIncreaseSize) Me.Controls.Add(Me.ucrInputAddReorder) Me.Controls.Add(Me.ucrChkAddLabelsText) @@ -893,6 +890,8 @@ Partial Class dlgBarAndPieChart Me.Controls.Add(Me.lblWordcloudLabel) Me.Controls.Add(Me.lblArea) Me.Controls.Add(Me.ucrVariablesAsFactorForBarChart) + Me.Controls.Add(Me.lblXvariable) + Me.Controls.Add(Me.ucrReceiverWordcloudAngle) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow Me.MaximizeBox = False Me.MinimizeBox = False @@ -940,7 +939,6 @@ Partial Class dlgBarAndPieChart Friend WithEvents ucrChkLollipop As ucrCheck Friend WithEvents ucrInputAddReorder As ucrInputComboBox Friend WithEvents lblReorder As Label - Friend WithEvents lblReorderX As Label Friend WithEvents ucrInputReorderX As ucrInputComboBox Friend WithEvents ucrInputReorderValue As ucrInputComboBox Friend WithEvents rdoTreeMap As RadioButton @@ -971,4 +969,5 @@ Partial Class dlgBarAndPieChart Friend WithEvents ucrChkIncreaseSize As ucrCheck Friend WithEvents ucrNudMaxSize As ucrNud Friend WithEvents ucrChkReorderValue As ucrCheck + Friend WithEvents ucrChkReorderFrequency As ucrCheck End Class \ No newline at end of file diff --git a/instat/dlgBarAndPieChart.vb b/instat/dlgBarAndPieChart.vb index 3a172a1cf1a..ae4b2446f6b 100644 --- a/instat/dlgBarAndPieChart.vb +++ b/instat/dlgBarAndPieChart.vb @@ -74,6 +74,7 @@ Public Class dlgBarAndPieChart Private clsGeomTextWordcloudFunction As New RFunction Private clsGeomTextWordcloudAesFunction As New RFunction Private clsScaleSizeAreaFunction As New RFunction + Private clsDummyFunction As New RFunction Private ReadOnly strAscending As String = "Ascending" Private ReadOnly strDescending As String = "Descending" @@ -125,7 +126,7 @@ Public Class dlgBarAndPieChart ucrPnlOptions.AddToLinkedControls({ucrChkFlipCoordinates, ucrChkPolarCoordinates, ucrReceiverByFactor, ucrInputBarChartPositions, ucrChkAddLabelsText, ucrVariablesAsFactorForBarChart, ucrChkBacktoback}, {rdoFrequency, rdoValue}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) ucrPnlOptions.AddToLinkedControls({ucrReceiverX, ucrChkReorderValue, ucrChkLollipop}, {rdoValue}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) - ucrPnlOptions.AddToLinkedControls(ucrInputReorderX, {rdoFrequency}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) + ucrPnlOptions.AddToLinkedControls(ucrChkReorderFrequency, {rdoFrequency}, bNewLinkedHideIfParameterMissing:=True) ucrPnlOptions.AddToLinkedControls({ucrReceiverArea, ucrReceiverFill, ucrChkLayout, ucrChkStart, ucrChkAddLabelsTreemap}, {rdoTreeMap}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) ucrPnlOptions.AddToLinkedControls({ucrReceiverWordcloudAngle, ucrReceiverWordcloudColor, ucrReceiverWordcloudLabel, ucrReceiverWordcloudSize, ucrChkIncreaseSize}, {rdoWordCloud}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) ucrReceiverByFactor.SetLinkedDisplayControl(lblByFactor) @@ -305,7 +306,6 @@ Public Class dlgBarAndPieChart ucrInputReorderX.SetItems({strAscending, strDescending, strReverse, strNone}) ucrInputReorderX.SetDropDownStyleAsNonEditable() - ucrInputReorderX.SetLinkedDisplayControl(lblReorderX) ucrInputReorderValue.SetItems({strAscending, strDescending, strReverse, strNone}) ucrInputReorderValue.SetDropDownStyleAsNonEditable() @@ -314,6 +314,11 @@ Public Class dlgBarAndPieChart ucrChkReorderValue.AddFunctionNamesCondition(False, "reorder", False) ucrChkReorderValue.AddToLinkedControls(ucrInputReorderValue, {True}, bNewLinkedHideIfParameterMissing:=True) + ucrChkReorderFrequency.SetText("Reorder Frequency") + ucrChkReorderFrequency.SetParameter(New RParameter("Checked", iNewPosition:=0)) + ucrChkReorderFrequency.SetValuesCheckedAndUnchecked("TRUE", "FALSE") + ucrChkReorderFrequency.AddToLinkedControls(ucrInputReorderX, {True}, bNewLinkedHideIfParameterMissing:=True, bNewLinkedAddRemoveParameter:=True) + ucrInputLayout.SetParameter(New RParameter("layout", 2)) dctLayout.Add("Squarified", Chr(34) & "squarified" & Chr(34)) dctLayout.Add("Scol", Chr(34) & "scol" & Chr(34)) @@ -391,6 +396,7 @@ Public Class dlgBarAndPieChart clsGeomTextWordcloudFunction = New RFunction clsGeomTextWordcloudAesFunction = New RFunction clsScaleSizeAreaFunction = New RFunction + clsDummyFunction = New RFunction ucrBarChartSelector.Reset() ucrBarChartSelector.SetGgplotFunction(clsBaseOperator) @@ -409,6 +415,8 @@ Public Class dlgBarAndPieChart rdoPie.Checked = True rdoFrequency.Checked = True + clsDummyFunction.AddParameter("Checked", "FALSE", iPosition:=0) + clsBaseOperator.SetOperation("+") clsBaseOperator.AddParameter("ggplot", clsRFunctionParameter:=clsRggplotFunction, iPosition:=0) clsBaseOperator.AddParameter("geom_bar", clsRFunctionParameter:=clsRgeomBarFunction, iPosition:=2) @@ -610,6 +618,7 @@ Public Class dlgBarAndPieChart ucrChkAddLabelsTreemap.SetRCode(clsBaseOperator, bReset) ucrNudMaxSize.SetRCode(clsScaleSizeAreaFunction, bReset) ucrChkIncreaseSize.SetRCode(clsScaleSizeAreaFunction, bReset) + ucrChkReorderFrequency.SetRCode(clsDummyFunction, bReset) End Sub Private Sub TestOkEnabled() @@ -718,13 +727,11 @@ Public Class dlgBarAndPieChart ucrChkLollipop.Enabled = If(rdoValue.Checked, True, False) If rdoFrequency.Checked Then If ucrVariablesAsFactorForBarChart.bSingleVariable Then - ucrInputReorderX.Visible = True ucrInputAddReorder.Visible = Not ucrReceiverByFactor.IsEmpty() If Not ucrInputAddReorder.Visible Then ucrInputAddReorder.SetText(strNone) End If Else - ucrInputReorderX.Visible = False ucrInputReorderX.SetText(strNone) End If ElseIf rdoValue.Checked Then diff --git a/instat/dlgCalculator.vb b/instat/dlgCalculator.vb index 4e67fcc6781..2e1203f7f9d 100644 --- a/instat/dlgCalculator.vb +++ b/instat/dlgCalculator.vb @@ -172,7 +172,7 @@ Public Class dlgCalculator Me.Width = iBasicWidth * 1.37 ucrBase.iHelpTopicID = 130 Case "Transform" - Me.Width = iBasicWidth * 1.37 + Me.Width = iBasicWidth * 1.48 ucrBase.iHelpTopicID = 166 Case "Circular" Me.Width = iBasicWidth * 1.36 @@ -188,7 +188,7 @@ Public Class dlgCalculator Me.Width = iBasicWidth * 1.27 ucrBase.iHelpTopicID = 598 Case "Integer" - Me.Width = iBasicWidth * 1.38 + Me.Width = iBasicWidth * 1.5 Case Else Me.Width = iBasicWidth End Select diff --git a/instat/dlgClimaticSummary.vb b/instat/dlgClimaticSummary.vb index 53a67e26187..c1473ac7261 100644 --- a/instat/dlgClimaticSummary.vb +++ b/instat/dlgClimaticSummary.vb @@ -87,7 +87,8 @@ Public Class dlgClimaticSummary ucrReceiverWithinYear.SetParameter(New RParameter("within_variable", 2, False)) ucrReceiverWithinYear.SetParameterIsString() - 'ucrReceiverWithinYear.strSelectorHeading = "Factors" + ucrReceiverWithinYear.SetClimaticType("month") + ucrReceiverWithinYear.bAutoFill = True ucrReceiverWithinYear.Selector = ucrSelectorVariable ucrReceiverWithinYear.SetIncludedDataTypes({"numeric", "factor"}) diff --git a/instat/dlgCluster.Designer.vb b/instat/dlgCluster.Designer.vb index 41fb25c9194..a507889f50f 100644 --- a/instat/dlgCluster.Designer.vb +++ b/instat/dlgCluster.Designer.vb @@ -194,7 +194,7 @@ Partial Class dlgCluster Me.ucrPnlSelectData.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink Me.ucrPnlSelectData.Location = New System.Drawing.Point(255, 65) Me.ucrPnlSelectData.Name = "ucrPnlSelectData" - Me.ucrPnlSelectData.Size = New System.Drawing.Size(135, 48) + Me.ucrPnlSelectData.Size = New System.Drawing.Size(160, 48) Me.ucrPnlSelectData.TabIndex = 4 ' 'ucrPnlPrepareData diff --git a/instat/dlgColumnStats.vb b/instat/dlgColumnStats.vb index 08683962d35..ddc5d469a6b 100644 --- a/instat/dlgColumnStats.vb +++ b/instat/dlgColumnStats.vb @@ -192,6 +192,10 @@ Public Class dlgColumnStats End If If Not ucrChkOmitMissing.Checked Then clsDefaultFunction.RemoveParameterByName("na_type") + clsDefaultFunction.RemoveParameterByName("na_max_n") + clsDefaultFunction.RemoveParameterByName("na_min_n") + clsDefaultFunction.RemoveParameterByName("na_max_prop") + clsDefaultFunction.RemoveParameterByName("na_consecutive_n") Else clsDefaultFunction.AddParameter("na_type", clsRFunctionParameter:=clsConcFunction, iPosition:=9) End If diff --git a/instat/dlgDescribeTwoVariable.Designer.vb b/instat/dlgDescribeTwoVariable.Designer.vb index fccec8ee931..d2a3d494067 100644 --- a/instat/dlgDescribeTwoVariable.Designer.vb +++ b/instat/dlgDescribeTwoVariable.Designer.vb @@ -42,6 +42,8 @@ Partial Class dlgDescribeTwoVariable Me.lblFirstVariable = New System.Windows.Forms.Label() Me.lbSecondVariable = New System.Windows.Forms.Label() Me.grpOptions = New System.Windows.Forms.GroupBox() + Me.cmdMissingOptions = New System.Windows.Forms.Button() + Me.ucrChkOmitMissing = New instat.ucrCheck() Me.lblSummary = New System.Windows.Forms.Label() Me.lblFirstType = New System.Windows.Forms.Label() Me.lblBy = New System.Windows.Forms.Label() @@ -55,22 +57,21 @@ Partial Class dlgDescribeTwoVariable Me.lblNumericVariable = New System.Windows.Forms.Label() Me.lblMarginName = New System.Windows.Forms.Label() Me.grpDisplay = New System.Windows.Forms.GroupBox() + Me.ucrReceiverPercentages = New instat.ucrReceiverSingle() Me.lblFactorsAsPercentage = New System.Windows.Forms.Label() + Me.ucrChkPercentageProportion = New instat.ucrCheck() + Me.ucrChkDisplayAsPercentage = New instat.ucrCheck() Me.grpFrequency = New System.Windows.Forms.GroupBox() - Me.lblColumnFactors = New System.Windows.Forms.Label() - Me.lblSigFigs = New System.Windows.Forms.Label() - Me.rdoThreeVariable = New System.Windows.Forms.RadioButton() - Me.ucrBase = New instat.ucrButtons() Me.ucrNudColumnFactors = New instat.ucrNud() + Me.lblColumnFactors = New System.Windows.Forms.Label() Me.ucrNudSigFigs = New instat.ucrNud() Me.ucrInputMarginName = New instat.ucrInputTextBox() + Me.lblSigFigs = New System.Windows.Forms.Label() Me.ucrChkDisplayMargins = New instat.ucrCheck() - Me.ucrReceiverPercentages = New instat.ucrReceiverSingle() - Me.ucrChkPercentageProportion = New instat.ucrCheck() - Me.ucrChkDisplayAsPercentage = New instat.ucrCheck() + Me.rdoThreeVariable = New System.Windows.Forms.RadioButton() + Me.ucrBase = New instat.ucrButtons() Me.ucrReceiverNumericVariable = New instat.ucrReceiverSingle() Me.ucrReceiverSecondFactor = New instat.ucrReceiverSingle() - Me.ucrChkOmitMissing = New instat.ucrCheck() Me.ucrReceiverSecondOpt = New instat.ucrReceiverSingle() Me.ucrPnlDescribe = New instat.UcrPanel() Me.ucrReceiverSecondVar = New instat.ucrReceiverSingle() @@ -85,7 +86,7 @@ Partial Class dlgDescribeTwoVariable 'cmdSummaries ' Me.cmdSummaries.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.cmdSummaries.Location = New System.Drawing.Point(6, 45) + Me.cmdSummaries.Location = New System.Drawing.Point(6, 70) Me.cmdSummaries.Name = "cmdSummaries" Me.cmdSummaries.Size = New System.Drawing.Size(105, 23) Me.cmdSummaries.TabIndex = 1 @@ -116,15 +117,35 @@ Partial Class dlgDescribeTwoVariable ' 'grpOptions ' + Me.grpOptions.Controls.Add(Me.cmdMissingOptions) Me.grpOptions.Controls.Add(Me.ucrChkOmitMissing) Me.grpOptions.Controls.Add(Me.cmdSummaries) - Me.grpOptions.Location = New System.Drawing.Point(256, 250) + Me.grpOptions.Location = New System.Drawing.Point(242, 222) Me.grpOptions.Name = "grpOptions" - Me.grpOptions.Size = New System.Drawing.Size(155, 76) + Me.grpOptions.Size = New System.Drawing.Size(169, 103) Me.grpOptions.TabIndex = 12 Me.grpOptions.TabStop = False Me.grpOptions.Text = "Options" ' + 'cmdMissingOptions + ' + Me.cmdMissingOptions.Enabled = False + Me.cmdMissingOptions.Location = New System.Drawing.Point(7, 44) + Me.cmdMissingOptions.Name = "cmdMissingOptions" + Me.cmdMissingOptions.Size = New System.Drawing.Size(104, 23) + Me.cmdMissingOptions.TabIndex = 2 + Me.cmdMissingOptions.Text = "Options" + Me.cmdMissingOptions.UseVisualStyleBackColor = True + ' + 'ucrChkOmitMissing + ' + Me.ucrChkOmitMissing.AutoSize = True + Me.ucrChkOmitMissing.Checked = False + Me.ucrChkOmitMissing.Location = New System.Drawing.Point(9, 19) + Me.ucrChkOmitMissing.Name = "ucrChkOmitMissing" + Me.ucrChkOmitMissing.Size = New System.Drawing.Size(143, 23) + Me.ucrChkOmitMissing.TabIndex = 0 + ' 'lblSummary ' Me.lblSummary.AutoSize = True @@ -271,6 +292,19 @@ Partial Class dlgDescribeTwoVariable Me.grpDisplay.TabStop = False Me.grpDisplay.Text = "Percentages" ' + 'ucrReceiverPercentages + ' + Me.ucrReceiverPercentages.AutoSize = True + Me.ucrReceiverPercentages.frmParent = Me + Me.ucrReceiverPercentages.Location = New System.Drawing.Point(21, 63) + Me.ucrReceiverPercentages.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverPercentages.Name = "ucrReceiverPercentages" + Me.ucrReceiverPercentages.Selector = Nothing + Me.ucrReceiverPercentages.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverPercentages.strNcFilePath = "" + Me.ucrReceiverPercentages.TabIndex = 8 + Me.ucrReceiverPercentages.ucrSelector = Nothing + ' 'lblFactorsAsPercentage ' Me.lblFactorsAsPercentage.AutoSize = True @@ -282,6 +316,24 @@ Partial Class dlgDescribeTwoVariable Me.lblFactorsAsPercentage.Tag = "Factors as Percentage:" Me.lblFactorsAsPercentage.Text = "Factors as Percentage:" ' + 'ucrChkPercentageProportion + ' + Me.ucrChkPercentageProportion.AutoSize = True + Me.ucrChkPercentageProportion.Checked = False + Me.ucrChkPercentageProportion.Location = New System.Drawing.Point(14, 86) + Me.ucrChkPercentageProportion.Name = "ucrChkPercentageProportion" + Me.ucrChkPercentageProportion.Size = New System.Drawing.Size(154, 23) + Me.ucrChkPercentageProportion.TabIndex = 3 + ' + 'ucrChkDisplayAsPercentage + ' + Me.ucrChkDisplayAsPercentage.AutoSize = True + Me.ucrChkDisplayAsPercentage.Checked = False + Me.ucrChkDisplayAsPercentage.Location = New System.Drawing.Point(14, 19) + Me.ucrChkDisplayAsPercentage.Name = "ucrChkDisplayAsPercentage" + Me.ucrChkDisplayAsPercentage.Size = New System.Drawing.Size(135, 23) + Me.ucrChkDisplayAsPercentage.TabIndex = 0 + ' 'grpFrequency ' Me.grpFrequency.Controls.Add(Me.ucrNudColumnFactors) @@ -298,53 +350,6 @@ Partial Class dlgDescribeTwoVariable Me.grpFrequency.TabStop = False Me.grpFrequency.Text = "Display" ' - 'lblColumnFactors - ' - Me.lblColumnFactors.AutoSize = True - Me.lblColumnFactors.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblColumnFactors.Location = New System.Drawing.Point(8, 53) - Me.lblColumnFactors.Name = "lblColumnFactors" - Me.lblColumnFactors.Size = New System.Drawing.Size(83, 13) - Me.lblColumnFactors.TabIndex = 21 - Me.lblColumnFactors.Tag = "" - Me.lblColumnFactors.Text = "Column Factors:" - ' - 'lblSigFigs - ' - Me.lblSigFigs.AutoSize = True - Me.lblSigFigs.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSigFigs.Location = New System.Drawing.Point(8, 25) - Me.lblSigFigs.Name = "lblSigFigs" - Me.lblSigFigs.Size = New System.Drawing.Size(96, 13) - Me.lblSigFigs.TabIndex = 4 - Me.lblSigFigs.Tag = "Significant_Figures:" - Me.lblSigFigs.Text = "Significant Figures:" - ' - 'rdoThreeVariable - ' - Me.rdoThreeVariable.Appearance = System.Windows.Forms.Appearance.Button - Me.rdoThreeVariable.FlatAppearance.BorderColor = System.Drawing.SystemColors.ActiveCaption - Me.rdoThreeVariable.FlatAppearance.BorderSize = 2 - Me.rdoThreeVariable.FlatAppearance.CheckedBackColor = System.Drawing.SystemColors.ActiveCaption - Me.rdoThreeVariable.FlatStyle = System.Windows.Forms.FlatStyle.Flat - Me.rdoThreeVariable.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.rdoThreeVariable.Location = New System.Drawing.Point(242, 12) - Me.rdoThreeVariable.Name = "rdoThreeVariable" - Me.rdoThreeVariable.Size = New System.Drawing.Size(100, 28) - Me.rdoThreeVariable.TabIndex = 23 - Me.rdoThreeVariable.Text = "Three Variables" - Me.rdoThreeVariable.TextAlign = System.Drawing.ContentAlignment.MiddleCenter - Me.rdoThreeVariable.UseVisualStyleBackColor = True - ' - 'ucrBase - ' - Me.ucrBase.AutoSize = True - Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(8, 435) - Me.ucrBase.Name = "ucrBase" - Me.ucrBase.Size = New System.Drawing.Size(405, 52) - Me.ucrBase.TabIndex = 13 - ' 'ucrNudColumnFactors ' Me.ucrNudColumnFactors.AutoSize = True @@ -358,6 +363,17 @@ Partial Class dlgDescribeTwoVariable Me.ucrNudColumnFactors.TabIndex = 22 Me.ucrNudColumnFactors.Value = New Decimal(New Integer() {0, 0, 0, 0}) ' + 'lblColumnFactors + ' + Me.lblColumnFactors.AutoSize = True + Me.lblColumnFactors.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.lblColumnFactors.Location = New System.Drawing.Point(8, 53) + Me.lblColumnFactors.Name = "lblColumnFactors" + Me.lblColumnFactors.Size = New System.Drawing.Size(83, 13) + Me.lblColumnFactors.TabIndex = 21 + Me.lblColumnFactors.Tag = "" + Me.lblColumnFactors.Text = "Column Factors:" + ' 'ucrNudSigFigs ' Me.ucrNudSigFigs.AutoSize = True @@ -382,6 +398,17 @@ Partial Class dlgDescribeTwoVariable Me.ucrInputMarginName.Size = New System.Drawing.Size(74, 21) Me.ucrInputMarginName.TabIndex = 20 ' + 'lblSigFigs + ' + Me.lblSigFigs.AutoSize = True + Me.lblSigFigs.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.lblSigFigs.Location = New System.Drawing.Point(8, 25) + Me.lblSigFigs.Name = "lblSigFigs" + Me.lblSigFigs.Size = New System.Drawing.Size(96, 13) + Me.lblSigFigs.TabIndex = 4 + Me.lblSigFigs.Tag = "Significant_Figures:" + Me.lblSigFigs.Text = "Significant Figures:" + ' 'ucrChkDisplayMargins ' Me.ucrChkDisplayMargins.AutoSize = True @@ -391,36 +418,30 @@ Partial Class dlgDescribeTwoVariable Me.ucrChkDisplayMargins.Size = New System.Drawing.Size(149, 23) Me.ucrChkDisplayMargins.TabIndex = 17 ' - 'ucrReceiverPercentages - ' - Me.ucrReceiverPercentages.AutoSize = True - Me.ucrReceiverPercentages.frmParent = Nothing - Me.ucrReceiverPercentages.Location = New System.Drawing.Point(21, 63) - Me.ucrReceiverPercentages.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverPercentages.Name = "ucrReceiverPercentages" - Me.ucrReceiverPercentages.Selector = Nothing - Me.ucrReceiverPercentages.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverPercentages.strNcFilePath = "" - Me.ucrReceiverPercentages.TabIndex = 8 - Me.ucrReceiverPercentages.ucrSelector = Nothing - ' - 'ucrChkPercentageProportion + 'rdoThreeVariable ' - Me.ucrChkPercentageProportion.AutoSize = True - Me.ucrChkPercentageProportion.Checked = False - Me.ucrChkPercentageProportion.Location = New System.Drawing.Point(14, 86) - Me.ucrChkPercentageProportion.Name = "ucrChkPercentageProportion" - Me.ucrChkPercentageProportion.Size = New System.Drawing.Size(154, 23) - Me.ucrChkPercentageProportion.TabIndex = 3 + Me.rdoThreeVariable.Appearance = System.Windows.Forms.Appearance.Button + Me.rdoThreeVariable.FlatAppearance.BorderColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoThreeVariable.FlatAppearance.BorderSize = 2 + Me.rdoThreeVariable.FlatAppearance.CheckedBackColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoThreeVariable.FlatStyle = System.Windows.Forms.FlatStyle.Flat + Me.rdoThreeVariable.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.rdoThreeVariable.Location = New System.Drawing.Point(242, 12) + Me.rdoThreeVariable.Name = "rdoThreeVariable" + Me.rdoThreeVariable.Size = New System.Drawing.Size(100, 28) + Me.rdoThreeVariable.TabIndex = 23 + Me.rdoThreeVariable.Text = "Three Variables" + Me.rdoThreeVariable.TextAlign = System.Drawing.ContentAlignment.MiddleCenter + Me.rdoThreeVariable.UseVisualStyleBackColor = True ' - 'ucrChkDisplayAsPercentage + 'ucrBase ' - Me.ucrChkDisplayAsPercentage.AutoSize = True - Me.ucrChkDisplayAsPercentage.Checked = False - Me.ucrChkDisplayAsPercentage.Location = New System.Drawing.Point(14, 19) - Me.ucrChkDisplayAsPercentage.Name = "ucrChkDisplayAsPercentage" - Me.ucrChkDisplayAsPercentage.Size = New System.Drawing.Size(135, 23) - Me.ucrChkDisplayAsPercentage.TabIndex = 0 + Me.ucrBase.AutoSize = True + Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink + Me.ucrBase.Location = New System.Drawing.Point(8, 435) + Me.ucrBase.Name = "ucrBase" + Me.ucrBase.Size = New System.Drawing.Size(408, 52) + Me.ucrBase.TabIndex = 13 ' 'ucrReceiverNumericVariable ' @@ -448,15 +469,6 @@ Partial Class dlgDescribeTwoVariable Me.ucrReceiverSecondFactor.TabIndex = 9 Me.ucrReceiverSecondFactor.ucrSelector = Nothing ' - 'ucrChkOmitMissing - ' - Me.ucrChkOmitMissing.AutoSize = True - Me.ucrChkOmitMissing.Checked = False - Me.ucrChkOmitMissing.Location = New System.Drawing.Point(9, 19) - Me.ucrChkOmitMissing.Name = "ucrChkOmitMissing" - Me.ucrChkOmitMissing.Size = New System.Drawing.Size(143, 23) - Me.ucrChkOmitMissing.TabIndex = 0 - ' 'ucrReceiverSecondOpt ' Me.ucrReceiverSecondOpt.AutoSize = True @@ -525,9 +537,7 @@ Partial Class dlgDescribeTwoVariable Me.Controls.Add(Me.rdoThreeVariable) Me.Controls.Add(Me.ucrBase) Me.Controls.Add(Me.grpFrequency) - Me.Controls.Add(Me.grpDisplay) Me.Controls.Add(Me.lblNumericVariable) - Me.Controls.Add(Me.ucrReceiverNumericVariable) Me.Controls.Add(Me.lblSecondFactor) Me.Controls.Add(Me.ucrReceiverSecondFactor) Me.Controls.Add(Me.grpOptions) @@ -542,6 +552,8 @@ Partial Class dlgDescribeTwoVariable Me.Controls.Add(Me.ucrReceiverFirstVars) Me.Controls.Add(Me.ucrSelectorDescribeTwoVar) Me.Controls.Add(Me.grpSummaries) + Me.Controls.Add(Me.grpDisplay) + Me.Controls.Add(Me.ucrReceiverNumericVariable) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow Me.MaximizeBox = False Me.MinimizeBox = False @@ -600,4 +612,5 @@ Partial Class dlgDescribeTwoVariable Friend WithEvents lblSigFigs As Label Friend WithEvents ucrReceiverPercentages As ucrReceiverSingle Friend WithEvents rdoThreeVariable As RadioButton + Friend WithEvents cmdMissingOptions As Button End Class diff --git a/instat/dlgDescribeTwoVariable.vb b/instat/dlgDescribeTwoVariable.vb index 2e1557b8b7b..f628b431ceb 100644 --- a/instat/dlgDescribeTwoVariable.vb +++ b/instat/dlgDescribeTwoVariable.vb @@ -470,6 +470,7 @@ Public Class dlgDescribeTwoVariable EnableDisableFrequencyControls() AddRemoveFrequencyParameters() ChangeLocations() + MissingOptions() TestOKEnabled() End Sub @@ -479,6 +480,24 @@ Public Class dlgDescribeTwoVariable Else clsRCorrelationFunction.RemoveParameterByName("use") End If + If Not ucrChkOmitMissing.Checked Then + clsRCustomSummaryFunction.RemoveParameterByName("na_type") + clsRCustomSummaryFunction.RemoveParameterByName("na_max_n") + clsRCustomSummaryFunction.RemoveParameterByName("na_min_n") + clsRCustomSummaryFunction.RemoveParameterByName("na_max_prop") + clsRCustomSummaryFunction.RemoveParameterByName("na_consecutive_n") + Else + clsRCustomSummaryFunction.AddParameter("na_type", clsRFunctionParameter:=clsCombineFunction, iPosition:=9) + End If + MissingOptions() + End Sub + + Private Sub MissingOptions() + If ucrChkOmitMissing.Checked AndAlso strFirstVariablesType = "numeric" AndAlso strSecondVariableType = "categorical" Then + cmdMissingOptions.Enabled = True + Else + cmdMissingOptions.Enabled = False + End If End Sub Private Sub ucrPnlDescribe_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrPnlDescribe.ControlValueChanged @@ -601,4 +620,10 @@ Public Class dlgDescribeTwoVariable clsMapFrequencyPipeOperator.AddParameter("data", clsRFunctionParameter:=ucrSelectorDescribeTwoVar.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) clsFrequencyTablesFunction.AddParameter("data_name", Chr(34) & ucrSelectorDescribeTwoVar.ucrAvailableDataFrames.cboAvailableDataFrames.Text & Chr(34), iPosition:=0) End Sub + + Private Sub cmdMissingOptions_Click(sender As Object, e As EventArgs) Handles cmdMissingOptions.Click + sdgMissingOptions.SetRFunction(clsNewSummaryFunction:=clsRCustomSummaryFunction, clsNewConcFunction:=clsCombineFunction, bReset:=bResetSubdialog) + bResetSubdialog = False + sdgMissingOptions.ShowDialog() + End Sub End Class \ No newline at end of file diff --git a/instat/dlgExtremes.Designer.vb b/instat/dlgExtremes.Designer.vb index 3f51b652d18..51a97ad0db9 100644 --- a/instat/dlgExtremes.Designer.vb +++ b/instat/dlgExtremes.Designer.vb @@ -59,7 +59,6 @@ Partial Class dlgExtremes Me.cmdZero = New System.Windows.Forms.Button() Me.cmdMinus = New System.Windows.Forms.Button() Me.lblFevdType = New System.Windows.Forms.Label() - Me.cmdDisplayOptions = New System.Windows.Forms.Button() Me.cmdFittingOptions = New System.Windows.Forms.Button() Me.lblDataToFit = New System.Windows.Forms.Label() Me.ucrInputThresholdforLocation = New instat.ucrInputTextBox() @@ -325,16 +324,6 @@ Partial Class dlgExtremes Me.lblFevdType.TabIndex = 7 Me.lblFevdType.Text = "Distribution:" ' - 'cmdDisplayOptions - ' - Me.cmdDisplayOptions.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.cmdDisplayOptions.Location = New System.Drawing.Point(401, 290) - Me.cmdDisplayOptions.Name = "cmdDisplayOptions" - Me.cmdDisplayOptions.Size = New System.Drawing.Size(108, 23) - Me.cmdDisplayOptions.TabIndex = 14 - Me.cmdDisplayOptions.Text = "Display Options" - Me.cmdDisplayOptions.UseVisualStyleBackColor = True - ' 'cmdFittingOptions ' Me.cmdFittingOptions.ImeMode = System.Windows.Forms.ImeMode.NoControl @@ -342,7 +331,7 @@ Partial Class dlgExtremes Me.cmdFittingOptions.Name = "cmdFittingOptions" Me.cmdFittingOptions.Size = New System.Drawing.Size(108, 23) Me.cmdFittingOptions.TabIndex = 12 - Me.cmdFittingOptions.Text = "Fitting Options" + Me.cmdFittingOptions.Text = "Options" Me.cmdFittingOptions.UseVisualStyleBackColor = True ' 'lblDataToFit @@ -363,6 +352,7 @@ Partial Class dlgExtremes Me.ucrInputThresholdforLocation.IsMultiline = False Me.ucrInputThresholdforLocation.IsReadOnly = False Me.ucrInputThresholdforLocation.Location = New System.Drawing.Point(79, 231) + Me.ucrInputThresholdforLocation.Margin = New System.Windows.Forms.Padding(9, 9, 9, 9) Me.ucrInputThresholdforLocation.Name = "ucrInputThresholdforLocation" Me.ucrInputThresholdforLocation.Size = New System.Drawing.Size(79, 21) Me.ucrInputThresholdforLocation.TabIndex = 10 @@ -371,9 +361,10 @@ Partial Class dlgExtremes ' Me.ucrTryModelling.AutoSize = True Me.ucrTryModelling.Location = New System.Drawing.Point(1, 258) + Me.ucrTryModelling.Margin = New System.Windows.Forms.Padding(4, 4, 4, 4) Me.ucrTryModelling.Name = "ucrTryModelling" Me.ucrTryModelling.RunCommandAsMultipleLines = False - Me.ucrTryModelling.Size = New System.Drawing.Size(389, 33) + Me.ucrTryModelling.Size = New System.Drawing.Size(396, 37) Me.ucrTryModelling.TabIndex = 11 ' 'ucrChkExplanatoryModelForLocationParameter @@ -381,6 +372,7 @@ Partial Class dlgExtremes Me.ucrChkExplanatoryModelForLocationParameter.AutoSize = True Me.ucrChkExplanatoryModelForLocationParameter.Checked = False Me.ucrChkExplanatoryModelForLocationParameter.Location = New System.Drawing.Point(258, 85) + Me.ucrChkExplanatoryModelForLocationParameter.Margin = New System.Windows.Forms.Padding(6, 6, 6, 6) Me.ucrChkExplanatoryModelForLocationParameter.Name = "ucrChkExplanatoryModelForLocationParameter" Me.ucrChkExplanatoryModelForLocationParameter.Size = New System.Drawing.Size(270, 23) Me.ucrChkExplanatoryModelForLocationParameter.TabIndex = 3 @@ -390,6 +382,7 @@ Partial Class dlgExtremes Me.ucrReceiverExpressionExplanatoryModelForLocParam.AutoSize = True Me.ucrReceiverExpressionExplanatoryModelForLocParam.frmParent = Me Me.ucrReceiverExpressionExplanatoryModelForLocParam.Location = New System.Drawing.Point(258, 108) + Me.ucrReceiverExpressionExplanatoryModelForLocParam.Margin = New System.Windows.Forms.Padding(6, 6, 6, 6) Me.ucrReceiverExpressionExplanatoryModelForLocParam.Name = "ucrReceiverExpressionExplanatoryModelForLocParam" Me.ucrReceiverExpressionExplanatoryModelForLocParam.Selector = Nothing Me.ucrReceiverExpressionExplanatoryModelForLocParam.Size = New System.Drawing.Size(251, 22) @@ -404,6 +397,7 @@ Partial Class dlgExtremes Me.ucrInputExtremes.GetSetSelectedIndex = -1 Me.ucrInputExtremes.IsReadOnly = False Me.ucrInputExtremes.Location = New System.Drawing.Point(79, 204) + Me.ucrInputExtremes.Margin = New System.Windows.Forms.Padding(9, 9, 9, 9) Me.ucrInputExtremes.Name = "ucrInputExtremes" Me.ucrInputExtremes.Size = New System.Drawing.Size(79, 21) Me.ucrInputExtremes.TabIndex = 8 @@ -411,7 +405,7 @@ Partial Class dlgExtremes 'ucrSaveExtremes ' Me.ucrSaveExtremes.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrSaveExtremes.Location = New System.Drawing.Point(10, 292) + Me.ucrSaveExtremes.Location = New System.Drawing.Point(10, 303) Me.ucrSaveExtremes.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrSaveExtremes.Name = "ucrSaveExtremes" Me.ucrSaveExtremes.Size = New System.Drawing.Size(320, 22) @@ -446,9 +440,10 @@ Partial Class dlgExtremes ' Me.ucrBase.AutoSize = True Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(10, 321) + Me.ucrBase.Location = New System.Drawing.Point(10, 330) + Me.ucrBase.Margin = New System.Windows.Forms.Padding(4, 4, 4, 4) Me.ucrBase.Name = "ucrBase" - Me.ucrBase.Size = New System.Drawing.Size(405, 52) + Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 15 ' 'dlgExtremes @@ -456,7 +451,7 @@ Partial Class dlgExtremes Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True - Me.ClientSize = New System.Drawing.Size(533, 378) + Me.ClientSize = New System.Drawing.Size(533, 389) Me.Controls.Add(Me.ucrInputThresholdforLocation) Me.Controls.Add(Me.lblThreshold) Me.Controls.Add(Me.ucrTryModelling) @@ -467,7 +462,6 @@ Partial Class dlgExtremes Me.Controls.Add(Me.lblFevdType) Me.Controls.Add(Me.ucrInputExtremes) Me.Controls.Add(Me.ucrSaveExtremes) - Me.Controls.Add(Me.cmdDisplayOptions) Me.Controls.Add(Me.cmdFittingOptions) Me.Controls.Add(Me.ucrSelectorExtremes) Me.Controls.Add(Me.lblDataToFit) @@ -514,7 +508,6 @@ Partial Class dlgExtremes Friend WithEvents lblFevdType As Label Friend WithEvents ucrInputExtremes As ucrInputComboBox Friend WithEvents ucrSaveExtremes As ucrSave - Friend WithEvents cmdDisplayOptions As Button Friend WithEvents cmdFittingOptions As Button Friend WithEvents ucrSelectorExtremes As ucrSelectorByDataFrameAddRemove Friend WithEvents lblDataToFit As Label diff --git a/instat/dlgExtremes.vb b/instat/dlgExtremes.vb index 419be357250..4ab00f7da98 100644 --- a/instat/dlgExtremes.vb +++ b/instat/dlgExtremes.vb @@ -20,14 +20,16 @@ Public Class dlgExtremes Private clsAttachFunction As New RFunction Private clsDetachFunction As New RFunction - Private clsFevdFunction, clsPlotsFunction As New RFunction + Private clsFevdFunction, clsPriorParamListFunction, clsPlotsFunction, clsConcatenateFunction, clsConfidenceIntervalFunction, +clsInitialListFunction, clsOmitMissingFunction As New RFunction 'clsLocationScaleResetOperator is not run but affects reset of the check box.Any better method of implementation? Private clsLocationScaleResetOperator As New ROperator Private clsLocationParamOperator As New ROperator Private bFirstLoad As Boolean = True Private bReset As Boolean = True Private bResettingDialogue As Boolean = False - + Private bResetSubDialogue As Boolean = False + Private strFirstParam As String = "0.1,10,0.1" Private Sub dlgExtremes_Load(sender As Object, e As EventArgs) Handles MyBase.Load If bFirstLoad Then InitialiseDialog() @@ -92,17 +94,25 @@ Public Class dlgExtremes Private Sub SetDefaults() clsFevdFunction = New RFunction clsPlotsFunction = New RFunction + clsPriorParamListFunction = New RFunction + clsInitialListFunction = New RFunction clsLocationParamOperator = New ROperator clsLocationScaleResetOperator = New ROperator clsAttachFunction = New RFunction clsDetachFunction = New RFunction - + clsConfidenceIntervalFunction = New RFunction + clsConcatenateFunction = New RFunction + clsOmitMissingFunction = New RFunction ucrBase.clsRsyntax.ClearCodes() ucrReceiverVariable.SetMeAsReceiver() ucrSelectorExtremes.Reset() ucrInputThresholdforLocation.SetText("0") ucrSaveExtremes.Reset() + bResetSubDialogue = True + + clsConcatenateFunction.SetRCommand("c") + clsConcatenateFunction.AddParameter("first", strFirstParam, iPosition:=0, bIncludeArgumentName:=False) clsLocationScaleResetOperator.SetOperation("") clsLocationScaleResetOperator.bBrackets = False @@ -115,6 +125,17 @@ Public Class dlgExtremes clsPlotsFunction.iCallType = 3 clsPlotsFunction.bExcludeAssignedFunctionOutput = False + clsPriorParamListFunction.SetRCommand("list") + clsPriorParamListFunction.AddParameter("v", clsRFunctionParameter:=clsConcatenateFunction, iPosition:=5) + + clsInitialListFunction.SetRCommand("list") + clsInitialListFunction.AddParameter("location", "0", iPosition:=0) + clsInitialListFunction.AddParameter("scale", "0.1", iPosition:=1) + clsInitialListFunction.AddParameter("shape", "-0.5", iPosition:=2) + + clsConfidenceIntervalFunction.SetPackageName("extRemes") + clsConfidenceIntervalFunction.SetRCommand("ci.fevd") + clsFevdFunction.SetPackageName("extRemes") clsFevdFunction.SetRCommand("fevd") @@ -126,10 +147,15 @@ Public Class dlgExtremes clsPlotsFunction.SetAssignTo("last_graph", strTempDataframe:=ucrSelectorExtremes.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:="last_graph") clsPlotsFunction.AddParameter("x", clsRFunctionParameter:=clsFevdFunction, iPosition:=0) + clsOmitMissingFunction.SetRCommand("na.omit") + clsOmitMissingFunction.SetPackageName("stats") + clsOmitMissingFunction.AddParameter("object", clsRFunctionParameter:=ucrSelectorExtremes.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + + clsAttachFunction.SetRCommand("attach") clsDetachFunction.SetRCommand("detach") - clsAttachFunction.AddParameter("what", clsRFunctionParameter:=ucrSelectorExtremes.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) - clsDetachFunction.AddParameter("name", clsRFunctionParameter:=ucrSelectorExtremes.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + clsAttachFunction.AddParameter("what", clsRFunctionParameter:=clsOmitMissingFunction, iPosition:=0) + clsDetachFunction.AddParameter("name", clsRFunctionParameter:=clsOmitMissingFunction, iPosition:=0) clsDetachFunction.AddParameter("unload", "TRUE", iPosition:=2) ucrBase.clsRsyntax.AddToBeforeCodes(clsAttachFunction) @@ -153,17 +179,16 @@ Public Class dlgExtremes bResettingDialogue = False End Sub - Private Sub cmdDisplayOptions_Click(sender As Object, e As EventArgs) Handles cmdDisplayOptions.Click - sdgExtremesDisplayOptions.SetRCode(clsNewPlotFunction:=clsPlotsFunction, clsNewRSyntax:=ucrBase.clsRsyntax) - sdgExtremesDisplayOptions.ShowDialog() - End Sub - Private Sub TestOkEnabled() ucrBase.OKEnabled(Not ucrReceiverVariable.IsEmpty) End Sub Private Sub cmdFittingOptions_Click(sender As Object, e As EventArgs) Handles cmdFittingOptions.Click - sdgExtremesMethod.SetRCode(clsNewFevdFunction:=clsFevdFunction) + sdgExtremesMethod.SetRCode(clsNewFevdFunction:=clsFevdFunction, clsNewPriorParamListFunction:=clsPriorParamListFunction, + clsNewConcatenateFunction:=clsConcatenateFunction, bReset:=bResetSubDialogue, + clsNewPlotFunction:=clsPlotsFunction, clsNewConfidenceIntervalFunction:=clsConfidenceIntervalFunction, + clsNewInitialListFunction:=clsInitialListFunction, clsNewRSyntax:=ucrBase.clsRsyntax) sdgExtremesMethod.ShowDialog() + bResetSubDialogue = False End Sub Private Sub cmdPlus_Click(sender As Object, e As EventArgs) Handles cmdPlus.Click @@ -274,9 +299,9 @@ Public Class dlgExtremes clsLocationScaleResetOperator.AddParameter("scaleLocation", clsROperatorParameter:=clsLocationParamOperator, iPosition:=0) End If grpFirstCalc.Visible = True - grpSecondCalc.Visible = True - Else - ucrReceiverVariable.SetMeAsReceiver() + grpSecondCalc.Visible = True + Else + ucrReceiverVariable.SetMeAsReceiver() clsFevdFunction.RemoveParameterByName("scale.fun") clsFevdFunction.RemoveParameterByName("location.fun") clsLocationScaleResetOperator.RemoveParameterByName("scaleLocation") @@ -284,7 +309,23 @@ Public Class dlgExtremes grpFirstCalc.Visible = False grpSecondCalc.Visible = False End If + End Sub - + Private Sub ucrReceiverExpressionExplanatoryModelForLocParam_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrReceiverExpressionExplanatoryModelForLocParam.ControlValueChanged + Dim strExplanatory As String = ucrReceiverExpressionExplanatoryModelForLocParam.GetText() + If ucrChkExplanatoryModelForLocationParameter.Checked _ + AndAlso Not ucrReceiverExpressionExplanatoryModelForLocParam.IsEmpty() Then + Dim strTempParam As String = strFirstParam + If strExplanatory.Contains("+") Then + For i = 0 To strExplanatory.Split("+").Length - 1 + strTempParam &= ",0.1" + Next + ElseIf Not IsNumeric(strExplanatory) Then + strTempParam &= ",0.1" + End If + clsConcatenateFunction.AddParameter("first", strTempParam, iPosition:=0, bIncludeArgumentName:=False) + Else + clsConcatenateFunction.AddParameter("first", strFirstParam, iPosition:=0, bIncludeArgumentName:=False) + End If End Sub End Class diff --git a/instat/dlgFind.vb b/instat/dlgFind.vb index 5f6ce05790e..bf09f7f211e 100644 --- a/instat/dlgFind.vb +++ b/instat/dlgFind.vb @@ -31,9 +31,6 @@ Public Class dlgFind Case "frmCommand" searchTextBox(frmCommand.txtCommand, targetPos) - Case "frmScript" - searchTextBox(frmScript.txtScript, targetPos) - Case "frmEditor" searchDataView(targetPos) @@ -106,7 +103,7 @@ Public Class dlgFind cmdFindNext.Enabled = True Me.AcceptButton = cmdFindNext cmdFindAll.Enabled = False - ElseIf currWindow.Name = "frmCommand" Or currWindow.Name = "frmLog" Or currWindow.Name = "frmScript" Then + ElseIf currWindow.Name = "frmCommand" Or currWindow.Name = "frmLog" Then cmdFindNext.Enabled = True Me.AcceptButton = cmdFindNext cmdFindAll.Enabled = False diff --git a/instat/dlgHideDataframes.Designer.vb b/instat/dlgHideDataframes.Designer.vb index 97902ec9232..7acd72a3ce1 100644 --- a/instat/dlgHideDataframes.Designer.vb +++ b/instat/dlgHideDataframes.Designer.vb @@ -43,22 +43,27 @@ Partial Class dlgHideDataframes Me.lblDataFrames = New System.Windows.Forms.Label() Me.lblHiddenDataFrames = New System.Windows.Forms.Label() Me.ucrReceiverMultiple = New instat.ucrReceiverMultiple() + Me.rdoUnhideDataFrame = New System.Windows.Forms.RadioButton() + Me.rdoHideDataFrame = New System.Windows.Forms.RadioButton() + Me.ucrPnlHideUnhide = New instat.UcrPanel() + Me.ucrReceiverMultipleUnhide = New instat.ucrReceiverMultiple() + Me.lblUnhideDataFrame = New System.Windows.Forms.Label() Me.SuspendLayout() ' 'ucrBase ' Me.ucrBase.AutoSize = True Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(10, 178) + Me.ucrBase.Location = New System.Drawing.Point(10, 190) Me.ucrBase.Name = "ucrBase" - Me.ucrBase.Size = New System.Drawing.Size(405, 52) + Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 1 ' 'ucrSelectorForDataFrames ' Me.ucrSelectorForDataFrames.AutoSize = True Me.ucrSelectorForDataFrames.bShowHiddenColumns = False - Me.ucrSelectorForDataFrames.Location = New System.Drawing.Point(10, 28) + Me.ucrSelectorForDataFrames.Location = New System.Drawing.Point(10, 44) Me.ucrSelectorForDataFrames.Margin = New System.Windows.Forms.Padding(0) Me.ucrSelectorForDataFrames.Name = "ucrSelectorForDataFrames" Me.ucrSelectorForDataFrames.Size = New System.Drawing.Size(218, 147) @@ -67,7 +72,7 @@ Partial Class dlgHideDataframes 'lblDataFrames ' Me.lblDataFrames.AutoSize = True - Me.lblDataFrames.Location = New System.Drawing.Point(10, 13) + Me.lblDataFrames.Location = New System.Drawing.Point(10, 29) Me.lblDataFrames.Name = "lblDataFrames" Me.lblDataFrames.Size = New System.Drawing.Size(76, 13) Me.lblDataFrames.TabIndex = 3 @@ -76,7 +81,7 @@ Partial Class dlgHideDataframes 'lblHiddenDataFrames ' Me.lblHiddenDataFrames.AutoSize = True - Me.lblHiddenDataFrames.Location = New System.Drawing.Point(248, 31) + Me.lblHiddenDataFrames.Location = New System.Drawing.Point(248, 47) Me.lblHiddenDataFrames.Name = "lblHiddenDataFrames" Me.lblHiddenDataFrames.Size = New System.Drawing.Size(113, 13) Me.lblHiddenDataFrames.TabIndex = 4 @@ -86,7 +91,7 @@ Partial Class dlgHideDataframes ' Me.ucrReceiverMultiple.AutoSize = True Me.ucrReceiverMultiple.frmParent = Me - Me.ucrReceiverMultiple.Location = New System.Drawing.Point(248, 46) + Me.ucrReceiverMultiple.Location = New System.Drawing.Point(248, 62) Me.ucrReceiverMultiple.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverMultiple.Name = "ucrReceiverMultiple" Me.ucrReceiverMultiple.Selector = Nothing @@ -95,17 +100,84 @@ Partial Class dlgHideDataframes Me.ucrReceiverMultiple.TabIndex = 5 Me.ucrReceiverMultiple.ucrSelector = Nothing ' + 'rdoUnhideDataFrame + ' + Me.rdoUnhideDataFrame.Appearance = System.Windows.Forms.Appearance.Button + Me.rdoUnhideDataFrame.FlatAppearance.BorderColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoUnhideDataFrame.FlatAppearance.BorderSize = 2 + Me.rdoUnhideDataFrame.FlatAppearance.CheckedBackColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoUnhideDataFrame.FlatStyle = System.Windows.Forms.FlatStyle.Flat + Me.rdoUnhideDataFrame.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.rdoUnhideDataFrame.Location = New System.Drawing.Point(208, 7) + Me.rdoUnhideDataFrame.Name = "rdoUnhideDataFrame" + Me.rdoUnhideDataFrame.Size = New System.Drawing.Size(100, 28) + Me.rdoUnhideDataFrame.TabIndex = 6 + Me.rdoUnhideDataFrame.Text = "Unhide" + Me.rdoUnhideDataFrame.TextAlign = System.Drawing.ContentAlignment.MiddleCenter + Me.rdoUnhideDataFrame.UseVisualStyleBackColor = True + ' + 'rdoHideDataFrame + ' + Me.rdoHideDataFrame.Appearance = System.Windows.Forms.Appearance.Button + Me.rdoHideDataFrame.FlatAppearance.BorderColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoHideDataFrame.FlatAppearance.BorderSize = 2 + Me.rdoHideDataFrame.FlatAppearance.CheckedBackColor = System.Drawing.SystemColors.ActiveCaption + Me.rdoHideDataFrame.FlatStyle = System.Windows.Forms.FlatStyle.Flat + Me.rdoHideDataFrame.ImeMode = System.Windows.Forms.ImeMode.NoControl + Me.rdoHideDataFrame.Location = New System.Drawing.Point(112, 7) + Me.rdoHideDataFrame.Name = "rdoHideDataFrame" + Me.rdoHideDataFrame.Size = New System.Drawing.Size(100, 28) + Me.rdoHideDataFrame.TabIndex = 7 + Me.rdoHideDataFrame.Text = "Hide" + Me.rdoHideDataFrame.TextAlign = System.Drawing.ContentAlignment.MiddleCenter + Me.rdoHideDataFrame.UseVisualStyleBackColor = True + ' + 'ucrPnlHideUnhide + ' + Me.ucrPnlHideUnhide.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink + Me.ucrPnlHideUnhide.Location = New System.Drawing.Point(92, 5) + Me.ucrPnlHideUnhide.Name = "ucrPnlHideUnhide" + Me.ucrPnlHideUnhide.Size = New System.Drawing.Size(241, 34) + Me.ucrPnlHideUnhide.TabIndex = 8 + ' + 'ucrReceiverMultipleUnhide + ' + Me.ucrReceiverMultipleUnhide.AutoSize = True + Me.ucrReceiverMultipleUnhide.frmParent = Me + Me.ucrReceiverMultipleUnhide.Location = New System.Drawing.Point(248, 62) + Me.ucrReceiverMultipleUnhide.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverMultipleUnhide.Name = "ucrReceiverMultipleUnhide" + Me.ucrReceiverMultipleUnhide.Selector = Nothing + Me.ucrReceiverMultipleUnhide.Size = New System.Drawing.Size(120, 112) + Me.ucrReceiverMultipleUnhide.strNcFilePath = "" + Me.ucrReceiverMultipleUnhide.TabIndex = 9 + Me.ucrReceiverMultipleUnhide.ucrSelector = Nothing + ' + 'lblUnhideDataFrame + ' + Me.lblUnhideDataFrame.AutoSize = True + Me.lblUnhideDataFrame.Location = New System.Drawing.Point(248, 47) + Me.lblUnhideDataFrame.Name = "lblUnhideDataFrame" + Me.lblUnhideDataFrame.Size = New System.Drawing.Size(125, 13) + Me.lblUnhideDataFrame.TabIndex = 10 + Me.lblUnhideDataFrame.Text = "Unhidden Data Frame(s):" + ' 'dlgHideDataframes ' Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True - Me.ClientSize = New System.Drawing.Size(422, 233) + Me.ClientSize = New System.Drawing.Size(416, 247) + Me.Controls.Add(Me.rdoHideDataFrame) + Me.Controls.Add(Me.rdoUnhideDataFrame) Me.Controls.Add(Me.lblHiddenDataFrames) Me.Controls.Add(Me.ucrReceiverMultiple) Me.Controls.Add(Me.lblDataFrames) Me.Controls.Add(Me.ucrSelectorForDataFrames) Me.Controls.Add(Me.ucrBase) + Me.Controls.Add(Me.ucrPnlHideUnhide) + Me.Controls.Add(Me.ucrReceiverMultipleUnhide) + Me.Controls.Add(Me.lblUnhideDataFrame) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow Me.MaximizeBox = False Me.MinimizeBox = False @@ -123,4 +195,9 @@ Partial Class dlgHideDataframes Friend WithEvents lblDataFrames As Label Friend WithEvents lblHiddenDataFrames As Label Friend WithEvents ucrReceiverMultiple As ucrReceiverMultiple + Friend WithEvents rdoHideDataFrame As RadioButton + Friend WithEvents rdoUnhideDataFrame As RadioButton + Friend WithEvents ucrPnlHideUnhide As UcrPanel + Friend WithEvents ucrReceiverMultipleUnhide As ucrReceiverMultiple + Friend WithEvents lblUnhideDataFrame As Label End Class diff --git a/instat/dlgHideDataframes.vb b/instat/dlgHideDataframes.vb index 7e4f972b409..482f211ce9f 100644 --- a/instat/dlgHideDataframes.vb +++ b/instat/dlgHideDataframes.vb @@ -22,6 +22,12 @@ Public Class dlgHideDataframes Public bFirstLoad As Boolean = True Private bReset As Boolean = True Private clsHideDataFramesFunction As New RFunction + Private clsAppendToDataFrameFunction As New RFunction + Private clsMappingFunction As New RFunction + Private clsDataUnhideOperator As New ROperator + Private clsTildeOperator As New ROperator + + Private clsDummyFunction As New RFunction Private Sub dlgHideDataframes_Load(sender As Object, e As EventArgs) Handles MyBase.Load If bFirstLoad Then @@ -31,8 +37,9 @@ Public Class dlgHideDataframes If bReset Then SetDefaults() End If - SetRCodeForControls(bReset) SetHiddenColumns() + ReopenDialog() + SetRCodeForControls(bReset) bReset = False autoTranslate(Me) End Sub @@ -43,22 +50,63 @@ Public Class dlgHideDataframes ucrReceiverMultiple.Selector = ucrSelectorForDataFrames ucrReceiverMultiple.strSelectorHeading = "Data Frames" ucrReceiverMultiple.SetItemType("dataframe") - ucrReceiverMultiple.SetMeAsReceiver() + + ucrReceiverMultipleUnhide.SetParameter(New RParameter("data_names", 0)) + ucrReceiverMultipleUnhide.SetParameterIsString() + ucrReceiverMultipleUnhide.Selector = ucrSelectorForDataFrames + + ucrPnlHideUnhide.AddRadioButton(rdoHideDataFrame) + ucrPnlHideUnhide.AddRadioButton(rdoUnhideDataFrame) + ucrPnlHideUnhide.AddParameterValuesCondition(rdoHideDataFrame, "checked", "rdoHide") + ucrPnlHideUnhide.AddParameterValuesCondition(rdoUnhideDataFrame, "checked", "rdoUnhide") + + ucrReceiverMultiple.SetLinkedDisplayControl(lblHiddenDataFrames) + ucrReceiverMultipleUnhide.SetLinkedDisplayControl(lblUnhideDataFrame) + + ucrPnlHideUnhide.AddToLinkedControls(ucrReceiverMultiple, {rdoHideDataFrame}, bNewLinkedHideIfParameterMissing:=True) + ucrPnlHideUnhide.AddToLinkedControls(ucrReceiverMultipleUnhide, {rdoUnhideDataFrame}, bNewLinkedHideIfParameterMissing:=True) End Sub Private Sub SetDefaults() clsHideDataFramesFunction = New RFunction + clsAppendToDataFrameFunction = New RFunction + clsMappingFunction = New RFunction + clsDataUnhideOperator = New ROperator + clsTildeOperator = New ROperator + clsDummyFunction = New RFunction + + ucrSelectorForDataFrames.Reset() + + clsDummyFunction.AddParameter("checked", "rdoHide", iPosition:=0) + + clsMappingFunction.SetPackageName("purrr") + clsMappingFunction.SetRCommand("map") + clsMappingFunction.AddParameter(".x", clsROperatorParameter:=clsDataUnhideOperator, iPosition:=0) + clsMappingFunction.AddParameter(".f", clsROperatorParameter:=clsTildeOperator, iPosition:=1) + + clsTildeOperator.SetOperation("~") + clsTildeOperator.AddParameter("right", clsRFunctionParameter:=clsAppendToDataFrameFunction, iPosition:=1) + clsTildeOperator.bForceIncludeOperation = True + + clsDataUnhideOperator.SetOperation("", bBracketsTemp:=False) + clsDataUnhideOperator.SetAssignTo("data_to_unhide") + clsHideDataFramesFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_hidden_data_frames") + clsAppendToDataFrameFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$append_to_dataframe_metadata") + clsAppendToDataFrameFunction.AddParameter("data_name", ".x", iPosition:=0) + clsAppendToDataFrameFunction.AddParameter("property", "is_hidden_label", iPosition:=1) + clsAppendToDataFrameFunction.AddParameter("new_val", "FALSE", iPosition:=2) + ucrBase.clsRsyntax.SetBaseRFunction(clsHideDataFramesFunction) End Sub Private Sub TestOKEnabled() - ' You cannot hide all data frames. When the receiver is blank all data frames are unhidden so this is allowed. - If ucrReceiverMultiple.lstSelectedVariables.Items.Count <> ucrSelectorForDataFrames.lstAvailableVariable.Items.Count Then - ucrBase.OKEnabled(True) + If rdoUnhideDataFrame.Checked Then + ucrBase.OKEnabled(Not ucrReceiverMultipleUnhide.IsEmpty) Else - ucrBase.OKEnabled(False) + ' You cannot hide all data frames. When the receiver is blank all data frames are unhidden so this is allowed. + ucrBase.OKEnabled(ucrReceiverMultiple.lstSelectedVariables.Items.Count <> ucrSelectorForDataFrames.lstAvailableVariable.Items.Count) End If End Sub @@ -69,7 +117,8 @@ Public Class dlgHideDataframes End Sub Public Sub SetRCodeForControls(bReset As Boolean) - SetRCode(Me, ucrBase.clsRsyntax.clsBaseFunction, bReset) + ucrPnlHideUnhide.SetRCode(clsDummyFunction, bReset) + ucrReceiverMultiple.SetRCode(clsHideDataFramesFunction, bReset) End Sub Private Sub SetHiddenColumns() @@ -78,13 +127,15 @@ Public Class dlgHideDataframes Dim clsGetHiddenDataFrames As New RFunction clsGetHiddenDataFrames.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_hidden_data_frames") + clsHideDataFramesFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$set_hidden_data_frames") - ucrReceiverMultiple.Clear() + ucrSelectorForDataFrames.lstAvailableVariable.Items.Clear() expTemp = frmMain.clsRLink.RunInternalScriptGetValue(clsGetHiddenDataFrames.ToScript(), bSilent:=True) + If expTemp IsNot Nothing AndAlso expTemp.Type <> Internals.SymbolicExpressionType.Null Then chrHiddenColumns = expTemp.AsCharacter For Each strDataFrame As String In chrHiddenColumns - ucrReceiverMultiple.Add(strDataFrame) + ucrSelectorForDataFrames.lstAvailableVariable.Items.Add(strDataFrame) Next End If End Sub @@ -92,4 +143,34 @@ Public Class dlgHideDataframes Private Sub ucrReceiverMultiple_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverMultiple.ControlContentsChanged TestOKEnabled() End Sub + + Private Sub ucrPnlHideUnhide_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrPnlHideUnhide.ControlValueChanged + If rdoHideDataFrame.Checked Then + ucrBase.clsRsyntax.SetBaseRFunction(clsHideDataFramesFunction) + clsDummyFunction.AddParameter("checked", "rdoHide", iPosition:=0) + ucrReceiverMultiple.SetMeAsReceiver() + Else + ucrBase.clsRsyntax.SetBaseRFunction(clsMappingFunction) + clsDummyFunction.AddParameter("checked", "rdoUnhide", iPosition:=0) + SetHiddenColumns() + ucrReceiverMultipleUnhide.SetMeAsReceiver() + End If + TestOKEnabled() + End Sub + + Private Sub ucrReceiverMultipleUnhide_Enter(sender As Object, e As EventArgs) Handles ucrReceiverMultipleUnhide.Enter + SetHiddenColumns() + TestOKEnabled() + End Sub + + Private Sub ucrReceiverMultipleUnhide_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrReceiverMultipleUnhide.ControlValueChanged + SetHiddenColumns() + TestOKEnabled() + clsDataUnhideOperator.AddParameter("data", ucrReceiverMultipleUnhide.GetVariableNames(True), iPosition:=0, bIncludeArgumentName:=False) + End Sub + + Private Sub ReopenDialog() + ucrReceiverMultiple.Clear() + ucrReceiverMultipleUnhide.Clear() + End Sub End Class \ No newline at end of file diff --git a/instat/dlgImportDataset.vb b/instat/dlgImportDataset.vb index eb62d0cae0e..2b3d1d782e4 100644 --- a/instat/dlgImportDataset.vb +++ b/instat/dlgImportDataset.vb @@ -5,8 +5,9 @@ Imports instat.Translations Public Class dlgImportDataset - Private clsImportTextFileFormats, clsImportCSVFileFormats, clsImportRDS, clsReadRDS, clsImportExcel, clsImport As New RFunction + Private clsImportTextFileFormats, clsImportCSVFileFormats, clsImportRDS, clsReadRDS, clsImportExcel, clsImport, clsImportfromJSON As New RFunction Private clsGetExcelSheetNames As New RFunction + Private clsJsonDataFrameFunction As New RFunction Private clsRangeOperator As New ROperator ''' ''' Ensures that any file paths containing special characters (e.g. accents) are @@ -295,6 +296,8 @@ Public Class dlgImportDataset clsImportExcel = New RFunction clsImport = New RFunction clsReadRDS = New RFunction + clsImportfromJSON = New RFunction + clsJsonDataFrameFunction = New RFunction clsGetExcelSheetNames = New RFunction clsRangeOperator = New ROperator clsEnc2Native = New RFunction @@ -330,6 +333,12 @@ Public Class dlgImportDataset clsReadRDS.SetRCommand("readRDS") clsReadRDS.SetAssignTo("new_RDS") + clsImportfromJSON.SetPackageName("jsonlite") + clsImportfromJSON.SetRCommand("fromJSON") + + clsJsonDataFrameFunction.SetRCommand("as.data.frame") + clsJsonDataFrameFunction.AddParameter("x", clsRFunctionParameter:=clsImportfromJSON, iPosition:=0) + 'This R command ensures that any file paths containing special characters (e.g. accents) 'are correctly encoded clsEnc2Native.SetRCommand("enc2native") @@ -465,6 +474,7 @@ Public Class dlgImportDataset ucrInputFilePath.AddAdditionalCodeParameterPair(clsImportExcelMulti, New RParameter("file", 0), iAdditionalPairNo:=6) ucrInputFilePath.AddAdditionalCodeParameterPair(clsGetFilesList, New RParameter("path", 0), iAdditionalPairNo:=7) ucrInputFilePath.AddAdditionalCodeParameterPair(clsFileNamesWithExt, New RParameter("path", 0), iAdditionalPairNo:=8) + ucrInputFilePath.AddAdditionalCodeParameterPair(clsImportfromJSON, New RParameter("txt", 0), iAdditionalPairNo:=9) ucrInputFilePath.SetRCode(clsImport, bReset) 'Save control @@ -475,6 +485,7 @@ Public Class dlgImportDataset ucrSaveFile.AddAdditionalRCode(clsImportMultipleFiles, iAdditionalPairNo:=5) ucrSaveFile.AddAdditionalRCode(clsImportMultipleTextFiles, iAdditionalPairNo:=6) ucrSaveFile.AddAdditionalRCode(clsPipeOperator, iAdditionalPairNo:=7) + ucrSaveFile.AddAdditionalRCode(clsJsonDataFrameFunction, iAdditionalPairNo:=8) ucrSaveFile.SetRCode(clsImport, bReset) 'todo. commented temporarily until we are able to add an OR condition for the panel @@ -671,6 +682,8 @@ Public Class dlgImportDataset ucrBase.clsRsyntax.SetBaseRFunction(If(clbSheets.CheckedItems.Count > 1, clsImportExcelMulti, clsImportExcel)) ExcelSheetsPreviewVisible(True) FillExcelSheets() + ElseIf IsJSONFileFormat() Then + ucrBase.clsRsyntax.SetBaseRFunction(clsJsonDataFrameFunction) Else ucrBase.clsRsyntax.SetBaseRFunction(clsImport) End If @@ -772,7 +785,7 @@ Public Class dlgImportDataset bCanImport = False 'grid preview is only supported for a few file formats. It is also not supported for folders - If bImportFromFolder OrElse Not (IsTextFileFormat() OrElse IsCSVFileFormat() OrElse IsExcelFileFormat()) Then + If bImportFromFolder OrElse Not (IsTextFileFormat() OrElse IsCSVFileFormat() OrElse IsExcelFileFormat() OrElse IsJSONFileFormat()) Then lblNoPreview.Show() bCanImport = True 'assume its true if preview is not supported for the file Exit Sub @@ -783,6 +796,8 @@ Public Class dlgImportDataset strRowMaxParamName = If(rdoSeparatortext.Checked, "nrows", "n_max") ElseIf IsCSVFileFormat() Then strRowMaxParamName = "nrows" + ElseIf IsJSONFileFormat() Then + strRowMaxParamName = "nrows" ElseIf IsExcelFileFormat() Then If dctSelectedExcelSheets.Count = 0 Then lblNoPreview.Show() @@ -1198,6 +1213,10 @@ Public Class dlgImportDataset Return {".xlsx", ".xls"}.Contains(strFileExtension) End Function + Private Function IsJSONFileFormat() As Boolean + Return {".json"}.Contains(strFileExtension) + End Function + Private Sub RemoveMissingValues() Dim clsPreviousBaseFunction As RFunction = ucrBase.clsRsyntax.clsBaseFunction If strFileExtension = ".rds" _ diff --git a/instat/dlgLinePlot.designer.vb b/instat/dlgLinePlot.designer.vb index 0f09b01dc13..f8840caa6e3 100644 --- a/instat/dlgLinePlot.designer.vb +++ b/instat/dlgLinePlot.designer.vb @@ -86,20 +86,16 @@ Partial Class dlgLinePlot Me.ucrInputSlopeLabelColour = New instat.ucrInputComboBox() Me.ucrNudSlopeTextSize = New instat.ucrNud() Me.ucrNudSlopeLabelSize = New instat.ucrNud() - Me.ucrChkSlopeLabelOptions = New instat.ucrCheck() - Me.ucrChkSlopeTextOptions = New instat.ucrCheck() Me.ucrInputDumbbellLine = New instat.ucrInputComboBox() Me.ucrInputDumbbellXEnd = New instat.ucrInputComboBox() Me.ucrInputDumbbellX = New instat.ucrInputComboBox() Me.ucrNudDumbbellLine = New instat.ucrNud() Me.ucrNudDumbbellXEnd = New instat.ucrNud() Me.ucrNudDumbbellX = New instat.ucrNud() - Me.ucrChkDumbbellColour = New instat.ucrCheck() Me.ucrChkDumbbellSize = New instat.ucrCheck() Me.ucrReceiverGroup = New instat.ucrReceiverSingle() Me.ucrReceiverSlopeY = New instat.ucrReceiverSingle() Me.ucrChkAddLine = New instat.ucrCheck() - Me.ucrChkAddPoints = New instat.ucrCheck() Me.ucrPnlOptions = New instat.UcrPanel() Me.ucrPnlStepOrPath = New instat.UcrPanel() Me.ucrChkPathOrStep = New instat.ucrCheck() @@ -118,6 +114,10 @@ Partial Class dlgLinePlot Me.ucrFactorOptionalReceiver = New instat.ucrReceiverSingle() Me.ucrChkSlopeLineOptions = New instat.ucrCheck() Me.UcrNudSlopeYTextSize = New instat.ucrNud() + Me.ucrChkDumbbellColour = New instat.ucrCheck() + Me.ucrChkAddPoints = New instat.ucrCheck() + Me.ucrChkSlopeLabelOptions = New instat.ucrCheck() + Me.ucrChkSlopeTextOptions = New instat.ucrCheck() Me.grpSmoothOptions.SuspendLayout() Me.SuspendLayout() ' @@ -188,7 +188,7 @@ Partial Class dlgLinePlot ' Me.rdoPath.AutoSize = True Me.rdoPath.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.rdoPath.Location = New System.Drawing.Point(154, 417) + Me.rdoPath.Location = New System.Drawing.Point(165, 417) Me.rdoPath.Name = "rdoPath" Me.rdoPath.Size = New System.Drawing.Size(47, 17) Me.rdoPath.TabIndex = 29 @@ -200,7 +200,7 @@ Partial Class dlgLinePlot ' Me.rdoStep.AutoSize = True Me.rdoStep.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.rdoStep.Location = New System.Drawing.Point(215, 417) + Me.rdoStep.Location = New System.Drawing.Point(220, 417) Me.rdoStep.Name = "rdoStep" Me.rdoStep.Size = New System.Drawing.Size(47, 17) Me.rdoStep.TabIndex = 30 @@ -317,7 +317,7 @@ Partial Class dlgLinePlot ' Me.ucrChkAddSE.AutoSize = True Me.ucrChkAddSE.Checked = False - Me.ucrChkAddSE.Location = New System.Drawing.Point(183, 49) + Me.ucrChkAddSE.Location = New System.Drawing.Point(195, 49) Me.ucrChkAddSE.Name = "ucrChkAddSE" Me.ucrChkAddSE.Size = New System.Drawing.Size(75, 23) Me.ucrChkAddSE.TabIndex = 8 @@ -443,7 +443,7 @@ Partial Class dlgLinePlot ' Me.lblXColour.AutoSize = True Me.lblXColour.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblXColour.Location = New System.Drawing.Point(93, 322) + Me.lblXColour.Location = New System.Drawing.Point(93, 326) Me.lblXColour.Name = "lblXColour" Me.lblXColour.Size = New System.Drawing.Size(17, 13) Me.lblXColour.TabIndex = 9 @@ -453,7 +453,7 @@ Partial Class dlgLinePlot ' Me.lblLineSize.AutoSize = True Me.lblLineSize.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblLineSize.Location = New System.Drawing.Point(308, 358) + Me.lblLineSize.Location = New System.Drawing.Point(308, 354) Me.lblLineSize.Name = "lblLineSize" Me.lblLineSize.Size = New System.Drawing.Size(30, 13) Me.lblLineSize.TabIndex = 50 @@ -473,7 +473,7 @@ Partial Class dlgLinePlot ' Me.lblXSize.AutoSize = True Me.lblXSize.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblXSize.Location = New System.Drawing.Point(94, 358) + Me.lblXSize.Location = New System.Drawing.Point(94, 355) Me.lblXSize.Name = "lblXSize" Me.lblXSize.Size = New System.Drawing.Size(17, 13) Me.lblXSize.TabIndex = 52 @@ -503,7 +503,7 @@ Partial Class dlgLinePlot ' Me.lblSlopeLabelSize.AutoSize = True Me.lblSlopeLabelSize.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSlopeLabelSize.Location = New System.Drawing.Point(216, 321) + Me.lblSlopeLabelSize.Location = New System.Drawing.Point(215, 322) Me.lblSlopeLabelSize.Name = "lblSlopeLabelSize" Me.lblSlopeLabelSize.Size = New System.Drawing.Size(30, 13) Me.lblSlopeLabelSize.TabIndex = 68 @@ -533,7 +533,7 @@ Partial Class dlgLinePlot ' Me.lblSlopeTextSize.AutoSize = True Me.lblSlopeTextSize.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSlopeTextSize.Location = New System.Drawing.Point(213, 351) + Me.lblSlopeTextSize.Location = New System.Drawing.Point(216, 355) Me.lblSlopeTextSize.Name = "lblSlopeTextSize" Me.lblSlopeTextSize.Size = New System.Drawing.Size(30, 13) Me.lblSlopeTextSize.TabIndex = 65 @@ -543,7 +543,7 @@ Partial Class dlgLinePlot ' Me.lblSlopeYTextSize.AutoSize = True Me.lblSlopeYTextSize.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSlopeYTextSize.Location = New System.Drawing.Point(286, 354) + Me.lblSlopeYTextSize.Location = New System.Drawing.Point(299, 354) Me.lblSlopeYTextSize.Name = "lblSlopeYTextSize" Me.lblSlopeYTextSize.Size = New System.Drawing.Size(61, 13) Me.lblSlopeYTextSize.TabIndex = 64 @@ -573,7 +573,7 @@ Partial Class dlgLinePlot ' Me.lblSlopeLineTicknes.AutoSize = True Me.lblSlopeLineTicknes.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblSlopeLineTicknes.Location = New System.Drawing.Point(191, 381) + Me.lblSlopeLineTicknes.Location = New System.Drawing.Point(210, 381) Me.lblSlopeLineTicknes.Name = "lblSlopeLineTicknes" Me.lblSlopeLineTicknes.Size = New System.Drawing.Size(54, 13) Me.lblSlopeLineTicknes.TabIndex = 72 @@ -606,7 +606,7 @@ Partial Class dlgLinePlot Me.ucrNudSlopeLineThickness.AutoSize = True Me.ucrNudSlopeLineThickness.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) Me.ucrNudSlopeLineThickness.Increment = New Decimal(New Integer() {1, 0, 0, 0}) - Me.ucrNudSlopeLineThickness.Location = New System.Drawing.Point(246, 381) + Me.ucrNudSlopeLineThickness.Location = New System.Drawing.Point(264, 378) Me.ucrNudSlopeLineThickness.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) Me.ucrNudSlopeLineThickness.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) Me.ucrNudSlopeLineThickness.Name = "ucrNudSlopeLineThickness" @@ -622,7 +622,7 @@ Partial Class dlgLinePlot Me.ucrInputSlopeLineColour.IsReadOnly = False Me.ucrInputSlopeLineColour.Location = New System.Drawing.Point(134, 377) Me.ucrInputSlopeLineColour.Name = "ucrInputSlopeLineColour" - Me.ucrInputSlopeLineColour.Size = New System.Drawing.Size(55, 21) + Me.ucrInputSlopeLineColour.Size = New System.Drawing.Size(69, 21) Me.ucrInputSlopeLineColour.TabIndex = 63 ' 'ucrInputSlopeTextColour @@ -633,7 +633,7 @@ Partial Class dlgLinePlot Me.ucrInputSlopeTextColour.IsReadOnly = False Me.ucrInputSlopeTextColour.Location = New System.Drawing.Point(134, 348) Me.ucrInputSlopeTextColour.Name = "ucrInputSlopeTextColour" - Me.ucrInputSlopeTextColour.Size = New System.Drawing.Size(55, 21) + Me.ucrInputSlopeTextColour.Size = New System.Drawing.Size(69, 21) Me.ucrInputSlopeTextColour.TabIndex = 62 ' 'ucrInputSlopeLabelColour @@ -644,7 +644,7 @@ Partial Class dlgLinePlot Me.ucrInputSlopeLabelColour.IsReadOnly = False Me.ucrInputSlopeLabelColour.Location = New System.Drawing.Point(134, 319) Me.ucrInputSlopeLabelColour.Name = "ucrInputSlopeLabelColour" - Me.ucrInputSlopeLabelColour.Size = New System.Drawing.Size(55, 21) + Me.ucrInputSlopeLabelColour.Size = New System.Drawing.Size(69, 21) Me.ucrInputSlopeLabelColour.TabIndex = 56 ' 'ucrNudSlopeTextSize @@ -673,24 +673,6 @@ Partial Class dlgLinePlot Me.ucrNudSlopeLabelSize.TabIndex = 57 Me.ucrNudSlopeLabelSize.Value = New Decimal(New Integer() {0, 0, 0, 0}) ' - 'ucrChkSlopeLabelOptions - ' - Me.ucrChkSlopeLabelOptions.AutoSize = True - Me.ucrChkSlopeLabelOptions.Checked = False - Me.ucrChkSlopeLabelOptions.Location = New System.Drawing.Point(10, 322) - Me.ucrChkSlopeLabelOptions.Name = "ucrChkSlopeLabelOptions" - Me.ucrChkSlopeLabelOptions.Size = New System.Drawing.Size(80, 24) - Me.ucrChkSlopeLabelOptions.TabIndex = 59 - ' - 'ucrChkSlopeTextOptions - ' - Me.ucrChkSlopeTextOptions.AutoSize = True - Me.ucrChkSlopeTextOptions.Checked = False - Me.ucrChkSlopeTextOptions.Location = New System.Drawing.Point(10, 352) - Me.ucrChkSlopeTextOptions.Name = "ucrChkSlopeTextOptions" - Me.ucrChkSlopeTextOptions.Size = New System.Drawing.Size(80, 24) - Me.ucrChkSlopeTextOptions.TabIndex = 58 - ' 'ucrInputDumbbellLine ' Me.ucrInputDumbbellLine.AddQuotesIfUnrecognised = True @@ -699,7 +681,7 @@ Partial Class dlgLinePlot Me.ucrInputDumbbellLine.IsReadOnly = False Me.ucrInputDumbbellLine.Location = New System.Drawing.Point(341, 318) Me.ucrInputDumbbellLine.Name = "ucrInputDumbbellLine" - Me.ucrInputDumbbellLine.Size = New System.Drawing.Size(50, 21) + Me.ucrInputDumbbellLine.Size = New System.Drawing.Size(69, 21) Me.ucrInputDumbbellLine.TabIndex = 49 ' 'ucrInputDumbbellXEnd @@ -710,7 +692,7 @@ Partial Class dlgLinePlot Me.ucrInputDumbbellXEnd.IsReadOnly = False Me.ucrInputDumbbellXEnd.Location = New System.Drawing.Point(229, 318) Me.ucrInputDumbbellXEnd.Name = "ucrInputDumbbellXEnd" - Me.ucrInputDumbbellXEnd.Size = New System.Drawing.Size(59, 21) + Me.ucrInputDumbbellXEnd.Size = New System.Drawing.Size(68, 21) Me.ucrInputDumbbellXEnd.TabIndex = 48 ' 'ucrInputDumbbellX @@ -721,7 +703,7 @@ Partial Class dlgLinePlot Me.ucrInputDumbbellX.IsReadOnly = False Me.ucrInputDumbbellX.Location = New System.Drawing.Point(112, 320) Me.ucrInputDumbbellX.Name = "ucrInputDumbbellX" - Me.ucrInputDumbbellX.Size = New System.Drawing.Size(55, 21) + Me.ucrInputDumbbellX.Size = New System.Drawing.Size(71, 21) Me.ucrInputDumbbellX.TabIndex = 9 ' 'ucrNudDumbbellLine @@ -763,15 +745,6 @@ Partial Class dlgLinePlot Me.ucrNudDumbbellX.TabIndex = 9 Me.ucrNudDumbbellX.Value = New Decimal(New Integer() {0, 0, 0, 0}) ' - 'ucrChkDumbbellColour - ' - Me.ucrChkDumbbellColour.AutoSize = True - Me.ucrChkDumbbellColour.Checked = False - Me.ucrChkDumbbellColour.Location = New System.Drawing.Point(9, 322) - Me.ucrChkDumbbellColour.Name = "ucrChkDumbbellColour" - Me.ucrChkDumbbellColour.Size = New System.Drawing.Size(80, 24) - Me.ucrChkDumbbellColour.TabIndex = 45 - ' 'ucrChkDumbbellSize ' Me.ucrChkDumbbellSize.AutoSize = True @@ -811,20 +784,11 @@ Partial Class dlgLinePlot ' Me.ucrChkAddLine.AutoSize = True Me.ucrChkAddLine.Checked = False - Me.ucrChkAddLine.Location = New System.Drawing.Point(90, 337) + Me.ucrChkAddLine.Location = New System.Drawing.Point(133, 337) Me.ucrChkAddLine.Name = "ucrChkAddLine" Me.ucrChkAddLine.Size = New System.Drawing.Size(77, 24) Me.ucrChkAddLine.TabIndex = 24 ' - 'ucrChkAddPoints - ' - Me.ucrChkAddPoints.AutoSize = True - Me.ucrChkAddPoints.Checked = False - Me.ucrChkAddPoints.Location = New System.Drawing.Point(9, 337) - Me.ucrChkAddPoints.Name = "ucrChkAddPoints" - Me.ucrChkAddPoints.Size = New System.Drawing.Size(80, 24) - Me.ucrChkAddPoints.TabIndex = 23 - ' 'ucrPnlOptions ' Me.ucrPnlOptions.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink @@ -872,7 +836,7 @@ Partial Class dlgLinePlot ' Me.ucrChkWithSE.AutoSize = True Me.ucrChkWithSE.Checked = False - Me.ucrChkWithSE.Location = New System.Drawing.Point(161, 367) + Me.ucrChkWithSE.Location = New System.Drawing.Point(248, 362) Me.ucrChkWithSE.Name = "ucrChkWithSE" Me.ucrChkWithSE.Size = New System.Drawing.Size(72, 23) Me.ucrChkWithSE.TabIndex = 26 @@ -883,7 +847,7 @@ Partial Class dlgLinePlot Me.ucrChkLineofBestFit.Checked = False Me.ucrChkLineofBestFit.Location = New System.Drawing.Point(9, 363) Me.ucrChkLineofBestFit.Name = "ucrChkLineofBestFit" - Me.ucrChkLineofBestFit.Size = New System.Drawing.Size(149, 24) + Me.ucrChkLineofBestFit.Size = New System.Drawing.Size(253, 24) Me.ucrChkLineofBestFit.TabIndex = 34 ' 'ucrSave @@ -926,14 +890,14 @@ Partial Class dlgLinePlot Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink Me.ucrBase.Location = New System.Drawing.Point(9, 467) Me.ucrBase.Name = "ucrBase" - Me.ucrBase.Size = New System.Drawing.Size(405, 52) + Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 0 ' 'ucrReceiverXEnd ' Me.ucrReceiverXEnd.AutoSize = True Me.ucrReceiverXEnd.frmParent = Me - Me.ucrReceiverXEnd.Location = New System.Drawing.Point(246, 288) + Me.ucrReceiverXEnd.Location = New System.Drawing.Point(248, 288) Me.ucrReceiverXEnd.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverXEnd.Name = "ucrReceiverXEnd" Me.ucrReceiverXEnd.Selector = Nothing @@ -972,7 +936,7 @@ Partial Class dlgLinePlot ' Me.ucrReceiverSlopeColour.AutoSize = True Me.ucrReceiverSlopeColour.frmParent = Me - Me.ucrReceiverSlopeColour.Location = New System.Drawing.Point(249, 288) + Me.ucrReceiverSlopeColour.Location = New System.Drawing.Point(247, 288) Me.ucrReceiverSlopeColour.Margin = New System.Windows.Forms.Padding(0) Me.ucrReceiverSlopeColour.Name = "ucrReceiverSlopeColour" Me.ucrReceiverSlopeColour.Selector = Nothing @@ -1008,7 +972,7 @@ Partial Class dlgLinePlot Me.UcrNudSlopeYTextSize.AutoSize = True Me.UcrNudSlopeYTextSize.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) Me.UcrNudSlopeYTextSize.Increment = New Decimal(New Integer() {1, 0, 0, 0}) - Me.UcrNudSlopeYTextSize.Location = New System.Drawing.Point(347, 350) + Me.UcrNudSlopeYTextSize.Location = New System.Drawing.Point(364, 350) Me.UcrNudSlopeYTextSize.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) Me.UcrNudSlopeYTextSize.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) Me.UcrNudSlopeYTextSize.Name = "UcrNudSlopeYTextSize" @@ -1016,26 +980,55 @@ Partial Class dlgLinePlot Me.UcrNudSlopeYTextSize.TabIndex = 61 Me.UcrNudSlopeYTextSize.Value = New Decimal(New Integer() {0, 0, 0, 0}) ' + 'ucrChkDumbbellColour + ' + Me.ucrChkDumbbellColour.AutoSize = True + Me.ucrChkDumbbellColour.Checked = False + Me.ucrChkDumbbellColour.Location = New System.Drawing.Point(9, 322) + Me.ucrChkDumbbellColour.Name = "ucrChkDumbbellColour" + Me.ucrChkDumbbellColour.Size = New System.Drawing.Size(80, 24) + Me.ucrChkDumbbellColour.TabIndex = 45 + ' + 'ucrChkAddPoints + ' + Me.ucrChkAddPoints.AutoSize = True + Me.ucrChkAddPoints.Checked = False + Me.ucrChkAddPoints.Location = New System.Drawing.Point(9, 337) + Me.ucrChkAddPoints.Name = "ucrChkAddPoints" + Me.ucrChkAddPoints.Size = New System.Drawing.Size(141, 24) + Me.ucrChkAddPoints.TabIndex = 23 + ' + 'ucrChkSlopeLabelOptions + ' + Me.ucrChkSlopeLabelOptions.AutoSize = True + Me.ucrChkSlopeLabelOptions.Checked = False + Me.ucrChkSlopeLabelOptions.Location = New System.Drawing.Point(10, 322) + Me.ucrChkSlopeLabelOptions.Name = "ucrChkSlopeLabelOptions" + Me.ucrChkSlopeLabelOptions.Size = New System.Drawing.Size(80, 24) + Me.ucrChkSlopeLabelOptions.TabIndex = 59 + ' + 'ucrChkSlopeTextOptions + ' + Me.ucrChkSlopeTextOptions.AutoSize = True + Me.ucrChkSlopeTextOptions.Checked = False + Me.ucrChkSlopeTextOptions.Location = New System.Drawing.Point(10, 352) + Me.ucrChkSlopeTextOptions.Name = "ucrChkSlopeTextOptions" + Me.ucrChkSlopeTextOptions.Size = New System.Drawing.Size(80, 24) + Me.ucrChkSlopeTextOptions.TabIndex = 58 + ' 'dlgLinePlot ' Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.ClientSize = New System.Drawing.Size(423, 523) Me.Controls.Add(Me.ucrChkSlopeLegend) - Me.Controls.Add(Me.ucrNudSlopeLabelPadding) - Me.Controls.Add(Me.lblSlopeLineTicknes) - Me.Controls.Add(Me.ucrNudSlopeLineThickness) Me.Controls.Add(Me.lblSlopeLineColour) Me.Controls.Add(Me.lblSlopeLabelSize) Me.Controls.Add(Me.lblSlopeLabelPadding) - Me.Controls.Add(Me.lblSopeTextColour) Me.Controls.Add(Me.lblSlopeTextSize) - Me.Controls.Add(Me.lblSlopeLabelColour) Me.Controls.Add(Me.ucrInputSlopeLineColour) Me.Controls.Add(Me.ucrInputSlopeTextColour) - Me.Controls.Add(Me.ucrInputSlopeLabelColour) Me.Controls.Add(Me.ucrNudSlopeTextSize) - Me.Controls.Add(Me.ucrNudSlopeLabelSize) Me.Controls.Add(Me.lblXEndColour) Me.Controls.Add(Me.lblLineColour) Me.Controls.Add(Me.lblXSize) @@ -1044,8 +1037,6 @@ Partial Class dlgLinePlot Me.Controls.Add(Me.lblXColour) Me.Controls.Add(Me.ucrInputDumbbellLine) Me.Controls.Add(Me.ucrInputDumbbellXEnd) - Me.Controls.Add(Me.ucrInputDumbbellX) - Me.Controls.Add(Me.ucrNudDumbbellLine) Me.Controls.Add(Me.ucrNudDumbbellXEnd) Me.Controls.Add(Me.ucrNudDumbbellX) Me.Controls.Add(Me.ucrChkDumbbellSize) @@ -1056,7 +1047,6 @@ Partial Class dlgLinePlot Me.Controls.Add(Me.lblSlopeY) Me.Controls.Add(Me.rdoSlope) Me.Controls.Add(Me.rdoDumbbell) - Me.Controls.Add(Me.grpSmoothOptions) Me.Controls.Add(Me.ucrChkAddLine) Me.Controls.Add(Me.rdoSmoothing) Me.Controls.Add(Me.rdoLine) @@ -1066,7 +1056,6 @@ Partial Class dlgLinePlot Me.Controls.Add(Me.ucrPnlStepOrPath) Me.Controls.Add(Me.ucrChkPathOrStep) Me.Controls.Add(Me.lblGroupLine) - Me.Controls.Add(Me.ucrChkValley) Me.Controls.Add(Me.ucrChkPeak) Me.Controls.Add(Me.ucrChkWithSE) Me.Controls.Add(Me.ucrChkLineofBestFit) @@ -1080,10 +1069,8 @@ Partial Class dlgLinePlot Me.Controls.Add(Me.lblXVariable) Me.Controls.Add(Me.lblAvailable) Me.Controls.Add(Me.lblXEnd) - Me.Controls.Add(Me.ucrReceiverXEnd) Me.Controls.Add(Me.ucrReceiverSlopeX) Me.Controls.Add(Me.ucrReceiverX) - Me.Controls.Add(Me.ucrReceiverSlopeColour) Me.Controls.Add(Me.ucrFactorOptionalReceiver) Me.Controls.Add(Me.ucrChkSlopeLineOptions) Me.Controls.Add(Me.UcrNudSlopeYTextSize) @@ -1092,6 +1079,19 @@ Partial Class dlgLinePlot Me.Controls.Add(Me.lblSlopeYTextSize) Me.Controls.Add(Me.ucrChkSlopeLabelOptions) Me.Controls.Add(Me.ucrChkSlopeTextOptions) + Me.Controls.Add(Me.ucrNudSlopeLabelSize) + Me.Controls.Add(Me.ucrNudSlopeLabelPadding) + Me.Controls.Add(Me.ucrNudDumbbellLine) + Me.Controls.Add(Me.ucrInputDumbbellX) + Me.Controls.Add(Me.lblSlopeLineTicknes) + Me.Controls.Add(Me.ucrNudSlopeLineThickness) + Me.Controls.Add(Me.grpSmoothOptions) + Me.Controls.Add(Me.ucrInputSlopeLabelColour) + Me.Controls.Add(Me.ucrChkValley) + Me.Controls.Add(Me.lblSopeTextColour) + Me.Controls.Add(Me.lblSlopeLabelColour) + Me.Controls.Add(Me.ucrReceiverXEnd) + Me.Controls.Add(Me.ucrReceiverSlopeColour) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow Me.MaximizeBox = False Me.MinimizeBox = False diff --git a/instat/dlgMergeAdditionalData.vb b/instat/dlgMergeAdditionalData.vb index da4d4522640..cf5d43ecef7 100644 --- a/instat/dlgMergeAdditionalData.vb +++ b/instat/dlgMergeAdditionalData.vb @@ -20,7 +20,7 @@ Imports RDotNet Public Class dlgMergeAdditionalData Private bFirstLoad As Boolean = True Private bReset As Boolean = True - Private clsInsertColumnFunction, clsGetColumnsFromData As New RFunction + Private clsInsertColumnFunction, clsGetColumnsFromData, clsListFunction, clsImportDataFunction As New RFunction Private lstJoinColumns As New List(Of String) Private clsLeftJoinFunction As New RFunction Private clsByListFunction As New RFunction @@ -70,6 +70,8 @@ Public Class dlgMergeAdditionalData clsLeftJoinFunction = New RFunction clsByListFunction = New RFunction clsInsertColumnFunction = New RFunction + clsImportDataFunction = New RFunction + clsListFunction = New RFunction clsGetColumnsFromData = New RFunction clsGetVariablesFunction = New RFunction @@ -90,7 +92,12 @@ Public Class dlgMergeAdditionalData clsGetColumnsFromData.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_columns_from_data") clsGetColumnsFromData.AddParameter("use_current_filter", "FALSE", iPosition:=2) - clsInsertColumnFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$add_columns_to_data") + + clsListFunction.SetRCommand("list") + + clsImportDataFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$import_data") + clsImportDataFunction.AddParameter("data_tables", clsRFunctionParameter:=clsListFunction, iPosition:=0) + clsImportDataFunction.AddParameter("prefix", "FALSE", iPosition:=1) SetDataFrameAssign() ucrBase.clsRsyntax.SetBaseRFunction(clsInsertColumnFunction) @@ -133,7 +140,8 @@ Public Class dlgMergeAdditionalData Private Sub SetDataFrameAssign() If clsLeftJoinFunction IsNot Nothing Then - If ucrToDataFrame.cboAvailableDataFrames.Text <> "" Then + Dim strParam As String = ucrToDataFrame.cboAvailableDataFrames.Text + If strParam <> "" Then clsLeftJoinFunction.RemoveAssignTo() If ucrChkSaveDataFrame.Checked Then clsLeftJoinFunction.SetAssignTo(ucrInputSaveDataFrame.GetText, strTempDataframe:=ucrInputSaveDataFrame.GetText) @@ -143,10 +151,10 @@ Public Class dlgMergeAdditionalData cmdCheckUnique.Visible = False SetInputCheckVisibility(False) Else - clsLeftJoinFunction.SetAssignTo(ucrToDataFrame.cboAvailableDataFrames.Text) - clsInsertColumnFunction.AddParameter("data_name", Chr(34) & ucrToDataFrame.cboAvailableDataFrames.Text & Chr(34), iPosition:=0) - clsInsertColumnFunction.AddParameter("col_data", clsRFunctionParameter:=clsLeftJoinFunction, iPosition:=1) - ucrBase.clsRsyntax.SetBaseRFunction(clsInsertColumnFunction) + clsLeftJoinFunction.SetAssignTo(strParam) + clsListFunction.ClearParameters() + clsListFunction.AddParameter(strParam, clsRFunctionParameter:=clsLeftJoinFunction, iPosition:=0) + ucrBase.clsRsyntax.SetBaseRFunction(clsImportDataFunction) ucrInputSaveDataFrame.Visible = False cmdCheckUnique.Visible = True End If diff --git a/instat/dlgNewDataFrame.Designer.vb b/instat/dlgNewDataFrame.Designer.vb index 115e16f4167..514b7ef0b89 100644 --- a/instat/dlgNewDataFrame.Designer.vb +++ b/instat/dlgNewDataFrame.Designer.vb @@ -534,7 +534,7 @@ Partial Class dlgNewDataFrame 'colDefault ' Me.colDefault.HeaderText = "Default" - Me.colDefault.Items.AddRange(New Object() {"NA", "0", "1", "1,1000", "letters[1:10]", "LETTERS[1:10]"}) + Me.colDefault.Items.AddRange(New Object() {"NA", "0", "1", "1,1000"}) Me.colDefault.Name = "colDefault" ' 'colLevels diff --git a/instat/dlgNewDataFrame.vb b/instat/dlgNewDataFrame.vb index d72a9f5538d..d2d81d6784d 100644 --- a/instat/dlgNewDataFrame.vb +++ b/instat/dlgNewDataFrame.vb @@ -603,6 +603,9 @@ Public Class dlgNewDataFrame Dim selectedCombobox As ComboBox = DirectCast(sender, ComboBox) If selectedCombobox.SelectedItem = "Factor" Then dataTypeGridView(iColumnLevelIndex, iRowLevelIndex).ReadOnly = False + Dim iColDefaultIndex As Integer = dataTypeGridView.CurrentRow.Cells("colDefault").ColumnIndex + Dim iRowDefaultIndex As Integer = dataTypeGridView.CurrentRow.Cells("colDefault").RowIndex + dataTypeGridView(iColDefaultIndex, iRowDefaultIndex).Value = "NA" Else dataTypeGridView(iColumnLevelIndex, iRowLevelIndex).ReadOnly = True dataTypeGridView(iColumnLevelIndex, iRowLevelIndex).Value = "" diff --git a/instat/dlgOneVariableSummarise.Designer.vb b/instat/dlgOneVariableSummarise.Designer.vb index 64e6efcf4bd..b088ef00b35 100644 --- a/instat/dlgOneVariableSummarise.Designer.vb +++ b/instat/dlgOneVariableSummarise.Designer.vb @@ -11,9 +11,8 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . - Partial Class dlgOneVariableSummarise Inherits System.Windows.Forms.Form @@ -34,7 +33,7 @@ Partial Class dlgOneVariableSummarise Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer - 'It can be modified using the Windows Form Designer. + 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Private Sub InitializeComponent() @@ -200,7 +199,7 @@ Partial Class dlgOneVariableSummarise ' Me.ucrBase.AutoSize = True Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(8, 336) + Me.ucrBase.Location = New System.Drawing.Point(8, 386) Me.ucrBase.Name = "ucrBase" Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 11 @@ -269,7 +268,7 @@ Partial Class dlgOneVariableSummarise Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True - Me.ClientSize = New System.Drawing.Size(421, 395) + Me.ClientSize = New System.Drawing.Size(421, 442) Me.Controls.Add(Me.cmdMissingOptions) Me.Controls.Add(Me.rdoSkim) Me.Controls.Add(Me.ucrInputMarginName) diff --git a/instat/dlgOneVariableSummarise.vb b/instat/dlgOneVariableSummarise.vb index c714fb0fd51..1a812f48b7e 100644 --- a/instat/dlgOneVariableSummarise.vb +++ b/instat/dlgOneVariableSummarise.vb @@ -11,9 +11,8 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . - Imports instat Imports instat.Translations @@ -26,7 +25,7 @@ Public Class dlgOneVariableSummarise clsHeaderLeftTopSummaryFunction, clsHeaderTopLeftVariableFunction, clsHeaderTopLeftSummaryFunction, clsDummyFunction, clsSkimrFunction As New RFunction - Private clsMmtableOperator As ROperator + Private clsMmtableOperator As New ROperator Private bResetSubdialog As Boolean = False Public strDefaultDataFrame As String = "" Public strDefaultColumns() As String = Nothing @@ -50,6 +49,7 @@ Public Class dlgOneVariableSummarise Private Sub InitialiseDialog() ucrBase.iHelpTopicID = 410 ucrBase.clsRsyntax.iCallType = 2 + ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False 'The selector is only used for one of the functions. Therefore it's parameter name is always the same. So this can be done in Initialise. ucrSelectorOneVarSummarise.SetParameter(New RParameter("data_name", 0)) @@ -120,6 +120,11 @@ Public Class dlgOneVariableSummarise clsSkimrFunction.SetPackageName("skimr") clsSkimrFunction.SetRCommand("skim_without_charts") clsSkimrFunction.AddParameter("data", clsRFunctionParameter:=ucrSelectorOneVarSummarise.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + clsSkimrFunction.SetAssignToOutputObject(strRObjectToAssignTo:="last_summary", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Summary, + strRObjectFormatToAssignTo:=RObjectFormat.Text, + strRDataFrameNameToAddObjectTo:=ucrSelectorOneVarSummarise.strCurrentDataFrame, + strObjectName:="last_summary") 'Dummy function used to set conditions for the summary and variable checkbox clsDummyFunction.AddParameter("variable_by_row", "TRUE", iPosition:=0) @@ -132,6 +137,11 @@ Public Class dlgOneVariableSummarise clsMmtableOperator.AddParameter("mmtable_function", clsRFunctionParameter:=clsMmtableFunction, iPosition:=0) clsMmtableOperator.AddParameter("header_left_top_variable", clsRFunctionParameter:=clsHeaderLeftTopVariableFunction, iPosition:=1) clsMmtableOperator.AddParameter("header_top_left_summary", clsRFunctionParameter:=clsHeaderTopLeftSummaryFunction, iPosition:=2) + clsMmtableOperator.SetAssignToOutputObject(strRObjectToAssignTo:="last_summary", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table, + strRObjectFormatToAssignTo:=RObjectFormat.Html, + strRDataFrameNameToAddObjectTo:=ucrSelectorOneVarSummarise.strCurrentDataFrame, + strObjectName:="last_summary") clsHeaderLeftTopVariableFunction.SetPackageName("mmtable2") clsHeaderLeftTopVariableFunction.SetRCommand("header_left_top") @@ -162,6 +172,11 @@ Public Class dlgOneVariableSummarise clsSummaryFunction.SetRCommand("summary") clsSummaryFunction.AddParameter("maxsum", iMaxSum) clsSummaryFunction.AddParameter("na.rm", "FALSE", iPosition:=3) + clsSummaryFunction.SetAssignToOutputObject(strRObjectToAssignTo:="last_summary", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table, + strRObjectFormatToAssignTo:=RObjectFormat.Text, + strRDataFrameNameToAddObjectTo:=ucrSelectorOneVarSummarise.strCurrentDataFrame, + strObjectName:="last_summary") clsSummaryTableFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$summary_table") clsSummaryTableFunction.AddParameter("treat_columns_as_factor", "TRUE", iPosition:=0) @@ -180,11 +195,13 @@ Public Class dlgOneVariableSummarise ucrNudMaxSum.SetRCode(clsSummaryFunction, bReset) ucrReceiverOneVarSummarise.SetRCode(clsSummaryFunction, bReset) ucrChkOmitMissing.SetRCode(clsSummaryFunction, bReset) + ucrChkDisplayMargins.SetRCode(clsSummaryTableFunction, bReset) ucrPnlSummaries.SetRCode(clsDummyFunction, bReset) ucrSelectorOneVarSummarise.SetRCode(clsSummaryTableFunction, bReset) ucrChkDisplayVariablesAsRows.SetRCode(clsDummyFunction, bReset) ucrChkDisplaySummariesAsRows.SetRCode(clsDummyFunction, bReset) + bRCodeSet = True End Sub @@ -244,6 +261,10 @@ Public Class dlgOneVariableSummarise Private Sub ucrSelectorOneVarSummarise_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrSelectorOneVarSummarise.ControlValueChanged clsSkimrFunction.AddParameter("data", clsRFunctionParameter:=ucrSelectorOneVarSummarise.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + + clsSummaryFunction._strDataFrameNameToAddAssignToObject = ucrSelectorOneVarSummarise.strCurrentDataFrame + clsMmtableOperator._strDataFrameNameToAddAssignToObject = ucrSelectorOneVarSummarise.strCurrentDataFrame + clsSkimrFunction._strDataFrameNameToAddAssignToObject = ucrSelectorOneVarSummarise.strCurrentDataFrame End Sub Private Sub ucrChkOmitMissing_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrChkOmitMissing.ControlValueChanged diff --git a/instat/dlgOpenNetCDF.vb b/instat/dlgOpenNetCDF.vb index 8e771e967c5..431710c08bc 100644 --- a/instat/dlgOpenNetCDF.vb +++ b/instat/dlgOpenNetCDF.vb @@ -252,7 +252,6 @@ Public Class dlgOpenNetCDF If strFiles.Count > 0 Then CheckCloseFile() clsNcOpenFunction.AddParameter("filename", Chr(34) & Replace(strFiles(0), "\", "/") & Chr(34)) - clsNcOpenFunction.bToBeAssigned = True clsNcOpenFunction.ToScript(strTemp) frmMain.clsRLink.RunScript(strTemp, strComment:="Opening connection to first NetCDF file", bUpdateGrids:=False) bCloseFile = True diff --git a/instat/dlgOptions.Designer.vb b/instat/dlgOptions.Designer.vb index a5871e1855e..8154dc157b6 100644 --- a/instat/dlgOptions.Designer.vb +++ b/instat/dlgOptions.Designer.vb @@ -14,30 +14,30 @@ ' You should have received a copy of the GNU General Public License ' along with this program. If not, see . - -Partial Class dlgOptions - Inherits System.Windows.Forms.Form - - 'Form overrides dispose to clean up the component list. - - Protected Overrides Sub Dispose(ByVal disposing As Boolean) - Try - If disposing AndAlso components IsNot Nothing Then - components.Dispose() - End If - Finally - MyBase.Dispose(disposing) - End Try - End Sub - - 'Required by the Windows Form Designer - Private components As System.ComponentModel.IContainer - - 'NOTE: The following procedure is required by the Windows Form Designer - 'It can be modified using the Windows Form Designer. - 'Do not modify it using the code editor. - - Private Sub InitializeComponent() + +Partial Class dlgOptions + Inherits System.Windows.Forms.Form + + 'Form overrides dispose to clean up the component list. + + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + Try + If disposing AndAlso components IsNot Nothing Then + components.Dispose() + End If + Finally + MyBase.Dispose(disposing) + End Try + End Sub + + 'Required by the Windows Form Designer + Private components As System.ComponentModel.IContainer + + 'NOTE: The following procedure is required by the Windows Form Designer + 'It can be modified using the Windows Form Designer. + 'Do not modify it using the code editor. + + Private Sub InitializeComponent() Dim TreeNode13 As System.Windows.Forms.TreeNode = New System.Windows.Forms.TreeNode("Languages") Dim TreeNode14 As System.Windows.Forms.TreeNode = New System.Windows.Forms.TreeNode("Comments") Dim TreeNode15 As System.Windows.Forms.TreeNode = New System.Windows.Forms.TreeNode("Import") @@ -64,6 +64,7 @@ Partial Class dlgOptions Me.ucrNudPreviewRows = New instat.ucrNud() Me.pnImportData = New System.Windows.Forms.Panel() Me.tbpOutputWindow = New System.Windows.Forms.TabPage() + Me.ucrChkMaximumOutputsHeight = New instat.ucrCheck() Me.ucrChkShowRCommandsinOutputWindow = New instat.ucrCheck() Me.ucrChkIncludeCommentsbyDefault = New instat.ucrCheck() Me.grpROptions = New System.Windows.Forms.GroupBox() @@ -123,6 +124,7 @@ Partial Class dlgOptions Me.ucrInputHost = New instat.ucrInputTextBox() Me.ucrInputDatabaseName = New instat.ucrInputTextBox() Me.cmdLanguage = New System.Windows.Forms.Button() + Me.ucrNudMaximumOutputsHeight = New instat.ucrNud() CType(Me.spltControls, System.ComponentModel.ISupportInitialize).BeginInit() Me.spltControls.Panel1.SuspendLayout() Me.spltControls.Panel2.SuspendLayout() @@ -384,6 +386,8 @@ Partial Class dlgOptions ' 'tbpOutputWindow ' + Me.tbpOutputWindow.Controls.Add(Me.ucrNudMaximumOutputsHeight) + Me.tbpOutputWindow.Controls.Add(Me.ucrChkMaximumOutputsHeight) Me.tbpOutputWindow.Controls.Add(Me.ucrChkShowRCommandsinOutputWindow) Me.tbpOutputWindow.Controls.Add(Me.ucrChkIncludeCommentsbyDefault) Me.tbpOutputWindow.Controls.Add(Me.grpROptions) @@ -396,22 +400,31 @@ Partial Class dlgOptions Me.tbpOutputWindow.Text = "Output Window" Me.tbpOutputWindow.UseVisualStyleBackColor = True ' + 'ucrChkMaximumOutputsHeight + ' + Me.ucrChkMaximumOutputsHeight.AutoSize = True + Me.ucrChkMaximumOutputsHeight.Checked = False + Me.ucrChkMaximumOutputsHeight.Location = New System.Drawing.Point(310, 135) + Me.ucrChkMaximumOutputsHeight.Name = "ucrChkMaximumOutputsHeight" + Me.ucrChkMaximumOutputsHeight.Size = New System.Drawing.Size(162, 23) + Me.ucrChkMaximumOutputsHeight.TabIndex = 28 + ' 'ucrChkShowRCommandsinOutputWindow ' Me.ucrChkShowRCommandsinOutputWindow.AutoSize = True Me.ucrChkShowRCommandsinOutputWindow.Checked = False - Me.ucrChkShowRCommandsinOutputWindow.Location = New System.Drawing.Point(10, 168) + Me.ucrChkShowRCommandsinOutputWindow.Location = New System.Drawing.Point(10, 158) Me.ucrChkShowRCommandsinOutputWindow.Name = "ucrChkShowRCommandsinOutputWindow" - Me.ucrChkShowRCommandsinOutputWindow.Size = New System.Drawing.Size(388, 23) + Me.ucrChkShowRCommandsinOutputWindow.Size = New System.Drawing.Size(271, 23) Me.ucrChkShowRCommandsinOutputWindow.TabIndex = 27 ' 'ucrChkIncludeCommentsbyDefault ' Me.ucrChkIncludeCommentsbyDefault.AutoSize = True Me.ucrChkIncludeCommentsbyDefault.Checked = False - Me.ucrChkIncludeCommentsbyDefault.Location = New System.Drawing.Point(10, 145) + Me.ucrChkIncludeCommentsbyDefault.Location = New System.Drawing.Point(10, 135) Me.ucrChkIncludeCommentsbyDefault.Name = "ucrChkIncludeCommentsbyDefault" - Me.ucrChkIncludeCommentsbyDefault.Size = New System.Drawing.Size(391, 23) + Me.ucrChkIncludeCommentsbyDefault.Size = New System.Drawing.Size(271, 23) Me.ucrChkIncludeCommentsbyDefault.TabIndex = 26 ' 'grpROptions @@ -1023,6 +1036,19 @@ Partial Class dlgOptions Me.cmdLanguage.Text = "Lang" Me.cmdLanguage.UseVisualStyleBackColor = True ' + 'ucrNudMaximumOutputsHeight + ' + Me.ucrNudMaximumOutputsHeight.AutoSize = True + Me.ucrNudMaximumOutputsHeight.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudMaximumOutputsHeight.Increment = New Decimal(New Integer() {1, 0, 0, 0}) + Me.ucrNudMaximumOutputsHeight.Location = New System.Drawing.Point(478, 135) + Me.ucrNudMaximumOutputsHeight.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) + Me.ucrNudMaximumOutputsHeight.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudMaximumOutputsHeight.Name = "ucrNudMaximumOutputsHeight" + Me.ucrNudMaximumOutputsHeight.Size = New System.Drawing.Size(50, 20) + Me.ucrNudMaximumOutputsHeight.TabIndex = 29 + Me.ucrNudMaximumOutputsHeight.Value = New Decimal(New Integer() {0, 0, 0, 0}) + ' 'dlgOptions ' Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) @@ -1078,10 +1104,10 @@ Partial Class dlgOptions Me.tbpClimsoft.PerformLayout() Me.ResumeLayout(False) - End Sub - Friend WithEvents cmdOk As Button - Friend WithEvents cmdCancel As Button - Friend WithEvents cmdHelp As Button + End Sub + Friend WithEvents cmdOk As Button + Friend WithEvents cmdCancel As Button + Friend WithEvents cmdHelp As Button Friend WithEvents cmdApply As Button Friend WithEvents tbcOptions As TabControl Friend WithEvents tbpLanguages As TabPage @@ -1158,4 +1184,6 @@ Partial Class dlgOptions Friend WithEvents lblLanguage As Label Friend WithEvents ucrInputLanguage As ucrInputComboBox Friend WithEvents cmdLanguage As Button -End Class + Friend WithEvents ucrChkMaximumOutputsHeight As ucrCheck + Friend WithEvents ucrNudMaximumOutputsHeight As ucrNud +End Class diff --git a/instat/dlgOptions.vb b/instat/dlgOptions.vb index d92348227f2..ff4bc1c9b40 100644 --- a/instat/dlgOptions.vb +++ b/instat/dlgOptions.vb @@ -72,7 +72,7 @@ Public Class dlgOptions ucrChkViewClimaticMenu.SetText("Show Climatic Menu") ucrChkViewProcurementMenu.SetText("Show Procurement Menu") ucrChkViewOptionsByContextMenu.SetText("Show Options By Context Menu") - ucrChkShowRCommandsinOutputWindow.SetText(" Show R Commands in Output Window") + ucrChkShowRCommandsinOutputWindow.SetText("Show R Commands in Output Window") ucrChkShowSignifStars.SetText("Show stars on summary tables for coefficients") ucrChkShowDataonGrid.SetText("Display dialog's selected data frame in grid") ucrChkIncludeDefaultParams.SetText("Include Default Parameter Values in R Commands") @@ -87,6 +87,10 @@ Public Class dlgOptions ucrInputLanguage.SetItems({"English", "French", "Kiswahili", "Portuguese", "Russian", "Spanish"}) ucrInputLanguage.SetDropDownStyleAsNonEditable() + ucrChkShowWaitDialog.SetText("Set maximum height for outputs") + ucrChkMaximumOutputsHeight.AddToLinkedControls(ucrNudMaximumOutputsHeight, {True}) + ucrNudMaximumOutputsHeight.Maximum = 1000 + SetVisibleLanButton() End Sub @@ -118,6 +122,11 @@ Public Class dlgOptions ucrInputHost.SetName(frmMain.clsInstatOptions.strClimsoftHost) ucrInputPort.SetName(frmMain.clsInstatOptions.strClimsoftPort) ucrInputUserName.SetName(frmMain.clsInstatOptions.strClimsoftUsername) + ucrChkMaximumOutputsHeight.Checked = frmMain.clsInstatOptions.iMaxOutputsHeight > 0 + ucrNudMaximumOutputsHeight.Value = If(frmMain.clsInstatOptions.iMaxOutputsHeight > 0, + frmMain.clsInstatOptions.iMaxOutputsHeight, + clsInstatOptionsDefaults.DEFAULTiMaxOutputsHeight) + Select Case frmMain.clsInstatOptions.strLanguageCultureCode Case "en-GB" ucrInputLanguage.SetText("English") @@ -174,6 +183,8 @@ Public Class dlgOptions frmMain.clsInstatOptions.SetClimsoftHost(ucrInputHost.GetText()) frmMain.clsInstatOptions.SetClimsoftPort(ucrInputPort.GetText()) frmMain.clsInstatOptions.SetClimsoftUsername(ucrInputUserName.GetText()) + frmMain.clsInstatOptions.SetMaximumOutputsHeight(If(ucrChkMaximumOutputsHeight.Checked, + ucrNudMaximumOutputsHeight.Value, -1)) End Sub Private Sub SetView() @@ -401,6 +412,10 @@ Public Class dlgOptions ApplyEnabled(True) End Sub + Private Sub AllControls_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrNudWaitSeconds.ControlValueChanged, ucrNudPreviewRows.ControlValueChanged, ucrNudMaxRows.ControlValueChanged, ucrNudMaxCols.ControlValueChanged, ucrNudDigits.ControlValueChanged, ucrNudAutoSaveMinutes.ControlValueChanged, ucrInputUserName.ControlValueChanged, ucrInputPort.ControlValueChanged, ucrInputHost.ControlValueChanged, ucrInputDatabaseName.ControlValueChanged, ucrInputComment.ControlContentsChanged, ucrChkViewStructuredMenu.ControlValueChanged, ucrChkViewProcurementMenu.ControlValueChanged, ucrChkViewOptionsByContextMenu.ControlValueChanged, ucrChkViewClimaticMenu.ControlValueChanged, ucrChkShowWaitDialog.ControlValueChanged, ucrChkShowSignifStars.ControlValueChanged, ucrChkShowRCommandsinOutputWindow.ControlValueChanged, ucrChkShowDataonGrid.ControlValueChanged, ucrChkIncludeDefaultParams.ControlValueChanged, ucrChkIncludeCommentsbyDefault.ControlValueChanged, ucrChkAutoSave.ControlValueChanged + + End Sub + Private Sub SetVisibleLanButton() If frmMain.clsInstatOptions IsNot Nothing Then If frmMain.clsInstatOptions.strLanguageCultureCode <> "en-GB" Then diff --git a/instat/dlgRPackages.vb b/instat/dlgRPackages.vb index 7fa4c5302b6..79363d1682c 100644 --- a/instat/dlgRPackages.vb +++ b/instat/dlgRPackages.vb @@ -75,33 +75,43 @@ Public Class dlgInstallRPackage clsPackageCheck.AddParameter("package", Chr(34) & ucrInputTextBoxRPackage.GetText() & Chr(34)) expOutput = frmMain.clsRLink.RunInternalScriptGetValue(clsPackageCheck.ToScript(), bSilent:=True) - If expOutput IsNot Nothing AndAlso Not expOutput.Type = Internals.SymbolicExpressionType.Null Then - chrOutput = expOutput.AsCharacter - If chrOutput.Count >= 1 Then - If chrOutput(0) = "0" Then - ucrInputMessage.SetText("No package with this name.") - ucrInputMessage.txtInput.BackColor = Color.LightCoral - ElseIf chrOutput(0) = "2" Then - ucrInputMessage.SetText("Package exists and not currently installed.") - ucrInputMessage.txtInput.BackColor = Color.LightGreen - ElseIf chrOutput(0) = "1" Then - If chrOutput.Count = 4 Then - If chrOutput(1) = "0" Then - ucrInputMessage.SetText("Package is installed and up to date.") - ucrInputMessage.txtInput.BackColor = Color.Yellow - ElseIf chrOutput(1) = "-1" Then - ucrInputMessage.SetText("Package is installed. Newer version available: " & chrOutput(3) & " (current: " & chrOutput(2) & ").") - End If - Else - ucrInputMessage.SetText("Package is installed. No version information available.") + + If expOutput Is Nothing OrElse expOutput.Type = Internals.SymbolicExpressionType.Null Then + ucrInputMessage.SetText("Cannot get package information.") + Exit Sub + End If + + chrOutput = expOutput.AsCharacter + If chrOutput.Count < 1 Then + ucrInputMessage.SetText("Cannot get package information.") + Exit Sub + End If + + Select Case chrOutput(0) + Case "1" + If chrOutput.Count = 4 Then + If chrOutput(1) = "0" Then + ucrInputMessage.SetText("Package is installed and up to date.") + ucrInputMessage.txtInput.BackColor = Color.Yellow + ElseIf chrOutput(1) = "-1" Then + ucrInputMessage.SetText("Package is installed. Newer version available: " & chrOutput(3) & " (current: " & chrOutput(2) & ").") End If + Else + ucrInputMessage.SetText("Package is installed. No version information available.") End If - Else - ucrInputMessage.SetText("Cannot get package information.") - End If - Else - ucrInputMessage.SetText("Cannot get package information. Check your internet connection.") - End If + Case "2" + ucrInputMessage.SetText("Package exists and not currently installed.") + ucrInputMessage.txtInput.BackColor = Color.LightGreen + Case "3" + ucrInputMessage.SetText("Package is installed but not a current CRAN package") + ucrInputMessage.txtInput.BackColor = Color.LightBlue + Case "4" + ucrInputMessage.SetText("Not a current CRAN package. Perhaps it has been archived") + ucrInputMessage.txtInput.BackColor = Color.LightSkyBlue + Case "5" + ucrInputMessage.SetText("No internet connection.Try reconnecting") + ucrInputMessage.txtInput.BackColor = Color.LightCoral + End Select End Sub Private Sub CheckEnable() diff --git a/instat/dlgRegularSequence.vb b/instat/dlgRegularSequence.vb index 27a7b64ed10..797415d16fe 100644 --- a/instat/dlgRegularSequence.vb +++ b/instat/dlgRegularSequence.vb @@ -179,7 +179,10 @@ Public Class dlgRegularSequence clsRepFunction.AddParameter("each", 1, iPosition:=2) clsRepFunction.AddParameter("length.out", ucrDataFrameLength.GetDataFrameLength, iPosition:=3) - clsRepFunction.SetAssignTo(ucrNewColumnName.GetText, strTempDataframe:=ucrSelectDataFrameRegularSequence.cboAvailableDataFrames.Text, strTempColumn:=ucrNewColumnName.GetText, bAssignToIsPrefix:=True) + clsRepFunction.SetAssignToColumnObject(strColToAssignTo:=ucrNewColumnName.GetText, + strColName:=ucrNewColumnName.GetText, + strRDataFrameNameToAddObjectTo:=ucrSelectDataFrameRegularSequence.strCurrDataFrame, + bAssignToIsPrefix:=True) ucrBase.clsRsyntax.SetBaseRFunction(clsRepFunction) End Sub @@ -248,8 +251,6 @@ Public Class dlgRegularSequence 'clone the "rep" command base function clsNewRepClone = clsRepFunction.Clone() - clsNewRepClone.bToBeAssigned = False - clsNewRepClone.bIsAssigned = False 'set up "as.character" command to be usde for testing clsAsCharacter.SetRCommand("as.character") diff --git a/instat/dlgScatterPlot.vb b/instat/dlgScatterPlot.vb index 21c58e1dcd1..8e4bc2a7aa9 100644 --- a/instat/dlgScatterPlot.vb +++ b/instat/dlgScatterPlot.vb @@ -11,7 +11,7 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . Imports instat.Translations @@ -117,7 +117,8 @@ Public Class dlgScatterPlot ucrChkAddRugPlot.AddToLinkedControls({ucrNudSize, ucrInputSides}, {True}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True) ucrSaveScatterPlot.SetPrefix("scatter_plot") - ucrSaveScatterPlot.SetSaveTypeAsGraph() + ucrSaveScatterPlot.SetSaveType(strRObjectType:=RObjectTypeLabel.Graph, + strRObjectFormat:=RObjectFormat.Image) ucrSaveScatterPlot.SetDataFrameSelector(ucrSelectorForScatter.ucrAvailableDataFrames) ucrSaveScatterPlot.SetCheckBoxText("Save Graph") ucrSaveScatterPlot.SetIsComboBox() @@ -212,7 +213,12 @@ Public Class dlgScatterPlot clsGeomSmoothFunction.AddParameter("method", Chr(34) & "lm" & Chr(34), iPosition:=0) clsGeomSmoothFunction.AddParameter("se", "FALSE", iPosition:=1) - clsBaseOperator.SetAssignTo("last_graph", strTempDataframe:=ucrSelectorForScatter.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:="last_graph") + clsBaseOperator.SetAssignToOutputObject(strRObjectToAssignTo:="last_graph", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Graph, + strRObjectFormatToAssignTo:=RObjectFormat.Image, + strRDataFrameNameToAddObjectTo:=ucrSelectorForScatter.strCurrentDataFrame, + strObjectName:="last_graph") + ucrBase.clsRsyntax.SetBaseROperator(clsBaseOperator) End Sub @@ -298,7 +304,7 @@ Public Class dlgScatterPlot sdgLayerOptions.ShowDialog() ucrReceiverLabel.SetRCode(clsRaesFunction, bReset) bResetlayerSubdialog = False - 'The aesthetics parameters on the main dialog are repopulated as required. + 'The aesthetics parameters on the main dialog are repopulated as required. For Each clsParam In clsRaesFunction.clsParameters Select Case clsParam.strArgumentName Case "x" @@ -330,4 +336,5 @@ Public Class dlgScatterPlot ucrReceiverX.ControlContentsChanged, ucrVariablesAsFactorForScatter.ControlContentsChanged, ucrSaveScatterPlot.ControlContentsChanged TestOkEnabled() End Sub + End Class diff --git a/instat/dlgSearch.Designer.vb b/instat/dlgSearch.Designer.vb new file mode 100644 index 00000000000..e5ac2666863 --- /dev/null +++ b/instat/dlgSearch.Designer.vb @@ -0,0 +1,42 @@ + +Partial Class dlgSearch + Inherits System.Windows.Forms.Form + + 'Form overrides dispose to clean up the component list. + + Protected Overrides Sub Dispose(ByVal disposing As Boolean) + Try + If disposing AndAlso components IsNot Nothing Then + components.Dispose() + End If + Finally + MyBase.Dispose(disposing) + End Try + End Sub + + 'Required by the Windows Form Designer + Private components As System.ComponentModel.IContainer + + 'NOTE: The following procedure is required by the Windows Form Designer + 'It can be modified using the Windows Form Designer. + 'Do not modify it using the code editor. + + Private Sub InitializeComponent() + Me.SuspendLayout() + ' + 'dlgSearch + ' + Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) + Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi + Me.AutoSize = True + Me.ClientSize = New System.Drawing.Size(390, 255) + Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedToolWindow + Me.MaximizeBox = False + Me.Name = "dlgSearch" + Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen + Me.Tag = "Search" + Me.Text = "Search" + Me.ResumeLayout(False) + + End Sub +End Class diff --git a/instat/frmGraphDisplay.resx b/instat/dlgSearch.resx similarity index 100% rename from instat/frmGraphDisplay.resx rename to instat/dlgSearch.resx diff --git a/instat/dlgSearch.vb b/instat/dlgSearch.vb new file mode 100644 index 00000000000..5b2c4608dee --- /dev/null +++ b/instat/dlgSearch.vb @@ -0,0 +1,3 @@ +Public Class dlgSearch + +End Class \ No newline at end of file diff --git a/instat/dlgSummaryTables.Designer.vb b/instat/dlgSummaryTables.Designer.vb index a8932d10a2a..fc4c0529ad1 100644 --- a/instat/dlgSummaryTables.Designer.vb +++ b/instat/dlgSummaryTables.Designer.vb @@ -42,29 +42,24 @@ Partial Class dlgSummaryTables Me.cmdSummaries = New System.Windows.Forms.Button() Me.lblSigFigs = New System.Windows.Forms.Label() Me.grpDisplay = New System.Windows.Forms.GroupBox() - Me.ucrNudColumnFactors = New instat.ucrNud() Me.lblColumnFactors = New System.Windows.Forms.Label() - Me.ucrChkDisplaySummaryVariablesAsRow = New instat.ucrCheck() - Me.ucrChkDisplayVariablesAsRows = New instat.ucrCheck() - Me.ucrChkDisplaySummariesAsRow = New instat.ucrCheck() - Me.ucrNudSigFigs = New instat.ucrNud() Me.grpMargin = New System.Windows.Forms.GroupBox() Me.rdoBoth = New System.Windows.Forms.RadioButton() Me.rdoSummary = New System.Windows.Forms.RadioButton() Me.rdoOuter = New System.Windows.Forms.RadioButton() - Me.ucrPnlMargin = New instat.UcrPanel() Me.lblMarginName = New System.Windows.Forms.Label() Me.lblVariables = New System.Windows.Forms.Label() Me.cmdFormatTable = New System.Windows.Forms.Button() Me.rdoFrequencyTable = New System.Windows.Forms.RadioButton() Me.rdoSummaryTable = New System.Windows.Forms.RadioButton() Me.grpPercentages = New System.Windows.Forms.GroupBox() - Me.ucrReceiverPercentages = New instat.ucrReceiverSingle() Me.lblFactorsAsPercentage = New System.Windows.Forms.Label() - Me.ucrChkPercentageProportion = New instat.ucrCheck() - Me.ucrChkDisplayAsPercentage = New instat.ucrCheck() Me.lblFrequencyMarginName = New System.Windows.Forms.Label() + Me.cmdMissingOptions = New System.Windows.Forms.Button() Me.ucrChkFrequencyDisplayMargins = New instat.ucrCheck() + Me.ucrReceiverPercentages = New instat.ucrReceiverSingle() + Me.ucrChkPercentageProportion = New instat.ucrCheck() + Me.ucrChkDisplayAsPercentage = New instat.ucrCheck() Me.ucrPnlSummaryFrequencyTables = New instat.UcrPanel() Me.ucrReorderSummary = New instat.ucrReorder() Me.ucrInputMarginName = New instat.ucrInputTextBox() @@ -72,6 +67,11 @@ Partial Class dlgSummaryTables Me.ucrChkOmitMissing = New instat.ucrCheck() Me.ucrChkStoreResults = New instat.ucrCheck() Me.ucrChkDisplayMargins = New instat.ucrCheck() + Me.ucrNudColumnFactors = New instat.ucrNud() + Me.ucrChkDisplaySummaryVariablesAsRow = New instat.ucrCheck() + Me.ucrChkDisplayVariablesAsRows = New instat.ucrCheck() + Me.ucrChkDisplaySummariesAsRow = New instat.ucrCheck() + Me.ucrNudSigFigs = New instat.ucrNud() Me.ucrChkSummaries = New instat.ucrCheck() Me.ucrBase = New instat.ucrButtons() Me.ucrReceiverSummaryCols = New instat.ucrReceiverMultiple() @@ -79,6 +79,7 @@ Partial Class dlgSummaryTables Me.ucrReceiverWeights = New instat.ucrReceiverSingle() Me.ucrChkWeight = New instat.ucrCheck() Me.ucrSelectorSummaryTables = New instat.ucrSelectorByDataFrameAddRemove() + Me.ucrPnlMargin = New instat.UcrPanel() Me.ucrInputFrequencyMarginName = New instat.ucrInputTextBox() Me.grpDisplay.SuspendLayout() Me.grpMargin.SuspendLayout() @@ -133,19 +134,6 @@ Partial Class dlgSummaryTables Me.grpDisplay.TabStop = False Me.grpDisplay.Text = "Display" ' - 'ucrNudColumnFactors - ' - Me.ucrNudColumnFactors.AutoSize = True - Me.ucrNudColumnFactors.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) - Me.ucrNudColumnFactors.Increment = New Decimal(New Integer() {1, 0, 0, 0}) - Me.ucrNudColumnFactors.Location = New System.Drawing.Point(111, 49) - Me.ucrNudColumnFactors.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) - Me.ucrNudColumnFactors.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) - Me.ucrNudColumnFactors.Name = "ucrNudColumnFactors" - Me.ucrNudColumnFactors.Size = New System.Drawing.Size(50, 20) - Me.ucrNudColumnFactors.TabIndex = 19 - Me.ucrNudColumnFactors.Value = New Decimal(New Integer() {0, 0, 0, 0}) - ' 'lblColumnFactors ' Me.lblColumnFactors.AutoSize = True @@ -157,46 +145,6 @@ Partial Class dlgSummaryTables Me.lblColumnFactors.Tag = "" Me.lblColumnFactors.Text = "Column Factors :" ' - 'ucrChkDisplaySummaryVariablesAsRow - ' - Me.ucrChkDisplaySummaryVariablesAsRow.AutoSize = True - Me.ucrChkDisplaySummaryVariablesAsRow.Checked = False - Me.ucrChkDisplaySummaryVariablesAsRow.Location = New System.Drawing.Point(11, 73) - Me.ucrChkDisplaySummaryVariablesAsRow.Name = "ucrChkDisplaySummaryVariablesAsRow" - Me.ucrChkDisplaySummaryVariablesAsRow.Size = New System.Drawing.Size(231, 23) - Me.ucrChkDisplaySummaryVariablesAsRow.TabIndex = 17 - ' - 'ucrChkDisplayVariablesAsRows - ' - Me.ucrChkDisplayVariablesAsRows.AutoSize = True - Me.ucrChkDisplayVariablesAsRows.Checked = False - Me.ucrChkDisplayVariablesAsRows.Location = New System.Drawing.Point(11, 97) - Me.ucrChkDisplayVariablesAsRows.Name = "ucrChkDisplayVariablesAsRows" - Me.ucrChkDisplayVariablesAsRows.Size = New System.Drawing.Size(186, 23) - Me.ucrChkDisplayVariablesAsRows.TabIndex = 11 - ' - 'ucrChkDisplaySummariesAsRow - ' - Me.ucrChkDisplaySummariesAsRow.AutoSize = True - Me.ucrChkDisplaySummariesAsRow.Checked = False - Me.ucrChkDisplaySummariesAsRow.Location = New System.Drawing.Point(11, 73) - Me.ucrChkDisplaySummariesAsRow.Name = "ucrChkDisplaySummariesAsRow" - Me.ucrChkDisplaySummariesAsRow.Size = New System.Drawing.Size(175, 23) - Me.ucrChkDisplaySummariesAsRow.TabIndex = 10 - ' - 'ucrNudSigFigs - ' - Me.ucrNudSigFigs.AutoSize = True - Me.ucrNudSigFigs.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) - Me.ucrNudSigFigs.Increment = New Decimal(New Integer() {1, 0, 0, 0}) - Me.ucrNudSigFigs.Location = New System.Drawing.Point(111, 23) - Me.ucrNudSigFigs.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) - Me.ucrNudSigFigs.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) - Me.ucrNudSigFigs.Name = "ucrNudSigFigs" - Me.ucrNudSigFigs.Size = New System.Drawing.Size(50, 20) - Me.ucrNudSigFigs.TabIndex = 5 - Me.ucrNudSigFigs.Value = New Decimal(New Integer() {0, 0, 0, 0}) - ' 'grpMargin ' Me.grpMargin.Controls.Add(Me.rdoBoth) @@ -245,20 +193,11 @@ Partial Class dlgSummaryTables Me.rdoOuter.Text = "Outer" Me.rdoOuter.UseVisualStyleBackColor = True ' - 'ucrPnlMargin - ' - Me.ucrPnlMargin.AutoSize = True - Me.ucrPnlMargin.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrPnlMargin.Location = New System.Drawing.Point(6, 14) - Me.ucrPnlMargin.Name = "ucrPnlMargin" - Me.ucrPnlMargin.Size = New System.Drawing.Size(0, 0) - Me.ucrPnlMargin.TabIndex = 13 - ' 'lblMarginName ' Me.lblMarginName.AutoSize = True Me.lblMarginName.ImeMode = System.Windows.Forms.ImeMode.NoControl - Me.lblMarginName.Location = New System.Drawing.Point(159, 287) + Me.lblMarginName.Location = New System.Drawing.Point(159, 288) Me.lblMarginName.Name = "lblMarginName" Me.lblMarginName.Size = New System.Drawing.Size(41, 13) Me.lblMarginName.TabIndex = 15 @@ -332,19 +271,6 @@ Partial Class dlgSummaryTables Me.grpPercentages.TabStop = False Me.grpPercentages.Text = "Percentages" ' - 'ucrReceiverPercentages - ' - Me.ucrReceiverPercentages.AutoSize = True - Me.ucrReceiverPercentages.frmParent = Me - Me.ucrReceiverPercentages.Location = New System.Drawing.Point(16, 60) - Me.ucrReceiverPercentages.Margin = New System.Windows.Forms.Padding(0) - Me.ucrReceiverPercentages.Name = "ucrReceiverPercentages" - Me.ucrReceiverPercentages.Selector = Nothing - Me.ucrReceiverPercentages.Size = New System.Drawing.Size(120, 20) - Me.ucrReceiverPercentages.strNcFilePath = "" - Me.ucrReceiverPercentages.TabIndex = 4 - Me.ucrReceiverPercentages.ucrSelector = Nothing - ' 'lblFactorsAsPercentage ' Me.lblFactorsAsPercentage.AutoSize = True @@ -356,24 +282,6 @@ Partial Class dlgSummaryTables Me.lblFactorsAsPercentage.Tag = "Factors as Percentage:" Me.lblFactorsAsPercentage.Text = "Of Factor (Optional):" ' - 'ucrChkPercentageProportion - ' - Me.ucrChkPercentageProportion.AutoSize = True - Me.ucrChkPercentageProportion.Checked = False - Me.ucrChkPercentageProportion.Location = New System.Drawing.Point(5, 171) - Me.ucrChkPercentageProportion.Name = "ucrChkPercentageProportion" - Me.ucrChkPercentageProportion.Size = New System.Drawing.Size(160, 23) - Me.ucrChkPercentageProportion.TabIndex = 3 - ' - 'ucrChkDisplayAsPercentage - ' - Me.ucrChkDisplayAsPercentage.AutoSize = True - Me.ucrChkDisplayAsPercentage.Checked = False - Me.ucrChkDisplayAsPercentage.Location = New System.Drawing.Point(14, 19) - Me.ucrChkDisplayAsPercentage.Name = "ucrChkDisplayAsPercentage" - Me.ucrChkDisplayAsPercentage.Size = New System.Drawing.Size(135, 23) - Me.ucrChkDisplayAsPercentage.TabIndex = 0 - ' 'lblFrequencyMarginName ' Me.lblFrequencyMarginName.AutoSize = True @@ -384,6 +292,16 @@ Partial Class dlgSummaryTables Me.lblFrequencyMarginName.TabIndex = 25 Me.lblFrequencyMarginName.Text = "Margin Name :" ' + 'cmdMissingOptions + ' + Me.cmdMissingOptions.Enabled = False + Me.cmdMissingOptions.Location = New System.Drawing.Point(205, 261) + Me.cmdMissingOptions.Name = "cmdMissingOptions" + Me.cmdMissingOptions.Size = New System.Drawing.Size(75, 23) + Me.cmdMissingOptions.TabIndex = 27 + Me.cmdMissingOptions.Text = "Options" + Me.cmdMissingOptions.UseVisualStyleBackColor = True + ' 'ucrChkFrequencyDisplayMargins ' Me.ucrChkFrequencyDisplayMargins.AutoSize = True @@ -393,6 +311,37 @@ Partial Class dlgSummaryTables Me.ucrChkFrequencyDisplayMargins.Size = New System.Drawing.Size(213, 23) Me.ucrChkFrequencyDisplayMargins.TabIndex = 24 ' + 'ucrReceiverPercentages + ' + Me.ucrReceiverPercentages.AutoSize = True + Me.ucrReceiverPercentages.frmParent = Nothing + Me.ucrReceiverPercentages.Location = New System.Drawing.Point(16, 60) + Me.ucrReceiverPercentages.Margin = New System.Windows.Forms.Padding(0) + Me.ucrReceiverPercentages.Name = "ucrReceiverPercentages" + Me.ucrReceiverPercentages.Selector = Nothing + Me.ucrReceiverPercentages.Size = New System.Drawing.Size(120, 20) + Me.ucrReceiverPercentages.strNcFilePath = "" + Me.ucrReceiverPercentages.TabIndex = 4 + Me.ucrReceiverPercentages.ucrSelector = Nothing + ' + 'ucrChkPercentageProportion + ' + Me.ucrChkPercentageProportion.AutoSize = True + Me.ucrChkPercentageProportion.Checked = False + Me.ucrChkPercentageProportion.Location = New System.Drawing.Point(5, 171) + Me.ucrChkPercentageProportion.Name = "ucrChkPercentageProportion" + Me.ucrChkPercentageProportion.Size = New System.Drawing.Size(160, 23) + Me.ucrChkPercentageProportion.TabIndex = 3 + ' + 'ucrChkDisplayAsPercentage + ' + Me.ucrChkDisplayAsPercentage.AutoSize = True + Me.ucrChkDisplayAsPercentage.Checked = False + Me.ucrChkDisplayAsPercentage.Location = New System.Drawing.Point(14, 19) + Me.ucrChkDisplayAsPercentage.Name = "ucrChkDisplayAsPercentage" + Me.ucrChkDisplayAsPercentage.Size = New System.Drawing.Size(135, 23) + Me.ucrChkDisplayAsPercentage.TabIndex = 0 + ' 'ucrPnlSummaryFrequencyTables ' Me.ucrPnlSummaryFrequencyTables.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink @@ -417,7 +366,7 @@ Partial Class dlgSummaryTables Me.ucrInputMarginName.AutoSize = True Me.ucrInputMarginName.IsMultiline = False Me.ucrInputMarginName.IsReadOnly = False - Me.ucrInputMarginName.Location = New System.Drawing.Point(206, 284) + Me.ucrInputMarginName.Location = New System.Drawing.Point(206, 285) Me.ucrInputMarginName.Name = "ucrInputMarginName" Me.ucrInputMarginName.Size = New System.Drawing.Size(74, 21) Me.ucrInputMarginName.TabIndex = 16 @@ -437,7 +386,7 @@ Partial Class dlgSummaryTables Me.ucrChkOmitMissing.Checked = False Me.ucrChkOmitMissing.Location = New System.Drawing.Point(10, 266) Me.ucrChkOmitMissing.Name = "ucrChkOmitMissing" - Me.ucrChkOmitMissing.Size = New System.Drawing.Size(271, 23) + Me.ucrChkOmitMissing.Size = New System.Drawing.Size(152, 23) Me.ucrChkOmitMissing.TabIndex = 9 ' 'ucrChkStoreResults @@ -458,6 +407,59 @@ Partial Class dlgSummaryTables Me.ucrChkDisplayMargins.Size = New System.Drawing.Size(150, 23) Me.ucrChkDisplayMargins.TabIndex = 10 ' + 'ucrNudColumnFactors + ' + Me.ucrNudColumnFactors.AutoSize = True + Me.ucrNudColumnFactors.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudColumnFactors.Increment = New Decimal(New Integer() {1, 0, 0, 0}) + Me.ucrNudColumnFactors.Location = New System.Drawing.Point(111, 49) + Me.ucrNudColumnFactors.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) + Me.ucrNudColumnFactors.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudColumnFactors.Name = "ucrNudColumnFactors" + Me.ucrNudColumnFactors.Size = New System.Drawing.Size(50, 20) + Me.ucrNudColumnFactors.TabIndex = 19 + Me.ucrNudColumnFactors.Value = New Decimal(New Integer() {0, 0, 0, 0}) + ' + 'ucrChkDisplaySummaryVariablesAsRow + ' + Me.ucrChkDisplaySummaryVariablesAsRow.AutoSize = True + Me.ucrChkDisplaySummaryVariablesAsRow.Checked = False + Me.ucrChkDisplaySummaryVariablesAsRow.Location = New System.Drawing.Point(11, 73) + Me.ucrChkDisplaySummaryVariablesAsRow.Name = "ucrChkDisplaySummaryVariablesAsRow" + Me.ucrChkDisplaySummaryVariablesAsRow.Size = New System.Drawing.Size(231, 23) + Me.ucrChkDisplaySummaryVariablesAsRow.TabIndex = 17 + ' + 'ucrChkDisplayVariablesAsRows + ' + Me.ucrChkDisplayVariablesAsRows.AutoSize = True + Me.ucrChkDisplayVariablesAsRows.Checked = False + Me.ucrChkDisplayVariablesAsRows.Location = New System.Drawing.Point(11, 97) + Me.ucrChkDisplayVariablesAsRows.Name = "ucrChkDisplayVariablesAsRows" + Me.ucrChkDisplayVariablesAsRows.Size = New System.Drawing.Size(186, 23) + Me.ucrChkDisplayVariablesAsRows.TabIndex = 11 + ' + 'ucrChkDisplaySummariesAsRow + ' + Me.ucrChkDisplaySummariesAsRow.AutoSize = True + Me.ucrChkDisplaySummariesAsRow.Checked = False + Me.ucrChkDisplaySummariesAsRow.Location = New System.Drawing.Point(11, 73) + Me.ucrChkDisplaySummariesAsRow.Name = "ucrChkDisplaySummariesAsRow" + Me.ucrChkDisplaySummariesAsRow.Size = New System.Drawing.Size(175, 23) + Me.ucrChkDisplaySummariesAsRow.TabIndex = 10 + ' + 'ucrNudSigFigs + ' + Me.ucrNudSigFigs.AutoSize = True + Me.ucrNudSigFigs.DecimalPlaces = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudSigFigs.Increment = New Decimal(New Integer() {1, 0, 0, 0}) + Me.ucrNudSigFigs.Location = New System.Drawing.Point(111, 23) + Me.ucrNudSigFigs.Maximum = New Decimal(New Integer() {100, 0, 0, 0}) + Me.ucrNudSigFigs.Minimum = New Decimal(New Integer() {0, 0, 0, 0}) + Me.ucrNudSigFigs.Name = "ucrNudSigFigs" + Me.ucrNudSigFigs.Size = New System.Drawing.Size(50, 20) + Me.ucrNudSigFigs.TabIndex = 5 + Me.ucrNudSigFigs.Value = New Decimal(New Integer() {0, 0, 0, 0}) + ' 'ucrChkSummaries ' Me.ucrChkSummaries.AutoSize = True @@ -536,6 +538,15 @@ Partial Class dlgSummaryTables Me.ucrSelectorSummaryTables.Size = New System.Drawing.Size(213, 183) Me.ucrSelectorSummaryTables.TabIndex = 0 ' + 'ucrPnlMargin + ' + Me.ucrPnlMargin.AutoSize = True + Me.ucrPnlMargin.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink + Me.ucrPnlMargin.Location = New System.Drawing.Point(6, 14) + Me.ucrPnlMargin.Name = "ucrPnlMargin" + Me.ucrPnlMargin.Size = New System.Drawing.Size(0, 0) + Me.ucrPnlMargin.TabIndex = 13 + ' 'ucrInputFrequencyMarginName ' Me.ucrInputFrequencyMarginName.AddQuotesIfUnrecognised = True @@ -553,6 +564,7 @@ Partial Class dlgSummaryTables Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True Me.ClientSize = New System.Drawing.Size(489, 571) + Me.Controls.Add(Me.cmdMissingOptions) Me.Controls.Add(Me.ucrChkFrequencyDisplayMargins) Me.Controls.Add(Me.grpPercentages) Me.Controls.Add(Me.rdoFrequencyTable) @@ -639,4 +651,5 @@ Partial Class dlgSummaryTables Friend WithEvents lblFrequencyMarginName As Label Friend WithEvents ucrChkFrequencyDisplayMargins As ucrCheck Friend WithEvents ucrReceiverPercentages As ucrReceiverSingle + Friend WithEvents cmdMissingOptions As Button End Class \ No newline at end of file diff --git a/instat/dlgSummaryTables.vb b/instat/dlgSummaryTables.vb index ea4f5b7bdcf..d96cdf3003d 100644 --- a/instat/dlgSummaryTables.vb +++ b/instat/dlgSummaryTables.vb @@ -11,9 +11,10 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . + Imports instat.Translations Public Class dlgSummaryTables Private bFirstload As Boolean = True @@ -90,6 +91,7 @@ Public Class dlgSummaryTables ucrChkOmitMissing.SetText("Omit Missing Values") ucrChkOmitMissing.SetValuesCheckedAndUnchecked("TRUE", "FALSE") ucrChkOmitMissing.SetRDefault("FALSE") + ucrChkOmitMissing.SetLinkedDisplayControl(cmdMissingOptions) ucrChkDisplayMargins.SetParameter(New RParameter("include_margins", 6)) ucrChkDisplayMargins.SetText("Display Outer Margins") @@ -179,7 +181,7 @@ Public Class dlgSummaryTables ucrChkPercentageProportion.SetRDefault("FALSE") ucrSaveTable.SetPrefix("summary_table") - ucrSaveTable.SetSaveTypeAsTable() + ucrSaveTable.SetSaveType(RObjectTypeLabel.Table, strRObjectFormat:=RObjectFormat.Html) ucrSaveTable.SetDataFrameSelector(ucrSelectorSummaryTables.ucrAvailableDataFrames) ucrSaveTable.SetIsComboBox() ucrSaveTable.SetCheckBoxText("Save Table") @@ -384,7 +386,13 @@ Public Class dlgSummaryTables ucrBase.clsRsyntax.AddToBeforeCodes(clsFrequencyDefaultFunction, iPosition:=0) ucrBase.clsRsyntax.SetBaseROperator(clsJoiningPipeOperator) - clsJoiningPipeOperator.SetAssignTo("last_table", strTempDataframe:=ucrSelectorSummaryTables.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempTable:="last_table") + + clsJoiningPipeOperator.SetAssignToOutputObject(strRObjectToAssignTo:="last_table", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table, + strRObjectFormatToAssignTo:=RObjectFormat.Html, + strRDataFrameNameToAddObjectTo:=ucrSelectorSummaryTables.strCurrentDataFrame, + strObjectName:="last_table") + bResetSubdialog = True End Sub diff --git a/instat/dlgThreeVariableFrequencies.vb b/instat/dlgThreeVariableFrequencies.vb index dff94c7331f..9df2af1525d 100644 --- a/instat/dlgThreeVariableFrequencies.vb +++ b/instat/dlgThreeVariableFrequencies.vb @@ -19,7 +19,8 @@ Public Class dlgThreeVariableFrequencies Private bFirstLoad As Boolean = True Private bReset As Boolean = True Private bResetSubdialog As Boolean = False - Private clsSjTab, clsSelect, clsSjPlot, clsGroupBy, clsGridArrange As New RFunction + Private clsSjTabFunction, clsSelectFunction, clsSjPlotFunction, + clsGroupByFunction, clsGridArrangeFunction, clsArrangeFunction As New RFunction Private clsTableBaseOperator, clsGraphBaseOperator As New ROperator Private clsCurrBaseCode As New RCodeStructure Private iMaxGraphGroupX As Integer @@ -45,7 +46,7 @@ Public Class dlgThreeVariableFrequencies End Sub Private Sub InitialiseDialog() - ucrBase.iHelpTopicID = 523 + ucrBase.iHelpTopicID = 415 ucrChkWeights.Enabled = False ' temporary because of bug in R functions being used ucrSelectorThreeVariableFrequencies.SetParameter(New RParameter("data", 0)) @@ -153,11 +154,12 @@ Public Class dlgThreeVariableFrequencies End Sub Private Sub SetDefaults() - clsSelect = New RFunction - clsSjPlot = New RFunction - clsGroupBy = New RFunction - clsSjTab = New RFunction - clsGridArrange = New RFunction + clsSelectFunction = New RFunction + clsSjPlotFunction = New RFunction + clsGroupByFunction = New RFunction + clsSjTabFunction = New RFunction + clsArrangeFunction = New RFunction + clsGridArrangeFunction = New RFunction clsTableBaseOperator = New ROperator clsGraphBaseOperator = New ROperator @@ -166,38 +168,42 @@ Public Class dlgThreeVariableFrequencies ucrSaveGraph.Reset() clsTableBaseOperator.SetOperation("%>%") - clsTableBaseOperator.AddParameter("group_by", clsRFunctionParameter:=clsGroupBy, iPosition:=1) - clsTableBaseOperator.AddParameter("select", clsRFunctionParameter:=clsSelect, iPosition:=2) - clsTableBaseOperator.AddParameter("sjtab", clsRFunctionParameter:=clsSjTab, iPosition:=3) + clsTableBaseOperator.AddParameter("group_by", clsRFunctionParameter:=clsGroupByFunction, iPosition:=1) + clsTableBaseOperator.AddParameter("select", clsRFunctionParameter:=clsSelectFunction, iPosition:=2) + clsTableBaseOperator.AddParameter("arrange", clsRFunctionParameter:=clsArrangeFunction, iPosition:=3) + clsTableBaseOperator.AddParameter("sjtab", clsRFunctionParameter:=clsSjTabFunction, iPosition:=4) clsGraphBaseOperator.SetOperation("%>%") - clsGraphBaseOperator.AddParameter("group_by", clsRFunctionParameter:=clsGroupBy, iPosition:=1) - clsGraphBaseOperator.AddParameter("select", clsRFunctionParameter:=clsSelect, iPosition:=2) - clsGraphBaseOperator.AddParameter("sjplot", clsRFunctionParameter:=clsSjPlot, iPosition:=3) - - clsGroupBy.SetPackageName("dplyr") - clsGroupBy.SetRCommand("group_by") - clsSelect.SetPackageName("dplyr") - clsSelect.SetRCommand("select") - - clsSjTab.SetPackageName("sjPlot") - clsSjTab.SetRCommand("sjtab") - clsSjTab.AddParameter("show.summary", "FALSE") - clsSjTab.AddParameter("digits", 0) - clsSjTab.AddParameter("fun", Chr(34) & "xtab" & Chr(34)) - clsSjTab.AddParameter("string.total", Chr(34) & "Total" & Chr(34)) - - clsSjPlot.SetPackageName("sjPlot") - clsSjPlot.SetRCommand("sjplot") - clsSjPlot.AddParameter("fun", Chr(34) & "grpfrq" & Chr(34)) - clsSjPlot.AddParameter("show.prc", "TRUE") - clsSjPlot.AddParameter("show.n", "TRUE") - - clsGridArrange.SetPackageName("gridExtra") - clsGridArrange.SetRCommand("grid.arrange") - clsGridArrange.AddParameter("grobs", clsROperatorParameter:=clsGraphBaseOperator) - - clsGridArrange.SetAssignTo("last_graph", strTempDataframe:=ucrSelectorThreeVariableFrequencies.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:="last_graph") + clsGraphBaseOperator.AddParameter("group_by", clsRFunctionParameter:=clsGroupByFunction, iPosition:=1) + clsGraphBaseOperator.AddParameter("select", clsRFunctionParameter:=clsSelectFunction, iPosition:=2) + clsGraphBaseOperator.AddParameter("arrange", clsRFunctionParameter:=clsArrangeFunction, iPosition:=3) + clsGraphBaseOperator.AddParameter("sjplot", clsRFunctionParameter:=clsSjPlotFunction, iPosition:=3) + + clsGroupByFunction.SetPackageName("dplyr") + clsGroupByFunction.SetRCommand("group_by") + clsSelectFunction.SetPackageName("dplyr") + clsSelectFunction.SetRCommand("select") + clsArrangeFunction.SetPackageName("dplyr") + clsArrangeFunction.SetRCommand("arrange") + + clsSjTabFunction.SetPackageName("sjPlot") + clsSjTabFunction.SetRCommand("sjtab") + clsSjTabFunction.AddParameter("show.summary", "FALSE") + clsSjTabFunction.AddParameter("digits", 0) + clsSjTabFunction.AddParameter("fun", Chr(34) & "xtab" & Chr(34)) + clsSjTabFunction.AddParameter("string.total", Chr(34) & "Total" & Chr(34)) + + clsSjPlotFunction.SetPackageName("sjPlot") + clsSjPlotFunction.SetRCommand("sjplot") + clsSjPlotFunction.AddParameter("fun", Chr(34) & "grpfrq" & Chr(34)) + clsSjPlotFunction.AddParameter("show.prc", "TRUE") + clsSjPlotFunction.AddParameter("show.n", "TRUE") + + clsGridArrangeFunction.SetPackageName("gridExtra") + clsGridArrangeFunction.SetRCommand("grid.arrange") + clsGridArrangeFunction.AddParameter("grobs", clsROperatorParameter:=clsGraphBaseOperator) + + clsGridArrangeFunction.SetAssignTo("last_graph", strTempDataframe:=ucrSelectorThreeVariableFrequencies.ucrAvailableDataFrames.cboAvailableDataFrames.Text, strTempGraph:="last_graph") ucrBase.clsRsyntax.SetBaseROperator(clsTableBaseOperator) clsCurrBaseCode = clsTableBaseOperator bResetSubdialog = True @@ -208,35 +214,38 @@ Public Class dlgThreeVariableFrequencies Dim clsTempParamY As RParameter clsTempParamX = New RParameter("x", 3) - ucrReceiverGroupsBy1st.AddAdditionalCodeParameterPair(clsSelect, clsTempParamX, iAdditionalPairNo:=1) + ucrReceiverGroupsBy1st.AddAdditionalCodeParameterPair(clsSelectFunction, clsTempParamX, iAdditionalPairNo:=1) clsTempParamX.bIncludeArgumentName = False clsTempParamY = New RParameter("y", 4) - ucrReceiverGroupBy2nd.AddAdditionalCodeParameterPair(clsSelect, clsTempParamY, iAdditionalPairNo:=1) + ucrReceiverGroupBy2nd.AddAdditionalCodeParameterPair(clsSelectFunction, clsTempParamY, iAdditionalPairNo:=1) clsTempParamY.bIncludeArgumentName = False + ucrReceiverGroupsBy1st.AddAdditionalCodeParameterPair(clsArrangeFunction, New RParameter("col", 0, bNewIncludeArgumentName:=False), iAdditionalPairNo:=2) + ucrReceiverGroupBy2nd.AddAdditionalCodeParameterPair(clsArrangeFunction, New RParameter("col", 0, bNewIncludeArgumentName:=False), iAdditionalPairNo:=2) + ucrSelectorThreeVariableFrequencies.AddAdditionalCodeParameterPair(clsGraphBaseOperator, ucrSelectorThreeVariableFrequencies.GetParameter, iAdditionalPairNo:=1) - ucrChkWeights.AddAdditionalCodeParameterPair(clsSjPlot, New RParameter("weight.by", 1), iAdditionalPairNo:=1) - ucrReceiverWeights.AddAdditionalCodeParameterPair(clsSjPlot, ucrChkWeights.GetParameter(), iAdditionalPairNo:=1) - - ucrReceiverRowFactor.SetRCode(clsSelect, bReset) - ucrReceiverColumnFactor.SetRCode(clsSelect, bReset) - ucrReceiverGroupsBy1st.SetRCode(clsGroupBy, bReset) - ucrReceiverGroupBy2nd.SetRCode(clsGroupBy, bReset) - ucrReceiverWeights.SetRCode(clsSjTab, bReset) - ucrChkWeights.SetRCode(clsSjTab, bReset) - ucrChkFlip.SetRCode(clsSjPlot, bReset) - ucrPnlFreqType.SetRCode(clsSjPlot, bReset) + ucrChkWeights.AddAdditionalCodeParameterPair(clsSjPlotFunction, New RParameter("weight.by", 1), iAdditionalPairNo:=1) + ucrReceiverWeights.AddAdditionalCodeParameterPair(clsSjPlotFunction, ucrChkWeights.GetParameter(), iAdditionalPairNo:=1) + + ucrReceiverRowFactor.SetRCode(clsSelectFunction, bReset) + ucrReceiverColumnFactor.SetRCode(clsSelectFunction, bReset) + ucrReceiverGroupsBy1st.SetRCode(clsGroupByFunction, bReset) + ucrReceiverGroupBy2nd.SetRCode(clsGroupByFunction, bReset) + ucrReceiverWeights.SetRCode(clsSjTabFunction, bReset) + ucrChkWeights.SetRCode(clsSjTabFunction, bReset) + ucrChkFlip.SetRCode(clsSjPlotFunction, bReset) + ucrPnlFreqType.SetRCode(clsSjPlotFunction, bReset) If bReset OrElse Not rdoBoth.Checked Then ucrPnlFrequencyDisplay.SetRCode(clsCurrBaseCode, bReset) End If ucrSelectorThreeVariableFrequencies.SetRCode(clsTableBaseOperator, bReset) - ucrChkCell.SetRCode(clsSjTab, bReset) - ucrChkColumn.SetRCode(clsSjTab, bReset) - ucrChkRow.SetRCode(clsSjTab, bReset) - ucrChkCount.SetRCode(clsSjTab, bReset) - ucrSaveGraph.SetRCode(clsGridArrange, bReset) + ucrChkCell.SetRCode(clsSjTabFunction, bReset) + ucrChkColumn.SetRCode(clsSjTabFunction, bReset) + ucrChkRow.SetRCode(clsSjTabFunction, bReset) + ucrChkCount.SetRCode(clsSjTabFunction, bReset) + ucrSaveGraph.SetRCode(clsGridArrangeFunction, bReset) End Sub Private Sub TestOkEnabled() @@ -267,7 +276,7 @@ Public Class dlgThreeVariableFrequencies clsCurrBaseCode = clsTableBaseOperator ucrBase.clsRsyntax.iCallType = 2 ElseIf rdoGraph.Checked Then - ucrBase.clsRsyntax.SetBaseRFunction(clsGridArrange) + ucrBase.clsRsyntax.SetBaseRFunction(clsGridArrangeFunction) clsCurrBaseCode = clsGraphBaseOperator ucrBase.clsRsyntax.iCallType = 3 End If @@ -276,26 +285,18 @@ Public Class dlgThreeVariableFrequencies Private Sub ucrBase_ClickOk(sender As Object, e As EventArgs) Handles ucrBase.ClickOk Dim strGraph As String Dim strTempScript As String = "" - Dim bIsAssigned As Boolean - Dim bToBeAssigned As Boolean - Dim strAssignTo As String + 'Dim bIsAssigned As Boolean + 'Dim bToBeAssigned As Boolean + 'Dim strAssignTo As String If rdoBoth.Checked Then - bIsAssigned = clsGridArrange.bIsAssigned - bToBeAssigned = clsGridArrange.bToBeAssigned - strAssignTo = clsGridArrange.strAssignTo - - strGraph = clsGridArrange.ToScript(strTempScript) + strGraph = clsGridArrangeFunction.ToScript(strTempScript) frmMain.clsRLink.RunScript(strTempScript & strGraph, iCallType:=3) - - clsGridArrange.bIsAssigned = bIsAssigned - clsGridArrange.bToBeAssigned = bToBeAssigned - clsGridArrange.strAssignTo = strAssignTo End If End Sub Private Sub cmdOptions_Click(sender As Object, e As EventArgs) Handles cmdOptions.Click - sdgTwoWayFrequencies.SetRCode(clsSjTab, clsSjPlot, clsGraphBaseOperator, bResetSubdialog, bNewUseTitle:=False) + sdgTwoWayFrequencies.SetRCode(clsSjTabFunction, clsSjPlotFunction, clsGraphBaseOperator, bResetSubdialog, bNewUseTitle:=False) bResetSubdialog = False sdgTwoWayFrequencies.ShowDialog() TestOkEnabled() @@ -332,13 +333,13 @@ Public Class dlgThreeVariableFrequencies Private Sub ucrPnlFreqType_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrPnlFreqType.ControlContentsChanged If rdoCell.Checked Then - clsSjPlot.AddParameter("margin", Chr(34) & "cell" & Chr(34)) + clsSjPlotFunction.AddParameter("margin", Chr(34) & "cell" & Chr(34)) ElseIf rdoColumn.Checked Then - clsSjPlot.AddParameter("margin", Chr(34) & "col" & Chr(34)) + clsSjPlotFunction.AddParameter("margin", Chr(34) & "col" & Chr(34)) ElseIf rdoRow.Checked Then - clsSjPlot.AddParameter("margin", Chr(34) & "row" & Chr(34)) + clsSjPlotFunction.AddParameter("margin", Chr(34) & "row" & Chr(34)) Else - clsSjPlot.RemoveParameterByName("margin") + clsSjPlotFunction.RemoveParameterByName("margin") End If End Sub diff --git a/instat/dlgThreeVariablePivotTable.Designer.vb b/instat/dlgThreeVariablePivotTable.Designer.vb index e1b8146d427..ef14c42d5f8 100644 --- a/instat/dlgThreeVariablePivotTable.Designer.vb +++ b/instat/dlgThreeVariablePivotTable.Designer.vb @@ -18,7 +18,7 @@ Partial Class dlgThreeVariablePivotTable Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer - 'It can be modified using the Windows Form Designer. + 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Private Sub InitializeComponent() @@ -147,7 +147,7 @@ Partial Class dlgThreeVariablePivotTable 'ucrSavePivot ' Me.ucrSavePivot.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrSavePivot.Location = New System.Drawing.Point(9, 366) + Me.ucrSavePivot.Location = New System.Drawing.Point(9, 389) Me.ucrSavePivot.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrSavePivot.Name = "ucrSavePivot" Me.ucrSavePivot.Size = New System.Drawing.Size(382, 23) @@ -201,7 +201,7 @@ Partial Class dlgThreeVariablePivotTable ' Me.ucrBase.AutoSize = True Me.ucrBase.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink - Me.ucrBase.Location = New System.Drawing.Point(9, 397) + Me.ucrBase.Location = New System.Drawing.Point(9, 420) Me.ucrBase.Name = "ucrBase" Me.ucrBase.Size = New System.Drawing.Size(408, 52) Me.ucrBase.TabIndex = 51 @@ -247,7 +247,7 @@ Partial Class dlgThreeVariablePivotTable Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi Me.AutoSize = True - Me.ClientSize = New System.Drawing.Size(417, 456) + Me.ClientSize = New System.Drawing.Size(417, 481) Me.Controls.Add(Me.lblFactorLevels) Me.Controls.Add(Me.ucrReceiverFactorLevels) Me.Controls.Add(Me.ucrChkNumericVariable) diff --git a/instat/dlgThreeVariablePivotTable.vb b/instat/dlgThreeVariablePivotTable.vb index a2bbdfdfee0..2029b6b86fd 100644 --- a/instat/dlgThreeVariablePivotTable.vb +++ b/instat/dlgThreeVariablePivotTable.vb @@ -11,7 +11,7 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . Imports instat.Translations Public Class dlgThreeVariablePivotTable @@ -19,11 +19,12 @@ Public Class dlgThreeVariablePivotTable Private bRcodeSet As Boolean = False Private bReset As Boolean = True Private clsConcatenateFunction, clsFlattenFunction, - clsGetObjectFunction, clsLevelsFunction, clsPasteFunction, + clsLevelsFunction, clsPasteFunction, clsRelevelPasteFunction, clsRPivotTableFunction, clsSelectFunction As New RFunction Private clsPipeOperator, clsLevelsDollarOperator As New ROperator + Private Sub dlgThreeVariablePivotTable_Load(sender As Object, e As EventArgs) Handles MyBase.Load If bFirstLoad Then InitialiseDialog() @@ -40,8 +41,8 @@ Public Class dlgThreeVariablePivotTable End Sub Private Sub InitialiseDialog() - ucrBase.iHelpTopicID = 603 - ucrBase.clsRsyntax.iCallType = 2 + ucrBase.iHelpTopicID = 417 + ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False ucrSelectorPivot.SetParameter(New RParameter("data", iNewPosition:=0)) ucrSelectorPivot.SetParameterIsrfunction() @@ -109,7 +110,7 @@ Public Class dlgThreeVariablePivotTable ucrInputSummary.SetLinkedDisplayControl(lblSummary) ucrSavePivot.SetPrefix("pivot_table") - ucrSavePivot.SetSaveTypeAsTable() + ucrSavePivot.SetSaveType(RObjectTypeLabel.Table, strRObjectFormat:=RObjectFormat.Html) ucrSavePivot.SetDataFrameSelector(ucrSelectorPivot.ucrAvailableDataFrames) ucrSavePivot.SetIsComboBox() ucrSavePivot.SetCheckBoxText("Save Table") @@ -120,7 +121,6 @@ Public Class dlgThreeVariablePivotTable clsConcatenateFunction = New RFunction clsFlattenFunction = New RFunction clsLevelsFunction = New RFunction - clsGetObjectFunction = New RFunction clsPasteFunction = New RFunction clsRelevelPasteFunction = New RFunction clsRPivotTableFunction = New RFunction @@ -132,54 +132,55 @@ Public Class dlgThreeVariablePivotTable ucrReceiverInitialRowFactors.SetMeAsReceiver() ucrSelectorPivot.Reset() ucrSavePivot.Reset() - ucrBase.clsRsyntax.ClearCodes() - - clsConcatenateFunction.SetRCommand("c") - - clsFlattenFunction.SetPackageName("stringr") - clsFlattenFunction.SetRCommand("str_flatten") - clsFlattenFunction.AddParameter("string", "survey_levels", iPosition:=0) - clsFlattenFunction.SetAssignTo("survey_levels") - clsGetObjectFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$get_objects") - clsGetObjectFunction.AddParameter("data_name", Chr(34) & ucrSelectorPivot.ucrAvailableDataFrames.cboAvailableDataFrames.Text & Chr(34), iPosition:=0) clsLevelsDollarOperator.SetOperation("$") clsLevelsFunction.SetRCommand("levels") clsLevelsFunction.AddParameter("x", clsROperatorParameter:=clsLevelsDollarOperator, iPosition:=0) - clsLevelsFunction.SetAssignTo("survey_levels") clsPasteFunction.SetRCommand("paste0") clsPasteFunction.AddParameter("first_parameter", Chr(34) & "\" & Chr(34) & Chr(34), iPosition:=0, bIncludeArgumentName:=False) - clsPasteFunction.AddParameter("second_parameter", "survey_levels", iPosition:=1, - bIncludeArgumentName:=False) + clsPasteFunction.AddParameter("second_parameter", clsRFunctionParameter:=clsLevelsFunction, + iPosition:=1, bIncludeArgumentName:=False) clsPasteFunction.AddParameter("third_parameter", Chr(34) & "\" & Chr(34) & "," & Chr(34), iPosition:=2, bIncludeArgumentName:=False) - clsPasteFunction.SetAssignTo("survey_levels") - clsPipeOperator.SetOperation("%>%") - clsPipeOperator.AddParameter("columns", clsRFunctionParameter:=clsSelectFunction, iPosition:=1) - clsPipeOperator.SetAssignTo("data_selected") + clsFlattenFunction.SetPackageName("stringr") + clsFlattenFunction.SetRCommand("str_flatten") + clsFlattenFunction.AddParameter("string", clsRFunctionParameter:=clsPasteFunction, iPosition:=0) + clsFlattenFunction.SetAssignTo("survey_levels") + clsRelevelPasteFunction.SetRCommand("paste0") clsRelevelPasteFunction.AddParameter("first_paramete", Chr(34) & "function(attr) { var sortAs = $.pivotUtilities.sortAs; return sortAs([" & Chr(34) & ", survey_levels," & Chr(34) & "]); }" & Chr(34), bIncludeArgumentName:=False, iPosition:=0) clsRelevelPasteFunction.SetAssignTo("relevel_variables") - clsRPivotTableFunction.SetPackageName("rpivotTable") - clsRPivotTableFunction.SetRCommand("rpivotTable") - clsRPivotTableFunction.AddParameter("data", clsRFunctionParameter:=ucrSelectorPivot.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + + clsConcatenateFunction.SetRCommand("c") clsSelectFunction.SetPackageName("dplyr") clsSelectFunction.SetRCommand("select") clsSelectFunction.AddParameter("concatenate", clsRFunctionParameter:=clsConcatenateFunction, iPosition:=0, bIncludeArgumentName:=False) - clsConcatenateFunction.SetRCommand("c") + clsPipeOperator.SetOperation("%>%") + clsPipeOperator.AddParameter("columns", clsRFunctionParameter:=clsSelectFunction, iPosition:=1) + clsPipeOperator.SetAssignTo("data_selected") + + clsRPivotTableFunction.SetPackageName("rpivotTable") + clsRPivotTableFunction.SetRCommand("rpivotTable") + clsRPivotTableFunction.AddParameter("data", clsRFunctionParameter:=ucrSelectorPivot.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) + clsRPivotTableFunction.SetAssignTo("last_table") + + clsRPivotTableFunction.SetAssignToOutputObject(strRObjectToAssignTo:="last_table", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table, + strRObjectFormatToAssignTo:=RObjectFormat.Html, + strRDataFrameNameToAddObjectTo:=ucrSelectorPivot.strCurrentDataFrame, + strObjectName:="last_table") - ucrBase.clsRsyntax.AddToBeforeCodes(clsRPivotTableFunction, iPosition:=4) - ucrBase.clsRsyntax.SetBaseRFunction(clsGetObjectFunction) + ucrBase.clsRsyntax.SetBaseRFunction(clsRPivotTableFunction) End Sub Private Sub SetRCodeForControls(bReset As Boolean) @@ -214,9 +215,7 @@ Public Class dlgThreeVariablePivotTable Private Sub ucrChkSelectedVariable_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrChkSelectedVariable.ControlValueChanged If ucrChkSelectedVariable.Checked Then ucrReceiverSelectedVariable.SetMeAsReceiver() - ucrBase.clsRsyntax.AddToBeforeCodes(clsPipeOperator, iPosition:=0) Else - ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsPipeOperator) If ucrChkNumericVariable.Checked Then ucrReceiverAdditionalRowFactor.SetMeAsReceiver() Else @@ -227,13 +226,13 @@ Public Class dlgThreeVariablePivotTable End Sub Private Sub ucrSelectorPivot_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrSelectorPivot.ControlValueChanged - clsGetObjectFunction.AddParameter("data_name", Chr(34) & ucrSelectorPivot.ucrAvailableDataFrames.cboAvailableDataFrames.Text & Chr(34), iPosition:=0) ChangeDataParameterValue() + clsRPivotTableFunction._strDataFrameNameToAddAssignToObject = ucrSelectorPivot.strCurrentDataFrame End Sub Private Sub ChangeDataParameterValue() If ucrChkSelectedVariable.Checked Then - clsRPivotTableFunction.AddParameter("data", "data_selected", iPosition:=0) + clsRPivotTableFunction.AddParameter("data", clsROperatorParameter:=clsPipeOperator, iPosition:=0) Else clsRPivotTableFunction.AddParameter("data", clsRFunctionParameter:=ucrSelectorPivot.ucrAvailableDataFrames.clsCurrDataFrame, iPosition:=0) End If @@ -280,17 +279,11 @@ Public Class dlgThreeVariablePivotTable If ucrChangedControls Is ucrReceiverFactorLevels Then If ucrReceiverFactorLevels.IsEmpty Then - ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsLevelsFunction) - ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsPasteFunction) ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsFlattenFunction) - ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsRelevelPasteFunction) clsRPivotTableFunction.RemoveParameterByName("sorters") Else - ucrBase.clsRsyntax.AddToBeforeCodes(clsLevelsFunction, 0) - ucrBase.clsRsyntax.AddToBeforeCodes(clsPasteFunction, 1) - ucrBase.clsRsyntax.AddToBeforeCodes(clsFlattenFunction, 2) - ucrBase.clsRsyntax.AddToBeforeCodes(clsRelevelPasteFunction, 3) - clsRPivotTableFunction.AddParameter("sorters", "relevel_variables", iPosition:=3) + ucrBase.clsRsyntax.AddToBeforeCodes(clsFlattenFunction, 0) + clsRPivotTableFunction.AddParameter(strParameterName:="sorters", clsRFunctionParameter:=clsRelevelPasteFunction, iPosition:=3) End If End If End Sub @@ -311,14 +304,6 @@ Public Class dlgThreeVariablePivotTable TestOkEnabled() End Sub - Private Sub ucrSavePivot_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrSavePivot.ControlValueChanged - If ucrSavePivot.ucrChkSave.Checked Then - clsGetObjectFunction.AddParameter("object_name", Chr(34) & ucrSavePivot.ucrInputComboSave.GetText & Chr(34), iPosition:=1) - Else - clsGetObjectFunction.AddParameter("object_name", Chr(34) & "last_table" & Chr(34), iPosition:=1) - End If - End Sub - Private Sub ucrChkNumericVariable_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrChkNumericVariable.ControlValueChanged If ucrChkNumericVariable.Checked Then ucrReceiverAdditionalRowFactor.SetMeAsReceiver() diff --git a/instat/dlgTwoWayFrequencies.vb b/instat/dlgTwoWayFrequencies.vb index 6c4bac5673b..f4cfee0920b 100644 --- a/instat/dlgTwoWayFrequencies.vb +++ b/instat/dlgTwoWayFrequencies.vb @@ -260,21 +260,21 @@ Public Class dlgTwoWayFrequencies Private Sub ucrBase_ClickOk(sender As Object, e As EventArgs) Handles ucrBase.ClickOk Dim strGraph As String Dim strTempScript As String = "" - Dim bIsAssigned As Boolean - Dim bToBeAssigned As Boolean - Dim strAssignTo As String + 'Dim bIsAssigned As Boolean + 'Dim bToBeAssigned As Boolean + 'Dim strAssignTo As String If rdoBoth.Checked Then - bIsAssigned = clsSjPlot.bIsAssigned - bToBeAssigned = clsSjPlot.bToBeAssigned - strAssignTo = clsSjPlot.strAssignTo + 'bIsAssigned = clsSjPlot.bIsAssigned + ' bToBeAssigned = clsSjPlot.bToBeAssigned + 'strAssignTo = clsSjPlot.strAssignTo strGraph = clsSjPlot.ToScript(strTempScript) frmMain.clsRLink.RunScript(strTempScript & strGraph, iCallType:=3) - clsSjPlot.bIsAssigned = bIsAssigned - clsSjPlot.bToBeAssigned = bToBeAssigned - clsSjPlot.strAssignTo = strAssignTo + 'clsSjPlot.bIsAssigned = bIsAssigned + 'clsSjPlot.bToBeAssigned = bToBeAssigned + 'clsSjPlot.strAssignTo = strAssignTo End If End Sub diff --git a/instat/dlgViewLabelsAndLevels.vb b/instat/dlgViewLabelsAndLevels.vb index cf922888fec..63e3f3a62c5 100644 --- a/instat/dlgViewLabelsAndLevels.vb +++ b/instat/dlgViewLabelsAndLevels.vb @@ -11,213 +11,228 @@ ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU General Public License for more details. ' -' You should have received a copy of the GNU General Public License +' You should have received a copy of the GNU General Public License ' along with this program. If not, see . -Imports RDotNet -Imports instat.Translations -Public Class dlgViewFactorLabels - Private bFirstLoad As Boolean = True - Private bReset As Boolean = True - Private strCurrDataFrame As String - Private clsViewFunction, clsSelectFunction, clsDeleteLabelsFunction As New RFunction - Private clsDummyDataFunction As New RFunction - - Private Sub dlgLabelAndLevels_Load(sender As Object, e As EventArgs) Handles MyBase.Load - If bFirstLoad Then - InitialiseDialog() - bFirstLoad = False - End If - If bReset Then - SetDefaults() - End If - SetRCodeForControls(bReset) - bReset = False - SetReceiverVariableVisible() - TestOkEnabled() - autoTranslate(Me) - End Sub - - Private Sub InitialiseDialog() - Dim lstOfControls As New List(Of Control) - - ucrBase.iHelpTopicID = 517 - ucrBase.clsRsyntax.iCallType = 2 - ucrReceiverVariables.SetParameter(New RParameter("col_names", 1)) - ucrReceiverVariables.SetParameterIsString() - ucrReceiverVariables.SetParameterIncludeArgumentName(False) - ucrReceiverVariables.Selector = ucrSelectorViewLabelsAndLevels - ucrReceiverVariables.SetMeAsReceiver() - - ucrSelectorViewLabelsAndLevels.SetParameter(New RParameter("data_name", 0)) - ucrSelectorViewLabelsAndLevels.SetParameterIsrfunction() - - ucrChkShowLabels.SetParameter(New RParameter("show.labels", 1)) - ucrChkShowLabels.SetText("Show Variable Labels") - ucrChkShowLabels.SetRDefault("TRUE") - - ucrChkShowType.SetParameter(New RParameter("show.type", 2)) - ucrChkShowType.SetText("Show Column Types") - ucrChkShowType.SetRDefault("FALSE") - - ucrChkShowValues.SetParameter(New RParameter("show.values", 3)) - ucrChkShowValues.SetText("Show Numeric Values") - ucrChkShowValues.SetRDefault("TRUE") - - ucrChkShowMissingValues.SetParameter(New RParameter("show.na", 4)) - ucrChkShowMissingValues.SetText("Show Missing Values") - ucrChkShowMissingValues.SetRDefault("FALSE") - - ucrChkShowId.SetParameter(New RParameter("show.id", 5)) - ucrChkShowId.SetText("Show ID") - ucrChkShowId.SetRDefault("TRUE") - - ucrChkShowPercentage.SetParameter(New RParameter("show.prc", 6)) - ucrChkShowPercentage.SetText("Show Percentages") - ucrChkShowPercentage.SetRDefault("FALSE") - - ucrChkShowFrequencies.SetParameter(New RParameter("show.frq", 7)) - ucrChkShowFrequencies.SetText("Show Frequencies") - ucrChkShowFrequencies.SetRDefault("FALSE") - - ucrChkAlternateColour.SetParameter(New RParameter("altr.row.col", 8)) - ucrChkAlternateColour.SetText("Highlight Alternate Rows") - ucrChkAlternateColour.SetRDefault("TRUE") - - ucrChkSortByName.SetParameter(New RParameter("sort.by.name", 9)) - ucrChkSortByName.SetText("Sort by Name") - ucrChkSortByName.SetRDefault("FALSE") - - ucrChkMaxLabels.SetText("Max Labels") - ucrChkMaxLabels.SetParameter(New RParameter("check", 1)) - ucrChkMaxLabels.SetValuesCheckedAndUnchecked("TRUE", "FALSE") - ucrChkMaxLabels.AddToLinkedControls({ucrNudMaxLength}, {True}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True, bNewLinkedChangeToDefaultState:=True, objNewDefaultState:="15") - - ucrNudMaxLength.SetParameter(New RParameter("max.len", 10)) - ucrNudMaxLength.Increment = 1 - ucrNudMaxLength.Minimum = 1 - - ucrPnlSelectData.SetParameter(New RParameter("checked", 0)) - ucrPnlSelectData.AddRadioButton(rdoWholeDataFrame, "data") - ucrPnlSelectData.AddRadioButton(rdoSelectedColumn, "column") - - ucrPnlOptions.AddRadioButton(rdoViewLabels) - ucrPnlOptions.AddRadioButton(rdoDeleteValueLabels) - ucrPnlOptions.AddFunctionNamesCondition(rdoViewLabels, "view_df") - ucrPnlOptions.AddFunctionNamesCondition(rdoDeleteValueLabels, frmMain.clsRLink.strInstatDataObject & "$append_to_variables_metadata") - ucrPnlOptions.AddToLinkedControls(ucrChkShowValues, {rdoViewLabels}, bNewLinkedHideIfParameterMissing:=True) - ucrPnlOptions.AddToLinkedControls(ucrReceiverVariables, {rdoViewLabels, rdoDeleteValueLabels}, bNewLinkedHideIfParameterMissing:=True) - ucrPnlOptions.AddToLinkedControls(ucrPnlSelectData, {rdoDeleteValueLabels}, bNewLinkedHideIfParameterMissing:=True) - lstOfControls.AddRange({grpDisplayOptions, grpLabels, grpSummaryStatistics, lblFactorColumns}) - ucrChkShowValues.SetLinkedDisplayControl(lstOfControls) - End Sub - - Private Sub SetDefaults() - clsViewFunction = New RFunction - clsSelectFunction = New RFunction - clsDeleteLabelsFunction = New RFunction - clsDummyDataFunction = New RFunction - - 'Reset - ucrSelectorViewLabelsAndLevels.Reset() - 'Defining the function - clsViewFunction.SetPackageName("sjPlot") - clsViewFunction.SetRCommand("view_df") - - clsDummyDataFunction.AddParameter("checked", "data", iPosition:=0) - clsDummyDataFunction.AddParameter("check", "FALSE", iPosition:=1) - - clsSelectFunction.SetAssignTo("selected_variables") - - clsDeleteLabelsFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$append_to_variables_metadata") - clsDeleteLabelsFunction.AddParameter("property", Chr(34) & "labels" & Chr(34), iPosition:=2) - clsDeleteLabelsFunction.AddParameter("new_val", Chr(34) & Chr(34), iPosition:=3) - - clsViewFunction.AddParameter("x", "selected_variables", iPosition:=0) - clsViewFunction.AddParameter("show.frq", "TRUE") - clsViewFunction.AddParameter("show.id", "FALSE") - ucrBase.clsRsyntax.SetBaseRFunction(clsViewFunction) - End Sub - - Private Sub SetRCodeForControls(bReset As Boolean) - ucrPnlOptions.SetRCode(ucrBase.clsRsyntax.clsBaseFunction, bReset) - ucrReceiverVariables.AddAdditionalCodeParameterPair(clsDeleteLabelsFunction, New RParameter("col_names", 1), iAdditionalPairNo:=1) - - ucrChkAlternateColour.SetRCode(clsViewFunction, bReset) - ucrChkShowFrequencies.SetRCode(clsViewFunction, bReset) - ucrChkShowId.SetRCode(clsViewFunction, bReset) - ucrChkShowLabels.SetRCode(clsViewFunction, bReset) - ucrChkShowMissingValues.SetRCode(clsViewFunction, bReset) - ucrChkSortByName.SetRCode(clsViewFunction, bReset) - ucrChkShowPercentage.SetRCode(clsViewFunction, bReset) - ucrChkShowType.SetRCode(clsViewFunction, bReset) - ucrChkShowValues.SetRCode(clsViewFunction, bReset) - ucrChkMaxLabels.SetRCode(clsDummyDataFunction, bReset) - ucrNudMaxLength.SetRCode(clsViewFunction, bReset) - ucrReceiverVariables.SetRCode(clsSelectFunction, bReset) - ucrPnlSelectData.SetRCode(clsDummyDataFunction, bReset) - End Sub - - Private Sub TestOkEnabled() - If rdoViewLabels.Checked Then - If Not ucrReceiverVariables.IsEmpty AndAlso (ucrChkShowLabels.Checked OrElse ucrChkShowType.Checked OrElse - ucrChkShowValues.Checked OrElse ucrChkShowFrequencies.Checked OrElse ucrChkShowPercentage.Checked) Then - ucrBase.OKEnabled(True) - Else - ucrBase.OKEnabled(False) - End If - Else - If rdoWholeDataFrame.Checked Then - ucrBase.OKEnabled(True) - ElseIf rdoSelectedColumn.Checked AndAlso Not ucrReceiverVariables.IsEmpty Then - ucrBase.OKEnabled(True) - Else - ucrBase.OKEnabled(False) - End If - End If - End Sub - - Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset - SetDefaults() - SetRCodeForControls(True) - TestOkEnabled() - End Sub - - Private Sub SetReceiverVariableVisible() - If rdoDeleteValueLabels.Checked Then - ucrReceiverVariables.Visible = rdoSelectedColumn.Checked - End If - End Sub - - Private Sub ucrPnlSelectData_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrPnlSelectData.ControlValueChanged, ucrPnlOptions.ControlValueChanged, ucrReceiverVariables.ControlValueChanged - SetReceiverVariableVisible() - If rdoViewLabels.Checked Then - ucrReceiverVariables.SetParameterIsRFunction() - ucrReceiverVariables.Location = New System.Drawing.Point(295, 84) - ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(True, True, True) - ucrReceiverVariables.bWithQuotes = False - ucrBase.clsRsyntax.AddToBeforeCodes(clsSelectFunction) - ucrBase.clsRsyntax.SetBaseRFunction(clsViewFunction) - Else - ucrBase.clsRsyntax.RemoveFromBeforeCodes(clsSelectFunction) - ucrReceiverVariables.Location = New System.Drawing.Point(302, 109) - ucrReceiverVariables.bWithQuotes = True - strCurrDataFrame = ucrSelectorViewLabelsAndLevels.ucrAvailableDataFrames.strCurrDataFrame - clsDeleteLabelsFunction.AddParameter("data_name", Chr(34) & strCurrDataFrame & Chr(34), iPosition:=0) - ucrBase.clsRsyntax.SetBaseRFunction(clsDeleteLabelsFunction) - If rdoWholeDataFrame.Checked Then - ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(False, False, False) - clsDeleteLabelsFunction.RemoveParameterByName("col_names") - ElseIf rdoSelectedColumn.Checked Then - ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(True, True, True) - clsDeleteLabelsFunction.AddParameter("col_names", ucrReceiverVariables.GetVariableNames(bWithQuotes:=True), iPosition:=1) - End If - End If - End Sub - - Private Sub ucrReceiverFactorColumns_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverVariables.ControlContentsChanged, - ucrChkShowFrequencies.ControlContentsChanged, ucrChkShowLabels.ControlContentsChanged, ucrChkShowPercentage.ControlContentsChanged, - ucrChkShowType.ControlContentsChanged, ucrChkShowValues.ControlContentsChanged, ucrPnlSelectData.ControlContentsChanged, ucrPnlOptions.ControlContentsChanged - TestOkEnabled() - End Sub +Imports RDotNet +Imports instat.Translations + +'todo. rename this to dlgViewLabelsAndLevels +Public Class dlgViewFactorLabels + Private bFirstLoad As Boolean = True + Private bReset As Boolean = True + Private strCurrDataFrame As String + Private clsSjTableFunction, clsSelectFunction, clsDeleteLabelsFunction As New RFunction + Private clsDummyDataFunction As New RFunction + + Private Sub dlgLabelAndLevels_Load(sender As Object, e As EventArgs) Handles MyBase.Load + If bFirstLoad Then + InitialiseDialog() + bFirstLoad = False + End If + If bReset Then + SetDefaults() + End If + SetRCodeForControls(bReset) + bReset = False + SetReceiverVariableVisible() + TestOkEnabled() + autoTranslate(Me) + End Sub + + Private Sub InitialiseDialog() + Dim lstOfControls As New List(Of Control) + + ucrBase.iHelpTopicID = 517 + ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False + + ucrReceiverVariables.SetParameter(New RParameter("col_names", 1)) + ucrReceiverVariables.SetParameterIsString() + ucrReceiverVariables.SetParameterIncludeArgumentName(False) + ucrReceiverVariables.Selector = ucrSelectorViewLabelsAndLevels + ucrReceiverVariables.SetMeAsReceiver() + + ucrSelectorViewLabelsAndLevels.SetParameter(New RParameter("data_name", 0)) + ucrSelectorViewLabelsAndLevels.SetParameterIsrfunction() + + ucrChkShowLabels.SetParameter(New RParameter("show.labels", 1)) + ucrChkShowLabels.SetText("Show Variable Labels") + ucrChkShowLabels.SetRDefault("TRUE") + + ucrChkShowType.SetParameter(New RParameter("show.type", 2)) + ucrChkShowType.SetText("Show Column Types") + ucrChkShowType.SetRDefault("FALSE") + + ucrChkShowValues.SetParameter(New RParameter("show.values", 3)) + ucrChkShowValues.SetText("Show Numeric Values") + ucrChkShowValues.SetRDefault("TRUE") + + ucrChkShowMissingValues.SetParameter(New RParameter("show.na", 4)) + ucrChkShowMissingValues.SetText("Show Missing Values") + ucrChkShowMissingValues.SetRDefault("FALSE") + + ucrChkShowId.SetParameter(New RParameter("show.id", 5)) + ucrChkShowId.SetText("Show ID") + ucrChkShowId.SetRDefault("TRUE") + + ucrChkShowPercentage.SetParameter(New RParameter("show.prc", 6)) + ucrChkShowPercentage.SetText("Show Percentages") + ucrChkShowPercentage.SetRDefault("FALSE") + + ucrChkShowFrequencies.SetParameter(New RParameter("show.frq", 7)) + ucrChkShowFrequencies.SetText("Show Frequencies") + ucrChkShowFrequencies.SetRDefault("FALSE") + + ucrChkAlternateColour.SetParameter(New RParameter("altr.row.col", 8)) + ucrChkAlternateColour.SetText("Highlight Alternate Rows") + ucrChkAlternateColour.SetRDefault("TRUE") + + ucrChkSortByName.SetParameter(New RParameter("sort.by.name", 9)) + ucrChkSortByName.SetText("Sort by Name") + ucrChkSortByName.SetRDefault("FALSE") + + ucrChkMaxLabels.SetText("Max Labels") + ucrChkMaxLabels.SetParameter(New RParameter("check", 1)) + ucrChkMaxLabels.SetValuesCheckedAndUnchecked("TRUE", "FALSE") + ucrChkMaxLabels.AddToLinkedControls({ucrNudMaxLength}, {True}, bNewLinkedAddRemoveParameter:=True, bNewLinkedHideIfParameterMissing:=True, bNewLinkedChangeToDefaultState:=True, objNewDefaultState:="15") + + ucrNudMaxLength.SetParameter(New RParameter("max.len", 10)) + ucrNudMaxLength.Increment = 1 + ucrNudMaxLength.Minimum = 1 + + ucrPnlSelectData.SetParameter(New RParameter("checked", 0)) + ucrPnlSelectData.AddRadioButton(rdoWholeDataFrame, "data") + ucrPnlSelectData.AddRadioButton(rdoSelectedColumn, "column") + + ucrPnlOptions.AddRadioButton(rdoViewLabels) + ucrPnlOptions.AddRadioButton(rdoDeleteValueLabels) + ucrPnlOptions.AddFunctionNamesCondition(rdoViewLabels, "view_df") + ucrPnlOptions.AddFunctionNamesCondition(rdoDeleteValueLabels, frmMain.clsRLink.strInstatDataObject & "$append_to_variables_metadata") + ucrPnlOptions.AddToLinkedControls(ucrChkShowValues, {rdoViewLabels}, bNewLinkedHideIfParameterMissing:=True) + ucrPnlOptions.AddToLinkedControls(ucrReceiverVariables, {rdoViewLabels, rdoDeleteValueLabels}, bNewLinkedHideIfParameterMissing:=True) + ucrPnlOptions.AddToLinkedControls(ucrPnlSelectData, {rdoDeleteValueLabels}, bNewLinkedHideIfParameterMissing:=True) + lstOfControls.AddRange({grpDisplayOptions, grpLabels, grpSummaryStatistics, lblFactorColumns}) + ucrChkShowValues.SetLinkedDisplayControl(lstOfControls) + End Sub + + Private Sub SetDefaults() + clsSjTableFunction = New RFunction + clsSelectFunction = New RFunction + clsDeleteLabelsFunction = New RFunction + clsDummyDataFunction = New RFunction + + 'Reset + ucrSelectorViewLabelsAndLevels.Reset() + 'Defining the function + clsSjTableFunction.SetPackageName("sjPlot") + clsSjTableFunction.SetRCommand("view_df") + + clsDummyDataFunction.AddParameter("checked", "data", iPosition:=0) + clsDummyDataFunction.AddParameter("check", "FALSE", iPosition:=1) + + clsSelectFunction.SetAssignTo("selected_variables") + + clsDeleteLabelsFunction.SetRCommand(frmMain.clsRLink.strInstatDataObject & "$append_to_variables_metadata") + clsDeleteLabelsFunction.AddParameter("property", Chr(34) & "labels" & Chr(34), iPosition:=2) + clsDeleteLabelsFunction.AddParameter("new_val", Chr(34) & Chr(34), iPosition:=3) + + clsSjTableFunction.AddParameter("x", clsRFunctionParameter:=clsSelectFunction, iPosition:=0) + clsSjTableFunction.AddParameter("show.frq", "TRUE") + clsSjTableFunction.AddParameter("show.id", "FALSE") + clsSjTableFunction.SetAssignTo("variables_sjTable") + + clsSjTableFunction.SetAssignToOutputObject(strRObjectToAssignTo:="last_table", + strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table, + strRObjectFormatToAssignTo:=RObjectFormat.Html, + strRDataFrameNameToAddObjectTo:=ucrSelectorViewLabelsAndLevels.strCurrentDataFrame, + strObjectName:="last_table") + + ucrBase.clsRsyntax.SetBaseRFunction(clsSjTableFunction) + End Sub + + Private Sub SetRCodeForControls(bReset As Boolean) + ucrPnlOptions.SetRCode(clsSjTableFunction, bReset) + ucrReceiverVariables.AddAdditionalCodeParameterPair(clsDeleteLabelsFunction, New RParameter("col_names", 1), iAdditionalPairNo:=1) + + ucrChkAlternateColour.SetRCode(clsSjTableFunction, bReset) + ucrChkShowFrequencies.SetRCode(clsSjTableFunction, bReset) + ucrChkShowId.SetRCode(clsSjTableFunction, bReset) + ucrChkShowLabels.SetRCode(clsSjTableFunction, bReset) + ucrChkShowMissingValues.SetRCode(clsSjTableFunction, bReset) + ucrChkSortByName.SetRCode(clsSjTableFunction, bReset) + ucrChkShowPercentage.SetRCode(clsSjTableFunction, bReset) + ucrChkShowType.SetRCode(clsSjTableFunction, bReset) + ucrChkShowValues.SetRCode(clsSjTableFunction, bReset) + ucrChkMaxLabels.SetRCode(clsDummyDataFunction, bReset) + ucrNudMaxLength.SetRCode(clsSjTableFunction, bReset) + ucrReceiverVariables.SetRCode(clsSelectFunction, bReset) + ucrPnlSelectData.SetRCode(clsDummyDataFunction, bReset) + End Sub + + Private Sub TestOkEnabled() + If rdoViewLabels.Checked Then + If Not ucrReceiverVariables.IsEmpty AndAlso (ucrChkShowLabels.Checked OrElse ucrChkShowType.Checked OrElse + ucrChkShowValues.Checked OrElse ucrChkShowFrequencies.Checked OrElse ucrChkShowPercentage.Checked) Then + ucrBase.OKEnabled(True) + Else + ucrBase.OKEnabled(False) + End If + Else + If rdoWholeDataFrame.Checked Then + ucrBase.OKEnabled(True) + ElseIf rdoSelectedColumn.Checked AndAlso Not ucrReceiverVariables.IsEmpty Then + ucrBase.OKEnabled(True) + Else + ucrBase.OKEnabled(False) + End If + End If + End Sub + + Private Sub ucrBase_ClickReset(sender As Object, e As EventArgs) Handles ucrBase.ClickReset + SetDefaults() + SetRCodeForControls(True) + TestOkEnabled() + End Sub + + Private Sub SetReceiverVariableVisible() + If rdoDeleteValueLabels.Checked Then + ucrReceiverVariables.Visible = rdoSelectedColumn.Checked + End If + End Sub + + Private Sub ucrPnlSelectData_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrPnlSelectData.ControlValueChanged, ucrPnlOptions.ControlValueChanged, ucrReceiverVariables.ControlValueChanged + SetReceiverVariableVisible() + If rdoViewLabels.Checked Then + ucrReceiverVariables.SetParameterIsRFunction() + ucrReceiverVariables.Location = New System.Drawing.Point(295, 84) + ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(True, True, True) + ucrReceiverVariables.bWithQuotes = False + ucrBase.clsRsyntax.SetBaseRFunction(clsSjTableFunction) + Else + ucrReceiverVariables.Location = New System.Drawing.Point(302, 109) + ucrReceiverVariables.bWithQuotes = True + strCurrDataFrame = ucrSelectorViewLabelsAndLevels.ucrAvailableDataFrames.strCurrDataFrame + clsDeleteLabelsFunction.AddParameter("data_name", Chr(34) & strCurrDataFrame & Chr(34), iPosition:=0) + ucrBase.clsRsyntax.SetBaseRFunction(clsDeleteLabelsFunction) + If rdoWholeDataFrame.Checked Then + ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(False, False, False) + clsDeleteLabelsFunction.RemoveParameterByName("col_names") + ElseIf rdoSelectedColumn.Checked Then + ucrSelectorViewLabelsAndLevels.HideShowAddOrDataOptionsOrListView(True, True, True) + clsDeleteLabelsFunction.AddParameter("col_names", ucrReceiverVariables.GetVariableNames(bWithQuotes:=True), iPosition:=1) + End If + End If + End Sub + + Private Sub ucrReceiverFactorColumns_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverVariables.ControlContentsChanged, + ucrChkShowFrequencies.ControlContentsChanged, ucrChkShowLabels.ControlContentsChanged, ucrChkShowPercentage.ControlContentsChanged, + ucrChkShowType.ControlContentsChanged, ucrChkShowValues.ControlContentsChanged, ucrPnlSelectData.ControlContentsChanged, ucrPnlOptions.ControlContentsChanged + TestOkEnabled() + End Sub + + Private Sub ucrSelectorViewLabelsAndLevels_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrSelectorViewLabelsAndLevels.ControlValueChanged + clsSjTableFunction._strDataFrameNameToAddAssignToObject = ucrSelectorViewLabelsAndLevels.strCurrentDataFrame + End Sub + + End Class \ No newline at end of file diff --git a/instat/frmGraphDisplay.Designer.vb b/instat/frmGraphDisplay.Designer.vb deleted file mode 100644 index 0b8e581d5af..00000000000 --- a/instat/frmGraphDisplay.Designer.vb +++ /dev/null @@ -1,71 +0,0 @@ -' R- Instat -' Copyright (C) 2015-2017 -' -' This program is free software: you can redistribute it and/or modify -' it under the terms of the GNU General Public License as published by -' the Free Software Foundation, either version 3 of the License, or -' (at your option) any later version. -' -' This program is distributed in the hope that it will be useful, -' but WITHOUT ANY WARRANTY; without even the implied warranty of -' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -' GNU General Public License for more details. -' -' You should have received a copy of the GNU General Public License -' along with this program. If not, see . - - -Partial Class frmGraphDisplay - Inherits System.Windows.Forms.Form - - 'Form overrides dispose to clean up the component list. - - Protected Overrides Sub Dispose(ByVal disposing As Boolean) - Try - If disposing AndAlso components IsNot Nothing Then - components.Dispose() - End If - Finally - MyBase.Dispose(disposing) - End Try - End Sub - - 'Required by the Windows Form Designer - Private components As System.ComponentModel.IContainer - - 'NOTE: The following procedure is required by the Windows Form Designer - 'It can be modified using the Windows Form Designer. - 'Do not modify it using the code editor. - - Private Sub InitializeComponent() - Me.pctGraph = New System.Windows.Forms.PictureBox() - CType(Me.pctGraph, System.ComponentModel.ISupportInitialize).BeginInit() - Me.SuspendLayout() - ' - 'pctGraph - ' - Me.pctGraph.Dock = System.Windows.Forms.DockStyle.Fill - Me.pctGraph.Location = New System.Drawing.Point(0, 0) - Me.pctGraph.Name = "pctGraph" - Me.pctGraph.Size = New System.Drawing.Size(484, 461) - Me.pctGraph.SizeMode = System.Windows.Forms.PictureBoxSizeMode.StretchImage - Me.pctGraph.TabIndex = 0 - Me.pctGraph.TabStop = False - ' - 'frmGraphDisplay - ' - Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) - Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi - Me.ClientSize = New System.Drawing.Size(484, 461) - Me.Controls.Add(Me.pctGraph) - Me.Name = "frmGraphDisplay" - Me.ShowIcon = False - Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterParent - Me.Text = "Graph Display" - CType(Me.pctGraph, System.ComponentModel.ISupportInitialize).EndInit() - Me.ResumeLayout(False) - - End Sub - - Friend WithEvents pctGraph As PictureBox -End Class diff --git a/instat/frmGraphDisplay.sw-KE.resx b/instat/frmGraphDisplay.sw-KE.resx deleted file mode 100644 index a3df4f013d3..00000000000 --- a/instat/frmGraphDisplay.sw-KE.resx +++ /dev/null @@ -1,15 +0,0 @@ - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - \ No newline at end of file diff --git a/instat/frmGraphDisplay.vb b/instat/frmGraphDisplay.vb deleted file mode 100644 index a1eb37cc05e..00000000000 --- a/instat/frmGraphDisplay.vb +++ /dev/null @@ -1,31 +0,0 @@ -' R- Instat -' Copyright (C) 2015-2017 -' -' This program is free software: you can redistribute it and/or modify -' it under the terms of the GNU General Public License as published by -' the Free Software Foundation, either version 3 of the License, or -' (at your option) any later version. -' -' This program is distributed in the hope that it will be useful, -' but WITHOUT ANY WARRANTY; without even the implied warranty of -' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -' GNU General Public License for more details. -' -' You should have received a copy of the GNU General Public License -' along with this program. If not, see . - -Public Class frmGraphDisplay - Private Sub frmGraphDisplay_Load(sender As Object, e As EventArgs) Handles MyBase.Load - - End Sub - - Public Sub SetImageFromFile(strFilePath As String) - Dim fsTemp As System.IO.FileStream - Dim imgTemp As Image - - fsTemp = New System.IO.FileStream(strFilePath, IO.FileMode.Open, IO.FileAccess.Read) - imgTemp = System.Drawing.Image.FromStream(fsTemp) - pctGraph.Image = imgTemp - fsTemp.Close() - End Sub -End Class \ No newline at end of file diff --git a/instat/frmMain.Designer.vb b/instat/frmMain.Designer.vb index 3c32301a5f5..5954fa71178 100644 --- a/instat/frmMain.Designer.vb +++ b/instat/frmMain.Designer.vb @@ -393,8 +393,9 @@ Partial Class frmMain Me.separator1 = New System.Windows.Forms.ToolStripSeparator() Me.mnuTbLast10Dialogs = New System.Windows.Forms.ToolStripSplitButton() Me.mnuLastGraph = New System.Windows.Forms.ToolStripSplitButton() - Me.mnuViewer = New System.Windows.Forms.ToolStripMenuItem() + Me.mnuNormalViewer = New System.Windows.Forms.ToolStripMenuItem() Me.mnuploty = New System.Windows.Forms.ToolStripMenuItem() + Me.mnuRViewer = New System.Windows.Forms.ToolStripMenuItem() Me.separator2 = New System.Windows.Forms.ToolStripSeparator() Me.mnuTbDataView = New System.Windows.Forms.ToolStripButton() Me.mnuTbOutput = New System.Windows.Forms.ToolStripButton() @@ -498,6 +499,7 @@ Partial Class frmMain Me.mnuPrepareColumnFactorFactorDataFrame = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPrepareColumnText = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPrepareColumnTextFindReplace = New System.Windows.Forms.ToolStripMenuItem() + Me.mnuPrepareColumnTextSearch = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPrepareColumnTextTransform = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPrepareColumnTextSplit = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPrepareColumnTextCombine = New System.Windows.Forms.ToolStripMenuItem() @@ -673,7 +675,6 @@ Partial Class frmMain Me.splDataOutput = New System.Windows.Forms.SplitContainer() Me.ucrDataViewer = New instat.ucrDataView() Me.ucrOutput = New instat.ucrOutputWindow() - Me.mnuRViewer = New System.Windows.Forms.ToolStripMenuItem() Me.mnuPlotly = New System.Windows.Forms.ToolStripMenuItem() Me.mnuColumnMetadata = New System.Windows.Forms.ToolStripMenuItem() Me.mnuDataFrameMetadata = New System.Windows.Forms.ToolStripMenuItem() @@ -708,7 +709,7 @@ Partial Class frmMain ' Me.mnuDescribe.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuDescribeOneVariable, Me.mnuDescribeTwoThreeVariables, Me.mnuDescribeSpecificTablesGraphs, Me.mnuDescribeGeneral, Me.ToolStripSeparator9, Me.mnuDescribeMultivariate, Me.ToolStripSeparator13, Me.mnuDescribeUseGraph, Me.mnuDescribeCombineGraph, Me.mnuDescribeThemes, Me.mnuDescribeViewGraph}) Me.mnuDescribe.Name = "mnuDescribe" - Me.mnuDescribe.Size = New System.Drawing.Size(64, 20) + Me.mnuDescribe.Size = New System.Drawing.Size(64, 22) Me.mnuDescribe.Tag = "Describe" Me.mnuDescribe.Text = "Describe" ' @@ -1035,7 +1036,7 @@ Partial Class frmMain ' Me.mnuModel.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuModelProbabilityDistributions, Me.ToolStripSeparator3, Me.mnuModelFitModel, Me.mnuModelCompareModels, Me.mnuModelUseModel, Me.mnuModelOtherOneVariable, Me.mnuModelOtherTwoVariables, Me.mnuModelOtherThreeVariables, Me.mnuModelOtherGeneral}) Me.mnuModel.Name = "mnuModel" - Me.mnuModel.Size = New System.Drawing.Size(53, 20) + Me.mnuModel.Size = New System.Drawing.Size(53, 22) Me.mnuModel.Tag = "Model" Me.mnuModel.Text = "Model" ' @@ -1444,7 +1445,7 @@ Partial Class frmMain ' Me.mnuView.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuViewDataView, Me.mnuViewOutputWindow, Me.mnuViewLog, Me.mnuViewScriptWindow, Me.mnuViewColumnMetadata, Me.mnuViewDataFrameMetadata, Me.ToolStripSeparator22, Me.mnuViewStructuredMenu, Me.mnuViewClimaticMenu, Me.mnuViewProcurementMenu, Me.mnuViewOptionsByContextMenu, Me.ToolStripSeparator39, Me.mnuViewResetToDefaultLayout, Me.mnuViewSwapDataAndMetadata}) Me.mnuView.Name = "mnuView" - Me.mnuView.Size = New System.Drawing.Size(44, 20) + Me.mnuView.Size = New System.Drawing.Size(44, 22) Me.mnuView.Tag = "View" Me.mnuView.Text = "View" ' @@ -1553,7 +1554,7 @@ Partial Class frmMain ' Me.mnuHelp.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuHelpHelpIntroduction, Me.mnuHelpHistFAQ, Me.mnuHelpGetingStarted, Me.ToolStripSeparator28, Me.mnuHelpWindows, Me.mnuHelpDataViewSpreadsheet, Me.mnuHelpMenus, Me.mnuHelpAboutR, Me.mnuHelpRPackagesCommands, Me.mnuHelpDataset, Me.ToolStripSeparator29, Me.mnuHelpGuide, Me.mnuHelpAboutRInstat, Me.mnuHelpLicence, Me.mnuHelpAcknowledgments}) Me.mnuHelp.Name = "mnuHelp" - Me.mnuHelp.Size = New System.Drawing.Size(44, 20) + Me.mnuHelp.Size = New System.Drawing.Size(44, 22) Me.mnuHelp.Tag = "Help" Me.mnuHelp.Text = "Help" ' @@ -1677,7 +1678,7 @@ Partial Class frmMain ' Me.mnuClimatic.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuClimaticFile, Me.ToolStripSeparator18, Me.mnuClimaticTidyandExamine, Me.mnuClimaticDates, Me.mnuClimaticDefineClimaticData, Me.mnuClimaticCheckData, Me.mnuClimaticPrepare, Me.ToolStripSeparator30, Me.mnuClimaticDescribe, Me.mnuClimaticNCMP, Me.mnuClimaticPICSA, Me.mnuCMSAF, Me.mnuClimaticCompare, Me.mnuClimaticMapping, Me.ToolStripSeparator16, Me.mnuClimaticModel, Me.mnuClimaticExamine, Me.mnuClimaticProcess, Me.ToolStripSeparator23, Me.mnuClimaticSCF, Me.mnuClimaticEvaporation, Me.mnuClimaticCrop, Me.mnuClimaticHeatSum, Me.mnuClimaticClimateMethods}) Me.mnuClimatic.Name = "mnuClimatic" - Me.mnuClimatic.Size = New System.Drawing.Size(63, 20) + Me.mnuClimatic.Size = New System.Drawing.Size(63, 22) Me.mnuClimatic.Tag = "Climatic" Me.mnuClimatic.Text = "Climatic" ' @@ -2877,7 +2878,7 @@ Partial Class frmMain ' Me.mnuEdit.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuEditFind, Me.mnuEditFindNext, Me.mnuEditReplace, Me.mnuEditCut, Me.mnuEditCopy, Me.mnuEditCopySpecial, Me.mnuEditPaste, Me.mnuPasteSpecial, Me.mnuEditPasteNewDataFrame, Me.mnuEditWordwrap, Me.mnuEditSelectAll, Me.ToolStripSeparator71, Me.mnuEditScript}) Me.mnuEdit.Name = "mnuEdit" - Me.mnuEdit.Size = New System.Drawing.Size(39, 20) + Me.mnuEdit.Size = New System.Drawing.Size(39, 22) Me.mnuEdit.Tag = "Edit" Me.mnuEdit.Text = "Edit" ' @@ -3010,6 +3011,7 @@ Partial Class frmMain Me.Tool_strip.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuTbOpen, Me.mnuTbOpenFromLibrary, Me.mnuTbSave, Me.toolStripSeparator, Me.mnuTbCopy, Me.mnuTbPaste, Me.separator1, Me.mnuTbLast10Dialogs, Me.mnuLastGraph, Me.separator2, Me.mnuTbDataView, Me.mnuTbOutput, Me.mnuMetadata, Me.mnuTbLog, Me.mnuTbResetLayout, Me.separator3, Me.mnuTbHelp, Me.mnuTbLan}) Me.Tool_strip.Location = New System.Drawing.Point(0, 24) Me.Tool_strip.Name = "Tool_strip" + Me.Tool_strip.Padding = New System.Windows.Forms.Padding(0, 0, 2, 0) Me.Tool_strip.RenderMode = System.Windows.Forms.ToolStripRenderMode.Professional Me.Tool_strip.RightToLeft = System.Windows.Forms.RightToLeft.No Me.Tool_strip.Size = New System.Drawing.Size(834, 37) @@ -3116,7 +3118,7 @@ Partial Class frmMain 'mnuLastGraph ' Me.mnuLastGraph.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image - Me.mnuLastGraph.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuViewer, Me.mnuploty}) + Me.mnuLastGraph.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuNormalViewer, Me.mnuploty, Me.mnuRViewer}) Me.mnuLastGraph.Image = CType(resources.GetObject("mnuLastGraph.Image"), System.Drawing.Image) Me.mnuLastGraph.ImageTransparentColor = System.Drawing.Color.Magenta Me.mnuLastGraph.Name = "mnuLastGraph" @@ -3124,18 +3126,24 @@ Partial Class frmMain Me.mnuLastGraph.Text = "ToolStripSplitButton3" Me.mnuLastGraph.ToolTipText = "View Last Graph" ' - 'mnuViewer + 'mnuNormalViewer ' - Me.mnuViewer.Name = "mnuViewer" - Me.mnuViewer.Size = New System.Drawing.Size(128, 22) - Me.mnuViewer.Text = "R Viewer..." + Me.mnuNormalViewer.Name = "mnuNormalViewer" + Me.mnuNormalViewer.Size = New System.Drawing.Size(180, 22) + Me.mnuNormalViewer.Text = "Viewer..." ' 'mnuploty ' Me.mnuploty.Name = "mnuploty" - Me.mnuploty.Size = New System.Drawing.Size(128, 22) + Me.mnuploty.Size = New System.Drawing.Size(180, 22) Me.mnuploty.Text = "Plotly..." ' + 'mnuRViewer + ' + Me.mnuRViewer.Name = "mnuRViewer" + Me.mnuRViewer.Size = New System.Drawing.Size(180, 22) + Me.mnuRViewer.Text = "R Viewer..." + ' 'separator2 ' Me.separator2.Name = "separator2" @@ -3258,6 +3266,7 @@ Partial Class frmMain Me.mnuBar.LayoutStyle = System.Windows.Forms.ToolStripLayoutStyle.HorizontalStackWithOverflow Me.mnuBar.Location = New System.Drawing.Point(0, 0) Me.mnuBar.Name = "mnuBar" + Me.mnuBar.Padding = New System.Windows.Forms.Padding(4, 1, 0, 1) Me.mnuBar.RenderMode = System.Windows.Forms.ToolStripRenderMode.System Me.mnuBar.ShowItemToolTips = True Me.mnuBar.Size = New System.Drawing.Size(834, 24) @@ -3268,7 +3277,7 @@ Partial Class frmMain ' Me.mnuFile.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuFileNewDataFrame, Me.mnuFileImportFromFile, Me.mnuFileImportFromLibrary, Me.ToolStripSeparator35, Me.mnuFileImportFromODK, Me.mnuFileImportFromCSPRO, Me.mnuFileImportFromDatabases, Me.mnuFileImportFromPostgres, Me.mnuFileImportFromRapidPro, Me.mnuFileImportandTidyNetCDFFile, Me.mnuFileConvert, Me.tlSeparatorFile, Me.mnuFileSave, Me.mnuFileSaveAs, Me.mnuFileExport, Me.mnuFilePrint, Me.mnuFilePrintPreview, Me.tlSeparatorFile3, Me.mnuFileCloseData, Me.ToolStripSeparator8, Me.mnuFIleExit}) Me.mnuFile.Name = "mnuFile" - Me.mnuFile.Size = New System.Drawing.Size(37, 20) + Me.mnuFile.Size = New System.Drawing.Size(37, 22) Me.mnuFile.Tag = "File" Me.mnuFile.Text = "File" ' @@ -3401,7 +3410,7 @@ Partial Class frmMain ' Me.mnuPrepare.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuPrepareDataFrame, Me.mnuPrepareCheckData, Me.ToolStripSeparator6, Me.mnuPrepareCalculator, Me.mnuPrepareColumnCalculate, Me.mnuPrepareColumnFactor, Me.mnuPrepareColumnText, Me.mnuPrepareColumnDate, Me.mnuPrepareColumnDefine, Me.ToolStripSeparator4, Me.mnuPrepareDataReshape, Me.ToolStripSeparator7, Me.mnuPrepareKeysAndLinks, Me.mnuPrepareDataBook, Me.mnuPrepareRObjects}) Me.mnuPrepare.Name = "mnuPrepare" - Me.mnuPrepare.Size = New System.Drawing.Size(59, 20) + Me.mnuPrepare.Size = New System.Drawing.Size(59, 22) Me.mnuPrepare.Tag = "Prepare" Me.mnuPrepare.Text = "Prepare" ' @@ -3839,7 +3848,7 @@ Partial Class frmMain ' 'mnuPrepareColumnText ' - Me.mnuPrepareColumnText.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuPrepareColumnTextFindReplace, Me.mnuPrepareColumnTextTransform, Me.mnuPrepareColumnTextSplit, Me.mnuPrepareColumnTextCombine, Me.mnuPrepareColumnTextMatch, Me.mnuPrepareColumnTextDistance}) + Me.mnuPrepareColumnText.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuPrepareColumnTextFindReplace, Me.mnuPrepareColumnTextSearch, Me.mnuPrepareColumnTextTransform, Me.mnuPrepareColumnTextSplit, Me.mnuPrepareColumnTextCombine, Me.mnuPrepareColumnTextMatch, Me.mnuPrepareColumnTextDistance}) Me.mnuPrepareColumnText.Name = "mnuPrepareColumnText" Me.mnuPrepareColumnText.Size = New System.Drawing.Size(186, 22) Me.mnuPrepareColumnText.Tag = "Column:_Text" @@ -3848,28 +3857,35 @@ Partial Class frmMain 'mnuPrepareColumnTextFindReplace ' Me.mnuPrepareColumnTextFindReplace.Name = "mnuPrepareColumnTextFindReplace" - Me.mnuPrepareColumnTextFindReplace.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextFindReplace.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextFindReplace.Tag = "Find/Replace..." Me.mnuPrepareColumnTextFindReplace.Text = "Find/Replace..." ' + 'mnuPrepareColumnTextSearch + ' + Me.mnuPrepareColumnTextSearch.Name = "mnuPrepareColumnTextSearch" + Me.mnuPrepareColumnTextSearch.Size = New System.Drawing.Size(180, 22) + Me.mnuPrepareColumnTextSearch.Text = "Search..." + Me.mnuPrepareColumnTextSearch.Visible = False + ' 'mnuPrepareColumnTextTransform ' Me.mnuPrepareColumnTextTransform.Name = "mnuPrepareColumnTextTransform" - Me.mnuPrepareColumnTextTransform.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextTransform.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextTransform.Tag = "Transform..." Me.mnuPrepareColumnTextTransform.Text = "Transform..." ' 'mnuPrepareColumnTextSplit ' Me.mnuPrepareColumnTextSplit.Name = "mnuPrepareColumnTextSplit" - Me.mnuPrepareColumnTextSplit.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextSplit.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextSplit.Tag = "Split..." Me.mnuPrepareColumnTextSplit.Text = "Split..." ' 'mnuPrepareColumnTextCombine ' Me.mnuPrepareColumnTextCombine.Name = "mnuPrepareColumnTextCombine" - Me.mnuPrepareColumnTextCombine.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextCombine.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextCombine.Tag = "Combine..." Me.mnuPrepareColumnTextCombine.Text = "Combine..." ' @@ -3877,7 +3893,7 @@ Partial Class frmMain ' Me.mnuPrepareColumnTextMatch.Enabled = False Me.mnuPrepareColumnTextMatch.Name = "mnuPrepareColumnTextMatch" - Me.mnuPrepareColumnTextMatch.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextMatch.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextMatch.Tag = "Match..." Me.mnuPrepareColumnTextMatch.Text = "Match..." Me.mnuPrepareColumnTextMatch.Visible = False @@ -3885,7 +3901,7 @@ Partial Class frmMain 'mnuPrepareColumnTextDistance ' Me.mnuPrepareColumnTextDistance.Name = "mnuPrepareColumnTextDistance" - Me.mnuPrepareColumnTextDistance.Size = New System.Drawing.Size(152, 22) + Me.mnuPrepareColumnTextDistance.Size = New System.Drawing.Size(180, 22) Me.mnuPrepareColumnTextDistance.Tag = "Distance..." Me.mnuPrepareColumnTextDistance.Text = "Distance..." ' @@ -4229,7 +4245,7 @@ Partial Class frmMain ' Me.mnuStructured.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuStructuredCircular, Me.mnuStructuredLow_Flow, Me.mnuStructuredSurvival, Me.mnuStructuredTimeSeries, Me.ToolStripSeparator63, Me.mnuStructuredClimatic, Me.mnuStructuredProcurement, Me.mnuStructuredOptionByContext}) Me.mnuStructured.Name = "mnuStructured" - Me.mnuStructured.Size = New System.Drawing.Size(74, 20) + Me.mnuStructured.Size = New System.Drawing.Size(74, 22) Me.mnuStructured.Text = "Structured" ' 'mnuStructuredCircular @@ -4423,7 +4439,7 @@ Partial Class frmMain ' Me.mnuProcurement.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuProcurementOpenFromLibrary, Me.mnuProcurementDefineData, Me.mnuProcurementPrepare, Me.mnuProcurementDescribe, Me.mnuProcurementMapping, Me.mnuProcurementModel, Me.ToolStripSeparator45, Me.mnuProcurementDefineRedFlags, Me.mnuProcurementUseCRI}) Me.mnuProcurement.Name = "mnuProcurement" - Me.mnuProcurement.Size = New System.Drawing.Size(88, 20) + Me.mnuProcurement.Size = New System.Drawing.Size(88, 22) Me.mnuProcurement.Text = "Procurement" ' 'mnuProcurementOpenFromLibrary @@ -4671,7 +4687,7 @@ Partial Class frmMain ' Me.mnuOptionsByContext.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuOptionsByContextCheckData, Me.mnuOptionsByContextDefine, Me.mnuOptionsByContextPrepare, Me.mnuOptionsByContextDescribe, Me.mnuOptionsByContextModel, Me.mnuOptionsByContextCropModel}) Me.mnuOptionsByContext.Name = "mnuOptionsByContext" - Me.mnuOptionsByContext.Size = New System.Drawing.Size(84, 20) + Me.mnuOptionsByContext.Size = New System.Drawing.Size(84, 22) Me.mnuOptionsByContext.Text = "Experiments" ' 'mnuOptionsByContextCheckData @@ -4828,7 +4844,7 @@ Partial Class frmMain ' Me.mnuTools.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.mnuToolsRunRCode, Me.mnuToolsRestartR, Me.mnuToolsCheckForUpdates, Me.mnuToolsClearOutputWindow, Me.ToolStripSeparator5, Me.mnuToolsSaveCurrentOptions, Me.mnuToolsLoadOptions, Me.mnuToolsInstallRPackage, Me.mnuToolsOptions}) Me.mnuTools.Name = "mnuTools" - Me.mnuTools.Size = New System.Drawing.Size(46, 20) + Me.mnuTools.Size = New System.Drawing.Size(46, 22) Me.mnuTools.Text = "Tools" ' 'mnuToolsRunRCode @@ -4920,7 +4936,7 @@ Partial Class frmMain Me.splOverall.Panel2.BackColor = System.Drawing.SystemColors.Control Me.splOverall.Panel2.Controls.Add(Me.splDataOutput) Me.splOverall.Size = New System.Drawing.Size(834, 399) - Me.splOverall.SplitterDistance = 168 + Me.splOverall.SplitterDistance = 167 Me.splOverall.SplitterWidth = 5 Me.splOverall.TabIndex = 10 ' @@ -4940,8 +4956,8 @@ Partial Class frmMain ' Me.splExtraWindows.Panel2.BackColor = System.Drawing.SystemColors.Control Me.splExtraWindows.Panel2.Controls.Add(Me.splLogScript) - Me.splExtraWindows.Size = New System.Drawing.Size(834, 168) - Me.splExtraWindows.SplitterDistance = 255 + Me.splExtraWindows.Size = New System.Drawing.Size(834, 167) + Me.splExtraWindows.SplitterDistance = 254 Me.splExtraWindows.SplitterWidth = 5 Me.splExtraWindows.TabIndex = 0 ' @@ -4960,8 +4976,8 @@ Partial Class frmMain ' Me.splMetadata.Panel2.BackColor = System.Drawing.SystemColors.Control Me.splMetadata.Panel2.Controls.Add(Me.ucrDataFrameMeta) - Me.splMetadata.Size = New System.Drawing.Size(255, 168) - Me.splMetadata.SplitterDistance = 72 + Me.splMetadata.Size = New System.Drawing.Size(254, 167) + Me.splMetadata.SplitterDistance = 71 Me.splMetadata.SplitterWidth = 5 Me.splMetadata.TabIndex = 0 ' @@ -4974,7 +4990,7 @@ Partial Class frmMain Me.ucrColumnMeta.Location = New System.Drawing.Point(0, 0) Me.ucrColumnMeta.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrColumnMeta.Name = "ucrColumnMeta" - Me.ucrColumnMeta.Size = New System.Drawing.Size(72, 168) + Me.ucrColumnMeta.Size = New System.Drawing.Size(71, 167) Me.ucrColumnMeta.TabIndex = 0 ' 'ucrDataFrameMeta @@ -4985,7 +5001,7 @@ Partial Class frmMain Me.ucrDataFrameMeta.Location = New System.Drawing.Point(0, 0) Me.ucrDataFrameMeta.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrDataFrameMeta.Name = "ucrDataFrameMeta" - Me.ucrDataFrameMeta.Size = New System.Drawing.Size(178, 168) + Me.ucrDataFrameMeta.Size = New System.Drawing.Size(178, 167) Me.ucrDataFrameMeta.TabIndex = 0 ' 'splLogScript @@ -5004,7 +5020,7 @@ Partial Class frmMain ' Me.splLogScript.Panel2.BackColor = System.Drawing.SystemColors.Control Me.splLogScript.Panel2.Controls.Add(Me.ucrScriptWindow) - Me.splLogScript.Size = New System.Drawing.Size(574, 168) + Me.splLogScript.Size = New System.Drawing.Size(575, 167) Me.splLogScript.SplitterDistance = 174 Me.splLogScript.SplitterWidth = 5 Me.splLogScript.TabIndex = 0 @@ -5017,7 +5033,7 @@ Partial Class frmMain Me.ucrLogWindow.Location = New System.Drawing.Point(0, 0) Me.ucrLogWindow.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrLogWindow.Name = "ucrLogWindow" - Me.ucrLogWindow.Size = New System.Drawing.Size(174, 168) + Me.ucrLogWindow.Size = New System.Drawing.Size(174, 167) Me.ucrLogWindow.TabIndex = 0 ' 'ucrScriptWindow @@ -5028,7 +5044,7 @@ Partial Class frmMain Me.ucrScriptWindow.Location = New System.Drawing.Point(0, 0) Me.ucrScriptWindow.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrScriptWindow.Name = "ucrScriptWindow" - Me.ucrScriptWindow.Size = New System.Drawing.Size(395, 168) + Me.ucrScriptWindow.Size = New System.Drawing.Size(396, 167) Me.ucrScriptWindow.TabIndex = 0 Me.ucrScriptWindow.Tag = "Script_Window" ' @@ -5048,7 +5064,7 @@ Partial Class frmMain ' Me.splDataOutput.Panel2.BackColor = System.Drawing.SystemColors.Control Me.splDataOutput.Panel2.Controls.Add(Me.ucrOutput) - Me.splDataOutput.Size = New System.Drawing.Size(834, 226) + Me.splDataOutput.Size = New System.Drawing.Size(834, 227) Me.splDataOutput.SplitterDistance = 384 Me.splDataOutput.SplitterWidth = 5 Me.splDataOutput.TabIndex = 0 @@ -5062,7 +5078,7 @@ Partial Class frmMain Me.ucrDataViewer.Location = New System.Drawing.Point(0, 0) Me.ucrDataViewer.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrDataViewer.Name = "ucrDataViewer" - Me.ucrDataViewer.Size = New System.Drawing.Size(384, 226) + Me.ucrDataViewer.Size = New System.Drawing.Size(384, 227) Me.ucrDataViewer.TabIndex = 0 Me.ucrDataViewer.Tag = "Data_View" ' @@ -5074,16 +5090,9 @@ Partial Class frmMain Me.ucrOutput.Location = New System.Drawing.Point(0, 0) Me.ucrOutput.Margin = New System.Windows.Forms.Padding(4, 5, 4, 5) Me.ucrOutput.Name = "ucrOutput" - Me.ucrOutput.Size = New System.Drawing.Size(445, 226) + Me.ucrOutput.Size = New System.Drawing.Size(445, 227) Me.ucrOutput.TabIndex = 0 ' - 'mnuRViewer - ' - Me.mnuRViewer.Name = "mnuRViewer" - Me.mnuRViewer.Size = New System.Drawing.Size(180, 22) - Me.mnuRViewer.Text = "R Viewer..." - Me.mnuRViewer.ToolTipText = "View Last Graph" - ' 'mnuPlotly ' Me.mnuPlotly.Name = "mnuPlotly" @@ -5675,7 +5684,6 @@ Partial Class frmMain Friend WithEvents mnuMetadata As ToolStripSplitButton Friend WithEvents mnuColumnMetadat As ToolStripMenuItem Friend WithEvents mnuDataFrameMetadat As ToolStripMenuItem - Friend WithEvents mnuRViewer As ToolStripMenuItem Friend WithEvents mnuPlotly As ToolStripMenuItem Friend WithEvents mnuColumnMetadata As ToolStripMenuItem Friend WithEvents mnuDataFrameMetadata As ToolStripMenuItem @@ -5782,7 +5790,7 @@ Partial Class frmMain Friend WithEvents mnuSubTbPaste As ToolStripMenuItem Friend WithEvents mnuSubTbPasteSpecial As ToolStripMenuItem Friend WithEvents mnuLastGraph As ToolStripSplitButton - Friend WithEvents mnuViewer As ToolStripMenuItem + Friend WithEvents mnuRViewer As ToolStripMenuItem Friend WithEvents mnuploty As ToolStripMenuItem Friend WithEvents ToolStripSeparator27 As ToolStripSeparator Friend WithEvents ToolStripSeparator71 As ToolStripSeparator @@ -5815,5 +5823,7 @@ Partial Class frmMain Friend WithEvents mnuOptionsByContextCropModel As ToolStripMenuItem Friend WithEvents mnuFileImportFromRapidPro As ToolStripMenuItem Friend WithEvents mnuFileImportFromPostgres As ToolStripMenuItem + Friend WithEvents mnuNormalViewer As ToolStripMenuItem Friend WithEvents mnuEditWordwrap As ToolStripMenuItem + Friend WithEvents mnuPrepareColumnTextSearch As ToolStripMenuItem End Class diff --git a/instat/frmMain.vb b/instat/frmMain.vb index 7e9e0f4d0a9..4af14c67edf 100644 --- a/instat/frmMain.vb +++ b/instat/frmMain.vb @@ -21,6 +21,7 @@ Imports System.Threading Imports instat.Translations Imports System.ComponentModel Imports System.Runtime.Serialization.Formatters.Binary +Imports System.Runtime.InteropServices Public Class frmMain Public clsRLink As RLink @@ -82,6 +83,13 @@ Public Class frmMain ' Add any initialization after the InitializeComponent() call. clsOutputLogger = New clsOutputLogger clsRLink = New RLink(clsOutputLogger) + If RuntimeInformation.IsOSPlatform(OSPlatform.Windows) Then + If Not CefRuntimeWrapper.InitialiseCefRuntime() Then + MessageBox.Show(Me, "Cef runtime could not be initialised." & Environment.NewLine & "Html content will be shown in your default browser.", + "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) + End If + + End If End Sub Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load @@ -382,14 +390,6 @@ Public Class frmMain End Try End Sub - Public Sub AddGraphForm(strFilePath As String) - Dim frmNewGraph As New frmGraphDisplay - - frmNewGraph.SetImageFromFile(strFilePath) - frmNewGraph.Show() - frmNewGraph.BringToFront() - End Sub - Public Sub AddToScriptWindow(strText As String, Optional bMakeVisible As Boolean = True) ucrScriptWindow.AppendText(strText) If bMakeVisible Then @@ -894,8 +894,12 @@ Public Class frmMain DeleteAutoSaveData() DeleteAutoSaveLog() DeleteAutoSaveDebugLog() + clsRLink.CloseREngine() + End If + + If RuntimeInformation.IsOSPlatform(OSPlatform.Windows) Then + CefRuntimeWrapper.ShutDownCef() End If - clsRLink.CloseREngine() Catch ex As Exception MsgBox("Error attempting to save setting files to App Data folder." & Environment.NewLine & "System error message: " & ex.Message, MsgBoxStyle.Critical, "Error saving settings") End Try @@ -2067,12 +2071,6 @@ Public Class frmMain UpdateLayout() End Sub - Private Sub MnuLastGraph_ButtonClick(sender As Object, e As EventArgs) Handles mnuLastGraph.ButtonClick - Me.Enabled = False - clsRLink.ViewLastGraph() - Me.Enabled = True - End Sub - Private Sub MnuMetadata_ButtonClick(sender As Object, e As EventArgs) Handles mnuMetadata.ButtonClick mnuViewColumnMetadata.Checked = Not mnuViewColumnMetadata.Checked mnuColumnMetadat.Checked = mnuViewColumnMetadata.Checked @@ -2109,7 +2107,7 @@ Public Class frmMain UpdateLayout() End Sub - Private Sub MnuViewer_Click(sender As Object, e As EventArgs) Handles mnuViewer.Click + Private Sub MnuLastGraph_ButtonClick(sender As Object, e As EventArgs) Handles mnuLastGraph.ButtonClick, mnuNormalViewer.Click Me.Enabled = False clsRLink.ViewLastGraph() Me.Enabled = True @@ -2121,6 +2119,12 @@ Public Class frmMain Me.Enabled = True End Sub + Private Sub MnuRViewer_Click(sender As Object, e As EventArgs) Handles mnuRViewer.Click + Me.Enabled = False + clsRLink.ViewLastGraph(bInRViewer:=True) + Me.Enabled = True + End Sub + Private Sub mnuModelFitModelOneVariable_Click(sender As Object, e As EventArgs) Handles mnuModelFitModelOneVariable.Click dlgOneVarFitModel.ShowDialog() End Sub @@ -2478,4 +2482,8 @@ Public Class frmMain Private Sub mnuEditWordwrap_Click(sender As Object, e As EventArgs) Handles mnuEditWordwrap.Click dlgWordwrap.ShowDialog() End Sub + + Private Sub mnuPrepareColumnTextSearch_Click(sender As Object, e As EventArgs) Handles mnuPrepareColumnTextSearch.Click + dlgSearch.ShowDialog() + End Sub End Class diff --git a/instat/frmScript.Designer.vb b/instat/frmScript.Designer.vb deleted file mode 100644 index 7dd623c34c5..00000000000 --- a/instat/frmScript.Designer.vb +++ /dev/null @@ -1,83 +0,0 @@ -' R- Instat -' Copyright (C) 2015-2017 -' -' This program is free software: you can redistribute it and/or modify -' it under the terms of the GNU General Public License as published by -' the Free Software Foundation, either version 3 of the License, or -' (at your option) any later version. -' -' This program is distributed in the hope that it will be useful, -' but WITHOUT ANY WARRANTY; without even the implied warranty of -' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -' GNU General Public License for more details. -' -' You should have received a copy of the GNU General Public License -' along with this program. If not, see . - - -Partial Class frmScript - Inherits System.Windows.Forms.Form - - 'Form overrides dispose to clean up the component list. - _ - Protected Overrides Sub Dispose(ByVal disposing As Boolean) - Try - If disposing AndAlso components IsNot Nothing Then - components.Dispose() - End If - Finally - MyBase.Dispose(disposing) - End Try - End Sub - - 'Required by the Windows Form Designer - Private components As System.ComponentModel.IContainer - - 'NOTE: The following procedure is required by the Windows Form Designer - 'It can be modified using the Windows Form Designer. - 'Do not modify it using the code editor. - - Private Sub InitializeComponent() - Me.txtScript = New System.Windows.Forms.TextBox() - Me.cmdClear = New System.Windows.Forms.Button() - Me.SuspendLayout() - ' - 'txtScript - ' - Me.txtScript.Dock = System.Windows.Forms.DockStyle.Bottom - Me.txtScript.Location = New System.Drawing.Point(0, 55) - Me.txtScript.Multiline = True - Me.txtScript.Name = "txtScript" - Me.txtScript.ReadOnly = True - Me.txtScript.Size = New System.Drawing.Size(548, 290) - Me.txtScript.TabIndex = 0 - ' - 'cmdClear - ' - Me.cmdClear.Dock = System.Windows.Forms.DockStyle.Right - Me.cmdClear.Location = New System.Drawing.Point(444, 0) - Me.cmdClear.Name = "cmdClear" - Me.cmdClear.Size = New System.Drawing.Size(104, 55) - Me.cmdClear.TabIndex = 1 - Me.cmdClear.Text = "Clear contents" - Me.cmdClear.UseVisualStyleBackColor = True - ' - 'frmScript - ' - Me.AutoScaleDimensions = New System.Drawing.SizeF(96.0!, 96.0!) - Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Dpi - Me.ClientSize = New System.Drawing.Size(548, 345) - Me.Controls.Add(Me.cmdClear) - Me.Controls.Add(Me.txtScript) - Me.Name = "frmScript" - Me.ShowIcon = False - Me.Tag = "Script_Window" - Me.Text = "Script Window" - Me.ResumeLayout(False) - Me.PerformLayout() - - End Sub - - Friend WithEvents txtScript As TextBox - Friend WithEvents cmdClear As Button -End Class diff --git a/instat/frmScript.sw-KE.resx b/instat/frmScript.sw-KE.resx deleted file mode 100644 index 9c9f69d752c..00000000000 --- a/instat/frmScript.sw-KE.resx +++ /dev/null @@ -1,15 +0,0 @@ - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - \ No newline at end of file diff --git a/instat/frmScript.vb b/instat/frmScript.vb deleted file mode 100644 index c4452e10cb0..00000000000 --- a/instat/frmScript.vb +++ /dev/null @@ -1,47 +0,0 @@ -' R- Instat -' Copyright (C) 2015-2017 -' -' This program is free software: you can redistribute it and/or modify -' it under the terms of the GNU General Public License as published by -' the Free Software Foundation, either version 3 of the License, or -' (at your option) any later version. -' -' This program is distributed in the hope that it will be useful, -' but WITHOUT ANY WARRANTY; without even the implied warranty of -' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -' GNU General Public License for more details. -' -' You should have received a copy of the GNU General Public License -' along with this program. If not, see . - -Public Class frmScript - Protected Overrides Sub OnFormClosing(ByVal e As FormClosingEventArgs) - MyBase.OnFormClosing(e) - If Not e.Cancel AndAlso e.CloseReason = CloseReason.UserClosing Then - e.Cancel = True - Me.Close() - End If - End Sub - - Public Sub copyText() - txtScript.Copy() - End Sub - - Public Sub selectAllText() - txtScript.SelectAll() - End Sub - - Private Sub frmScript_VisibleChanged(sender As Object, e As EventArgs) Handles Me.VisibleChanged - frmMain.mnuViewScriptWindow.Checked = Me.Visible - End Sub - - Private Sub cmdClear_Click(sender As Object, e As EventArgs) Handles cmdClear.Click - Dim dlgResponse As DialogResult - If txtScript.Text <> "" Then - dlgResponse = MessageBox.Show("Are you sure you want to clear the " & Me.Text, "Clear " & Me.Text, MessageBoxButtons.YesNo) - If dlgResponse = DialogResult.Yes Then - txtScript.Clear() - End If - End If - End Sub -End Class diff --git a/instat/instat.vbproj b/instat/instat.vbproj index 70c71c81b92..f5070882585 100644 --- a/instat/instat.vbproj +++ b/instat/instat.vbproj @@ -1,5 +1,8 @@  + + + Debug @@ -111,11 +114,23 @@ true + + app.manifest + False References\Antlr3.Runtime.dll + + ..\packages\CefSharp.Common.104.4.240\lib\net452\CefSharp.dll + + + ..\packages\CefSharp.Common.104.4.240\lib\net452\CefSharp.Core.dll + + + ..\packages\CefSharp.WinForms.104.4.240\lib\net452\CefSharp.WinForms.dll + ..\packages\DotNetZip.1.15.0\lib\net40\DotNetZip.dll @@ -222,6 +237,20 @@ Form + + + + frmMaximiseOutput.vb + + + Form + + + dlgSearch.vb + + + Form + dlgWordwrap.vb @@ -1277,12 +1306,6 @@ Form - - frmGraphDisplay.vb - - - Form - frmPackageIssues.vb @@ -2568,12 +2591,6 @@ Form - - frmScript.vb - - - Form - frmVariables.vb @@ -2776,12 +2793,6 @@ UserControl - - ucrSaveModel.vb - - - UserControl - ucrScript.vb @@ -2900,6 +2911,13 @@ UserControl + + Component + + + + Component + ucrOutputPage.vb @@ -3021,6 +3039,9 @@ dlgScript.vb + + dlgSearch.vb + dlgSeasonalPlot.vb @@ -3054,6 +3075,10 @@ dlgThreeVariablePivotTable.vb + + frmMaximiseOutput.vb + Designer + frmOutputWindow.vb @@ -4069,12 +4094,6 @@ dlgColumnStructures.vb - - frmGraphDisplay.vb - - - frmGraphDisplay.vb - frmPackageIssues.vb @@ -4768,12 +4787,6 @@ frmMetaData.vb - - frmScript.vb - - - frmScript.vb - frmVariables.vb @@ -5112,12 +5125,6 @@ ucrSave.vb - - ucrSaveModel.vb - - - ucrSaveModel.vb - ucrScript.vb @@ -5189,6 +5196,7 @@ PreserveNewest + @@ -5599,7 +5607,12 @@ This project references NuGet package(s) that are missing on this computer. Use NuGet Package Restore to download them. For more information, see http://go.microsoft.com/fwlink/?LinkID=322105. The missing file is {0}. + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - \ No newline at end of file diff --git a/instat/ucrSaveModel.sw-KE.resx b/instat/ucrSaveModel.sw-KE.resx deleted file mode 100644 index e671d7eb01b..00000000000 --- a/instat/ucrSaveModel.sw-KE.resx +++ /dev/null @@ -1,51 +0,0 @@ - - - - text/microsoft-resx - - - 2.0 - - - System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - - True - - - 0, 3 - - - 83, 17 - - - 1 - - - &Hifadhi Modeli - - - 86, 0 - - - 0, 0, 0, 0 - - - 180, 20 - - - 0 - - - 6, 13 - - - 265, 20 - - - True - - \ No newline at end of file diff --git a/instat/ucrSaveModel.vb b/instat/ucrSaveModel.vb deleted file mode 100644 index 621a8eb63a3..00000000000 --- a/instat/ucrSaveModel.vb +++ /dev/null @@ -1,36 +0,0 @@ -' R- Instat -' Copyright (C) 2015-2017 -' -' This program is free software: you can redistribute it and/or modify -' it under the terms of the GNU General Public License as published by -' the Free Software Foundation, either version 3 of the License, or -' (at your option) any later version. -' -' This program is distributed in the hope that it will be useful, -' but WITHOUT ANY WARRANTY; without even the implied warranty of -' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -' GNU General Public License for more details. -' -' You should have received a copy of the GNU General Public License -' along with this program. If not, see . - -Public Class ucrSaveModel - Public Sub New() - ' This call is required by the designer. - InitializeComponent() - - ' Add any initialization after the InitializeComponent() call. - ucrInputModelName.SetDefaultTypeAsModel() - ucrInputModelName.SetItemsTypeAsModels() - End Sub - - Public Event CheckedChanged(bChecked As Boolean) - Private Sub chkSaveModel_CheckedChanged(sender As Object, e As EventArgs) Handles chkSaveModel.CheckedChanged - If chkSaveModel.Checked Then - ucrInputModelName.Visible = True - Else - ucrInputModelName.Visible = False - End If - RaiseEvent CheckedChanged(chkSaveModel.Checked) - End Sub -End Class diff --git a/instat/ucrTry.vb b/instat/ucrTry.vb index dbc910d4bb8..dbf965054fd 100644 --- a/instat/ucrTry.vb +++ b/instat/ucrTry.vb @@ -98,8 +98,9 @@ Public Class ucrTry Dim clsCodeClone As RCodeStructure = clsTempCode.Clone() Dim strBeforeAfterScript As String = "" Dim strBeforeAfterTemp As String = clsCodeClone.ToScript(strBeforeAfterScript) - 'Sometimes the output of the R-command we deal with should not be part of the script... That's only the case when this output has already been assigned. - If clsCodeClone.bExcludeAssignedFunctionOutput AndAlso clsCodeClone.bIsAssigned Then + 'Sometimes the output of the R-command we deal with should not be part of the script... + 'That's only the case when this output has already been assigned. + If clsCodeClone.bExcludeAssignedFunctionOutput AndAlso clsCodeClone.IsAssigned() Then lstScripts.Add(strBeforeAfterScript) Else lstScripts.Add(strBeforeAfterScript & strBeforeAfterTemp) @@ -184,8 +185,8 @@ Public Class ucrTry Dim clsCodeClone As RCodeStructure = clsTempCode.Clone() Dim strBeforeAfterScript As String = "" Dim strBeforeAfterTemp As String = clsCodeClone.ToScript(strBeforeAfterScript) - 'Sometimes the output of the R-command we deal with should not be part of the script... That's only the case when this output has already been assigned. - If clsCodeClone.bExcludeAssignedFunctionOutput AndAlso clsCodeClone.bIsAssigned Then + 'Sometimes the output of the R-command we deal with should not be part of the script... + If clsCodeClone.bExcludeAssignedFunctionOutput Then lstScripts.Add(strBeforeAfterScript) Else lstScripts.Add(strBeforeAfterScript & strBeforeAfterTemp)