diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2023-05-17 17:52:53 +0200 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2023-05-18 10:30:45 +0200 |
| commit | 66a3b09fc3b2927f1333f4fd54426fc5918d89cb (patch) | |
| tree | f2e90dcabf4b59a891923345757bc5b55c33035d /wizards | |
| parent | 8afcd6e74fd8f36a5599a852383ffdb59ed734e9 (diff) | |
ScriptForge (SFDialogs) create controls dynamically
The dialog service hosts now a bunch of methods
to create new controls dynamically in an existing
dialog predefined in the Basic IDE.
In other words, a dialog is initialized with controls
in the Basic IDE. New controls can be added at run-time
before or after the Execute() statement.
All the new methods have in common their first 2 arguments:
ControlName
Place: an (X, Y, Width, Height) array
or a com.sun.star.awt.Rectangle
New methods:
CreateButton(..., toggle, push)
CreateCheckBox(..., multiline)
CreateComboBox(..., border, dropdown, linecount)
CreateCurrencyField(..., border, spinbutton, minvalue,
maxvalue, increment, accuracy)
CreateDateField(..., border, dropdown, mindate, maxdate)
CreateFileControl(..., border)
CreateFixedLine(..., orientation)
CreateFixedText(..., border, multiline, align, verticalalign)
CreateFormattedField(..., border, spinbutton, minvalue,
maxvalue)
CreateGroupBox(...)
CreateImageControl(..., border, scale)
CreateListBox(..., border, dropdown, linecount, multiselect)
CreateNumericField(..., border, spinbutton, minvalue,
maxvalue, increment, accuracy)
CreatePatternField(..., border, editmask, literalmask)
CreateProgressBar(..., border, minvalue, maxvalue)
CreateRadioButton(..., multiline)
CreateScrollBar(..., orientation, border, minvalue, maxvalue)
CreateTableControl(..., border, rowheaders, columnheaders,
scrollbars, gridlines)
CreateTextField(..., border, multiline, maximumlength,
passwordcharacter)
CreateTimeField(..., border, mintime, maxtime)
CreateTreeControl(..., border)
All the methods return a SF_DialogControl instance.
The arguments have bben chosen based on functionality
rather than on layout. After the creatio of the control,
most properties and methods relevant to SF_DialogControl
objects are applicable. Also the XControlModel property
might contribute to layout refinements.
Other changes:
- The SF_DialogControl class receives next updatable
properties: Border and TabIndex
- The dialogcontrol.SetTableData() receives an
additional argument: rowheaderwidth
- The dialogcontrol.Resize() method without arguments
resizes the control to its "preferred size", a size
adjusted depending on its actual content
All the new functionalities are callable from both
Basic and Python user scripts.
Described changes will require a serios review of the
Dialog and DialogControl help pages.
Change-Id: I654eeae5456527bf14b1f4b43f04d176bbd830b6
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/151896
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/source/scriptforge/SF_Exception.xba | 6 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Root.xba | 9 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/ScriptForge.pot | 15 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/en.po | 15 | ||||
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 104 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_Dialog.xba | 1286 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_DialogControl.xba | 178 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_DialogUtils.xba | 69 |
8 files changed, 1614 insertions, 68 deletions
diff --git a/wizards/source/scriptforge/SF_Exception.xba b/wizards/source/scriptforge/SF_Exception.xba index f752e054f2b5..6add0b158990 100644 --- a/wizards/source/scriptforge/SF_Exception.xba +++ b/wizards/source/scriptforge/SF_Exception.xba @@ -126,6 +126,7 @@ Const DIALOGDEADERROR = "DIALOGDEADERROR" Const CONTROLTYPEERROR = "CONTROLTYPEERROR" Const TEXTFIELDERROR = "TEXTFIELDERROR" Const PAGEMANAGERERROR = "PAGEMANAGERERROR" +Const DUPLICATECONTROLERROR = "DUPLICATECONTROLERROR" ' SF_Database Const DBREADONLYERROR = "DBREADONLYERROR" @@ -1024,6 +1025,11 @@ Try: Case PAGEMANAGERERROR ' SF_Dialog.SetPageManager(PilotsList, TabsList, WizardsList) sMessage = sLocation _ & "\n" & "\n" & .GetText("PAGEMANAGER", pvArgs(0), pvArgs(1), pvArgs(2), pvArgs(3), pvArgs(4), pvArgs(5)) + Case DUPLICATECONTROLERROR ' SF_Dialog.CreateControl(ControlName, DialogName) + pvArgs(0) = _RightCase(pvArgs(0)) + sMessage = sLocation _ + & "\n" & "\n" & "\n" & .GetText("VALIDATEERROR", pvArgs(0)) _ + & "\n" & "\n" & .GetText("DUPLICATECONTROL", pvArgs(0), pvArgs(1), pvArgs(2)) Case DBREADONLYERROR ' SF_Database.RunSql() sMessage = sLocation _ & "\n" & "\n" & .GetText("DBREADONLY", vLocation(2)) diff --git a/wizards/source/scriptforge/SF_Root.xba b/wizards/source/scriptforge/SF_Root.xba index 2966866bd5b8..e2649d0ce1d1 100644 --- a/wizards/source/scriptforge/SF_Root.xba +++ b/wizards/source/scriptforge/SF_Root.xba @@ -1008,6 +1008,15 @@ Try: & "%5: An identifier\n" _ & "%6: A list of names separated by commas" _ ) + ' SF_Dialog.CreateControl + .AddText( Context := "DUPLICATECONTROL" _ + , MsgId := "A control with the same name exists already in the dialog '%3'.\n\n" _ + & "« %1 » = %2\n" _ + , Comment := "SF_Dialog CreateControl\n" _ + & "%1: An identifier\n" _ + & "%2: A string\n" _ + & "%3: A dialog name" _ + ) ' SF_Database.RunSql .AddText( Context := "DBREADONLY" _ , MsgId := "The database has been opened in read-only mode.\n" _ diff --git a/wizards/source/scriptforge/po/ScriptForge.pot b/wizards/source/scriptforge/po/ScriptForge.pot index e1eca9ae462f..58d9a4afeaab 100644 --- a/wizards/source/scriptforge/po/ScriptForge.pot +++ b/wizards/source/scriptforge/po/ScriptForge.pot @@ -14,7 +14,7 @@ msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" -"POT-Creation-Date: 2023-01-22 15:34:36\n" +"POT-Creation-Date: 2023-05-15 16:22:55\n" "PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" @@ -943,6 +943,19 @@ msgid "" " %5 : « %6 »" msgstr "" +#. SF_Dialog CreateControl +#. %1: An identifier +#. %2: A string +#. %3: A dialog name +#, kde-format +msgctxt "DUPLICATECONTROL" +msgid "" +"A control with the same name exists already in the dialog '%3'.\n" +"\n" +"« %1 » = %2\n" +"" +msgstr "" + #. SF_Database when running update SQL statement #. %1: The concerned method #, kde-format diff --git a/wizards/source/scriptforge/po/en.po b/wizards/source/scriptforge/po/en.po index e1eca9ae462f..58d9a4afeaab 100644 --- a/wizards/source/scriptforge/po/en.po +++ b/wizards/source/scriptforge/po/en.po @@ -14,7 +14,7 @@ msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n" -"POT-Creation-Date: 2023-01-22 15:34:36\n" +"POT-Creation-Date: 2023-05-15 16:22:55\n" "PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <EMAIL@ADDRESS>\n" @@ -943,6 +943,19 @@ msgid "" " %5 : « %6 »" msgstr "" +#. SF_Dialog CreateControl +#. %1: An identifier +#. %2: A string +#. %3: A dialog name +#, kde-format +msgctxt "DUPLICATECONTROL" +msgid "" +"A control with the same name exists already in the dialog '%3'.\n" +"\n" +"« %1 » = %2\n" +"" +msgstr "" + #. SF_Database when running update SQL statement #. %1: The concerned method #, kde-format diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index ff5a3ef8b6ee..adfb4d69ef97 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -668,7 +668,7 @@ class SFScriptForge: :param unodate: com.sun.star.util.DateTime, com.sun.star.util.Date or com.sun.star.util.Time :return: the equivalent datetime.datetime """ - date = datetime.datetime(1899, 12, 30, 0, 0, 0, 0) # Idem as Basic builtin TimeSeria() function + date = datetime.datetime(1899, 12, 30, 0, 0, 0, 0) # Idem as Basic builtin TimeSerial() function datetype = repr(type(unodate)) if 'com.sun.star.util.DateTime' in datetype: if 1900 <= unodate.Year <= datetime.MAXYEAR: @@ -1869,6 +1869,99 @@ class SFDialogs: def Controls(self, controlname = ''): return self.ExecMethod(self.vbMethod + self.flgArrayRet + self.flgHardCode, 'Controls', controlname) + def CreateButton(self, controlname, place, toggle = False, push = ''): + return self.ExecMethod(self.vbMethod, 'CreateButton', controlname, place, toggle, push) + + def CreateCheckBox(self, controlname, place, multiline = False): + return self.ExecMethod(self.vbMethod, 'CreateCheckBox', controlname, place, multiline) + + def CreateComboBox(self, controlname, place, border = '3D', dropdown = True, linecount = 5): + return self.ExecMethod(self.vbMethod, 'CreateComboBox', controlname, place, border, dropdown, linecount) + + def CreateCurrencyField(self, controlname, place, border = '3D', spinbutton = False, minvalue = -1000000, + maxvalue = +1000000, increment = 1, accuracy = 2): + return self.ExecMethod(self.vbMethod, 'CreateCurrencyField', controlname, place, border, spinbutton, + minvalue, maxvalue, increment, accuracy) + + def CreateDateField(self, controlname, place, border = '3D', dropdown = True, + mindate = datetime.datetime(1900, 1, 1, 0, 0, 0, 0), + maxdate = datetime.datetime(2200, 12, 31, 0, 0, 0, 0)): + if isinstance(mindate, datetime.datetime): + mindate = SFScriptForge.SF_Basic.CDateToUnoDateTime(mindate) + if isinstance(maxdate, datetime.datetime): + maxdate = SFScriptForge.SF_Basic.CDateToUnoDateTime(maxdate) + return self.ExecMethod(self.vbMethod + self.flgDateArg, 'CreateDateField', controlname, place, border, + dropdown, mindate, maxdate) + + def CreateFileControl(self, controlname, place, border = '3D'): + return self.ExecMethod(self.vbMethod, 'CreateFileControl', controlname, place, border) + + def CreateFixedLine(self, controlname, place, orientation): + return self.ExecMethod(self.vbMethod, 'CreateFixedLine', controlname, place, orientation) + + def CreateFixedText(self, controlname, place, border = 'NONE', multiline = False, align = 'LEFT', + verticalalign = 'TOP'): + return self.ExecMethod(self.vbMethod, 'CreateFixedText', controlname, place, border, multiline, align, + verticalalign) + + def CreateFormattedField(self, controlname, place, border = '3D', spinbutton = False, + minvalue = -1000000, maxvalue = +1000000): + return self.ExecMethod(self.vbMethod, 'CreateFormattedField', controlname, place, border, spinbutton, + minvalue, maxvalue) + + def CreateGroupBox(self, controlname, place): + return self.ExecMethod(self.vbMethod, 'CreateGroupBox', controlname, place) + + def CreateImageControl(self, controlname, place, border = '3D', scale = 'FITTOSIZE'): + return self.ExecMethod(self.vbMethod, 'CreateImageControl', controlname, place, border, scale) + + def CreateListBox(self, controlname, place, border = '3D', dropdown = True, linecount = 5, + multiselect = False): + return self.ExecMethod(self.vbMethod, 'CreateListBox', controlname, place, border, dropdown, + linecount, multiselect) + + def CreateNumericField(self, controlname, place, border = '3D', spinbutton = False, + minvalue = -1000000, maxvalue = +1000000, increment = 1, accuracy = 2): + return self.ExecMethod(self.vbMethod, 'CreateNumericField', controlname, place, border, spinbutton, + minvalue, maxvalue, increment, accuracy) + + def CreatePatternField(self, controlname, place, border = '3D', editmask = '', literalmask = ''): + return self.ExecMethod(self.vbMethod, 'CreatePatternField', controlname, place, border, + editmask, literalmask) + + def CreateProgressBar(self, controlname, place, border = '3D', minvalue = 0, maxvalue = 100): + return self.ExecMethod(self.vbMethod, 'CreateProgressBar', controlname, place, border, minvalue, maxvalue) + + def CreateRadioButton(self, controlname, place, multiline = False): + return self.ExecMethod(self.vbMethod, 'CreateRadioButton', controlname, place, multiline) + + def CreateScrollBar(self, controlname, place, orientation, border = '3D', minvalue = 0, maxvalue = 100): + return self.ExecMethod(self.vbMethod, 'CreateScrollBar', controlname, place, orientation, border, + minvalue, maxvalue) + + def CreateTableControl(self, controlname, place, border = '3D', rowheaders = True, columnheaders = True, + scrollbars = 'None', gridlines = False): + return self.ExecMethod(self.vbMethod, 'CreateTableControl', controlname, place, border, + rowheaders, columnheaders, scrollbars, gridlines) + + def CreateTextField(self, controlname, place, border = '3D', multiline = False, + maximumlength = 0, passwordcharacter = ''): + return self.ExecMethod(self.vbMethod, 'CreateTextField', controlname, place, border, + multiline, maximumlength, passwordcharacter) + + def CreateTimeField(self, controlname, place, border = '3D', + mintime = datetime.datetime(1899, 12, 30, 0, 0, 0, 0), + maxtime = datetime.datetime(1899, 12, 30, 23, 59, 59, 0)): + if isinstance(mintime, datetime.datetime): + mintime = SFScriptForge.SF_Basic.CDateToUnoDateTime(mintime) + if isinstance(maxtime, datetime.datetime): + maxtime = SFScriptForge.SF_Basic.CDateToUnoDateTime(maxtime) + return self.ExecMethod(self.vbMethod + self.flgDateArg, 'CreateTimeField', controlname, place, border, + mintime, maxtime) + + def CreateTreeControl(self, controlname, place, border = '3D'): + return self.ExecMethod(self.vbMethod, 'CreateTreeControl', controlname, place, border) + def EndExecute(self, returnvalue): return self.ExecMethod(self.vbMethod + self.flgHardCode, 'EndExecute', returnvalue) @@ -1903,7 +1996,7 @@ class SFDialogs: serviceimplementation = 'basic' servicename = 'SFDialogs.DialogControl' servicesynonyms = () - serviceproperties = dict(Cancel = True, Caption = True, ControlType = False, CurrentNode = True, + serviceproperties = dict(Border = True, Cancel = True, Caption = True, ControlType = False, CurrentNode = True, Default = True, Enabled = True, Format = True, Height = True, ListCount = False, ListIndex = True, Locked = True, MultiSelect = True, Name = False, OnActionPerformed = True, OnAdjustmentValueChanged = True, OnFocusGained = True, @@ -1912,7 +2005,7 @@ class SFDialogs: OnMouseExited = True, OnMouseMoved = True, OnMousePressed = True, OnMouseReleased = True, OnNodeExpanded = True, OnNodeSelected = True, OnTextChanged = True, Page = True, Parent = False, Picture = True, - RootNode = False, RowSource = True, Text = False, TipText = True, + RootNode = False, RowSource = True, TabIndex = True, Text = False, TipText = True, TripleState = True, URL = True, Value = True, Visible = True, Width = True, X = True, Y = True, XControlModel = False, XControlView = False, XGridColumnModel = False, XGridDataModel = False, XTreeDataModel = False) @@ -1944,8 +2037,9 @@ class SFDialogs: def SetFocus(self): return self.ExecMethod(self.vbMethod, 'SetFocus') - def SetTableData(self, dataarray, widths = (1,), alignments = ''): - return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetTableData', dataarray, widths, alignments) + def SetTableData(self, dataarray, widths = (1,), alignments = '', rowheaderwidth = 10): + return self.ExecMethod(self.vbMethod + self.flgArrayArg, 'SetTableData', dataarray, widths, alignments, + rowheaderwidth) def WriteLine(self, line = ''): return self.ExecMethod(self.vbMethod, 'WriteLine', line) diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba index c252838b6c4f..7ce10d21f7b2 100644 --- a/wizards/source/sfdialogs/SF_Dialog.xba +++ b/wizards/source/sfdialogs/SF_Dialog.xba @@ -51,6 +51,7 @@ REM ================================================================== EXCEPTION Private Const DIALOGDEADERROR = "DIALOGDEADERROR" Private Const PAGEMANAGERERROR = "PAGEMANAGERERROR" +Private Const DUPLICATECONTROLERROR = "DUPLICATECONTROLERROR" REM ============================================================= PRIVATE MEMBERS @@ -596,6 +597,7 @@ Try: ._DialogName = _Name Set ._ControlModel = _DialogModel.getByName(ControlName) Set ._ControlView = _DialogControl.getControl(ControlName) + ._ControlView.setModel(._ControlModel) ._Initialize() End With Else @@ -614,6 +616,1138 @@ CatchNotFound: GoTo Finally End Function ' SFDialogs.SF_Dialog.Controls +''' CreateXXX functions: +''' ------------------- +''' Common arguments: +''' ControlName: the name of the new control. It must not exist yet. +''' Place: either +''' - an array with 4 elements: (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle [X, Y, Width, Height] +''' All elements are expressed in "Map AppFont" units. + +REM ----------------------------------------------------------------------------- +Public Function CreateButton(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Toggle As Variant _ + , Optional ByVal Push As Variant _ + ) As Object +''' Create a new control of type Button in the actual dialog. +''' Specific args: +''' Toggle: when True a Toggle button is created. Default = False +''' Push: "OK", "CANCE" or "" (default) +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myButton = dialog.CreateButton("Button1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iPush As Integer ' Alias of Push +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateButton" +Const cstSubArgs = "ControlName, Place, [Toggle=False], [Push=""""|""OK""|""CANCEL""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Toggle) Or IsEmpty(Toggle) Then Toggle = False + If IsMissing(Push) Or IsEmpty(Push) Then Push = "" + If Not ScriptForge.SF_Utils._Validate(Toggle, "Toggle", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Push, "Push", V_STRING, Array("", "OK", "CANCEL")) Then GoTo Finally + +Try: + ' Handle specific arguments + Select Case UCase(Push) + Case "" : iPush = com.sun.star.awt.PushButtonType.STANDARD + Case "OK" : iPush = com.sun.star.awt.PushButtonType.OK + Case "CANCEL" : iPush = com.sun.star.awt.PushButtonType.CANCEL + End Select + vPropNames = Array("Toggle", "PushButtonType") + vPropValues = Array(CBool(Toggle), iPush) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlButtonModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateButton = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateButton + +REM ----------------------------------------------------------------------------- +Public Function CreateCheckBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal MultiLine As Variant _ + ) As Object +''' Create a new control of type CheckBox in the actual dialog. +''' Specific args: +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myCheckBox = dialog.CreateCheckBox("CheckBox1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateCheckBox" +Const cstSubArgs = "ControlName, Place, [MultiLine=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("VisualEffect", "MultiLine") + vPropValues = Array(1, CBool(MultiLine)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlCheckBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateCheckBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateCheckBox + +REM ----------------------------------------------------------------------------- +Public Function CreateComboBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal LineCount As Variant _ + ) As Object +''' Create a new control of type ComboBox in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown: When True (default), a drop down button is displayed +''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5) +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myComboBox = dialog.CreateComboBox("ComboBox1", Array(20, 20, 60, 15), Dropdown := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateComboBox" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True + If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Dropdown", "LineCount") + vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlComboBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateComboBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateComboBox + +REM ----------------------------------------------------------------------------- +Public Function CreateCurrencyField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + , Optional ByVal Increment As Variant _ + , Optional ByVal Accuracy As Variant _ + ) As Object +''' Create a new control of type CurrencyField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000 +''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000 +''' Increment: the step when the spin button is pressed. Default = 1 +''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myCurrencyField = dialog.CreateCurrencyField("CurrencyField1", Array(20, 20, 60, 15), SpinButton := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateCurrencyField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00 + If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy") + vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlCurrencyFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateCurrencyField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateCurrencyField + +REM ----------------------------------------------------------------------------- +Public Function CreateDateField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal MinDate As Variant _ + , Optional ByVal MaxDate As Variant _ + ) As Object +''' Create a new control of type DateField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown:: when True (default = False), a dropdown button is shown +''' MinDate: the smallest date that can be entered in the control. Dafault = 1900-01-01 +''' MaxDate: the largest Date that can be entered in the control. Dafault = 2200-12-31 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myDateField = dialog.CreateDateField("DateField1", Array(20, 20, 60, 15), Dropdown := True) + +Dim oControl As Object ' Return Date +Dim iBorder As Integer ' Alias of border +Dim oMinDate As New com.sun.star.util.Date +Dim oMaxDate As New com.sun.star.util.Date +Dim vFormats As Variant ' List of available date formats +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateDateField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=False]" _ + & ", [MinDate=DateSerial(1900, 1, 1)], [MaxDate=DateSerial(2200, 12, 31)]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = False + If IsMissing(MinDate) Or IsEmpty(MinDate) Then MinDate = DateSerial(1900, 1, 1) + If IsMissing(MaxDate) Or IsEmpty(MaxDate) Then MaxDate = DateSerial(2200, 12, 31) + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinDate, "MinDate", ScriptForge.V_DATE) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxDate, "MaxDate", ScriptForge.V_DATE) Then GoTo Finally + vFormats = SF_DialogUtils._FormatsList("DateField") + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + With oMinDate + .Year = Year(MinDate) : .Month = Month(MinDate) : .Day = Day(MinDate) + End With + With oMaxDate + .Year = Year(MaxDate) : .Month = Month(MaxDate) : .Day = Day(MaxDate) + End With + vPropNames = Array("Border", "Dropdown", "DateMin", "DateMax", "DateFormat") + vPropValues = Array(iBorder, CBool(Dropdown), oMinDate, oMaxDate, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "Standard (short)"))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlDateFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateDateField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateDateField + +REM ----------------------------------------------------------------------------- +Public Function CreateFileControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + ) As Object +''' Create a new control of type FileControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFileControl = dialog.CreateFileControl("FileControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFileControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border") + vPropValues = Array(iBorder) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFileControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFileControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateFileControl + +REM ----------------------------------------------------------------------------- +Public Function CreateFixedLine(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Orientation As Variant _ + ) As Object +''' Create a new control of type FixedLine in the actual dialog. +''' Specific args: +''' Orientation: "H[orizontal]" or "V[ertical]". +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFixedLine = dialog.CreateFixedLine("FixedLine1", Array(20, 20, 60, 15), Orientation := "vertical") + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFixedLine" +Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("Orientation") + vPropValues = Array(CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFixedLineModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFixedLine = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateFixedLine + +REM ----------------------------------------------------------------------------- +Public Function CreateFixedText(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MultiLine As Variant _ + , Optional ByVal Align As Variant _ + , Optional ByVal VerticalAlign As Variant _ + ) As Object +''' Create a new control of type FixedText in the actual dialog. +''' Specific args: +''' Border: "NONE" (default) or "FLAT" or "3D" +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Align: horizontal alignment, "LEFT" (default) or "CENTER" or "RIGHT" +''' VerticalAlign: vertical alignment, "TOP" (default) or "MIDDLE" or "BOTTOM" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFixedText = dialog.CreateFixedText("FixedText1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iAlign As Integer ' Alias of Align +Dim iVerticalAlign As Integer ' Alias of VerticalAlign +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFixedText" +Const cstSubArgs = "ControlName, Place, [MultiLine=False], [Border=""NONE""|""FLAT""|""3D""]" _ + & ", [Align=""LEFT""|""CENTER""|""RIGHT""], [VerticalAlign=""TOP""|""MIDDLE""|""BOTTOM""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "NONE" + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If IsMissing(Align) Or IsEmpty(Align) Then Align = "LEFT" + If IsMissing(VerticalAlign) Or IsEmpty(VerticalAlign) Then VerticalAlign = "TOP" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Align, "Align", V_STRING, Array("LEFT", "CENTER", "RIGHT")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(VerticalAlign, "VerticalAlign", V_STRING, Array("TOP", "MIDDLE", "BOTTOM")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + iAlign = ScriptForge.SF_Array.IndexOf(Array("LEFT", "CENTER", "BOTTOM"), Align) + Select Case UCase(VerticalAlign) + Case "TOP" : iVerticalAlign = com.sun.star.style.VerticalAlignment.TOP + Case "MIDDLE" : iVerticalAlign = com.sun.star.style.VerticalAlignment.MIDDLE + Case "BOTTOM" : iVerticalAlign = com.sun.star.style.VerticalAlignment.BOTTOM + End Select + vPropNames = Array("Border", "MultiLine", "Align", "VerticalAlign") + vPropValues = Array(iBorder, CBool(MultiLine), iAlign, iVerticalAlign) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFixedTextModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFixedText = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateFixedText + +REM ----------------------------------------------------------------------------- +Public Function CreateFormattedField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type FormattedField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000 +''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myFormattedField = dialog.CreateFormattedField("FormattedField1", Array(20, 20, 60, 15), SpinButton := True) +''' myFormattedField.Format = "##0,00E+00" + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateFormattedField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("FormatsSupplier", "Border", "Spin", "EffectiveMin", "EffectiveMax") + vPropValues = Array(CreateUnoService("com.sun.star.util.NumberFormatsSupplier") _ + , iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlFormattedFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateFormattedField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateFormattedField + +REM ----------------------------------------------------------------------------- +Public Function CreateGroupBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + ) As Object +''' Create a new control of type GroupBox in the actual dialog. +''' Specific args: +''' Orientation: "H[orizontal]" or "V[ertical]" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myGroupBox = dialog.CreateGroupBox("GroupBox1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateGroupBox" +Const cstSubArgs = "ControlName, Place" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array() + vPropValues = Array() + + ' Create the control + Set oControl = _CreateNewControl("UnoControlGroupBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateGroupBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateGroupBox + +REM ----------------------------------------------------------------------------- +Public Function CreateImageControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Scale As Variant _ + ) As Object +''' Create a new control of type ImageControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Scale: One of next values: "FITTOSIZE" (default), "KEEPRATIO" or "NO" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myImageControl = dialog.CreateImageControl("ImageControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iScale As Integer ' Alias of Scale +Dim bScale As Boolean ' When False, no scaling +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateImageControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Scale=""FITTOSIZE""|""KEEPRATIO""|""NO""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Scale) Or IsEmpty(Scale) Then Scale = "FITTOSIZE" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Scale, "Scale", V_STRING, Array("FITTOSIZE", "KEEPRATIO", "NO")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + Select Case UCase(Scale) + Case "NO" : iScale = com.sun.star.awt.ImageScaleMode.NONE : bScale = False + Case "FITTOSIZE" : iScale = com.sun.star.awt.ImageScaleMode.ANISOTROPIC : bScale = True + Case "KEEPRATIO" : iScale = com.sun.star.awt.ImageScaleMode.ISOTROPIC : bScale = True + End Select + vPropNames = Array("Border", "ScaleImage", "ScaleMode") + vPropValues = Array(iBorder, bScale, iScale) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlImageControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateImageControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateImageControl + +REM ----------------------------------------------------------------------------- +Public Function CreateListBox(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal Dropdown As Variant _ + , Optional ByVal LineCount As Variant _ + , Optional ByVal MultiSelect As Variant _ + ) As Object +''' Create a new control of type ListBox in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Dropdown: When True (default), a drop down button is displayed +''' LineCount: Specifies the maximum line count displayed in the drop down (default = 5) +''' MultiSelect: When True, more than 1 entry may be selected. Default = False +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myListBox = dialog.CreateListBox("ListBox1", Array(20, 20, 60, 15), Dropdown := True, MultiSelect := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateListBox" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [Dropdown=True], [LineCount=5], [MultiSelect=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(Dropdown) Or IsEmpty(Dropdown) Then Dropdown = True + If IsMissing(LineCount) Or IsEmpty(LineCount) Then LineCount = 5 + If IsMissing(MultiSelect) Or IsEmpty(MultiSelect) Then MultiSelect = True + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Dropdown, "Dropdown", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LineCount, "LineCount", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiSelect, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Dropdown", "LineCount", "MultiSelection") + vPropValues = Array(iBorder, CBool(Dropdown), CInt(LineCount), CBool(MultiSelect)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlListBoxModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateListBox = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateListBox + +REM ----------------------------------------------------------------------------- +Public Function CreateNumericField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal SpinButton As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + , Optional ByVal Increment As Variant _ + , Optional ByVal Accuracy As Variant _ + ) As Object +''' Create a new control of type NumericField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' SpinButton:: when True (default = False), a spin button is present +''' MinValue: the smallest value that can be entered in the control. Dafault = -1000000 +''' MaxValue: the largest value that can be entered in the control. Dafault = +1000000 +''' Increment: the step when the spin button is pressed. Default = 1 +''' Accuracy: specifies the decimal accuracy. Default = 2 decimal digits +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myNumericField = dialog.CreateNumericField("NumericField1", Array(20, 20, 60, 15), SpinButton := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateNumericField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [SpinButton=False]" _ + & ", [MinValue=-1000000], MaxValue=+1000000], [Increment=1], [Accuracy=2]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(SpinButton) Or IsEmpty(SpinButton) Then SpinButton = False + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = -1000000.00 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = +1000000.00 + If IsMissing(Increment) Or IsEmpty(Increment) Then Increment = 1.00 + If IsMissing(Accuracy) Or IsEmpty(Accuracy) Then Accuracy = 2 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SpinButton, "SpinButton", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Increment, "Increment", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Accuracy, "Accuracy", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Spin", "ValueMin", "ValueMax", "ValueStep", "DecimalAccuracy") + vPropValues = Array(iBorder, CBool(SpinButton), CDbl(MinValue), CDbl(MaxValue), CDbl(Increment), CInt(Accuracy)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlNumericFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateNumericField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateNumericField + +REM ----------------------------------------------------------------------------- +Public Function CreatePatternField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal EditMask As Variant _ + , Optional ByVal LiteralMask As Variant _ + ) As Object +''' Create a new control of type PatternField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Editmask: a character code that determines what the user may enter +''' LiteralMask: contains the initial values that are displayed in the pattern field +''' More details on https://wiki.documentfoundation.org/Documentation/DevGuide/Graphical_User_Interfaces#Pattern_Field +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myPatternField = dialog.CreatePatternField("PatternField1", Array(20, 20, 60, 15), EditMask := "NNLNNLLLLL", LiteralMask := "__.__.2002") + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreatePatternField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [EditMask=""""], [LiteralMask=""""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(EditMask) Or IsEmpty(EditMask) Then EditMask = "" + If IsMissing(LiteralMask) Or IsEmpty(LiteralMask) Then LiteralMask = "" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(EditMask, "EditMask", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(LiteralMask, "LiteralMask", V_STRING) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "EditMask", "LiteralMask") + vPropValues = Array(iBorder, EditMask, LiteralMask) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlPatternFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreatePatternField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreatePatternField + +REM ----------------------------------------------------------------------------- +Public Function CreateProgressBar(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type ProgressBar in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinValue: the smallest value that can be entered in the control. Default = 0 +''' MaxValue: the largest value that can be entered in the control. Default = 100 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myProgressBar = dialog.CreateProgressBar("ProgressBar1", Array(20, 20, 60, 15), MaxValue := 1000) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateProgressBar" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100 + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "ProgressValueMin", "ProgressValueMax") + vPropValues = Array(iBorder, CLng(MinValue), CLng(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlProgressBarModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateProgressBar = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateProgressBar + +REM ----------------------------------------------------------------------------- +Public Function CreateRadioButton(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal MultiLine As Variant _ + ) As Object +''' Create a new control of type RadioButton in the actual dialog. +''' Specific args: +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myRadioButton = dialog.CreateRadioButton("RadioButton1", Array(20, 20, 60, 15), MultiLine := True) + +Dim oControl As Object ' Return value +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateRadioButton" +Const cstSubArgs = "ControlName, Place, [MultiLine=False]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + vPropNames = Array("VisualEffect", "MultiLine") + vPropValues = Array(1, CBool(MultiLine)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlRadioButtonModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateRadioButton = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateRadioButton + +REM ----------------------------------------------------------------------------- +Public Function CreateScrollBar(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Orientation As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinValue As Variant _ + , Optional ByVal MaxValue As Variant _ + ) As Object +''' Create a new control of type ScrollBar in the actual dialog. +''' Specific args: +''' Orientation: H[orizontal] or V[ertical] +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinValue: the smallest value that can be entered in the control. Dafault = 0 +''' MaxValue: the largest value that can be entered in the control. Dafault = 100 +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myScrollBar = dialog.CreateScrollBar("ScrollBar1", Array(20, 20, 60, 15), MaxValue := 1000) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateScrollBar" +Const cstSubArgs = "ControlName, Place, Orientation=""H""|""Horizontal""|""V""|""Vertical""" _ + & ", [Border=""3D""|""FLAT""|""NONE""], [MinValue=0], MaxValue=100]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinValue) Or IsEmpty(MinValue) Then MinValue = 0 + If IsMissing(MaxValue) Or IsEmpty(MaxValue) Then MaxValue = 100 + + If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, Array("H", "Horizontal", "V", "Vertical")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MinValue, "MinValue", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaxValue, "MaxValue", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "Orientation", "ScrollValueMin", "ScrollValueMax") + vPropValues = Array(iBorder, CLng(Iif(Left(UCase(Orientation), 1) = "V", 1, 0)), CLng(MinValue), CLng(MaxValue)) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlScrollBarModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateScrollBar = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateScrollBar + +REM ----------------------------------------------------------------------------- +Public Function CreateTableControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal RowHeaders As Variant _ + , Optional ByVal ColumnHeaders As Variant _ + , Optional ByVal ScrollBars As Variant _ + , Optional ByVal GridLines As Variant _ + ) As Object +''' Create a new control of type TableControl in the actual dialog. +''' To fill the table with data, use the SetTableData() method +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' RowHeaders: when True (default), the row Headerss are shown +''' ColumnHeaders: when True (default), the column Headerss are shown +''' ScrollBars: H[orizontal] or V[ertical] or B[oth] or N[one] (default) +''' Note that scrollbars always appear dynamically when they are needed +''' GridLines: when True (default = False) horizontal and vertical lines are painted between the grid cells +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTableControl = dialog.CreateTableControl("TableControl1", Array(20, 20, 60, 15), ScrollBars := "B") + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTableControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [RowHeaders=True], [ColumnHeaders=True]" _ + & ", [ScrollBars=""N""|""None""|""B""|""Both""|""H""|""Horizontal""|""V""|""Vertical""" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(RowHeaders) Or IsEmpty(RowHeaders) Then RowHeaders = True + If IsMissing(ColumnHeaders) Or IsEmpty(ColumnHeaders) Then ColumnHeaders = True + If IsMissing(ScrollBars) Or IsEmpty(ScrollBars) Then ScrollBars = "None" + If IsMissing(GridLines) Or IsEmpty(GridLines) Then GridLines = False + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(RowHeaders, "RowHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ColumnHeaders, "ColumnHeaders", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ScrollBars, "ScrollBars", V_STRING, Array("N", "None", "B", "Both", "H", "Horizontal", "V", "Vertical")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(GridLines, "GridLines", ScriptForge.V_BOOLEAN) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "ShowRowHeader", "ShowColumnHeader", "VScroll", "HScroll", "UseGridLines") + vPropValues = Array(iBorder, CBool(RowHeaders), CBool(ColumnHeaders) _ + , Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "V" _ + , Left(ScrollBars, 1) = "B" Or Left(ScrollBars, 1) = "H" _ + , CBool(GridLines) _ + ) + + ' Create the control + Set oControl = _CreateNewControl("grid.UnoControlGridModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTableControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTableControl + +REM ----------------------------------------------------------------------------- +Public Function CreateTextField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MultiLine As Variant _ + , Optional ByVal MaximumLength As Variant _ + , Optional ByVal PasswordCharacter As Variant _ + ) As Object +''' Create a new control of type TextField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MultiLine: When True (default = False), the caption may be displayed on more than one line +''' MaximumLength: the maximum character count (default = 0 meaning unlimited) +''' PasswordCharacter: a single character specifying the echo for a password text field (default = "") +''' MultiLine must be False to have PasswordCharacter being applied +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTextField = dialog.CreateTextField("TextField1", Array(20, 20, 120, 50), MultiLine := True) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim iPassword As Integer ' Integer alias of PasswordCharacter +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTextField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""], [MultiLine=False], [MaximumLength=0, [PasswordCharacter=""""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MultiLine) Or IsEmpty(MultiLine) Then MultiLine = False + If IsMissing(MaximumLength) Or IsEmpty(MaximumLength) Then MaximumLength = 0 + If IsMissing(PasswordCharacter) Or IsEmpty(PasswordCharacter) Then PasswordCharacter = "" + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MultiLine, "MultiLine", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MaximumLength, "MaximumLength", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(PasswordCharacter, "PasswordCharacter", V_STRING) Then GoTo Finally + + ' MultiLine has precedence over Password + If MultiLine Then PasswordCharacter = "" + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + If Len(PasswordCharacter) > 0 Then iPassword = Asc(Left(PasswordCharacter, 1)) Else iPassword = 0 + vPropNames = Array("Border", "MultiLine", "MaxTextLen", "EchoChar", "AutoVScroll") ' AutoHScroll not implemented ?? + vPropValues = Array(iBorder, CBool(MultiLine), CInt(MaximumLength), iPassword, True) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlEditModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTextField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTextField + +REM ----------------------------------------------------------------------------- +Public Function CreateTimeField(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + , Optional ByVal MinTime As Variant _ + , Optional ByVal MaxTime As Variant _ + ) As Object +''' Create a new control of type TimeField in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' MinTime: the smallest time that can be entered in the control. Dafault = 0 +''' MaxTime: the largest time that can be entered in the control. Dafault = 24h +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTimeField = dialog.CreateTimeField("TimeField1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return Time +Dim iBorder As Integer ' Alias of border +Dim oMinTime As New com.sun.star.util.Time +Dim oMaxTime As New com.sun.star.util.Time +Dim vFormats As Variant ' List of available time formats +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTimeField" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" _ + & ", [MinTime=TimeSerial(0, 0, 0)], [MaxTime=TimeSerial(23, 59, 59)]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If IsMissing(MinTime) Or IsEmpty(MinTime) Then MinTime = TimeSerial(0, 0, 0) + If IsMissing(MaxTime) Or IsEmpty(MaxTime) Then MaxTime = TimeSerial(23, 59, 59) + + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValiDate(MinTime, "MinTime", ScriptForge.V_DATE) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValiDate(MaxTime, "MaxTime", ScriptForge.V_DATE) Then GoTo Finally + vFormats = SF_DialogUtils._FormatsList("TimeField") + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + With oMinTime + .Hours = Hour(MinTime) : .Minutes = Minute(MinTime) : .Seconds = Second(MinTime) + End With + With oMaxTime + .Hours = Hour(MaxTime) : .Minutes = Minute(MaxTime) : .Seconds = Second(MaxTime) + End With + vPropNames = Array("Border", "TimeMin", "TimeMax", "TimeFormat") + vPropValues = Array(iBorder, oMinTime, oMaxTime, CInt(ScriptForge.SF_Array.IndexOf(vFormats(), "24h short"))) + + ' Create the control + Set oControl = _CreateNewControl("UnoControlTimeFieldModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTimeField = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDialogs.SF_Dialog.CreateTimeField + +REM ----------------------------------------------------------------------------- +Public Function CreateTreeControl(Optional ByVal ControlName As Variant _ + , Optional ByRef Place As Variant _ + , Optional ByVal Border As Variant _ + ) As Object +''' Create a new control of type TreeControl in the actual dialog. +''' Specific args: +''' Border: "3D" (default) or "FLAT" or "NONE" +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myTreeControl = dialog.CreateTreeControl("TreeControl1", Array(20, 20, 60, 15)) + +Dim oControl As Object ' Return value +Dim iBorder As Integer ' Alias of border +Dim vPropNames As Variant ' Array of names of specific arguments +Dim vPropValues As Variant ' Array of values of specific arguments +Const cstThisSub = "SFDialogs.Dialog.CreateTreeControl" +Const cstSubArgs = "ControlName, Place, [Border=""3D""|""FLAT""|""NONE""]" + +Check: + Set oControl = Nothing + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place) Then GoTo Finally + + If IsMissing(Border) Or IsEmpty(Border) Then Border = "3D" + If Not ScriptForge.SF_Utils._Validate(Border, "Border", V_STRING, Array("3D", "FLAT", "NONE")) Then GoTo Finally + +Try: + ' Manage specific properties + iBorder = ScriptForge.SF_Array.IndexOf(Array("NONE", "3D", "FLAT"), Border) + vPropNames = Array("Border", "SelectionType", "Editable", "ShowsHandles", "ShowsRootHandles") + vPropValues = Array(iBorder, com.sun.star.view.SelectionType.SINGLE, False, True, True) + + ' Create the control + Set oControl = _CreateNewControl("tree.TreeControlModel", ControlName, Place, vPropNames, vPropValues) + +Finally: + Set CreateTreeControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CreateTreeControl + REM ----------------------------------------------------------------------------- Public Sub EndExecute(Optional ByVal ReturnValue As Variant) ''' Ends the display of a modal dialog and gives back the argument @@ -845,6 +1979,27 @@ Public Function Methods() As Variant "Activate" _ , "Center" _ , "Controls" _ + , "CreateButton" _ + , "CreateCheckBox" _ + , "CreateComboBox" _ + , "CreateCurrencyField" _ + , "CreateDateField" _ + , "CreateFileControl" _ + , "CreateFixedLine" _ + , "CreateFixedText" _ + , "CreateFormattedField" _ + , "CreateGroupBox" _ + , "CreateImageControl" _ + , "CreateListBox" _ + , "CreateNumericField" _ + , "CreatePatternField" _ + , "CreateProgressBar" _ + , "CreateRadioButton" _ + , "CfeateScrollBar" _ + , "CreateTableControl" _ + , "CreateTextField" _ + , "CreateTimeField" _ + , "CreateTreeControl" _ , "EndExecute" _ , "Execute" _ , "GetTextsFromL10N" _ @@ -1104,6 +2259,133 @@ End Function ' SFDialogs.SF_Dialog.Terminate REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- +Private Function _CheckNewControl(cstThisSub As String, cstSubArgs As String _ + , Optional ByVal ControlName As Variant _ + , ByRef Place As Variant _ + ) As Boolean +''' Check the generic arguments of a CreateXXX() method for control creation. +''' Called by the CreateButton, CreateCheckBox, ... specific methods +''' Args: +''' cstThisSub, cstSubArgs: caller routine and its arguments +''' Name: the name of the new control. It must not exist yet +''' Place: the size and position expressed in APPFONT units, either +''' - an array (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle structure +''' Exceptions: +''' DUPLICATECONTROLERROR A control with the same name exists already +''' Returns: +''' True when arguments passed the check + +Dim bCheck As Boolean ' Return value + + bCheck = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ControlName, "ControlName", V_STRING) Then GoTo Finally + If IsArray(Place) Then + If Not ScriptForge.SF_Utils._ValidateArray(Place, "Place", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Place, "Place", ScriptForge.V_OBJECT) Then GoTo Finally + End If + End If + If _DialogModel.hasByName(ControlName) Then GoTo CatchDuplicate + + bCheck = True + +Finally: + _CheckNewControl = bCheck + ' Call to _ExitFunction is done in the caller to allow handling of specific arguments + Exit Function +CatchDuplicate: + ScriptForge.SF_Exception.RaiseFatal(DUPLICATECONTROLERROR, "ControlName", ControlName, _Name) + GoTo Finally +End Function ' SFDialogs.SF_Dialog._CheckNewControl + +REM ----------------------------------------------------------------------------- +Private Function _CreateNewControl(ByVal psType As String _ + , ByVal ControlName As Variant _ + , ByRef Place As Variant _ + , ByRef ArgNames As Variant _ + , ByRef ArgValues As Variant _ + ) As Object +''' Generic creation of a new control. +''' Called by the CreateButton, CreateCheckBox, ... specific methods +''' Args: +''' cstThisSub, cstSubArgs: caller routine and its arguments +''' psType: one of the UnoControlxxx control models +''' Name: the name of the new control. It must not exist yet +''' Place: the size and position expressed in APPFONT units, either +''' - an array (X, Y, Width, Height) +''' - a com.sun.star.awt.Rectangle structure +''' ArgNames: the list of the specific arguments linked to the given psType +''' ArgValues: their values +''' Returns: +''' A new SF_DialogControl class instance or Nothing if creation failed + +Dim oControl As Object ' Return value +Dim oControlModel As Object ' com.sun.star.awt.XControlModel +Dim vPlace As Variant ' Alias of Place when object to avoid "Object variable not set" error +Dim lCache As Long ' Number of elements in the controls cache +Static oSession As Object + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oControl = Nothing + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + +Try: + ' Create a new (empty) model instance + Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & psType) + + oControlModel.Name = ControlName + + ' Set dimension and position + With oControlModel + If IsArray(Place) Then + If UBound(Place) = 3 Then + .PositionX = Place(0) + .PositionY = Place(1) + .Width = Place(2) + .Height = Place(3) + End If + ElseIf oSession.UnoObjectType(Place) = "com.sun.star.awt.Rectangle" Then + Set vPlace = Place + .PositionX = vPlace.X + .PositionY = vPlace.Y + .Width = vPlace.Width + .Height = vPlace.Height + Else + 'Leave eveything to zero + End If + End With + + ' Store the specific propertes in the model + If UBound(ArgNames) >= 0 Then oControlModel.setPropertyValues(ArgNames, ArgValues) + + ' Insert the new completed control model in the dialog + _DialogModel.insertByName(ControlName, oControlModel) + + ' Update controls cache - existing cache is presumed unchanged: new control is added at the end of Model.ElementNames + lCache = UBound(_ControlCache) + If lCache < 0 Then + ReDim _ControlCache(0 To 0) + Else + ReDim Preserve _ControlCache(0 To lCache + 1) + End If + + ' Now the UNO control exists, build the SF_DialogControl instance as usual + Set oControl = Controls(ControlName) + +Finally: + Set _CreateNewControl = oControl + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog._CreateNewControl + +REM ----------------------------------------------------------------------------- Private Function _FindRadioSiblings(ByVal psRadioButton As String) As String ''' Given the name of the first radio button of a group, return all the names of the group ''' For dialogs, radio buttons are considered of the same group @@ -1213,6 +2495,7 @@ Public Sub _Initialize() ''' - Addition of the new object in the Dialogs buffer ''' - Initialisation of persistent storage for controls +Dim lControls As Long ' Number of controls at dialog creation Try: ' Keep reference to model Set _DialogModel = _DialogControl.Model @@ -1230,7 +2513,8 @@ Try: ' Size the persistent storage _ControlCache = Array() - ReDim _ControlCache(0 To UBound(_DialogModel.getElementNames())) + lControls = UBound(_DialogModel.getElementNames()) + If lControls >= 0 Then ReDim _ControlCache(0 To lControls) Finally: Exit Sub diff --git a/wizards/source/sfdialogs/SF_DialogControl.xba b/wizards/source/sfdialogs/SF_DialogControl.xba index ddcd7f4aab99..cc4f6ca7dd13 100644 --- a/wizards/source/sfdialogs/SF_DialogControl.xba +++ b/wizards/source/sfdialogs/SF_DialogControl.xba @@ -232,6 +232,18 @@ End Function ' SFDialogs.SF_DialogControl Explicit Destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- +Property Get Border() As Variant +''' The Border property refers to the surrounding of the control: 3D, FLAT or NONE + Border = _PropertyGet("Border", "") +End Property ' SFDialogs.SF_DialogControl.Border (get) + +REM ----------------------------------------------------------------------------- +Property Let Border(Optional ByVal pvBorder As Variant) +''' Set the updatable property Border + _PropertySet("Border", pvBorder) +End Property ' SFDialogs.SF_DialogControl.Border (let) + +REM ----------------------------------------------------------------------------- Property Get Cancel() As Variant ''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button. Cancel = _PropertyGet("Cancel", False) @@ -308,7 +320,6 @@ End Property ' SFDialogs.SF_DialogControl.Format (get) REM ----------------------------------------------------------------------------- Property Let Format(Optional ByVal pvFormat As Variant) ''' Set the updatable property Format -''' NB: Format is read-only for formatted field controls _PropertySet("Format", pvFormat) End Property ' SFDialogs.SF_DialogControl.Format (let) @@ -618,6 +629,19 @@ Property Let RowSource(Optional ByVal pvRowSource As Variant) End Property ' SFDialogs.SF_DialogControl.RowSource (let) REM ----------------------------------------------------------------------------- +Property Get TabIndex() As Variant +''' The TabIndex property specifies a control's place in the tab order in the dialog +''' Zero or negative means no tab set in the control + TabIndex = _PropertyGet("TabIndex", -1) +End Property ' SFDialogs.SF_DialogControl.TabIndex (get) + +REM ----------------------------------------------------------------------------- +Property Let TabIndex(Optional ByVal pvTabIndex As Variant) +''' Set the updatable property TabIndex + _PropertySet("TabIndex", pvTabIndex) +End Property ' SFDialogs.SF_DialogControl.TabIndex (let) + +REM ----------------------------------------------------------------------------- Property Get Text() As Variant ''' The Text property specifies the actual content of the control like it is displayed on the screen Text = _PropertyGet("Text", "") @@ -1108,7 +1132,8 @@ Public Function Properties() As Variant ''' Return the list or properties of the Timer class as an array Properties = Array( _ - "Cancel" _ + "Border" _ + , "Cancel" _ , "Caption" _ , "ControlType" _ , "CurrentNode" _ @@ -1142,6 +1167,7 @@ Public Function Properties() As Variant , "Picture" _ , "RootNode" _ , "RowSource" _ + , "TabIndex" _ , "Text" _ , "TipText" _ , "TripleState" _ @@ -1263,6 +1289,7 @@ REM ---------------------------------------------------------------------------- Public Function SetTableData(Optional ByRef DataArray As Variant _ , Optional ByRef Widths As Variant _ , Optional ByRef Alignments As Variant _ + , Optional ByVal RowHeaderWidth As Variant _ ) As Boolean ''' Fill a table control with the given data. Preexisting data is erased ''' The Basic IDE allows to define if the control has a row and/or a column header @@ -1274,15 +1301,17 @@ Public Function SetTableData(Optional ByRef DataArray As Variant _ ''' Args: ''' DataArray: the set of data to display in the table control, including optional column/row headers ''' Is a 2D array in Basic, is a tuple of tuples when called from Python -''' Widths: the column's relative widths as a 1D array, each element corresponding with a column +''' Widths: the column's relative widths as a 1D array, each element corresponding with one data column ''' If the array is shorter than the number of columns, the last value is kept for the next columns. ''' Example: ''' Widths := Array(1, 2) ''' means that the first column is half as wide as all the other columns -''' When the argument is absent, the columns are evenly spread over the control +''' When the argument is absent, the columns are evenly spread over the available space in the control ''' Alignments: the column's horizontal alignment as a string with length = number of columns. ''' Possible characters are: ''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour) +''' RowGeaderWidth: width of the row header column expressed in AppFont units. Default = 10. +''' The argument is ignored when the TableControl has no row header. ''' Returns: ''' True when successful ''' Examples: @@ -1312,28 +1341,30 @@ Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn Dim dWidth As Double ' A single item of Widths Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths +Dim lHeaderWidth As Long ' Row header width when row header present, otherwise = 0 +Dim lAverageWidth As Long ' Width to apply when columns spead evenly across table Dim vDataRow As Variant ' A single row content in the tablecontrol Dim vDataItem As Variant ' A single DataArray item Dim sAlign As String ' Column's horizontal alignments (single chars: L, C, R, space) Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX Dim i As Long, j As Long, k As Long -Const cstRowHdrWidth = 12 ' Estimated width of the row header - Const cstThisSub = "SFDialogs.DialogControl.SetTableData" -Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""]" +Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""], [RowHeaderWidth=10]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bData = False Check: - If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array(1) + If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array() If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = "" + If IsMissing(RowHeaderWidth) Or IsEmpty(RowHeaderWidth) Then RowHeaderWidth = 10 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If _ControlType <> CTLTABLECONTROL Then GoTo CatchType If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(RowHeaderWidth, "RowHeaderWidth", ScriptForge.V_NUMERIC) Then GoTo Catch End If Try: @@ -1395,6 +1426,15 @@ Try: If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j) _GridColumnModel.addColumn(oColumn) Next j + + ' Manage row headers width + If _ControlModel.ShowRowHeader Then + lHeaderWidth = RowHeaderWidth + _ControlModel.RowHeaderWidth = lHeaderWidth + Else + lHeaderWidth = 0 + End If + ' Size the columns. Column sizing cannot be done before all the columns are added If lMaxW >= lMinW Then ' There must be at least 1 width given as argument ' Size the columns proportionally with their relative widths @@ -1405,8 +1445,9 @@ Try: i = i + 1 If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW) Next j - ' Set absolute widths - If dRelativeWidth > 0.0 Then dWidthFactor = CDbl((_ControlModel.Width - cstRowHdrWidth) / dRelativeWidth) Else dWidthFactor = 1.0 + + ' Set absolute column widths + If dRelativeWidth > 0.0 Then dWidthFactor = CDbl(_ControlModel.Width - lHeaderWidth) / dRelativeWidth Else dWidthFactor = 1.0 i = lMinW - 1 For j = 0 To lMax2 - lMinCol i = i + 1 @@ -1414,9 +1455,10 @@ Try: _GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth) Next j Else - ' Size all columns evenly + ' Size header and columns evenly + lAverageWidth = (_ControlModel.Width - lHeaderWidth) / (lMax2 - lMin2 + 1) For j = 0 To lMax2 - lMinCol - _GridColumnModel.Columns(j).ColumnWidth = (_ControlModel.Width - cstRowHdrWidth) / (lMax2 - lMonCol + 1) + _GridColumnModel.Columns(j).ColumnWidth = lAverageWidth Next j End If @@ -1598,43 +1640,6 @@ Finally: End Function ' SFDialogs.SF_DialogControl._FindNode REM ----------------------------------------------------------------------------- -Private Function _FormatsList() As Variant -''' Return the allowed format entries as a zero-based array for Date and Time control types - -Dim vFormats() As Variant ' Return value - - Select Case _ControlType - Case CTLDATEFIELD - vFormats = Array( _ - "Standard (short)" _ - , "Standard (short YY)" _ - , "Standard (short YYYY)" _ - , "Standard (long)" _ - , "DD/MM/YY" _ - , "MM/DD/YY" _ - , "YY/MM/DD" _ - , "DD/MM/YYYY" _ - , "MM/DD/YYYY" _ - , "YYYY/MM/DD" _ - , "YY-MM-DD" _ - , "YYYY-MM-DD" _ - ) - Case CTLTIMEFIELD - vFormats = Array( _ - "24h short" _ - , "24h long" _ - , "12h short" _ - , "12h long" _ - ) - Case Else - vFormats = Array() - End Select - - _FormatsList = vFormats - -End Function ' SFDialogs.SF_DialogControl._FormatsList - -REM ----------------------------------------------------------------------------- Public Function _GetEventName(ByVal psProperty As String) As String ''' Return the LO internal event name derived from the SF property name ''' The SF property name is not case sensitive, while the LO name is case-sensitive @@ -1764,6 +1769,16 @@ Const cstSubArgs = "" If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") Select Case UCase(psProperty) + Case UCase("Border") + Select Case _ControlType + Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _ + , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _ + , CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If oSession.HasUNOProperty(_ControlModel, "Border") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.Border) + Case CTLCHECKBOX, CTLRADIOBUTTON + If oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then _PropertyGet = Array("NONE", "3D", "FLAT")(_ControlModel.VisualEffect) + Case Else : GoTo CatchType + End Select Case UCase("Cancel") Select Case _ControlType Case CTLBUTTON @@ -1805,9 +1820,9 @@ Const cstSubArgs = "" Case UCase("Format") Select Case _ControlType Case CTLDATEFIELD - If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat) + If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.DateFormat) Case CTLTIMEFIELD - If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat) + If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = SF_DialogUtils._FormatsList(_ControlType)(_ControlModel.TimeFormat) Case CTLFORMATTEDFIELD If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString @@ -1939,6 +1954,16 @@ Const cstSubArgs = "" End If Case Else : GoTo CatchType End Select + Case UCase("TabIndex") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _ + , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _ + , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then + If CBool(_ControlModel.TabStop) Or IsEmpty(_ControlModel.TabStop) Then _PropertyGet = _ControlModel.TabIndex Else _PropertyGet = 0 + End If + Case Else : GoTo CatchType + End Select Case UCase("Text") Select Case _ControlType Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD @@ -1965,7 +1990,7 @@ Const cstSubArgs = "" Case CTLBUTTON 'Boolean, toggle buttons only vGet = False If oSession.HasUnoProperty(_ControlModel, "Toggle") Then - If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) + If oSession.HasUnoProperty(_ControlModel, "State") And _ControlMOdel.Toggle Then vGet = ( _ControlModel.State = 1 ) End If Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2 @@ -2092,8 +2117,12 @@ Private Function _PropertySet(Optional ByVal psProperty As String _ Dim bSet As Boolean ' Return value Static oSession As Object ' Alias of SF_Session Dim vSet As Variant ' Value to set in UNO model or view property +Dim vBorders As Variant ' Array of allowed Border vaues Dim vFormats As Variant ' Format property: output of _FormatsList() Dim iFormat As Integer ' Format property: index in vFormats +Dim oNumberFormats As Object ' com.sun.star.util.XNumberFormats +Dim lFormatKey As Long ' Format index for formatted fields +Dim oLocale As Object ' com.sun.star.lang.Locale Dim vSelection As Variant ' Alias of Model.SelectedItems Dim vList As Variant ' Alias of Model.StringItemList Dim lIndex As Long ' Index in StringItemList @@ -2113,6 +2142,21 @@ Const cstSubArgs = "Value" If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") bSet = True Select Case UCase(psProperty) + Case UCase("Border") + Select Case _ControlType + Case CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT, CTLFORMATTEDFIELD _ + , CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD, CTLPROGRESSBAR _ + , CTLRADIOBUTTON, CTLSCROLLBAR , CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + vBorders = Array("NONE", "3D", "FLAT") + If Not ScriptForge.SF_Utils._Validate(pvValue, "Border", V_STRING, vBorders) Then GoTo Finally + vSet = ScriptForge.SF_Array.IndexOf(vBorders, pvValue) + If oSession.HasUNOProperty(_ControlModel, "Border") Then + _ControlModel.Border = vSet + ElseIf oSession.HasUNOProperty(_ControlModel, "VisualEffect") Then ' Checkbox case + _ControlModel.VisualEffect = vSet + End If + Case Else : GoTo CatchType + End Select Case UCase("Cancel") Select Case _ControlType Case CTLBUTTON @@ -2160,7 +2204,7 @@ Const cstSubArgs = "Value" Case UCase("Format") Select Case _ControlType Case CTLDATEFIELD, CTLTIMEFIELD - vFormats = _FormatsList() + vFormats = SF_DialogUtils._FormatsList(_ControlType) If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False) If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then @@ -2168,6 +2212,20 @@ Const cstSubArgs = "Value" ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _ControlModel.TimeFormat = iFormat End If + Case CTLFORMATTEDFIELD ' The format may exist already or not yet + If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING) Then GoTo Finally + If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") Then + If Not IsNull(_ControlModel.FormatsSupplier) Then + Set oLocale = ScriptForge.SF_Utils._GetUnoService("FormatLocale") + Set oNumberFormats = _ControlModel.FormatsSupplier.getNumberFormats() + lFormatKey = oNumberFormats.queryKey(pvValue, oLocale, True) + If lFormatKey < 0 Then ' Format not found + _ControlModel.FormatKey = oNumberFormats.addNew(pvValue, oLocale) + Else + _ControlModel.FormatKey = lFormatKey + End If + End If + End If Case Else : GoTo CatchType End Select Case UCase("Height") @@ -2296,6 +2354,18 @@ Const cstSubArgs = "Value" If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue Case Else : GoTo CatchType End Select + Case UCase("TabIndex") + Select Case _ControlType + Case CTLBUTTON, CTLCHECKBOX, CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFIXEDTEXT _ + , CTLFORMATTEDFIELD, CTLHYPERLINK, CTLIMAGECONTROL, CTLLISTBOX, CTLNUMERICFIELD, CTLPATTERNFIELD _ + , CTLRADIOBUTTON, CTLSCROLLBAR, CTLTABLECONTROL, CTLTEXTFIELD, CTLTIMEFIELD, CTLTREECONTROL + If Not ScriptForge.SF_Utils._Validate(pvValue, "TabIndex", ScriptForge.V_NUMERIC) Then GoTo Finally + If oSession.HasUnoProperty(_ControlModel, "TabIndex") Then + _ControlModel.TabStop = ( pvValue > 0 ) + _ControlModel.TabIndex = Iif(pvValue > 0, pvValue, -1) + End If + Case Else : GoTo CatchType + End Select Case UCase("TipText") If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue @@ -2318,7 +2388,7 @@ Const cstSubArgs = "Value" Case CTLBUTTON 'Boolean, toggle buttons only If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then - _ControlModel.State = Iif(pvValue, 1, 0) + If _ControlModel.Toggle Then _ControlModel.State = Iif(pvValue, 1, 0) Else _ControlModel.State = 2 End If Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally diff --git a/wizards/source/sfdialogs/SF_DialogUtils.xba b/wizards/source/sfdialogs/SF_DialogUtils.xba index 52412b4bd799..e364acac46d3 100644 --- a/wizards/source/sfdialogs/SF_DialogUtils.xba +++ b/wizards/source/sfdialogs/SF_DialogUtils.xba @@ -158,6 +158,49 @@ Try: End Function ' SFDialogs.SF_DialogUtils._ConvertToAppFont REM ----------------------------------------------------------------------------- +Private Function _FormatsList(psControlType) As Variant +''' Return the list of the allowed formats for Date and Time control types +''' Args: +''' DateField or TimeField control +''' Returns: +''' The allowed format entries as a zero-based array + +Dim vFormats() As Variant ' Return value +Const CTLDATEFIELD = "DateField" +Const CTLTIMEFIELD = "TimeField" + + Select Case psControlType + Case CTLDATEFIELD + vFormats = Array( _ + "Standard (short)" _ + , "Standard (short YY)" _ + , "Standard (short YYYY)" _ + , "Standard (long)" _ + , "DD/MM/YY" _ + , "MM/DD/YY" _ + , "YY/MM/DD" _ + , "DD/MM/YYYY" _ + , "MM/DD/YYYY" _ + , "YYYY/MM/DD" _ + , "YY-MM-DD" _ + , "YYYY-MM-DD" _ + ) + Case CTLTIMEFIELD + vFormats = Array( _ + "24h short" _ + , "24h long" _ + , "12h short" _ + , "12h long" _ + ) + Case Else + vFormats = Array() + End Select + + _FormatsList = vFormats + +End Function ' SFDialogs.SF_DialogUtils._FormatsList + +REM ----------------------------------------------------------------------------- Public Function _Resize(ByRef Control As Object _ , Optional ByVal Left As Variant _ , Optional ByVal Top As Variant _ @@ -165,7 +208,9 @@ Public Function _Resize(ByRef Control As Object _ , Optional ByVal Height As Variant _ ) As Boolean ''' Move the top-left corner of a dialog or a dialog control to new coordinates and/or modify its dimensions -''' Without arguments, the method resets the initial dimensions +''' Without arguments, the method either: +''' leaves the position unchanged and computes best fit dimensions +''' resets the initial position and dimensions (Scrollbar, ProgressBar, FixedLine, GroupBox, TreeControl", TableControl) ''' Attributes denoting the position and size of a dialog are expressed in "Map AppFont" units. ''' Map AppFont units are device and resolution independent. ''' One Map AppFont unit is equal to one eighth of the average character (Systemfont) height and one quarter of the average character width. @@ -186,7 +231,9 @@ Dim oView As Object ' View of Control object Dim Displayed As Boolean ' When Trs, the dialog is currently active Dim oSize As Object ' com.sun.star.awt.Size Dim oPoint As Object ' com.sun.star.awt.Point +Dim oPreferredSize As Object ' com.sun.star.awt.Size Dim iFlags As Integer ' com.sun.star.awt.PosSize constants +Static oSession As Object ' SF_Session alias Dim cstThisSub As String Const cstSubArgs = "[Left], [Top], [Width], [Height]" @@ -222,12 +269,22 @@ Try: Displayed = .[Parent]._Displayed Case Else End Select - ' Reset factory settings when relevant + ' Manage absence of arguments: best fit or reset If Left = MINPOSITION And Top = MINPOSITION And Width = -1 And Height = -1 Then - Left = ._Left - Top = ._Top - Width = ._Width - Height = ._Height + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") + If oSession.HasUnoMethod(oView, "getPreferredSize") Then + ' Compute a best fit size when relevant + Set oPreferredSize = oView.getPreferredSize() + Set oSize = SF_DialogUtils._ConvertSizeToAppFont(oView, oPreferredSize.Width, oPreferredSize.Height) + Width = oSize.Width + Height = oSize.Height + Else + ' Reset factory settings otherwise + Left = ._Left + Top = ._Top + Width = ._Width + Height = ._Height + End If End If End With |