wizards/source/scriptforge/SF_UI.xba | 2
wizards/source/scriptforge/python/scriptforge.py | 11 +
wizards/source/sfdatabases/SF_Database.xba | 4
wizards/source/sfdatabases/SF_Datasheet.xba | 167 ++++++++++++++++++++---
wizards/source/sfdatabases/SF_Register.xba | 59 +++++---
wizards/source/sfdocuments/SF_Base.xba | 6
wizards/source/sfdocuments/SF_Document.xba | 2
wizards/source/sfdocuments/SF_Form.xba | 6
wizards/source/sfwidgets/SF_Menu.xba | 10 +
wizards/source/sfwidgets/SF_MenuListener.xba | 5
wizards/source/sfwidgets/SF_Register.xba | 16 +-
11 files changed, 234 insertions(+), 54 deletions(-)
New commits:
commit 18638efa3973bf919a2502866773c02b7c24f7d7
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Fri Nov 4 16:54:41 2022 +0100
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Sat Nov 5 17:10:41 2022 +0100
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 <j...@ledure.be>
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
Tested-by: Jenkins
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
@@ -122,6 +122,12 @@ Property Get CurrentRow() As Long
CurrentRow = _PropertyGet("CurrentRow")
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
@@ -130,6 +136,12 @@ Property Get LastRow() As Long
LastRow = _PropertyGet("LastRow")
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
@@ -282,6 +294,60 @@ Catch:
GoTo Finally
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
@@ -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
