diff options
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 3 | ||||
| -rw-r--r-- | wizards/source/sfdialogs/SF_Dialog.xba | 93 |
2 files changed, 81 insertions, 15 deletions
diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index 76845c71e75d..96474e4eb4de 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -1866,6 +1866,9 @@ class SFDialogs: parentobj = parent.objectreference if isinstance(parent, parentclasses) else parent return self.ExecMethod(self.vbMethod + self.flgObject + self.flgHardCode, 'Center', parentobj) + def CloneControl(self, sourcename, controlname, left = 1, top = 1): + return self.ExecMethod(self.vbMethod, 'CloneControl', sourcename, controlname, left, top) + def Controls(self, controlname = ''): return self.ExecMethod(self.vbMethod + self.flgArrayRet + self.flgHardCode, 'Controls', controlname) diff --git a/wizards/source/sfdialogs/SF_Dialog.xba b/wizards/source/sfdialogs/SF_Dialog.xba index cf32bf92629b..21e307b99995 100644 --- a/wizards/source/sfdialogs/SF_Dialog.xba +++ b/wizards/source/sfdialogs/SF_Dialog.xba @@ -572,6 +572,58 @@ Catch: End Function ' SF_Documents.SF_Dialog.Center REM ----------------------------------------------------------------------------- +Public Function CloneControl(Optional ByVal SourceName As Variant _ + , Optional ByVal ControlName As Variant _ + , Optional ByVal Left As Variant _ + , Optional ByVal Top As Variant _ + ) As Object +''' Duplicate an existing control of any type in the actual dialog. +''' The duplicated control is left unchanged. The new control can be relocated. +''' Specific args: +''' SourceName: the name of the control to duplicate +''' ControlName: the name of the new control. It must not exist yet +''' Left, Top: the coordinates of the new control expressed in "Map AppFont" units +''' Returns: +''' an instance of the SF_DialogControl class or Nothing +''' Example: +''' Set myButton2 = dialog.CloneControl("Button1", "Button2", 30, 30) + +Dim oControl As Object ' Return value +Dim oSourceModel As Object ' com.sun.star.awt.XControlModel of the source +Dim oControlModel As Object ' com.sun.star.awt.XControlModel of the new control +Const cstThisSub = "SFDialogs.Dialog.CloneControl" +Const cstSubArgs = "SourceName, ControlName, [Left=1], [Top=1]" + +Check: + Set oControl = Nothing + + If IsMissing(Left) Or IsEmpty(Left) Then Left = 1 + If IsMissing(Top) Or IsEmpty(Top) Then Top = 1 + + If Not _CheckNewControl(cstThisSub, cstSubArgs, ControlName, Place := Null) Then GoTo Finally + + If Not ScriptForge.SF_Utils._Validate(SourceName, "SourceName", V_String, _DialogModel.getElementNames()) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Left, "Left", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Top, "Top", ScriptForge.V_NUMERIC) Then GoTo Finally + +Try: + ' All control types are presumes cloneable + Set oSourceModel = _DialogModel.getByName(SourceName) + Set oControlModel = oSourceModel.createClone() + oControlModel.Name = ControlName + + ' Create the control + Set oControl = _CreateNewControl(oControlModel, ControlName, Array(Left, Top)) + +Finally: + Set CloneControl = oControl + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDialogs.SF_Dialog.CloneControl + +REM ----------------------------------------------------------------------------- Public Function Controls(Optional ByVal ControlName As Variant) As Variant ''' Return either ''' - the list of the controls contained in the dialog @@ -2069,6 +2121,7 @@ Public Function Methods() As Variant Methods = Array( _ "Activate" _ , "Center" _ + , "CloneControl" _ , "Controls" _ , "CreateButton" _ , "CreateCheckBox" _ @@ -2178,7 +2231,7 @@ Try: Next i bOrder = True - + Finally: OrderTabs = bOrder SF_Utils._ExitFunction(cstThisSub) @@ -2443,10 +2496,10 @@ Private Function _CheckNewControl(cstThisSub As String, cstSubArgs As String _ ''' 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 +''' cstThisSub, cstSubArgs: caller routine and its arguments. Used to formulate an error message, if any. +''' ControlName: 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) +''' - an array (X, Y, Width, Height) or Array(x, Y) ''' - a com.sun.star.awt.Rectangle structure ''' Exceptions: ''' DUPLICATECONTROLERROR A control with the same name exists already @@ -2463,7 +2516,7 @@ Check: 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 + ElseIf Not IsNull(Place) Then If Not ScriptForge.SF_Utils._Validate(Place, "Place", ScriptForge.V_OBJECT) Then GoTo Finally End If End If @@ -2481,22 +2534,22 @@ CatchDuplicate: End Function ' SFDialogs.SF_Dialog._CheckNewControl REM ----------------------------------------------------------------------------- -Private Function _CreateNewControl(ByVal psType As String _ +Private Function _CreateNewControl(ByVal pvModel As Variant _ , ByVal ControlName As Variant _ , ByRef Place As Variant _ - , ByRef ArgNames As Variant _ - , ByRef ArgValues As Variant _ + , Optional ByRef ArgNames As Variant _ + , Optional 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 +''' pvModel: one of the UnoControlxxx control models (as a string) +''' or such a model as a UNO class instance (cloned from an existing control) +''' ControlName: 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 +''' ArgNames: the list of the specific arguments linked to the given pvModel ''' ArgValues: their values ''' Returns: ''' A new SF_DialogControl class instance or Nothing if creation failed @@ -2507,23 +2560,33 @@ Dim vPlace As Variant ' Alias of Place when object to avoid "Object Dim lCache As Long ' Number of elements in the controls cache Static oSession As Object +Check: 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") + If IsMissing(ArgNames) Or IsEmpty(ArgNames) Then ArgNames = Array() + If IsMissing(ArgValues) Or IsEmpty(ArgValues) Then ArgValues = Array() + Try: - ' Create a new (empty) model instance - Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & psType) + ' When rhe model is a string, create a new (empty) model instance + Select Case VarType(pvModel) + Case V_STRING : Set oControlModel = _DialogModel.createInstance("com.sun.star.awt." & pvModel) + Case ScriptForge.V_OBJECT : Set oControlModel = pvModel + End Select oControlModel.Name = ControlName ' Set dimension and position With oControlModel If IsArray(Place) Then - If UBound(Place) = 3 Then + ' Ignore width and height when new control is cloed from an existing one + If UBound(Place) >= 1 Then .PositionX = Place(0) .PositionY = Place(1) + End If + If UBound(Place) >= 3 Then .Width = Place(2) .Height = Place(3) End If |