diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2022-11-04 16:54:41 +0100 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2022-11-05 17:10:41 +0100 |
| commit | 18638efa3973bf919a2502866773c02b7c24f7d7 (patch) | |
| tree | 79159bfed99824cbc0928c666ad329aae8f7bebc /wizards/source | |
| parent | e0a5a201d4170f4dac23a0e1aa8df18918549991 (diff) | |
ScriptForge - (SF_Datasheet) new menu methods
Next 2 methods are added:
CreateMenu()
RemoveMenu()
They allow the addition of a menu entry in the menubar
of datasheets in the same way as in documents.
The implementation required to make the
SFWidgets.SF_Menu
SFWidgets.SF_MenuListener
SFWidgets.SF_Register
classes and modules more generic to be applicable
in several contexts.
In addition, 2 properties are added:
DatabaseFileName
ParentDatabase
to better identify the database from which the datasheet
is derived.
New properties and methods are applicable both
for Basic and Python user scripts.
Change-Id: Iac6318287e89b18810a53ec5928a68e921ea96db
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/142285
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Diffstat (limited to 'wizards/source')
| -rw-r--r-- | wizards/source/scriptforge/SF_UI.xba | 2 | ||||
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 11 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Database.xba | 4 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Datasheet.xba | 167 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Register.xba | 59 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Base.xba | 6 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 2 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Form.xba | 6 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Menu.xba | 10 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_MenuListener.xba | 5 | ||||
| -rw-r--r-- | wizards/source/sfwidgets/SF_Register.xba | 16 |
11 files changed, 234 insertions, 54 deletions
diff --git a/wizards/source/scriptforge/SF_UI.xba b/wizards/source/scriptforge/SF_UI.xba index 8d2b78e3714b..186d88244d75 100644 --- a/wizards/source/scriptforge/SF_UI.xba +++ b/wizards/source/scriptforge/SF_UI.xba @@ -1364,4 +1364,4 @@ Private Function _Repr() As String End Function ' ScriptForge.SF_UI._Repr REM ============================================ END OF SCRIPTFORGE.SF_UI -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index 940c355f1e44..24a4aac8d70f 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -1777,8 +1777,9 @@ class SFDatabases: serviceimplementation = 'basic' servicename = 'SFDatabases.Datasheet' servicesynonyms = ('datasheet', 'sfdatabases.datasheet') - serviceproperties = dict(ColumnHeaders = False, CurrentColumn = False, CurrentRow = False, LastRow = False, - SOurce = False, SourceType = False, XComponent = False, XControlModel = False, + serviceproperties = dict(ColumnHeaders = False, CurrentColumn = False, CurrentRow = False, + DatabaseFileName = False, LastRow = False, ParentDatabase = False, Source = False, + SourceType = False, XComponent = False, XControlModel = False, XTabControllerModel = False) def Activate(self): @@ -1790,6 +1791,9 @@ class SFDatabases: def CloseDatasheet(self): return self.ExecMethod(self.vbMethod, 'CloseDatasheet') + def CreateMenu(self, menuheader, before = '', submenuchar = '>'): + return self.ExecMethod(self.vbMethod, 'CreateMenu', menuheader, before, submenuchar) + def GetText(self, column = 0): return self.ExecMethod(self.vbMethod, 'GetText', column) @@ -1802,6 +1806,9 @@ class SFDatabases: def OrderBy(self, order = ''): return self.ExecMethod(self.vbMethod, 'OrderBy', order) + def RemoveMenu(self, menuheader): + return self.ExecMethod(self.vbMethod, 'RemoveMenu', menuheader) + # ##################################################################################################################### # SFDialogs CLASS (alias of SFDialogs Basic library) ### diff --git a/wizards/source/sfdatabases/SF_Database.xba b/wizards/source/sfdatabases/SF_Database.xba index 6994f791a433..f0dec87c294e 100644 --- a/wizards/source/sfdatabases/SF_Database.xba +++ b/wizards/source/sfdatabases/SF_Database.xba @@ -897,7 +897,7 @@ Try: ' Setup the dispatcher Set oURL = New com.sun.star.util.URL oURL.Complete = ".component:DB/DataSourceBrowser" - Set oDispatch = StarDesktop.queryDispatch(oURL, "_Blank", 8) + Set oDispatch = StarDesktop.queryDispatch(oURL, "_blank", com.sun.star.frame.FrameSearchFlag.CREATE) ' Setup the arguments of the component to create With ScriptForge.SF_Utils @@ -916,7 +916,7 @@ Try: ' Open the targeted datasheet Set oNewDatasheet = oDispatch.dispatchWithReturnValue(oURL, vArgs) - If Not IsNull(oNewDatasheet) Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", [Me], oNewDatasheet) + If Not IsNull(oNewDatasheet) Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", oNewDatasheet, [Me]) Finally: Set _OpenDatasheet = oOpen diff --git a/wizards/source/sfdatabases/SF_Datasheet.xba b/wizards/source/sfdatabases/SF_Datasheet.xba index 743e2ca3ea86..f085ac510a60 100644 --- a/wizards/source/sfdatabases/SF_Datasheet.xba +++ b/wizards/source/sfdatabases/SF_Datasheet.xba @@ -123,6 +123,12 @@ Property Get CurrentRow() As Long End Property ' SFDatabases.SF_Datasheet.CurrentRow REM ----------------------------------------------------------------------------- +Property Get DatabaseFileName() As String +''' Returns the file name of the Base file in FSO.FileNaming format + DatabaseFileName = _PropertyGet("DatabaseFileName") +End Property ' SFDatabases.SF_Datasheet.DatabaseFileName + +REM ----------------------------------------------------------------------------- Property Get LastRow() As Long ''' Returns the total number of rows ''' The process may imply to move the cursor to the last available row. @@ -131,6 +137,12 @@ Property Get LastRow() As Long End Property ' SFDatabases.SF_Datasheet.LastRow REM ----------------------------------------------------------------------------- +Property Get ParentDatabase() As Object +''' Returns the database instance to which the datasheet belongs + Set ParentDatabase = _PropertyGet("ParentDatabase") +End Property ' SFDatabases.SF_Datasheet.ParentDatabase + +REM ----------------------------------------------------------------------------- Property Get Source() As String ''' Returns the source of the data: table name, query name or sql statement Source = _PropertyGet("Source") @@ -283,6 +295,60 @@ Catch: End Function ' SFDatabases.SF_Datasheet.CloseDatasheet REM ----------------------------------------------------------------------------- +Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ + , Optional ByVal Before As Variant _ + , Optional ByVal SubmenuChar As Variant _ + ) As Object +''' Create a new menu entry in the datasheet's menubar +''' The menu is not intended to be saved neither in the LibreOffice global environment, nor elsewhere +''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further. +''' Args: +''' MenuHeader: the name/header of the menu +''' Before: the place where to put the new menu on the menubar (string or number >= 1) +''' When not found => last position +''' SubmenuChar: the delimiter used in menu trees. Default = ">" +''' Returns: +''' A SFWidgets.Menu instance or Nothing +''' Examples: +''' Dim oMenu As Object +''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles") +''' With oMenu +''' .AddItem("Item 1", Command := ".uno:About") +''' '... +''' .Dispose() ' When definition is complete, the menu instance may be disposed +''' End With +''' ' ... + +Dim oMenu As Object ' return value +Const cstThisSub = "SFDatabases.Datasheet.CreateMenu" +Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set oMenu = Nothing + +Check: + If IsMissing(Before) Or IsEmpty(Before) Then Before = "" + If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = "" + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally + End If + +Try: + Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Component, MenuHeader, Before, SubmenuChar) + +Finally: + Set CreateMenu = oMenu + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDatabases.SF_Document.CreateMenu + +REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: @@ -442,7 +508,7 @@ Public Function GoToCell(Optional ByVal Row As Variant _ ''' oSheet.GoToCell(1000000, "ShipCity")) ' Set the cursor on he last row, column "ShipCity" Dim bGoTo As Boolean ' Return value -Dim lCol As Long ' Numeric index of Column in lists of columns +Dim lCol As Long ' Numeric index of Column in list of columns Dim lMaxCol As Long ' Index of last column Const cstThisSub = "SFDatabases.Datasheet.GoToCell" Const cstSubArgs = "[Row=0], [Column=0]" @@ -503,10 +569,12 @@ Public Function Methods() As Variant "Activate" _ , "ApplyFilter" _ , "CloseDatasheet" _ + , "CreateMenu" _ , "GetText" _ , "GetValue" _ , "GoToCell" _ , "OrderBy" _ + , "RemoveMenu" _ ) End Function ' SFDatabases.SF_Datasheet.Methods @@ -569,7 +637,9 @@ Public Function Properties() As Variant "ColumnHeaders" _ , "CurrentColumn" _ , "CurrentRow" _ + , "DatabaseFileName" _ , "LastRow" _ + , "ParentDatabase" _ , "Source" _ , "SourceType" _ , "XComponent" _ @@ -579,6 +649,69 @@ Public Function Properties() As Variant End Function ' SFDatabases.SF_Datasheet.Properties +REM ----------------------------------------------------------------------------- +Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean +''' Remove a menu entry in the document's menubar +''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document +''' Args: +''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string +''' Returns: +''' True when successful +''' Examples: +''' oDoc.RemoveMenu("File") +''' ' ... + +Dim bRemove As Boolean ' Return value +Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager +Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar +Dim sName As String ' Menu name +Dim iMenuId As Integer ' Menu identifier +Dim iMenuPosition As Integer ' Menu position >= 0 +Dim i As Integer +Const cstTilde = "~" + +Const cstThisSub = "SFDatabases.Datasheet.RemoveMenu" +Const cstSubArgs = "MenuHeader" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRemove = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally + End If + +Try: + Set oLayout = _Component.Frame.LayoutManager + Set oMenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar + + ' Search the menu identifier to remove by its name, Mark its position + With oMenuBar + iMenuPosition = -1 + For i = 0 To .ItemCount - 1 + iMenuId = .getItemId(i) + sName = Replace(.getItemText(iMenuId), cstTilde, "") + If MenuHeader= sName Then + iMenuPosition = i + Exit For + End If + Next i + ' Remove the found menu item + If iMenuPosition >= 0 Then + .removeItem(iMenuPosition, 1) + bRemove = True + End If + End With + +Finally: + RemoveMenu = bRemove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDatabases.SF_Datasheet.RemoveMenu + REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- @@ -589,10 +722,11 @@ Public Sub _Initialize() Dim iType As Integer ' One of the com.sun.star.sdb.CommandType constants Dim oColumn As Object ' A single column Dim oColumnDescriptor As Object ' A single column descriptor +Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem Dim i As Long Try: - _ParentType = [_Parent].ObjectType + If IsNull([_Parent]) Then _ParentType = "" Else _ParentType = [_Parent].ObjectType With _Component ' The existence of _Component.Selection must be checked upfront @@ -611,31 +745,33 @@ Try: ' Useful UNO objects Set _Frame = .Frame Set _ControlView = .CurrentControl - Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel + Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel() Set _ControlModel = _ControlView.getModel() + End With ' Retrieve the parent database instance - Select Case [_Parent].ObjectType + With _TabControllerModel + Select Case _ParentType Case "BASE" - With _TabControllerModel - Set _ParentDatabase = [_Parent].GetDatabase(.User, .Password) - End With + Set _ParentDatabase = [_Parent].GetDatabase(.User, .Password) Set _ParentBase = [_Parent] Case "DATABASE" Set _ParentDatabase = [_Parent] Set _ParentBase = Nothing + Case "" ' Derive the DATABASE instance from what can be found in the Component + Set _ParentDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _ + , FSO._ConvertFromUrl(_BaseFileName), , , .User, .Password) + _ParentType = "DATABASE" + Set _ParentBase = Nothing End Select - ' Load column headers - _ColumnHeaders = _TabControllerModel.getColumns().getElementNames() - + _ColumnHeaders = .getColumns().getElementNames() End With Finally: Exit Sub End Sub ' SFDatabases.SF_Datasheet._Initialize - ' or Nothing when opened manually from the user interface REM ----------------------------------------------------------------------------- Private Function _IsStillAlive(Optional ByVal pbError As Boolean) As Boolean ''' Returns True if the datasheet has not been closed manually or incidentally since the last use @@ -685,14 +821,13 @@ Const cstSubArgs = "" Select Case psProperty Case "ColumnHeaders" - ' or Nothing when opened manually from the user interface - - ' or Nothing when opened manually from the user interface _PropertyGet = _ColumnHeaders Case "CurrentColumn" _PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition()) Case "CurrentRow" _PropertyGet = _TabControllerModel.Row + Case "DatabaseFileName" + _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName) Case "LastRow" With _TabControllerModel If .IsRowCountFinal Then @@ -708,6 +843,8 @@ Const cstSubArgs = "" End If End If End With + Case "ParentDatabase" + Set _PropertyGet = _ParentDatabase Case "Source" _PropertyGet = _Command Case "SourceType" @@ -741,4 +878,4 @@ Private Function _Repr() As String End Function ' SFDatabases.SF_Datasheet._Repr REM ============================================ END OF SFDATABASES.SF_DATASHEET -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdatabases/SF_Register.xba b/wizards/source/sfdatabases/SF_Register.xba index 25d41e99718a..04c76ff59e94 100644 --- a/wizards/source/sfdatabases/SF_Register.xba +++ b/wizards/source/sfdatabases/SF_Register.xba @@ -152,8 +152,8 @@ Public Function _NewDatabaseFromSource(Optional ByVal pvArgs As Variant) As Obje Dim oDatabase As Object ' Return value Dim oConnection As Object ' com.sun.star.sdbc.XConnection Dim oDataSource As Object ' Alias of pvArgs(0) -Dim sUser As String ' Alias of pvARgs(1) -Dim sPassword As String ' Alias of pvARgs(2) +Dim sUser As String ' Alias of pvArgs(1) +Dim sPassword As String ' Alias of pvArgs(2) If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oDatabase = Nothing @@ -194,11 +194,11 @@ End Function ' SFDatabases.SF_Register._NewDatabaseFromSource REM ----------------------------------------------------------------------------- Public Function _NewDatasheet(Optional ByVal pvArgs As Variant) As Object -' Optional ByRef poParent As Object _ -' , Optional ByRef poComponent As Object _ +' Optional ByRef poComponent As Object _ +' , Optional ByRef poParent As Object _ ' ) As Object ''' Create a new instance of the SF_Datasheet class -''' Called from (internal calls only) +''' Called from ''' base.Datasheets() ''' base.OpenTable() ''' base.OpenQuery() @@ -206,36 +206,57 @@ Public Function _NewDatasheet(Optional ByVal pvArgs As Variant) As Object ''' database.OpenQuery() ''' database.OpenSql() ''' Args: -''' Parent: the parent SF_Database or SF_Base instance having produced the new datasheet ''' Component: the component of the new datasheet ''' com.sun.star.lang.XComponent - org.openoffice.comp.dbu.ODatasourceBrowser +''' Parent: the parent SF_Database or SF_Base instance having produced the new datasheet +''' When absent, the SF_Database instance will be derived from the component ''' Returns: ''' The instance or Nothing Dim oDatasheet As Object ' Return value Dim oParent As Object ' The parent SF_Database or SF_Base instance having produced the new datasheet Dim oComponent As Object ' The component of the new datasheet +Dim oWindow As Object ' ui.Window user-defined type +Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") + +Const TABLEDATA = "TableData" +Const QUERYDATA = "QueryData" +Const SQLDATA = "SqlData" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oDatasheet = Nothing Check: - ' Get arguments - If UBound(pvArgs) <> 1 Then GoTo Catch - Set oParent = pvArgs(0) - Set oComponent = pvArgs(1) - If IsNull(oParent) Or IsNull(oComponent) Then GoTo Catch + ' Get, check and assign arguments + If Not IsArray(pvArgs) Then GoTo Catch + If UBound(pvArgs) >= 0 Then + Set oComponent = pvArgs(0) + End If + If UBound(pvArgs) = 0 Then + Set oParent = Nothing + ElseIf UBound(pvArgs) = 1 Then + Set oParent = pvArgs(1) + Else + GoTo Catch + End If + + ' Check the validity of the proposed window: is it really a datasheet ? Otherwise, do nothing + If IsNull(oComponent) Then GoTo Catch + Set oWindow = oUi._IdentifyWindow(oComponent) + With oWindow + If .DocumentType <> TABLEDATA And .DocumentType <> QUERYDATA And .DocumentType <> SQLDATA Then GoTo Catch + End With If IsEmpty(oComponent.Selection) Then GoTo Catch Try: - Set oDatasheet = New SF_Datasheet - With oDatasheet - Set .[Me] = oDatasheet - Set .[_Parent] = oParent - Set ._Component = oComponent - ' Achieve the initialization - ._Initialize() - End With + Set oDatasheet = New SF_Datasheet + With oDatasheet + Set .[Me] = oDatasheet + Set .[_Parent] = oParent + Set ._Component = oComponent + ' Achieve the initialization + ._Initialize() + End With Finally: Set _NewDatasheet = oDatasheet diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba index 6b70d9fc4228..eb39c86e851f 100644 --- a/wizards/source/sfdocuments/SF_Base.xba +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -551,7 +551,7 @@ Try: Set oNewQuery = .loadComponent(com.sun.star.sdb.application.DatabaseObject.QUERY, QueryName, DesignMode) End With ' When design mode, the method returns Nothing - If Not DesignMode Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", [Me], oNewQuery) + If Not DesignMode Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", oNewQuery, [Me]) Finally: Set OpenQuery = oOpen @@ -604,7 +604,7 @@ Try: Set oNewTable = .loadComponent(com.sun.star.sdb.application.DatabaseObject.TABLE, TableName, DesignMode) End With ' When design mode, the method returns Nothing - If Not DesignMode Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", [Me], oNewTable) + If Not DesignMode Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", oNewTable, [Me]) Finally: Set OpenTable = oOpen @@ -1095,4 +1095,4 @@ Private Function _Repr() As String End Function ' SFDocuments.SF_Base._Repr REM ============================================ END OF SFDOCUMENTS.SF_BASE -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba index e537b90e5da1..bba8b3c21bd5 100644 --- a/wizards/source/sfdocuments/SF_Document.xba +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -766,7 +766,7 @@ End Function ' SFDocuments.SF_Document.Properties REM ----------------------------------------------------------------------------- Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _ , Optional ByRef _Document As Variant _ -) As Boolean + ) As Boolean ''' Remove a menu entry in the document's menubar ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document ''' Args: diff --git a/wizards/source/sfdocuments/SF_Form.xba b/wizards/source/sfdocuments/SF_Form.xba index 404c24bd3b20..2879536efb6f 100644 --- a/wizards/source/sfdocuments/SF_Form.xba +++ b/wizards/source/sfdocuments/SF_Form.xba @@ -660,6 +660,7 @@ Public Function GetDatabase(Optional ByVal User As Variant _ ''' Set myDb = oForm.GetDatabase() Dim FSO As Object ' Alias for SF_FileSystem +Dim sDataSource As String ' Database file name in FileNaming format Dim sUser As String ' Alias for User Dim sPassword As String ' Alias for Password Const cstThisSub = "SFDocuments.Form.GetDatabase" @@ -700,9 +701,10 @@ Try: Else ' Check if DataSourceName is a file or a registered name and create database instance accordingly Set FSO = ScriptForge.SF_FileSystem - If FSO.FileExists(FSO._ConvertFromUrl(_Form.DataSourceName)) Then + sDataSource = FSO._ConvertFromUrl(_Form.DataSourceName) + If FSO.FileExists(sDataSource) Then Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _ - , _Form.DataSourceName, , , sUser, sPassword) + , sDataSource, , , sUser, sPassword) Else Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database" _ , , _Form.DataSourceName, , sUser, sPassword) diff --git a/wizards/source/sfwidgets/SF_Menu.xba b/wizards/source/sfwidgets/SF_Menu.xba index e211685361bf..85d505904df5 100644 --- a/wizards/source/sfwidgets/SF_Menu.xba +++ b/wizards/source/sfwidgets/SF_Menu.xba @@ -503,12 +503,20 @@ Public Sub _Initialize(ByRef poComponent As Object _ Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager Dim sName As String ' Menu name Dim iMenuId As Integer ' Menu identifier +Dim oWindow As Object ' ui.Window type +Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") Dim i As Integer Const cstTilde = "~" +Check: + ' How does the window look on top of which a menu is requested ? + Set oWindow = oUi._IdentifyWindow(poComponent) + With oWindow + If Not IsNull(.Frame) Then Set oLayout = .Frame.LayoutManager Else GoTo Finally + End With + Try: ' Initialize the menubar - Set oLayout = poComponent.CurrentController.Frame.LayoutManager Set MenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar ' Determine the new menu identifier and its position diff --git a/wizards/source/sfwidgets/SF_MenuListener.xba b/wizards/source/sfwidgets/SF_MenuListener.xba index 6045f2dd8d96..9ab018f77b8b 100644 --- a/wizards/source/sfwidgets/SF_MenuListener.xba +++ b/wizards/source/sfwidgets/SF_MenuListener.xba @@ -71,8 +71,8 @@ Dim bType As Boolean ' True when status is meaningful: item is radio but Dim bStatus As Boolean ' Status of the menu item, always False for normal items Dim oFrame As Object ' com.sun.star.comp.framework.Frame Dim oDispatcher As Object ' com.sun.star.frame.DispatchHelper -Dim oSession As Object ' SF_Session service Dim vScript As Variant ' Split command in script/argument +Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") Dim oArgs() As new com.sun.star.beans.PropertyValue On Local Error GoTo Catch ' Avoid stopping event scripts @@ -88,15 +88,14 @@ Try: End With If Len(sCommand) > 0 Then + Set oFrame = StarDesktop.ActiveFrame ' A menu has been clicked necessarily in the current window If Left(sCommand, Len(cstUnoPrefix)) = cstUnoPrefix Then ' Execute uno command - Set oFrame = StarDesktop.CurrentComponent.CurrentController.Frame ' A menu has been clicked necessarily in the current window Set oDispatcher = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") oDispatcher.executeDispatch(oFrame, sCommand, "", 0, oArgs()) oFrame.activate() Else ' Execute script - Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") vScript = Split(sCommand, cstScriptArg) oSession._ExecuteScript(vScript(0), vScript(1) & "," & Iif(bStatus, "1", "0")) ' Return value is ignored End If diff --git a/wizards/source/sfwidgets/SF_Register.xba b/wizards/source/sfwidgets/SF_Register.xba index 2c58b858d1e9..7dc27083be65 100644 --- a/wizards/source/sfwidgets/SF_Register.xba +++ b/wizards/source/sfwidgets/SF_Register.xba @@ -113,7 +113,7 @@ Public Function _NewPopupMenu(Optional ByVal pvArgs As Variant) As Object ''' Create a new instance of the SF_PopupMenu class ''' Args: ''' Event: a mouse event -''' If the event has no source or is not a mouse event, the menu is displayed above ThisComponent +''' If the event has no source or is not a mouse event, the menu is displayed above the actual window ''' X, Y: forced coordinates ''' SubmenuChar: Delimiter used in menu trees ''' Returns: the instance or Nothing @@ -123,14 +123,17 @@ Dim Event As Variant ' Mouse event Dim X As Long ' Mouse click coordinates Dim Y As Long Dim SubmenuChar As String ' Delimiter in menu trees -Dim oSession As Object ' ScriptForge.SF_Session Dim vUno As Variant ' UNO type split into an array Dim sEventType As String ' Event type, must be "MouseEvent" Dim oControl As Object ' The dialog or form control view which triggered the event +Dim oWindow As Object ' ui.Window type +Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session") +Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI") If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: + ' Check and get arguments, their number may vary If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) If UBound(pvArgs) >= 0 Then Event = pvArgs(0) Else Event = Nothing @@ -145,7 +148,7 @@ Check: Set oMenu = Nothing Try: - Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + ' Find and identify the control that triggered the popup menu Set oControl = Nothing If Not IsNull(Event) Then ' Determine the X, Y coordinates @@ -158,9 +161,12 @@ Try: If oSession.HasUnoProperty(Event, "Source") Then Set oControl = Event.Source.Peer End If End If - ' If not a mouse event, if no control, ... + ' If not a mouse event, if no control, find what can be decent alternatives: (a menu header in) the actual window If IsNull(oControl) Then - If Not IsNull(ThisComponent) Then Set oControl = ThisComponent.CurrentController.Frame.getContainerWindow() + Set oWindow = oUi._IdentifyWindow(StarDesktop.getCurrentComponent()) ' A menu has been clicked necessarily in the current window + With oWindow + If Not IsNull(.Frame) Then Set oControl = .Frame.getContainerWindow() + End With End If If Not IsNull(oControl) Then |