Merge pull request #9431 from derekagorhom/Presentations

Added title and themes to the presentation table dialog
IDEMSInternational · Feb 18, 2025 · 140e31c · 140e31c
2 parents 1b49d9e + 19a6114
commit 140e31c
Show file tree

Hide file tree

Showing 6 changed files with 301 additions and 82 deletions.
diff --git a/instat/UserTables/dlgGeneralTable.Designer.vb b/instat/UserTables/dlgGeneralTable.Designer.vb
diff --git a/instat/UserTables/dlgGeneralTable.vb b/instat/UserTables/dlgGeneralTable.vb
@@ -2,7 +2,7 @@
 
 Public Class dlgGeneralTable
     Private clsBaseOperator As New ROperator
-    Private clsHeadRFunction, clsGtRFunction As New RFunction
+    Private clsHeadRFunction, clsHeaderRFunction, clsCellsTitleRFunction, clsTitleStyleRFunction, clsTitleFooterRFunction, clsGtRFunction, clsThemeRFunction As New RFunction
 
     Private bFirstload As Boolean = True
     Private bReset As Boolean = True
@@ -24,6 +24,11 @@ Public Class dlgGeneralTable
     Private Sub btnMoreOptions_Click(sender As Object, e As EventArgs) Handles btnMoreOptions.Click
         sdgTableOptions.Setup(ucrSelectorCols.strCurrentDataFrame, clsBaseOperator)
         sdgTableOptions.ShowDialog(Me)
+        ucrInputTitle.SetText(sdgTableOptions.ucrHeader.ucrInputTitle.GetText)
+        ucrInputTitleFooter.SetText(sdgTableOptions.ucrHeader.ucrInputTitleFooter.GetText)
+        ucrCboSelectThemes.SetText(sdgTableOptions.ucrCboSelectThemes.GetText)
+        ucrChkSelectTheme.Checked = sdgTableOptions.ucrChkSelectTheme.Checked
+        sdgTableStyles.GetNewUserInputAsRFunction()
     End Sub
 
     Private Sub ucrControls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrReceiverMultipleCols.ControlContentsChanged
@@ -44,6 +49,9 @@ Public Class dlgGeneralTable
         ucrReceiverMultipleCols.Selector = ucrSelectorCols
         ucrReceiverMultipleCols.SetLinkedDisplayControl(lblColumns)
 
+        ucrInputTitle.SetParameter(New RParameter("title", iNewPosition:=0))
+        ucrInputTitleFooter.SetParameter(New RParameter("footnote", iNewPosition:=0))
+
         ucrChkPreview.SetText("Preview")
         ucrChkPreview.AddParameterPresentCondition(True, "head", bNewIsPositive:=True)
         ucrChkPreview.AddParameterPresentCondition(False, "head", bNewIsPositive:=False)
@@ -61,14 +69,23 @@ Public Class dlgGeneralTable
         ucrSaveTable.SetCheckBoxText("Store Table")
         ucrSaveTable.SetAssignToIfUncheckedValue("last_table")
 
+        ucrChkSelectTheme.Checked = True
+        ucrChkSelectTheme.SetText("Select Theme")
+        ucrCboSelectThemes.SetItems({"None", "Dark Theme", "538 Theme", "Dot Matrix Theme", "Espn Theme", "Excel Theme", "Guardian Theme", "NY Times Theme", "PFF Theme"})
+        ucrCboSelectThemes.SetDropDownStyleAsNonEditable()
+
         ucrBase.clsRsyntax.bExcludeAssignedFunctionOutput = False
     End Sub
 
-
     Private Sub SetDefaults()
         clsBaseOperator = New ROperator
+
         clsHeadRFunction = New RFunction
         clsGtRFunction = New RFunction
+        clsHeaderRFunction = New RFunction
+        clsCellsTitleRFunction = New RFunction
+        clsTitleFooterRFunction = New RFunction
+        clsTitleStyleRFunction = New RFunction
 
         ucrSelectorCols.Reset()
         ucrReceiverMultipleCols.SetMeAsReceiver()
@@ -80,13 +97,34 @@ Public Class dlgGeneralTable
 
         clsHeadRFunction.SetPackageName("utils")
         clsHeadRFunction.SetRCommand("head")
-        clsHeadRFunction.AddParameter(strParameterName:="x", strParameterValue:=100, iPosition:=0, bIncludeArgumentName:=False)
+        clsHeadRFunction.AddParameter(strParameterName:="x", strParameterValue:=10, iPosition:=0, bIncludeArgumentName:=False)
         clsBaseOperator.AddParameter(strParameterName:="head", clsRFunctionParameter:=clsHeadRFunction, iPosition:=1, bIncludeArgumentName:=False)
 
         clsGtRFunction.SetPackageName("gt")
         clsGtRFunction.SetRCommand("gt")
         clsBaseOperator.AddParameter(strParameterName:="gt", clsRFunctionParameter:=clsGtRFunction, iPosition:=2, bIncludeArgumentName:=False)
 
