Syncing titles and themes in presentation table

instat/UserTables/Header/ucrHeader.vb

@@ -1,8 +1,8 @@
 
 Public Class ucrHeader
     Private clsOperator As New ROperator
-    Private clsHeaderRFunction, clsTitleFooterRFunction, clsSubtitleFooterRFunction, clsTitleLocationRFunction, clsSubtitleLocationRFunction, clsTitleStyleRFunction, clsSubtitleStyleRFunction As New RFunction
-
+    Private clsHeaderRFunction, clsTitleFooterRFunction, clsSubtitleFooterRFunction, clsTitleLocationRFunction, clsSubtitleLocationRFunction, clsSubtitleStyleRFunction As New RFunction
+    Public clsTitleStyleRFunction As New RFunction
 
     Private bFirstload As Boolean = True
 

instat/UserTables/dlgGeneralTable.vb

@@ -2,8 +2,8 @@
 
 Public Class dlgGeneralTable
     Private clsBaseOperator As New ROperator
-    Private clsHeadRFunction, clsGtRFunction As New RFunction
-
+    Private clsHeadRFunction, clsHeaderRFunction, clsCellsTitleRFunction, clsTitleFooterRFunction, clsGtRFunction, clsThemeRFunction As New RFunction
+    Public clsTitleStyleRFunction 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
+        clsTitleStyleRFunction = sdgTableOptions.ucrHeader.clsTitleStyleRFunction
     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,6 +69,11 @@ 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
 
@@ -69,24 +82,42 @@ Public Class dlgGeneralTable
         clsBaseOperator = New ROperator
         clsHeadRFunction = New RFunction
         clsGtRFunction = New RFunction
-
+        clsHeaderRFunction = New RFunction
+        clsTitleStyleRFunction = New RFunction
+        clsCellsTitleRFunction = New RFunction
         ucrSelectorCols.Reset()
         ucrReceiverMultipleCols.SetMeAsReceiver()
         ucrSaveTable.Reset()
         ucrChkPreview.Checked = True
+        ucrChkSelectTheme.Checked = True
 
         clsBaseOperator.SetOperation("%>%")
         clsBaseOperator.bBrackets = False
 
         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)
+
+        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 +127,13 @@ 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 +149,63 @@ 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()
+    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) 'Add if it is not already there
+            clsThemeRFunction.SetPackageName("gtExtras")
+
+        Else
+            ucrCboSelectThemes.Visible = False
+            clsThemeRFunction.SetRCommand("") ' Clear the theme command, but keep the parameter!
+            'Do not remove the parameter from the base operator
+        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