+        Dim strCommand As String = ""
+        clsThemeRFunction.SetPackageName("gtExtras")
+        clsThemeRFunction.SetRCommand(strCommand)
+        clsBaseOperator.AddParameter("theme_format", clsRFunctionParameter:=clsThemeRFunction)
+
+        clsHeaderRFunction.SetPackageName("gt")
+        clsHeaderRFunction.SetRCommand("tab_header")
+        clsHeaderRFunction.AddParameter("title", ucrInputTitle.GetText, iPosition:=1)
+        clsBaseOperator.AddParameter("theme_Header", clsRFunctionParameter:=clsHeaderRFunction)
+
+        clsTitleFooterRFunction.SetPackageName("gt")
+        clsTitleFooterRFunction.SetRCommand("tab_footnote")
+        clsTitleFooterRFunction.AddParameter("footnote", ucrInputTitleFooter.GetText, iPosition:=1)
+        clsTitleFooterRFunction.AddParameter("locations", clsRFunctionParameter:=clsCellsTitleRFunction, iPosition:=2)
+        clsBaseOperator.AddParameter("theme_footer", clsRFunctionParameter:=clsTitleFooterRFunction)
+
+        Dim strGroupParamValue As String = "title"
+        clsCellsTitleRFunction.SetPackageName("gt")
+        clsCellsTitleRFunction.SetRCommand("cells_title")
+        clsCellsTitleRFunction.AddParameter(strParameterName:="groups", strParameterValue:=Chr(34) & strGroupParamValue & Chr(34), iPosition:=0)
+
         clsBaseOperator.SetAssignToOutputObject(strRObjectToAssignTo:="last_table",
                                                   strRObjectTypeLabelToAssignTo:=RObjectTypeLabel.Table,
                                                   strRObjectFormatToAssignTo:=RObjectFormat.Html,
@@ -96,11 +134,11 @@ Public Class dlgGeneralTable
         ucrBase.clsRsyntax.SetBaseROperator(clsBaseOperator)
     End Sub
 
-
     Private Sub SetRCodeForControls(bReset As Boolean)
         ucrReceiverMultipleCols.SetRCode(clsBaseOperator, bReset)
         ucrSaveTable.SetRCode(clsBaseOperator, bReset)
-
+        ucrInputTitle.SetRCode(clsHeaderRFunction, True, bCloneIfNeeded:=True)
+        ucrInputTitleFooter.SetRCode(clsTitleFooterRFunction, True, bCloneIfNeeded:=True)
         ucrChkPreview.SetRCode(clsBaseOperator, bReset)
         ucrNudPreview.SetRCode(clsHeadRFunction, bReset)
     End Sub
@@ -116,4 +154,70 @@ Public Class dlgGeneralTable
             clsBaseOperator.RemoveParameterByName("head")
         End If
     End Sub
+
+    Private Sub btnTitleFormat_Click(sender As Object, e As EventArgs) Handles btnTitleStyle.Click
+        Dim clsListStyleRFunction As RFunction = clsTablesUtils.ShowStyleSubDialog(Me.ParentForm, clsTitleStyleRFunction)
+        If clsListStyleRFunction Is Nothing Then
+            Exit Sub
+        End If
+
+        clsTitleStyleRFunction = clsTablesUtils.GetNewStyleRFunction(clsListStyleRFunction, clsCellsTitleRFunction)
+        If clsTitleStyleRFunction IsNot Nothing Then
+            clsBaseOperator.AddParameter(strParameterName:="tab_style_for_title_param", clsRFunctionParameter:=clsTitleStyleRFunction)
+        End If
+    End Sub
+
+    Private Sub ucrInputControls_ControlContentsChanged(ucrChangedControl As ucrCore) Handles ucrInputTitle.ControlContentsChanged, ucrInputTitleFooter.ControlContentsChanged
+        ucrInputTitleFooter.Enabled = Not ucrInputTitle.IsEmpty()
+        If Not ucrInputTitle.IsEmpty Then
+            clsBaseOperator.AddParameter("theme_Header", clsRFunctionParameter:=clsHeaderRFunction)
+        Else
+            clsBaseOperator.RemoveParameterByName("theme_Header")
+        End If
+        If Not ucrInputTitleFooter.IsEmpty Then
+            clsBaseOperator.AddParameter("theme_footer", clsRFunctionParameter:=clsTitleFooterRFunction)
+        Else
+            clsBaseOperator.RemoveParameterByName("theme_footer")
+        End If
+    End Sub
+
+    Private Sub ucrChkSelectTheme_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrChkSelectTheme.ControlValueChanged
+        If ucrChkSelectTheme.Checked Then
+            ucrCboSelectThemes.Visible = True
+            clsBaseOperator.AddParameter("theme_format", clsRFunctionParameter:=clsThemeRFunction)
+        Else
+            clsBaseOperator.RemoveParameterByName("theme_format")
+            ucrCboSelectThemes.Visible = False
+            clsThemeRFunction.ClearParameters()
+        End If
+    End Sub
+
+    Private Sub ucrCboSelectThemes_ControlValueChanged(ucrChangedControl As ucrCore) Handles ucrCboSelectThemes.ControlValueChanged
+
+        If clsThemeRFunction Is Nothing Then
+            Exit Sub
+        End If
+        Dim strCommand As String = ""
+        Select Case ucrCboSelectThemes.GetText
+            Case "Dark Theme"
+                strCommand = "gt_theme_dark"
+            Case "538 Theme"
+                strCommand = "gt_theme_538"
+            Case "Dot Matrix Theme"
+                strCommand = "gt_theme_dot_matrix"
+            Case "Espn Theme"
+                strCommand = "gt_theme_espn"
+            Case "Excel Theme"
+                strCommand = "gt_theme_excel"
+            Case "Guardian Theme"
+                strCommand = "gt_theme_guardian"
+            Case "NY Times Theme"
+                strCommand = "gt_theme_nytimes"
+            Case "PFF Theme"
+                strCommand = "gt_theme_pff"
+        End Select
+
+        clsThemeRFunction.SetRCommand(strCommand)
+    End Sub
+
 End Class