update
This commit is contained in:
Jane
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,399 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Collect" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM MODULE NAME <> COLLECTION (is a reserved name for ... collections)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be COLLECTION
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _CollType As String
|
||||
Private _Parent As Object
|
||||
Private _Count As Long
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOLLECTION
|
||||
Set _This = Nothing
|
||||
_CollType = ""
|
||||
Set _Parent = Nothing
|
||||
_Count = 0
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get Count() As Long
|
||||
Count = _PropertyGet("Count")
|
||||
End Property ' Count (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Function Item(ByVal Optional pvItem As Variant) As Variant
|
||||
'Return property value.
|
||||
'pvItem either numeric index or property name
|
||||
|
||||
Const cstThisSub = "Collection.getItem"
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvItem) Then Goto Exit_Function ' To allow object watching in Basic IDE, do not generate error
|
||||
Select Case _CollType
|
||||
Case COLLCOMMANDBARCONTROLS ' Have no name
|
||||
If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
Case Else
|
||||
If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
End Select
|
||||
|
||||
Dim vNames() As Variant, oProperty As Object
|
||||
|
||||
Set Item = Nothing
|
||||
Select Case _CollType
|
||||
Case COLLALLDIALOGS
|
||||
Set Item = Application.AllDialogs(pvItem)
|
||||
Case COLLALLFORMS
|
||||
Set Item = Application.AllForms(pvItem)
|
||||
Case COLLALLMODULES
|
||||
Set Item = Application.AllModules(pvItem)
|
||||
Case COLLCOMMANDBARS
|
||||
Set Item = Application.CommandBars(pvItem)
|
||||
Case COLLCOMMANDBARCONTROLS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.CommandBarControls(pvItem)
|
||||
Case COLLCONTROLS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.Controls(pvItem)
|
||||
Case COLLFORMS
|
||||
Set Item = Application.Forms(pvItem)
|
||||
Case COLLFIELDS
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Set Item = _Parent.Fields(pvItem)
|
||||
Case COLLPROPERTIES
|
||||
If IsNull(_Parent) Then GoTo Error_Parent
|
||||
Select Case _Parent._Type
|
||||
Case OBJCONTROL, OBJSUBFORM, OBJDATABASE, OBJDIALOG, OBJFIELD _
|
||||
, OBJFORM, OBJQUERYDEF, OBJRECORDSET, OBJTABLEDEF
|
||||
Set Item = _Parent.Properties(pvItem)
|
||||
Case OBJCOLLECTION, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY
|
||||
' NOT SUPPORTED
|
||||
End Select
|
||||
Case COLLQUERYDEFS
|
||||
Set Item = _Parent.QueryDefs(pvItem)
|
||||
Case COLLRECORDSETS
|
||||
Set Item = _Parent.Recordsets(pvItem)
|
||||
Case COLLTABLEDEFS
|
||||
Set Item = _Parent.TableDefs(pvItem)
|
||||
Case COLLTEMPVARS
|
||||
Set Item = Application.TempVars(pvItem)
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
Set Item = Nothing
|
||||
GoTo Exit_Function
|
||||
Error_Parent:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, True, Array(_GetLabel("OBJECT"), _GetLabel("PARENT")))
|
||||
Set Item = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Item V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
|
||||
' Append a new TableDef or TempVar object to the TableDefs/TempVars collections
|
||||
|
||||
Const cstThisSub = "Collection.Add"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object
|
||||
Dim vObject As Variant, oTempVar As Object
|
||||
Add = False
|
||||
If IsMissing(pvNew) Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTABLEDEFS
|
||||
If Not Utils._CheckArgument(pvNew, 1, vbObject) Then Goto Exit_Function
|
||||
Set vObject = pvNew
|
||||
With vObject
|
||||
Set odbDatabase = ._ParentDatabase
|
||||
If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
|
||||
Set oConnection = odbDatabase.Connection
|
||||
If IsNull(.TableDescriptor) Or .TableFieldsCount = 0 Then Goto Error_Sequence
|
||||
Set oTables = oConnection.getTables()
|
||||
oTables.appendByDescriptor(.TableDescriptor)
|
||||
Set .Table = oTables.getByName(._Name)
|
||||
.CatalogName = .Table.CatalogName
|
||||
.SchemaName = .Table.SchemaName
|
||||
.TableName = .Table.Name
|
||||
.TableDescriptor.dispose()
|
||||
Set .TableDescriptor = Nothing
|
||||
.TableFieldsCount = 0
|
||||
.TableKeysCount = 0
|
||||
End With
|
||||
Case COLLTEMPVARS
|
||||
If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
|
||||
If pvNew = "" Then Goto Error_Name
|
||||
If IsMissing(pvValue) Then Call _TraceArguments()
|
||||
If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
|
||||
Set oTempVar = New TempVar
|
||||
oTempVar._This = oTempVar
|
||||
oTempVar._Name = pvNew
|
||||
oTempVar._Value = pvValue
|
||||
_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count + 1
|
||||
Add = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Sequence:
|
||||
TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name)
|
||||
Goto Exit_Function
|
||||
Error_Name:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew))
|
||||
AddItem = False
|
||||
Goto Exit_Function
|
||||
End Function ' Add V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Delete(ByVal Optional pvName As Variant) As Boolean
|
||||
' Delete a TableDef or QueryDef object in the TableDefs/QueryDefs collections
|
||||
|
||||
Const cstThisSub = "Collection.Delete"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim odbDatabase As Object, oColl As Object, vName As Variant
|
||||
Delete = False
|
||||
If IsMissing(pvName) Then pvName = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTABLEDEFS, COLLQUERYDEFS
|
||||
If _A2B_.CurrentDocIndex() <> 0 Then Goto Error_NotApplicable
|
||||
Set odbDatabase = Application._CurrentDb()
|
||||
If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
|
||||
If _CollType = COLLTABLEDEFS Then Set oColl = odbDatabase.Connection.getTables() Else Set oColl = odbDatabase.Connection.getQueries()
|
||||
With oColl
|
||||
vName = _InList(pvName, .getElementNames(), True)
|
||||
If vName = False Then Goto trace_NotFound
|
||||
.dropByName(vName)
|
||||
End With
|
||||
odbDatabase.Document.store()
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count - 1
|
||||
Delete = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Trace_NotFound:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Left(_CollType, 5)), pvName))
|
||||
Goto Exit_Function
|
||||
End Function ' Delete V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Collection.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Collection.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Remove(ByVal Optional pvName As Variant) As Boolean
|
||||
' Remove a TempVar from the TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim oColl As Object, vName As Variant
|
||||
Remove = False
|
||||
If IsMissing(pvName) Then pvName = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTEMPVARS
|
||||
If Not _A2B_.hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
|
||||
_A2B_.TempVars.Remove(UCase(pvName))
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
_Count = _Count - 1
|
||||
Remove = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Name:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName))
|
||||
AddItem = False
|
||||
Goto Exit_Function
|
||||
End Function ' Remove V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function RemoveAll() As Boolean
|
||||
' Remove the whole TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTEMPVARS
|
||||
Set _A2B_.TempVars = New Collection
|
||||
_Count = 0
|
||||
Case Else
|
||||
Goto Error_NotApplicable
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
End Function ' RemoveAll V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Count", "Item", "ObjectType")
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Collection.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Count")
|
||||
_PropertyGet = _Count
|
||||
Case UCase("Item")
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Collection.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Collection._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,396 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CommandBar" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be COMMANDBAR
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _ResourceURL As String
|
||||
Private _Window As Object ' com.sun.star.frame.XFrame
|
||||
Private _Module As String
|
||||
Private _Toolbar As Object
|
||||
Private _BarBuiltin As Integer ' 1 = builtin, 2 = custom stored in LO/AOO (Base), 3 = custom stored in document (Form)
|
||||
Private _BarType As Integer ' See msoBarTypeXxx constants
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOMMANDBAR
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_ResourceURL = ""
|
||||
Set _Window = Nothing
|
||||
_Module = ""
|
||||
Set _Toolbar = Nothing
|
||||
_BarBuiltin = 0
|
||||
_BarType = -1
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BuiltIn() As Boolean
|
||||
BuiltIn = _PropertyGet("BuiltIn")
|
||||
End Property ' BuiltIn (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
Public Function pName() As String ' For compatibility with < V0.9.0
|
||||
pName = _PropertyGet("Name")
|
||||
End Function ' pName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Parent() As Object
|
||||
Parent = _Parent
|
||||
End Function ' Parent (get) V6.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Visible() As Variant
|
||||
Visible = _PropertyGet("Visible")
|
||||
End Property ' Visible (get)
|
||||
|
||||
Property Let Visible(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Visible", pvValue)
|
||||
End Property ' Visible (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CommandBarControls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Return an object of type CommandBarControl indicated by its index
|
||||
' Index is different from UNO index: separators do not count
|
||||
' If no pvIndex argument, return a Collection type
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.CommandBarControls"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim oLayout As Object, vElements() As Variant, iIndexToolbar As Integer, oToolbar As Object
|
||||
Dim i As Integer, iItemsCount As Integer, oSettings As Object, vItem() As Variant, bSeparator As Boolean
|
||||
Dim oObject As Object
|
||||
|
||||
Set oObject = Nothing
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If pvIndex < 0 Then Goto Trace_IndexError
|
||||
End If
|
||||
|
||||
Select Case _BarType
|
||||
Case msoBarTypeNormal, msoBarTypeMenuBar
|
||||
Case Else : Goto Error_NotApplicable ' Status bar not supported
|
||||
End Select
|
||||
|
||||
Set oLayout = _Window.LayoutManager
|
||||
vElements = oLayout.getElements()
|
||||
iIndexToolbar = _FindElement(vElements())
|
||||
If iIndexToolbar < 0 Then Goto Error_NotApplicable ' Toolbar not visible
|
||||
Set oToolbar = vElements(iIndexToolbar)
|
||||
|
||||
iItemsCount = 0
|
||||
Set oSettings = oToolbar.getSettings(False)
|
||||
|
||||
bSeparator = False
|
||||
For i = 0 To oSettings.getCount() - 1
|
||||
Set vItem() = oSettings.getByIndex(i)
|
||||
If _GetPropertyValue(vItem, "Type", 1) <> 1 Then ' Type = 1 indicates separator
|
||||
iItemsCount = iItemsCount + 1
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If pvIndex = iItemsCount - 1 Then
|
||||
Set oObject = New CommandBarControl
|
||||
With oObject
|
||||
Set ._This = oObject
|
||||
Set ._Parent = _This
|
||||
._ParentCommandBarName = _Name
|
||||
._ParentCommandBar = oToolbar
|
||||
._ParentBuiltin = ( _BarBuiltin = 1 )
|
||||
._Element = vItem()
|
||||
._InternalIndex = i
|
||||
._Index = iItemsCount ' Indexes start at 1
|
||||
._BeginGroup = bSeparator
|
||||
End With
|
||||
End If
|
||||
bSeparator = False
|
||||
End If
|
||||
Else
|
||||
bSeparator = True
|
||||
End If
|
||||
Next i
|
||||
|
||||
If IsNull(oObject) Then
|
||||
Select Case True
|
||||
Case IsMissing(pvIndex)
|
||||
Set oObject = New Collect
|
||||
Set oObject._This = oObject
|
||||
oObject._CollType = COLLCOMMANDBARCONTROLS
|
||||
Set oObject._Parent = _This
|
||||
oObject._Count = iItemsCount
|
||||
Case Else ' pvIndex is numeric
|
||||
Goto Trace_IndexError
|
||||
End Select
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set CommandBarControls = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Trace_IndexError:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
End Function ' CommandBarControls V1,3,0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Alias for CommandBarControls (VBA)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.Controls"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim oObject As Object
|
||||
|
||||
If IsMissing(pvIndex) Then Set oObject = CommandBarControls() Else Set oObject = CommandBarControls(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Set Controls = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls V1,3,0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("CommandBar.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("CommandBar.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Reset() As Boolean
|
||||
' Reset a whole command bar to its initial values
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBar.Reset"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
_Toolbar.reload()
|
||||
|
||||
Exit_Function:
|
||||
Reset = True
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
Reset = False
|
||||
GoTo Exit_Function
|
||||
End Function ' Reset V1.3.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _FindElement(pvElements As Variant) As Integer
|
||||
' Return -1 if not found, otherwise return index in elements table of LayoutManager
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
_FindElement = -1
|
||||
If Not IsArray(pvElements) Then Exit Function
|
||||
|
||||
For i = 0 To UBound(pvElements)
|
||||
If _ResourceURL = pvElements(i).ResourceURL Then
|
||||
_FindElement = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("BuiltIn", "Name", "ObjectType", "Visible")
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBar.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("BuiltIn")
|
||||
_PropertyGet = ( _BarBuiltin = 1 )
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Visible")
|
||||
Set oLayout = _Window.LayoutManager
|
||||
iElementIndex = _FindElement(oLayout.getElements())
|
||||
If iElementIndex < 0 Then _PropertyGet = False Else _PropertyGet = oLayout.isElementVisible(_ResourceURL)
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBar.set" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertySet = True
|
||||
Dim iArgNr As Integer
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
|
||||
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase("CommandBar.setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
Set oLayout = _Window.LayoutManager
|
||||
With oLayout
|
||||
iElementIndex = _FindElement(.getElements())
|
||||
If iElementIndex < 0 Then
|
||||
If pvValue Then
|
||||
.createElement(_ResourceURL)
|
||||
.showElement(_ResourceURL)
|
||||
End If
|
||||
Else
|
||||
If pvValue <> .isElementVisible(_ResourceURL) Then
|
||||
If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL)
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,339 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CommandBarControl" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be COMMANDBARCONTROL
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _InternalIndex As Integer ' Index in toolbar including separators
|
||||
Private _Index As Integer ' Index in collection, starting at 1 !!
|
||||
Private _ControlType As Integer ' 1 of the msoControl* constants
|
||||
Private _ParentCommandBarName As String
|
||||
Private _ParentCommandBar As Object ' com.sun.star.ui.XUIElement
|
||||
Private _ParentBuiltin As Boolean
|
||||
Private _Element As Variant
|
||||
Private _BeginGroup As Boolean
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJCOMMANDBARCONTROL
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Index = -1
|
||||
_ParentCommandBarName = ""
|
||||
Set _ParentCommandBar = Nothing
|
||||
_ParentBuiltin = False
|
||||
_Element = Array()
|
||||
_BeginGroup = False
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BeginGroup() As Boolean
|
||||
BeginGroup = _PropertyGet("BeginGroup")
|
||||
End Property ' BeginGroup (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get BuiltIn() As Boolean
|
||||
BuiltIn = _PropertyGet("BuiltIn")
|
||||
End Property ' BuiltIn (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Caption() As Variant
|
||||
Caption = _PropertyGet("Caption")
|
||||
End Property ' Caption (get)
|
||||
|
||||
Property Let Caption(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Caption", pvValue)
|
||||
End Property ' Caption (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Index() As Integer
|
||||
Index = _PropertyGet("Index")
|
||||
End Property ' Index (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnAction() As Variant
|
||||
OnAction = _PropertyGet("OnAction")
|
||||
End Property ' OnAction (get)
|
||||
|
||||
Property Let OnAction(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnAction", pvValue)
|
||||
End Property ' OnAction (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Parent() As Object
|
||||
Parent = _PropertyGet("Parent")
|
||||
End Property ' Parent (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get TooltipText() As Variant
|
||||
TooltipText = _PropertyGet("TooltipText")
|
||||
End Property ' TooltipText (get)
|
||||
|
||||
Property Let TooltipText(ByVal pvValue As Variant)
|
||||
Call _PropertySet("TooltipText", pvValue)
|
||||
End Property ' TooltipText (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function pType() As Integer
|
||||
pType = _PropertyGet("Type")
|
||||
End Function ' Type (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Visible() As Variant
|
||||
Visible = _PropertyGet("Visible")
|
||||
End Property ' Visible (get)
|
||||
|
||||
Property Let Visible(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Visible", pvValue)
|
||||
End Property ' Visible (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Execute()
|
||||
' Execute the command stored in a toolbar button
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "CommandBarControl.Execute"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim sExecute As String
|
||||
|
||||
Execute = True
|
||||
sExecute = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
|
||||
Select Case True
|
||||
Case sExecute = "" : Execute = False
|
||||
Case _IsLeft(sExecute, ".uno:")
|
||||
Execute = DoCmd.RunCommand(sExecute)
|
||||
Case _IsLeft(sExecute, "vnd.sun.star.script:")
|
||||
Execute = Utils._RunScript(sExecute, Array(Nothing))
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
Execute = False
|
||||
GoTo Exit_Function
|
||||
End Function ' Execute V1.3.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("CommandBarControl.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("CommandBar.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("BeginGroup", "BuiltIn", "Caption", "Index" _
|
||||
, "ObjectType", "OnAction", "Parent" _
|
||||
, "TooltipText", "Type", "Visible" _
|
||||
)
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBarControl.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertyGet = Null
|
||||
|
||||
Dim oLayout As Object, iElementIndex As Integer
|
||||
Dim sValue As String
|
||||
Const cstUnoPrefix = ".uno:"
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("BeginGroup")
|
||||
_PropertyGet = _BeginGroup
|
||||
Case UCase("BuiltIn")
|
||||
sValue = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
_PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) )
|
||||
Case UCase("Caption")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "Label", "")
|
||||
Case UCase("Index")
|
||||
_PropertyGet = _Index
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("OnAction")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "CommandURL", "")
|
||||
Case UCase("Parent")
|
||||
Set _PropertyGet = _Parent
|
||||
Case UCase("TooltipText")
|
||||
sValue = _GetPropertyValue(_Element, "Tooltip", "")
|
||||
If sValue <> "" Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, "Label", "")
|
||||
Case UCase("Type")
|
||||
_PropertyGet = msoControlButton
|
||||
Case UCase("Visible")
|
||||
_PropertyGet = _GetPropertyValue(_Element, "IsVisible", "")
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "CommandBarControl.set" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertySet = True
|
||||
Dim iArgNr As Integer
|
||||
Dim oSettings As Object, sValue As String
|
||||
|
||||
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase("CommandBar.setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
If _ParentBuiltin Then Goto Trace_Error ' Modifications of individual controls forbidden for builtin toolbars (design choice)
|
||||
|
||||
Const cstUnoPrefix = ".uno:"
|
||||
Const cstScript = "vnd.sun.star.script:"
|
||||
|
||||
Set oSettings = _ParentCommandBar.getSettings(True)
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("OnAction")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, _AddNumeric(vbString), , False) Then Goto Trace_Error_Value
|
||||
Select Case VarType(pvValue)
|
||||
Case vbString
|
||||
If _IsLeft(pvValue, cstUnoPrefix) Then
|
||||
sValue = pvValue
|
||||
ElseIf _IsLeft(pvValue, cstScript) Then
|
||||
sValue = pvValue
|
||||
Else
|
||||
sValue = DoCmd.RunCommand(pvValue, True)
|
||||
End If
|
||||
Case Else ' Numeric
|
||||
sValue = DoCmd.RunCommand(pvValue, True)
|
||||
End Select
|
||||
_SetPropertyValue(_Element, "CommandURL", sValue)
|
||||
Case UCase("TooltipText")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
_SetPropertyValue(_Element, "Tooltip", pvValue)
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
_SetPropertyValue(_Element, "IsVisible", pvValue)
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
oSettings.replaceByIndex(_InternalIndex, _Element)
|
||||
_ParentCommandBar.setSettings(oSettings)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,598 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DataDef" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be TABLEDEF or QUERYDEF
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String ' For tables: [[Catalog.]Schema.]Table
|
||||
Private _ParentDatabase As Object
|
||||
Private _ReadOnly As Boolean
|
||||
Private Table As Object ' com.sun.star.sdb.dbaccess.ODBTable
|
||||
Private CatalogName As String
|
||||
Private SchemaName As String
|
||||
Private TableName As String
|
||||
Private Query As Object ' com.sun.star.sdb.dbaccess.OQuery
|
||||
Private TableDescriptor As Object ' com.sun.star.sdb.dbaccess.ODBTable
|
||||
Private TableFieldsCount As Integer
|
||||
Private TableKeysCount As Integer
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = ""
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
Set _ParentDatabase = Nothing
|
||||
_ReadOnly = False
|
||||
Set Table = Nothing
|
||||
CatalogName = ""
|
||||
SchemaName = ""
|
||||
TableName = ""
|
||||
Set Query = Nothing
|
||||
Set TableDescriptor = Nothing
|
||||
TableFieldsCount = 0
|
||||
TableKeysCount = 0
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SQL() As Variant
|
||||
SQL = _PropertyGet("SQL")
|
||||
End Property ' SQL (get)
|
||||
|
||||
Property Let SQL(ByVal pvValue As Variant)
|
||||
Call _PropertySet("SQL", pvValue)
|
||||
End Property ' SQL (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function pType() As Integer
|
||||
pType = _PropertyGet("Type")
|
||||
End Function ' Type (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function CreateField(ByVal Optional pvFieldName As Variant _
|
||||
, ByVal optional pvType As Variant _
|
||||
, ByVal optional pvSize As Variant _
|
||||
, ByVal optional pvAttributes As Variant _
|
||||
) As Object
|
||||
'Return a Field object
|
||||
Const cstThisSub = "TableDef.CreateField"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim oTable As Object, oNewField As Object, oKeys As Object, oPrimaryKey As Object, oColumn As Object
|
||||
Const cstMaxKeyLength = 30
|
||||
|
||||
CreateField = Nothing
|
||||
If _ParentDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
|
||||
If IsMissing(pvFieldName) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvFieldName, 1, vbString) Then Goto Exit_Function
|
||||
If pvFieldName = "" Then Call _TraceArguments()
|
||||
If IsMissing(pvType) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric( _
|
||||
dbInteger, dbLong, dbBigInt, dbFloat, vbSingle, dbDouble _
|
||||
, dbNumeric, dbDecimal, dbText, dbChar, dbMemo _
|
||||
, dbDate, dbTime, dbTimeStamp _
|
||||
, dbBinary, dbVarBinary, dbLongBinary, dbBoolean _
|
||||
)) Then Goto Exit_Function
|
||||
If IsMissing(pvSize) Then pvSize = 0
|
||||
If pvSize < 0 Then pvSize = 0
|
||||
If Not Utils._CheckArgument(pvSize, 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If IsMissing(pvAttributes) Then pvAttributes = 0
|
||||
If Not Utils._CheckArgument(pvAttributes, 1, Utils._AddNumeric(), Array(0, dbAutoIncrField)) Then Goto Exit_Function
|
||||
|
||||
If _Type <> OBJTABLEDEF Then Goto Error_NotApplicable
|
||||
If IsNull(Table) And IsNull(TableDescriptor) Then Goto Error_NotApplicable
|
||||
|
||||
If _ReadOnly Then Goto Error_NoUpdate
|
||||
|
||||
Set oNewField = New Field
|
||||
With oNewField
|
||||
._This = oNewField
|
||||
._Name = pvFieldName
|
||||
._ParentName = _Name
|
||||
._ParentType = OBJTABLEDEF
|
||||
If IsNull(Table) Then Set oTable = TableDescriptor Else Set oTable = Table
|
||||
Set .Column = oTable.Columns.createDataDescriptor()
|
||||
End With
|
||||
With oNewField.Column
|
||||
.Name = pvFieldName
|
||||
Select Case pvType
|
||||
Case dbInteger : .Type = com.sun.star.sdbc.DataType.TINYINT
|
||||
Case dbLong : .Type = com.sun.star.sdbc.DataType.INTEGER
|
||||
Case dbBigInt : .Type = com.sun.star.sdbc.DataType.BIGINT
|
||||
Case dbFloat : .Type = com.sun.star.sdbc.DataType.FLOAT
|
||||
Case dbSingle : .Type = com.sun.star.sdbc.DataType.REAL
|
||||
Case dbDouble : .Type = com.sun.star.sdbc.DataType.DOUBLE
|
||||
Case dbNumeric, dbCurrency : .Type = com.sun.star.sdbc.DataType.NUMERIC
|
||||
Case dbDecimal : .Type = com.sun.star.sdbc.DataType.DECIMAL
|
||||
Case dbText : .Type = com.sun.star.sdbc.DataType.CHAR
|
||||
Case dbChar : .Type = com.sun.star.sdbc.DataType.VARCHAR
|
||||
Case dbMemo : .Type = com.sun.star.sdbc.DataType.LONGVARCHAR
|
||||
Case dbDate : .Type = com.sun.star.sdbc.DataType.DATE
|
||||
Case dbTime : .Type = com.sun.star.sdbc.DataType.TIME
|
||||
Case dbTimeStamp : .Type = com.sun.star.sdbc.DataType.TIMESTAMP
|
||||
Case dbBinary : .Type = com.sun.star.sdbc.DataType.BINARY
|
||||
Case dbVarBinary : .Type = com.sun.star.sdbc.DataType.VARBINARY
|
||||
Case dbLongBinary : .Type = com.sun.star.sdbc.DataType.LONGVARBINARY
|
||||
Case dbBoolean : .Type = com.sun.star.sdbc.DataType.BOOLEAN
|
||||
End Select
|
||||
.Precision = Int(pvSize)
|
||||
If pvType = dbNumeric Or pvType = dbDecimal Or pvType = dbCurrency Then .Scale = Int(pvSize * 10) - Int(pvSize) * 10
|
||||
.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE
|
||||
If Utils._hasUNOProperty(oNewField.Column, "CatalogName") Then .CatalogName = CatalogName
|
||||
If Utils._hasUNOProperty(oNewField.Column, "SchemaName") Then .SchemaName = SchemaName
|
||||
If Utils._hasUNOProperty(oNewField.Column, "TableName") Then .TableName = TableName
|
||||
If Not IsNull(TableDescriptor) Then TableFieldsCount = TableFieldsCount + 1
|
||||
If pvAttributes = dbAutoIncrField Then
|
||||
If Not IsNull(Table) Then Goto Error_Sequence ' Do not accept adding an AutoValue field when table exists
|
||||
Set oKeys = oTable.Keys
|
||||
Set oPrimaryKey = oKeys.createDataDescriptor()
|
||||
Set oColumn = oPrimaryKey.Columns.createDataDescriptor()
|
||||
oColumn.Name = pvFieldName
|
||||
oColumn.CatalogName = CatalogName
|
||||
oColumn.SchemaName = SchemaName
|
||||
oColumn.TableName = TableName
|
||||
oColumn.IsAutoIncrement = True
|
||||
oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
|
||||
oPrimaryKey.Columns.appendByDescriptor(oColumn)
|
||||
oPrimaryKey.Name = Left("PK_" & Join(Split(TableName, " "), "_") & "_" & Join(Split(pvFieldName, " "), "_"), cstMaxKeyLength)
|
||||
oPrimaryKey.Type = com.sun.star.sdbcx.KeyType.PRIMARY
|
||||
oKeys.appendByDescriptor(oPrimaryKey)
|
||||
.IsAutoIncrement = True
|
||||
.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
|
||||
oColumn.dispose()
|
||||
Else
|
||||
.IsAutoIncrement = False
|
||||
End If
|
||||
End With
|
||||
oTable.Columns.appendByDescriptor(oNewfield.Column)
|
||||
|
||||
Set CreateField = oNewField
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Error_NotApplicable:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Sequence:
|
||||
TraceError(TRACEFATAL, ERRFIELDCREATION, Utils._CalledSub(), 0, 1, pvFieldName)
|
||||
Goto Exit_Function
|
||||
Error_NoUpdate:
|
||||
TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
End Function ' CreateField V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Execute(ByVal Optional pvOptions As Variant) As Boolean
|
||||
'Execute a stored query. The query must be an ACTION query.
|
||||
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".Execute"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
On Local Error Goto Error_Function
|
||||
Const cstNull = -1
|
||||
Execute = False
|
||||
If _Type <> OBJQUERYDEF Then Goto Trace_Method
|
||||
If IsMissing(pvOptions) Then
|
||||
pvOptions = cstNull
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvOptions, 1, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
|
||||
End If
|
||||
|
||||
'Check action query
|
||||
Dim oStatement As Object, vResult As Variant
|
||||
Dim iType As Integer, sSql As String
|
||||
iType = pType
|
||||
If ( (iType And DBQAction) = 0 ) And ( (iType And DBQDDL) = 0 ) Then Goto Trace_Action
|
||||
|
||||
'Execute action query
|
||||
Set oStatement = _ParentDatabase.Connection.createStatement()
|
||||
sSql = Query.Command
|
||||
If pvOptions = dbSQLPassThrough Then oStatement.EscapeProcessing = False _
|
||||
Else oStatement.EscapeProcessing = Query.EscapeProcessing
|
||||
On Local Error Goto SQL_Error
|
||||
vResult = oStatement.executeUpdate(_ParentDatabase._ReplaceSquareBrackets(sSql))
|
||||
On Local Error Goto Error_Function
|
||||
|
||||
Execute = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Method:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, cstThisSub, 0, , cstThisSub)
|
||||
Goto Exit_Function
|
||||
Trace_Action:
|
||||
TraceError(TRACEFATAL, ERRNOTACTIONQUERY, cstThisSub, 0, , _Name)
|
||||
Goto Exit_Function
|
||||
SQL_Error:
|
||||
TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , sSql)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Execute V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Fields(ByVal Optional pvIndex As Variant) As Object
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".Fields"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Set Fields = Nothing
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
End If
|
||||
|
||||
Dim sObjects() As String, sObjectName As String, oObject As Object
|
||||
Dim i As Integer, bFound As Boolean, oFields As Object
|
||||
|
||||
If _Type = OBJTABLEDEF Then Set oFields = Table.getColumns() Else Set oFields = Query.getColumns()
|
||||
sObjects = oFields.ElementNames()
|
||||
Select Case True
|
||||
Case IsMissing(pvIndex)
|
||||
Set oObject = New Collect
|
||||
Set oObject._This = oObject
|
||||
oObject._CollType = COLLFIELDS
|
||||
Set oObject._Parent = _This
|
||||
oObject._Count = UBound(sObjects) + 1
|
||||
Goto Exit_Function
|
||||
Case VarType(pvIndex) = vbString
|
||||
bFound = False
|
||||
' Check existence of object and find its exact (case-sensitive) name
|
||||
For i = 0 To UBound(sObjects)
|
||||
If UCase(pvIndex) = UCase(sObjects(i)) Then
|
||||
sObjectName = sObjects(i)
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If Not bFound Then Goto Trace_NotFound
|
||||
Case Else ' pvIndex is numeric
|
||||
If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
|
||||
sObjectName = sObjects(pvIndex)
|
||||
End Select
|
||||
|
||||
Set oObject = New Field
|
||||
Set oObject._This = oObject
|
||||
oObject._Name = sObjectName
|
||||
Set oObject.Column = oFields.getByName(sObjectName)
|
||||
oObject._ParentName = _Name
|
||||
oObject._ParentType = _Type
|
||||
Set oObject._ParentDatabase = _ParentDatabase
|
||||
|
||||
Exit_Function:
|
||||
Set Fields = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
Trace_NotFound:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("FIELD"), pvIndex))
|
||||
Goto Exit_Function
|
||||
Trace_IndexError:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
End Function ' Fields
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".getProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".hasProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function OpenRecordset(ByVal Optional pvType As Variant, ByVal Optional pvOptions As Variant, ByVal Optional pvLockEdit As Variant) As Object
|
||||
'Return a Recordset object based on current table- or querydef object
|
||||
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".OpenRecordset"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
Const cstNull = -1
|
||||
Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As Boolean
|
||||
Dim iType As Integer, iOptions As Integer, iLockEdit As Integer
|
||||
|
||||
|
||||
Set oObject = Nothing
|
||||
If VarType(pvType) = vbError Then
|
||||
iType = cstNull
|
||||
ElseIf IsMissing(pvType) Then
|
||||
iType = cstNull
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
|
||||
iType = pvType
|
||||
End If
|
||||
If VarType(pvOptions) = vbError Then
|
||||
iOptions = cstNull
|
||||
ElseIf IsMissing(pvOptions) Then
|
||||
iOptions = cstNull
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
|
||||
iOptions = pvOptions
|
||||
End If
|
||||
If VarType(pvLockEdit) = vbError Then
|
||||
iLockEdit = cstNull
|
||||
ElseIf IsMissing(pvLockEdit) Then
|
||||
iLockEdit = cstNull
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function
|
||||
iLockEdit = pvLockEdit
|
||||
End If
|
||||
|
||||
Select Case _Type
|
||||
Case OBJTABLEDEF
|
||||
lCommandType = com.sun.star.sdb.CommandType.TABLE
|
||||
sCommand = _Name
|
||||
Case OBJQUERYDEF
|
||||
lCommandType = com.sun.star.sdb.CommandType.QUERY
|
||||
sCommand = _Name
|
||||
If iOptions = dbSQLPassThrough Then bPassThrough = True Else bPassThrough = Not Query.EscapeProcessing
|
||||
End Select
|
||||
|
||||
Set oObject = New Recordset
|
||||
With oObject
|
||||
._CommandType = lCommandType
|
||||
._Command = sCommand
|
||||
._ParentName = _Name
|
||||
._ParentType = _Type
|
||||
._ForwardOnly = ( iType = dbOpenForwardOnly )
|
||||
._PassThrough = bPassThrough
|
||||
._ReadOnly = ( (iLockEdit = dbReadOnly) Or _ReadOnly )
|
||||
Set ._ParentDatabase = _ParentDatabase
|
||||
Set ._This = oObject
|
||||
Call ._Initialize()
|
||||
End With
|
||||
With _ParentDatabase
|
||||
.RecordsetMax = .RecordsetMax + 1
|
||||
oObject._Name = Format(.RecordsetMax, "0000000")
|
||||
.RecordsetsColl.Add(oObject, UCase(oObject._Name))
|
||||
End With
|
||||
|
||||
If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() ' Do nothing if resultset empty
|
||||
|
||||
Exit_Function:
|
||||
Set OpenRecordset = oObject
|
||||
Set oObject = Nothing
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
Set oObject = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' OpenRecordset V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".Properties"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
Set vProperty._ParentDatabase = _ParentDatabase
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type) & ".setProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
Select Case _Type
|
||||
Case OBJTABLEDEF
|
||||
_PropertiesList = Array("Name", "ObjectType")
|
||||
Case OBJQUERYDEF
|
||||
_PropertiesList = Array("Name", "ObjectType", "SQL", "Type")
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type)
|
||||
Utils._SetCalledSub(cstThisSub & ".get" & psProperty)
|
||||
Dim sSql As String, sVerb As String, iType As Integer
|
||||
_PropertyGet = EMPTY
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("SQL")
|
||||
_PropertyGet = Query.Command
|
||||
Case UCase("Type")
|
||||
iType = 0
|
||||
sSql = Utils._Trim(UCase(Query.Command))
|
||||
sVerb = Split(sSql, " ")(0)
|
||||
If sVerb = "SELECT" Then iType = iType + dbQSelect
|
||||
If sVerb = "SELECT" And InStr(sSql, " INTO ") > 0 _
|
||||
Or sVerb = "CREATE" And InStr(sSql, " TABLE ") > 0 _
|
||||
Then iType = iType + dbQMakeTable
|
||||
If sVerb = "SELECT" And InStr(sSql, " UNION ") > 0 Then iType = iType + dbQSetOperation
|
||||
If Not Query.EscapeProcessing Then iType = iType + dbQSQLPassThrough
|
||||
If sVerb = "INSERT" Then iType = iType + dbQAppend
|
||||
If sVerb = "DELETE" Then iType = iType + dbQDelete
|
||||
If sVerb = "UPDATE" Then iType = iType + dbQUpdate
|
||||
If sVerb = "CREATE" _
|
||||
Or sVerb = "ALTER" _
|
||||
Or sVerb = "DROP" _
|
||||
Or sVerb = "RENAME" _
|
||||
Or sVerb = "TRUNCATE" _
|
||||
Then iType = iType + dbQDDL
|
||||
' dbQAction implied by dbQMakeTable, dbQAppend, dbQDelete and dbQUpdate
|
||||
' To check Type use: If (iType And dbQxxx) <> 0 Then ...
|
||||
_PropertyGet = iType
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub & ".get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub & "._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = Utils._PCase(_Type)
|
||||
Utils._SetCalledSub(cstThisSub & ".set" & psProperty)
|
||||
|
||||
'Execute
|
||||
Dim iArgNr As Integer
|
||||
|
||||
_PropertySet = True
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase(cstThisSub & ".setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub & ".set" & psProperty) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
If _ReadOnly Then Goto Error_NoUpdate
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("SQL")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
Query.Command = pvValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub & ".set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_NoUpdate:
|
||||
TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub & "._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,818 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Dialog" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be DIALOG
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Shortcut As String
|
||||
Private _Dialog As Object ' com.sun.star.io.XInputStreamProvider
|
||||
Private _Storage As String ' GLOBAL or DOCUMENT
|
||||
Private _Library As String
|
||||
Private UnoDialog As Object ' com.sun.star.awt.XControl
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJDIALOG
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
Set _Dialog = Nothing
|
||||
_Storage = ""
|
||||
_Library = ""
|
||||
Set UnoDialog = Nothing
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Caption() As Variant
|
||||
Caption = _PropertyGet("Caption")
|
||||
End Property ' Caption (get)
|
||||
|
||||
Property Let Caption(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Caption", pvValue)
|
||||
End Property ' Caption (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Height() As Variant
|
||||
Height = _PropertyGet("Height")
|
||||
End Property ' Height (get)
|
||||
|
||||
Property Let Height(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Height", pvValue)
|
||||
End Property ' Height (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get IsLoaded() As Boolean
|
||||
IsLoaded = _PropertyGet("IsLoaded")
|
||||
End Property
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
Public Function pName() As String ' For compatibility with < V0.9.0
|
||||
pName = _PropertyGet("Name")
|
||||
End Function ' pName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnFocusGained() As Variant
|
||||
OnFocusGained = _PropertyGet("OnFocusGained")
|
||||
End Property ' OnFocusGained (get)
|
||||
|
||||
Property Let OnFocusGained(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnFocusGained", pvValue)
|
||||
End Property ' OnFocusGained (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnFocusLost() As Variant
|
||||
OnFocusLost = _PropertyGet("OnFocusLost")
|
||||
End Property ' OnFocusLost (get)
|
||||
|
||||
Property Let OnFocusLost(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnFocusLost", pvValue)
|
||||
End Property ' OnFocusLost (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnKeyPressed() As Variant
|
||||
OnKeyPressed = _PropertyGet("OnKeyPressed")
|
||||
End Property ' OnKeyPressed (get)
|
||||
|
||||
Property Let OnKeyPressed(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnKeyPressed", pvValue)
|
||||
End Property ' OnKeyPressed (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnKeyReleased() As Variant
|
||||
OnKeyReleased = _PropertyGet("OnKeyReleased")
|
||||
End Property ' OnKeyReleased (get)
|
||||
|
||||
Property Let OnKeyReleased(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnKeyReleased", pvValue)
|
||||
End Property ' OnKeyReleased (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMouseDragged() As Variant
|
||||
OnMouseDragged = _PropertyGet("OnMouseDragged")
|
||||
End Property ' OnMouseDragged (get)
|
||||
|
||||
Property Let OnMouseDragged(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMouseDragged", pvValue)
|
||||
End Property ' OnMouseDragged (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMouseEntered() As Variant
|
||||
OnMouseEntered = _PropertyGet("OnMouseEntered")
|
||||
End Property ' OnMouseEntered (get)
|
||||
|
||||
Property Let OnMouseEntered(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMouseEntered", pvValue)
|
||||
End Property ' OnMouseEntered (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMouseExited() As Variant
|
||||
OnMouseExited = _PropertyGet("OnMouseExited")
|
||||
End Property ' OnMouseExited (get)
|
||||
|
||||
Property Let OnMouseExited(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMouseExited", pvValue)
|
||||
End Property ' OnMouseExited (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMouseMoved() As Variant
|
||||
OnMouseMoved = _PropertyGet("OnMouseMoved")
|
||||
End Property ' OnMouseMoved (get)
|
||||
|
||||
Property Let OnMouseMoved(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMouseMoved", pvValue)
|
||||
End Property ' OnMouseMoved (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMousePressed() As Variant
|
||||
OnMousePressed = _PropertyGet("OnMousePressed")
|
||||
End Property ' OnMousePressed (get)
|
||||
|
||||
Property Let OnMousePressed(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMousePressed", pvValue)
|
||||
End Property ' OnMousePressed (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnMouseReleased() As Variant
|
||||
OnMouseReleased = _PropertyGet("OnMouseReleased")
|
||||
End Property ' OnMouseReleased (get)
|
||||
|
||||
Property Let OnMouseReleased(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnMouseReleased", pvValue)
|
||||
End Property ' OnMouseReleased (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
|
||||
' Return either an error or an object of type OPTIONGROUP based on its name
|
||||
' A group is determined by the successive TabIndexes of the radio button
|
||||
' The name of the group = the name of its first element
|
||||
|
||||
Utils._SetCalledSub("Dialog.OptionGroup")
|
||||
If IsMissing(pvGroupName) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Set OptionGroup = Nothing
|
||||
If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
Dim iAllCount As Integer, iRadioLast As Integer, iGroupCount As Integer, iBegin As Integer, iEnd As Integer
|
||||
Dim oRadios() As Object, sGroupName As String
|
||||
Dim i As Integer, j As Integer, bFound As Boolean, ocControl As Object, oRadio As Object, iTabIndex As Integer
|
||||
Dim ogGroup As Object, vGroup() As Variant, vIndex() As Variant
|
||||
iAllCount = Controls.Count
|
||||
If iAllCount > 0 Then
|
||||
iRadioLast = -1
|
||||
ReDim oRadios(0 To iAllCount - 1)
|
||||
For i = 0 To iAllCount - 1 ' Store all RadioButtons objects
|
||||
Set ocControl = Controls(i)
|
||||
If ocControl._SubType = CTLRADIOBUTTON Then
|
||||
iRadioLast = iRadioLast + 1
|
||||
Set oRadios(iRadioLast) = ocControl
|
||||
End If
|
||||
Next i
|
||||
Else
|
||||
Goto Error_Arg ' No control in dialog
|
||||
End If
|
||||
|
||||
If iRadioLast < 0 then Goto Error_Arg ' No radio buttons in the dialog
|
||||
|
||||
'Resort oRadio array based on tab indexes
|
||||
If iRadioLast > 0 Then
|
||||
For i = 0 To iRadioLast - 1 ' Bubble sort
|
||||
For j = i + 1 To iRadioLast
|
||||
If oRadios(i).TabIndex > oRadios(j).TabIndex Then
|
||||
Set oRadio = oRadios(i)
|
||||
Set oRadios(i) = oRadios(j)
|
||||
Set oRadios(j) = oRadio
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
End If
|
||||
|
||||
'Scan Names to find match with argument
|
||||
bFound = False
|
||||
For i = 0 To iRadioLast
|
||||
If UCase(oRadios(i)._Name) = UCase(pvGroupName) Then
|
||||
Select Case i
|
||||
Case 0 : bFound = True
|
||||
Case Else
|
||||
If oRadios(i).TabIndex > oRadios(i - 1).TabIndex + 1 Then
|
||||
bFound = True
|
||||
Else
|
||||
Goto Error_Arg ' same group as preceding item although name correct
|
||||
End If
|
||||
End Select
|
||||
If bFound Then
|
||||
iBegin = i
|
||||
iEnd = i
|
||||
sGroupName = oRadios(i)._Name
|
||||
End If
|
||||
ElseIf bFound Then
|
||||
If oRadios(i).TabIndex = oRadios(i - 1).TabIndex + 1 Then iEnd = i
|
||||
End If
|
||||
Next i
|
||||
|
||||
If bFound Then ' Create OptionGroup
|
||||
iGroupCount = iEnd - iBegin + 1
|
||||
Set ogGroup = New OptionGroup
|
||||
ReDim vGroup(0 To iGroupCount - 1)
|
||||
ReDim vIndex(0 To iGroupCount - 1)
|
||||
With ogGroup
|
||||
._This = ogGroup
|
||||
._Name = sGroupName
|
||||
._Count = iGroupCount
|
||||
._ButtonsGroup = vGroup
|
||||
._ButtonsIndex = vIndex
|
||||
For i = 0 To iGroupCount - 1
|
||||
Set ._ButtonsGroup(i) = oRadios(iBegin + i).ControlModel
|
||||
._ButtonsIndex(i) = i
|
||||
Next i
|
||||
._ParentType = CTLPARENTISDIALOG
|
||||
._ParentComponent = UnoDialog
|
||||
End With
|
||||
Else Goto Error_Arg
|
||||
End If
|
||||
|
||||
Set OptionGroup = ogGroup
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.OptionGroup")
|
||||
Exit Function
|
||||
Error_Arg:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.OptionGroup", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' OptionGroup V0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Page() As Variant
|
||||
Page = _PropertyGet("Page")
|
||||
End Property ' Page (get)
|
||||
|
||||
Property Let Page(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Page", pvValue)
|
||||
End Property ' Page (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Parent() As Object
|
||||
Parent = _Parent
|
||||
End Function ' Parent (get) V6.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Const cstThisSub = "Dialog.Properties"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Visible() As Variant
|
||||
Visible = _PropertyGet("Visible")
|
||||
End Property ' Visible (get)
|
||||
|
||||
Property Let Visible(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Visible", pvValue)
|
||||
End Property ' Visible (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Width() As Variant
|
||||
Width = _PropertyGet("Width")
|
||||
End Property ' Width (get)
|
||||
|
||||
Property Let Width(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Width", pvValue)
|
||||
End Property ' Width (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Return a Control object with name or index = pvIndex
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Dialog.Controls")
|
||||
|
||||
Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
|
||||
Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
|
||||
Dim j As Integer
|
||||
|
||||
Set ocControl = Nothing
|
||||
If Not IsLoaded Then Goto Trace_Error_NotOpen
|
||||
Set ocControl = New Control
|
||||
Set ocControl._This = ocControl
|
||||
Set ocControl._Parent = _This
|
||||
ocControl._ParentType = CTLPARENTISDIALOG
|
||||
sParentShortcut = _Shortcut
|
||||
sControls() = UnoDialog.Model.getElementNames()
|
||||
iControlCount = UBound(sControls) + 1
|
||||
|
||||
If IsMissing(pvIndex) Then ' No argument, return Collection object
|
||||
Set oCounter = New Collect
|
||||
Set oCounter._This = oCounter
|
||||
oCounter._CollType = COLLCONTROLS
|
||||
oCounter._Count = iControlCount
|
||||
Set oCounter._Parent = _This
|
||||
Set Controls = oCounter
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
|
||||
' Start building the ocControl object
|
||||
' Determine exact name
|
||||
|
||||
Select Case VarType(pvIndex)
|
||||
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
|
||||
If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index
|
||||
ocControl._Name = sControls(pvIndex)
|
||||
Case vbString ' Check control name validity (non case sensitive)
|
||||
bFound = False
|
||||
sIndex = UCase(Utils._Trim(pvIndex))
|
||||
For i = 0 To iControlCount - 1
|
||||
If UCase(sControls(i)) = sIndex Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
|
||||
End Select
|
||||
|
||||
ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name)
|
||||
Set ocControl.ControlModel = UnoDialog.Model.getByName(ocControl._Name)
|
||||
Set ocControl.ControlView = UnoDialog.getControl(ocControl._Name)
|
||||
ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
|
||||
ocControl._FormComponent = UnoDialog
|
||||
|
||||
ocControl._Initialize()
|
||||
Set Controls = ocControl
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.Controls")
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex))
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Trace_Error_NotOpen:
|
||||
TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, , _Name)
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Trace_NotFound:
|
||||
TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, pvIndex))
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.Controls", Erl)
|
||||
Set Controls = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub EndExecute(ByVal Optional pvReturn As Variant)
|
||||
' Stop executing the dialog
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
Utils._SetCalledSub("Dialog.endExecute")
|
||||
|
||||
If IsMissing(pvReturn) Then pvReturn = 0
|
||||
If Not Utils._CheckArgument(pvReturn, 1, Utils._AddNumeric(), , False) Then Goto Trace_Error
|
||||
|
||||
Dim lExecute As Long
|
||||
lExecute = CLng(pvReturn)
|
||||
If IsNull(_Dialog) Then Goto Error_Execute
|
||||
If IsNull(UnoDialog) Then Goto Error_Not_Started
|
||||
Call UnoDialog.endDialog(lExecute)
|
||||
|
||||
Exit_Sub:
|
||||
Utils._ResetCalledSub("Dialog.endExecute")
|
||||
Exit Sub
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array("1", Utils._CStr(pvReturn)))
|
||||
Goto Exit_Sub
|
||||
Error_Execute:
|
||||
TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
|
||||
Goto Exit_Sub
|
||||
Error_Not_Started:
|
||||
TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
|
||||
Goto Exit_Sub
|
||||
Error_Sub:
|
||||
TraceError(TRACEABORT, Err, "Dialog.endExecute", Erl)
|
||||
GoTo Exit_Sub
|
||||
End Sub ' EndExecute
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Execute() As Long
|
||||
' Execute dialog
|
||||
|
||||
'If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
'Seems smart not to trap errors: debugging of dialog events otherwise made very difficult !
|
||||
Utils._SetCalledSub("Dialog.Execute")
|
||||
|
||||
Dim lExecute As Long
|
||||
If IsNull(_Dialog) Then Goto Error_Execute
|
||||
If IsNull(UnoDialog) Then Goto Error_Not_Started
|
||||
lExecute = UnoDialog.execute()
|
||||
|
||||
Select Case lExecute
|
||||
Case 1 : Execute = dlgOK
|
||||
Case 0 : Execute = dlgCancel
|
||||
Case Else : Execute = lExecute
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.Execute")
|
||||
Exit Function
|
||||
Error_Execute:
|
||||
TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_Not_Started:
|
||||
TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.Execute", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Execute
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Dialog.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Dialog.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Move( ByVal Optional pvLeft As Variant _
|
||||
, ByVal Optional pvTop As Variant _
|
||||
, ByVal Optional pvWidth As Variant _
|
||||
, ByVal Optional pvHeight As Variant _
|
||||
) As Variant
|
||||
' Execute Move method
|
||||
Utils._SetCalledSub("Dialog.Move")
|
||||
On Local Error Goto Error_Function
|
||||
Move = False
|
||||
Dim iArgNr As Integer
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("Move") : iArgNr = 1
|
||||
Case UCase("Dialog.Move") : iArgNr = 0
|
||||
End Select
|
||||
If IsMissing(pvLeft) Then pvLeft = -1
|
||||
If IsMissing(pvTop) Then pvTop = -1
|
||||
If IsMissing(pvWidth) Then pvWidth = -1
|
||||
If IsMissing(pvHeight) Then pvHeight = -1
|
||||
If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
|
||||
Dim iArg As Integer, iWrong As Integer ' Check arguments values
|
||||
iArg = 0
|
||||
If pvHeight < -1 Then
|
||||
iArg = 4 : iWrong = pvHeight
|
||||
ElseIf pvWidth < -1 Then
|
||||
iArg = 3 : iWrong = pvWidth
|
||||
ElseIf pvTop < -1 Then
|
||||
iArg = 2 : iWrong = pvTop
|
||||
ElseIf pvLeft < -1 Then
|
||||
iArg = 1 : iWrong = pvLeft
|
||||
End If
|
||||
If iArg > 0 Then
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong))
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
Dim iPosSize As Integer
|
||||
iPosSize = 0
|
||||
If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X
|
||||
If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y
|
||||
If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH
|
||||
If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT
|
||||
If iPosSize > 0 Then UnoDialog.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize)
|
||||
Move = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.Move")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.Move", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Move
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("Dialog.setProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("Dialog.setProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Start() As Boolean
|
||||
' Create dialog
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Dialog.Start")
|
||||
|
||||
Dim oStart As Object
|
||||
Start = False
|
||||
If IsNull(_Dialog) Then Goto Error_Start
|
||||
If Not IsNull(UnoDialog) Then Goto Error_Yet_Started
|
||||
Set oStart = CreateUnoDialog(_Dialog)
|
||||
If IsNull(oStart) Then
|
||||
Goto Error_Start
|
||||
Else
|
||||
Start = True
|
||||
Set UnoDialog = oStart
|
||||
With _A2B_
|
||||
If .hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) ' Inserted to solve errors, when aborts between start and terminate
|
||||
.Dialogs.Add(UnoDialog, UCase(_Name))
|
||||
End With
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.Start")
|
||||
Exit Function
|
||||
Error_Start:
|
||||
TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_Yet_Started:
|
||||
TraceError(TRACEWARNING, ERRDIALOGSTARTED, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.Start", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Start
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Terminate() As Boolean
|
||||
' Close dialog
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Dialog.Terminate")
|
||||
|
||||
Terminate = False
|
||||
If IsNull(_Dialog) Then Goto Error_Terminate
|
||||
If IsNull(UnoDialog) Then Goto Error_Not_Started
|
||||
UnoDialog.Dispose()
|
||||
Set UnoDialog = Nothing
|
||||
_A2B_.Dialogs.Remove(_Name)
|
||||
Terminate = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.Terminate")
|
||||
Exit Function
|
||||
Error_Terminate:
|
||||
TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
|
||||
Goto Exit_Function
|
||||
Error_Not_Started:
|
||||
TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog.Terminate", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Terminate
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _GetListener(ByVal psProperty As String) As String
|
||||
' Return the X...Listener corresponding with the property in argument
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("OnFocusGained"), UCase("OnFocusLost")
|
||||
_GetListener = "XFocusListener"
|
||||
Case UCase("OnKeyPressed"), UCase("OnKeyReleased")
|
||||
_GetListener = "XKeyListener"
|
||||
Case UCase("OnMouseDragged"), UCase("OnMouseMoved")
|
||||
_GetListener = "XMouseMotionListener"
|
||||
Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased")
|
||||
_GetListener = "XMouseListener"
|
||||
End Select
|
||||
|
||||
End Function ' _GetListener V1.7.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
If IsLoaded Then
|
||||
_PropertiesList = Array("Caption", "Height", "IsLoaded", "Name" _
|
||||
, "OnFocusGained", "OnFocusLost", "OnKeyPressed", "OnKeyReleased", "OnMouseDragged" _
|
||||
, "OnMouseEntered", "OnMouseExited", "OnMouseMoved", "OnMousePressed", "OnMouseReleased" _
|
||||
, "ObjectType", "Page", "Visible", "Width" _
|
||||
)
|
||||
Else
|
||||
_PropertiesList = Array("IsLoaded", "Name" _
|
||||
)
|
||||
End If
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Dialog.get" & psProperty)
|
||||
|
||||
Dim oDialogEvents As Object, sEventName As String
|
||||
|
||||
'Execute
|
||||
_PropertyGet = EMPTY
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name"), UCase("IsLoaded")
|
||||
Case Else
|
||||
If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
|
||||
End Select
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Caption")
|
||||
_PropertyGet = UnoDialog.getTitle()
|
||||
Case UCase("Height")
|
||||
_PropertyGet = UnoDialog.getPosSize().Height
|
||||
Case UCase("IsLoaded")
|
||||
_PropertyGet = _A2B_.hasItem(COLLALLDIALOGS, _Name)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
||||
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
||||
, UCase("OnMousePressed"), UCase("OnMouseReleased")
|
||||
Set oDialogEvents = unoDialog.Model.getEvents()
|
||||
sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty)
|
||||
If oDialogEvents.hasByName(sEventName) Then
|
||||
_PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
|
||||
Else
|
||||
_PropertyGet = ""
|
||||
End If
|
||||
Case UCase("Page")
|
||||
_PropertyGet = UnoDialog.Model.Step
|
||||
Case UCase("Visible")
|
||||
_PropertyGet = UnoDialog.IsVisible()
|
||||
Case UCase("Width")
|
||||
_PropertyGet = UnoDialog.getPosSize().Width
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Trace_Error_Dialog:
|
||||
TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
|
||||
Utils._SetCalledSub("Dialog.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
Dim oDialogEvents As Object, sEventName As String, oEvent As Object, sListener As String, sEvent As String
|
||||
|
||||
'Execute
|
||||
Dim iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "Dialog.") Then iArgNr = 1 Else iArgNr = 2
|
||||
If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Caption")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
UnoDialog.setTitle(pvValue)
|
||||
Case UCase("Height")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
UnoDialog.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT)
|
||||
Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
|
||||
, UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
|
||||
, UCase("OnMousePressed"), UCase("OnMouseReleased")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
If Not Utils._RegisterDialogEventScript(UnoDialog.Model _
|
||||
, psProperty _
|
||||
, _GetListener(psProperty) _
|
||||
, pvValue _
|
||||
) Then GoTo Trace_Error_Dialog
|
||||
Case UCase("Page")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < 0 Then Goto Trace_Error_Value
|
||||
UnoDialog.Model.Step = pvValue
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
UnoDialog.setVisible(pvValue)
|
||||
Case UCase("Width")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value
|
||||
UnoDialog.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH)
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Dialog.set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error_Dialog:
|
||||
TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Dialog._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,493 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Event" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be EVENT
|
||||
Private _EventSource As Object
|
||||
Private _EventType As String
|
||||
Private _EventName As String
|
||||
Private _SubComponentName As String
|
||||
Private _SubComponentType As Long
|
||||
Private _ContextShortcut As String
|
||||
Private _ButtonLeft As Boolean ' com.sun.star.awt.MouseButton.XXX
|
||||
Private _ButtonRight As Boolean
|
||||
Private _ButtonMiddle As Boolean
|
||||
Private _XPos As Variant ' Null or Long
|
||||
Private _YPos As Variant ' Null or Long
|
||||
Private _ClickCount As Long
|
||||
Private _KeyCode As Integer ' com.sun.star.awt.Key.XXX
|
||||
Private _KeyChar As String
|
||||
Private _KeyFunction As Integer ' com.sun.star.awt.KeyFunction.XXX
|
||||
Private _KeyAlt As Boolean
|
||||
Private _KeyCtrl As Boolean
|
||||
Private _KeyShift As Boolean
|
||||
Private _FocusChangeTemporary As Boolean ' False if user action in same window
|
||||
Private _RowChangeAction As Long ' com.sun.star.sdb.RowChangeAction.XXX
|
||||
Private _Recommendation As String ' "IGNORE" or ""
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJEVENT
|
||||
_EventSource = Nothing
|
||||
_EventType = ""
|
||||
_EventName = ""
|
||||
_SubComponentName = ""
|
||||
_SubComponentType = -1
|
||||
_ContextShortcut = ""
|
||||
_ButtonLeft = False ' See com.sun.star.awt.MouseButton.XXX
|
||||
_ButtonRight = False
|
||||
_ButtonMiddle = False
|
||||
_XPos = Null
|
||||
_YPos = Null
|
||||
_ClickCount = 0
|
||||
_KeyCode = 0
|
||||
_KeyChar = ""
|
||||
_KeyFunction = com.sun.star.awt.KeyFunction.DONTKNOW
|
||||
_KeyAlt = False
|
||||
_KeyCtrl = False
|
||||
_KeyShift = False
|
||||
_FocusChangeTemporary = False
|
||||
_RowChangeAction = 0
|
||||
_Recommendation = ""
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ButtonLeft() As Variant
|
||||
ButtonLeft = _PropertyGet("ButtonLeft")
|
||||
End Property ' ButtonLeft (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ButtonMiddle() As Variant
|
||||
ButtonMiddle = _PropertyGet("ButtonMiddle")
|
||||
End Property ' ButtonMiddle (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ButtonRight() As Variant
|
||||
ButtonRight = _PropertyGet("ButtonRight")
|
||||
End Property ' ButtonRight (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ClickCount() As Variant
|
||||
ClickCount = _PropertyGet("ClickCount")
|
||||
End Property ' ClickCount (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ContextShortcut() As Variant
|
||||
ContextShortcut = _PropertyGet("ContextShortcut")
|
||||
End Property ' ContextShortcut (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventName() As Variant
|
||||
EventName = _PropertyGet("EventName")
|
||||
End Property ' EventName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventSource() As Variant
|
||||
EventSource = _PropertyGet("EventSource")
|
||||
End Property ' EventSource (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get EventType() As Variant
|
||||
EventType = _PropertyGet("EventType")
|
||||
End Property ' EventType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get FocusChangeTemporary() As Variant
|
||||
FocusChangeTemporary = _PropertyGet("FocusChangeTemporary")
|
||||
End Property ' FocusChangeTemporary (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyAlt() As Variant
|
||||
KeyAlt = _PropertyGet("KeyAlt")
|
||||
End Property ' KeyAlt (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyChar() As Variant
|
||||
KeyChar = _PropertyGet("KeyChar")
|
||||
End Property ' KeyChar (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyCode() As Variant
|
||||
KeyCode = _PropertyGet("KeyCode")
|
||||
End Property ' KeyCode (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyCtrl() As Variant
|
||||
KeyCtrl = _PropertyGet("KeyCtrl")
|
||||
End Property ' KeyCtrl (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyFunction() As Variant
|
||||
KeyFunction = _PropertyGet("KeyFunction")
|
||||
End Property ' KeyFunction (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get KeyShift() As Variant
|
||||
KeyShift = _PropertyGet("KeyShift")
|
||||
End Property ' KeyShift (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Recommendation() As Variant
|
||||
Recommendation = _PropertyGet("Recommendation")
|
||||
End Property ' Recommendation (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get RowChangeAction() As Variant
|
||||
RowChangeAction = _PropertyGet("RowChangeAction")
|
||||
End Property ' RowChangeAction (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Source() As Variant
|
||||
' Return the object having fired the event: Form, Control or SubForm
|
||||
' Else return the root Database object
|
||||
Source = _PropertyGet("Source")
|
||||
End Function ' Source (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SubComponentName() As String
|
||||
SubComponentName = _PropertyGet("SubComponentName")
|
||||
End Property ' SubComponentName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SubComponentType() As Long
|
||||
SubComponentType = _PropertyGet("SubComponentType")
|
||||
End Property ' SubComponentType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get XPos() As Variant
|
||||
XPos = _PropertyGet("XPos")
|
||||
End Property ' XPos (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get YPos() As Variant
|
||||
YPos = _PropertyGet("YPos")
|
||||
End Property ' YPos (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Form.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Form.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub _Initialize(poEvent As Object)
|
||||
|
||||
Dim oObject As Object, i As Integer
|
||||
Dim sShortcut As String, sAddShortcut As String, sArray() As String
|
||||
Dim sImplementation As String, oSelection As Object
|
||||
Dim iCurrentDoc As Integer, oDoc As Object
|
||||
Dim vPersistent As Variant
|
||||
Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Set oObject = poEvent.Source
|
||||
_EventSource = oObject
|
||||
sArray = Split(Utils._getUNOTypeName(poEvent), ".")
|
||||
_EventType = UCase(sArray(UBound(sArray)))
|
||||
If Utils._hasUNOProperty(poEvent, "EventName") Then _EventName = poEvent.EventName
|
||||
|
||||
Select Case _EventType
|
||||
Case "DOCUMENTEVENT"
|
||||
'SubComponent processing
|
||||
Select Case UCase(_EventName)
|
||||
Case UCase("OnSubComponentClosed"), UCase("OnSubComponentOpened")
|
||||
Set oSelection = poEvent.ViewController.getSelection()(0)
|
||||
_SubComponentName = oSelection.Name
|
||||
With com.sun.star.sdb.application.DatabaseObject
|
||||
Select Case oSelection.Type
|
||||
Case .TABLE : _SubComponentType = acTable
|
||||
Case .QUERY : _SubComponentType = acQuery
|
||||
Case .FORM : _SubComponentType = acForm
|
||||
Case .REPORT : _SubComponentType = acReport
|
||||
Case Else
|
||||
End Select
|
||||
End With
|
||||
Case Else
|
||||
End Select
|
||||
Case "EVENTOBJECT"
|
||||
Case "ACTIONEVENT"
|
||||
Case "FOCUSEVENT"
|
||||
_FocusChangeTemporary = poEvent.Temporary
|
||||
Case "ITEMEVENT"
|
||||
Case "INPUTEVENT", "KEYEVENT"
|
||||
_KeyCode = poEvent.KeyCode
|
||||
_KeyChar = poEvent.KeyChar
|
||||
_KeyFunction = poEvent.KeyFunc
|
||||
_KeyAlt = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD2)
|
||||
_KeyCtrl = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD1)
|
||||
_KeyShift = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.SHIFT)
|
||||
Case "MOUSEEVENT"
|
||||
_ButtonLeft = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.LEFT)
|
||||
_ButtonRight = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.RIGHT)
|
||||
_ButtonMiddle = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.MIDDLE)
|
||||
_XPos = poEvent.X
|
||||
_YPos = poEvent.Y
|
||||
_ClickCount = poEvent.ClickCount
|
||||
Case "ROWCHANGEEVENT"
|
||||
_RowChangeAction = poEvent.Action
|
||||
Case "TEXTEVENT"
|
||||
Case "ADJUSTMENTEVENT", "DOCKINGEVENT", "ENDDOCKINGEVENT", "ENDPOPUPMODEEVENT", "ENHANCEDMOUSEEVENT" _
|
||||
, "MENUEVENT", "PAINTEVENT", "SPINEVENT", "VCLCONTAINEREVENT", "WINDOWEVENT"
|
||||
Goto Exit_Function
|
||||
Case Else
|
||||
Goto Exit_Function
|
||||
End Select
|
||||
|
||||
' Evaluate ContextShortcut
|
||||
sShortcut = ""
|
||||
sImplementation = Utils._ImplementationName(oObject)
|
||||
|
||||
Select Case True
|
||||
Case sImplementation = "stardiv.Toolkit.UnoDialogControl" ' Dialog
|
||||
_ContextShortcut = "Dialogs!" & _EventSource.Model.Name
|
||||
Goto Exit_Function
|
||||
Case Left(sImplementation, 16) = "stardiv.Toolkit." ' Control in Dialog
|
||||
_ContextShortcut = "Dialogs!" & _EventSource.Context.Model.Name _
|
||||
& "!" & _EventSource.Model.Name
|
||||
Goto Exit_Function
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
iCurrentDoc = _A2B_.CurrentDocIndex(, False)
|
||||
If iCurrentDoc < 0 Then Goto Exit_Function
|
||||
Set oDoc = _A2B_.CurrentDocument(iCurrentDoc)
|
||||
|
||||
' To manage 2x triggers of "Before record action" form event
|
||||
If _EventType = "ROWCHANGEEVENT" And sImplementation <> "com.sun.star.comp.forms.ODatabaseForm" Then _Recommendation = "IGNORE"
|
||||
|
||||
Do While sImplementation <> "SwXTextDocument"
|
||||
sAddShortcut = ""
|
||||
Select Case sImplementation
|
||||
Case "com.sun.star.comp.forms.OFormsCollection" ' Do nothing
|
||||
Case Else
|
||||
If Utils._hasUNOProperty(oObject, "Model") Then
|
||||
If oObject.Model.Name <> "MainForm" And oObject.Model.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Model.Name)
|
||||
ElseIf Utils._hasUNOProperty(oObject, "Name") Then
|
||||
If oObject.Name <> "MainForm" And oObject.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Name)
|
||||
End If
|
||||
If sAddShortcut <> "" Then
|
||||
If sImplementation = cstDatabaseForm And oDoc.DbConnect = DBCONNECTBASE Then sAddShortcut = sAddShortcut & ".Form"
|
||||
sShortcut = sAddShortcut & Iif(Len(sShortcut) > 0, "!" & sShortcut, "")
|
||||
End If
|
||||
End Select
|
||||
Select Case True
|
||||
Case Utils._hasUNOProperty(oObject, "Model")
|
||||
Set oObject = oObject.Model.Parent
|
||||
Case Utils._hasUNOProperty(oObject, "Parent")
|
||||
Set oObject = oObject.Parent
|
||||
Case Else
|
||||
Goto Exit_Function
|
||||
End Select
|
||||
sImplementation = Utils._ImplementationName(oObject)
|
||||
Loop
|
||||
' Add Forms! prefix
|
||||
Select Case oDoc.DbConnect
|
||||
Case DBCONNECTBASE
|
||||
vPersistent = Split(oObject.StringValue, "/")
|
||||
sAddShortcut = Utils._Surround(_GetHierarchicalName(vPersistent(UBound(vPersistent) - 1)))
|
||||
sShortcut = "Forms!" & sAddShortcut & "!" & sShortcut
|
||||
Case DBCONNECTFORM
|
||||
sShortcut = "Forms!0!" & sShortcut
|
||||
End Select
|
||||
|
||||
sArray = Split(sShortcut, "!")
|
||||
' If presence of "Forms!myform!myform.Form", eliminate 2nd element
|
||||
' Eliminate anyway blanco subcomponents (e.g. Forms!!myForm)
|
||||
If UBound(sArray) >= 2 Then
|
||||
If UCase(sArray(1)) & ".FORM" = UCase(sArray(2)) Then sArray(1) = ""
|
||||
sArray = Utils._TrimArray(sArray)
|
||||
End If
|
||||
' If first element ends with .Form, remove suffix
|
||||
If UBound(sArray) >= 1 Then
|
||||
If Len(sArray(1)) > 5 And Right(sArray(1), 5) = ".Form" Then sArray(1) = left(sArray(1), Len(sArray(1)) - 5)
|
||||
sShortcut = Join(sArray, "!")
|
||||
End If
|
||||
If Len(sShortcut) >= 2 Then
|
||||
If Right(sShortcut, 1) = "!" Then
|
||||
_ContextShortcut = Left(sShortcut, Len(sShortcut) - 1)
|
||||
Else
|
||||
_ContextShortcut = sShortcut
|
||||
End If
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Sub
|
||||
Error_Function:
|
||||
TraceError(TRACEWARNING, Err, "Event.Initialize", Erl)
|
||||
GoTo Exit_Function
|
||||
End Sub ' _Initialize V0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
Dim sSubComponentName As String, sSubComponentType As String
|
||||
sSubComponentName = Iif(_SubComponentType > -1, "SubComponentName", "")
|
||||
sSubComponentType = Iif(_SubComponentType > -1, "SubComponentType", "")
|
||||
Dim sXPos As String, sYPos As String
|
||||
sXPos = Iif(IsNull(_XPos), "", "XPos")
|
||||
sYPos = Iif(IsNull(_YPos), "", "YPos")
|
||||
|
||||
_PropertiesList = Utils._TrimArray(Array( _
|
||||
"ButtonLeft", "ButtonRight", "ButtonMiddle", "ClickCount" _
|
||||
, "ContextShortcut", "EventName", "EventType", "FocusChangeTemporary", _
|
||||
, "KeyAlt", "KeyChar", "KeyCode", "KeyCtrl", "KeyFunction", "KeyShift" _
|
||||
, "ObjectType", "Recommendation", "RowChangeAction", "Source" _
|
||||
, sSubComponentName, sSubComponentType, sXPos, sYPos _
|
||||
))
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Event.get" & psProperty)
|
||||
|
||||
_PropertyGet = EMPTY
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("ButtonLeft")
|
||||
_PropertyGet = _ButtonLeft
|
||||
Case UCase("ButtonMiddle")
|
||||
_PropertyGet = _ButtonMiddle
|
||||
Case UCase("ButtonRight")
|
||||
_PropertyGet = _ButtonRight
|
||||
Case UCase("ClickCount")
|
||||
_PropertyGet = _ClickCount
|
||||
Case UCase("ContextShortcut")
|
||||
_PropertyGet = _ContextShortcut
|
||||
Case UCase("FocusChangeTemporary")
|
||||
_PropertyGet = _FocusChangeTemporary
|
||||
Case UCase("EventName")
|
||||
_PropertyGet = _EventName
|
||||
Case UCase("EventSource")
|
||||
_PropertyGet = _EventSource
|
||||
Case UCase("EventType")
|
||||
_PropertyGet = _EventType
|
||||
Case UCase("KeyAlt")
|
||||
_PropertyGet = _KeyAlt
|
||||
Case UCase("KeyChar")
|
||||
_PropertyGet = _KeyChar
|
||||
Case UCase("KeyCode")
|
||||
_PropertyGet = _KeyCode
|
||||
Case UCase("KeyCtrl")
|
||||
_PropertyGet = _KeyCtrl
|
||||
Case UCase("KeyFunction")
|
||||
_PropertyGet = _KeyFunction
|
||||
Case UCase("KeyShift")
|
||||
_PropertyGet = _KeyShift
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Recommendation")
|
||||
_PropertyGet = _Recommendation
|
||||
Case UCase("RowChangeAction")
|
||||
_PropertyGet = _RowChangeAction
|
||||
Case UCase("Source")
|
||||
If _ContextShortcut = "" Then
|
||||
_PropertyGet = _EventSource
|
||||
Else
|
||||
_PropertyGet = getObject(_ContextShortcut)
|
||||
End If
|
||||
Case UCase("SubComponentName")
|
||||
_PropertyGet = _SubComponentName
|
||||
Case UCase("SubComponentType")
|
||||
_PropertyGet = _SubComponentType
|
||||
Case UCase("XPos")
|
||||
If IsNull(_XPos) Then Goto Trace_Error
|
||||
_PropertyGet = _XPos
|
||||
Case UCase("YPos")
|
||||
If IsNull(_YPos) Then Goto Trace_Error
|
||||
_PropertyGet = _YPos
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Event.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
' Errors are not displayed to avoid display infinite cycling
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, False, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Event._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet V1.1.0
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,923 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Field" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be FIELD
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Precision As Long
|
||||
Private _ParentName As String
|
||||
Private _ParentType As String
|
||||
Private _ParentDatabase As Object
|
||||
Private _ParentRecordset As Object
|
||||
Private _DefaultValue As String
|
||||
Private _DefaultValueSet As Boolean
|
||||
Private Column As Object ' com.sun.star.sdb.OTableColumnWrapper
|
||||
' or org.openoffice.comp.dbaccess.OQueryColumn
|
||||
' or com.sun.star.sdb.ODataColumn
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJFIELD
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_ParentName = ""
|
||||
_ParentType = ""
|
||||
_DefaultValue = ""
|
||||
_DefaultValueSet = False
|
||||
Set Column = Nothing
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get DataType() As Long ' AOO/LibO type
|
||||
DataType = _PropertyGet("DataType")
|
||||
End Property ' DataType (get)
|
||||
|
||||
Property Get DataUpdatable() As Boolean
|
||||
DataUpdatable = _PropertyGet("DataUpdatable")
|
||||
End Property ' DataUpdatable (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get DbType() As Long ' MSAccess type
|
||||
DbType = _PropertyGet("DbType")
|
||||
End Property ' DbType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get DefaultValue() As Variant
|
||||
DefaultValue = _PropertyGet("DefaultValue")
|
||||
End Property ' DefaultValue (get)
|
||||
|
||||
Property Let DefaultValue(ByVal pvDefaultValue As Variant)
|
||||
Call _PropertySet("DefaultValue", pvDefaultValue)
|
||||
End Property ' DefaultValue (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Description() As Variant
|
||||
Description = _PropertyGet("Description")
|
||||
End Property ' Description (get)
|
||||
|
||||
Property Let Description(ByVal pvDescription As Variant)
|
||||
Call _PropertySet("Description", pvDescription)
|
||||
End Property ' Description (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get FieldSize() As Long
|
||||
FieldSize = _PropertyGet("FieldSize")
|
||||
End Property ' FieldSize (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Size() As Long
|
||||
Size = _PropertyGet("Size")
|
||||
End Property ' Size (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SourceField() As String
|
||||
SourceField = _PropertyGet("SourceField")
|
||||
End Property ' SourceField (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get SourceTable() As String
|
||||
SourceTable = _PropertyGet("SourceTable")
|
||||
End Property ' SourceTable (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get TypeName() As String
|
||||
TypeName = _PropertyGet("TypeName")
|
||||
End Property ' TypeName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
Property Let Value(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Value", pvValue)
|
||||
End Property ' Value (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AppendChunk(ByRef Optional pvValue As Variant) As Boolean
|
||||
' Store a chunk of string or binary characters into the current field, presumably a large object (CLOB or BLOB)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "Field.AppendChunk"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
AppendChunk = False
|
||||
|
||||
If IsMissing(pvValue) Then Call _TraceArguments()
|
||||
|
||||
If _ParentType <> OBJRECORDSET Then Goto Trace_Error ' Not on table- or querydefs ... !
|
||||
If Not Column.IsWritable Then Goto Trace_Error_Updatable
|
||||
If Column.IsReadOnly Then Goto Trace_Error_Updatable
|
||||
If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
|
||||
|
||||
Dim iChunkType As Integer
|
||||
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type ' DOES NOT WORK FOR CHARACTER TYPES
|
||||
' Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
|
||||
' iChunkType = vbString
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB, .CHAR ' .CHAR added for Sqlite3
|
||||
iChunkType = vbByte
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
End With
|
||||
|
||||
AppendChunk = _ParentRecordset._AppendChunk(_Name, pvValue, iChunkType)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error_Update:
|
||||
TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Updatable:
|
||||
TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub)
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' AppendChunk V1.5.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function GetChunk(ByVal Optional pvOffset As Variant, ByVal Optional pvBytes As Variant) As Variant
|
||||
' Get a chunk of string or binary characters from the current field, presumably a large object (CLOB or BLOB)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "Field.GetChunk"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim oValue As Object, bNullable As Boolean, bNull As Boolean, vValue() As Variant
|
||||
Dim lLength As Long, lOffset As Long, lValue As Long
|
||||
|
||||
If IsMissing(pvOffset) Or IsMissing(pvBytes) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvOffset, 1, _AddNumeric()) Then Goto Exit_Function
|
||||
If pvOffset < 0 Then
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvOffset))
|
||||
Goto Exit_Function
|
||||
End If
|
||||
If Not Utils._CheckArgument(pvBytes, 2, _AddNumeric()) Then Goto Exit_Function
|
||||
If pvBytes < 0 Then
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(2, pvBytes))
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
|
||||
bNull = False
|
||||
GetChunk = Null
|
||||
vValue = Array()
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type ' DOES NOT WORK FOR CHARACTER TYPES
|
||||
' Case .CHAR, .VARCHAR, .LONGVARCHAR
|
||||
' Set oValue = Column.getCharacterStream()
|
||||
' Case .CLOB
|
||||
' Set oValue = Column.getClob.getCharacterStream()
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY
|
||||
Set oValue = Column.getBinaryStream()
|
||||
Case .BLOB
|
||||
Set oValue = Column.getBlob.getBinaryStream()
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then
|
||||
lOffset = CLng(pvOffset)
|
||||
If lOffset > 0 Then oValue.skipBytes(lOffset)
|
||||
lValue = oValue.readBytes(vValue, pvBytes)
|
||||
End If
|
||||
oValue.closeInput()
|
||||
End With
|
||||
GetChunk = vValue
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub)
|
||||
Goto Exit_Function
|
||||
Trace_Argument:
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex))
|
||||
Set vForms = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' GetChunk V1.5.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Const cstThisSub = "Field.getProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
Const cstThisSub = "Field.hasProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String, sName As String
|
||||
Const cstThisSub = "Field.Properties"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
sName = _ParentType & "/" & _ParentName & "/" & _Name
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
Set vProperty._ParentDatabase = _ParentDatabase
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ReadAllBytes(ByVal Optional pvFile As Variant) As Boolean
|
||||
' Read the whole content of a file into Long Binary Field object
|
||||
|
||||
Const cstThisSub = "Field.ReadAllBytes"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
ReadAllBytes = _ReadAll(pvFile, "ReadAllBytes")
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ReadAllBytes
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ReadAllText(ByVal Optional pvFile As Variant) As Boolean
|
||||
' Read the whole content of a file into a Long Char Field object
|
||||
|
||||
Const cstThisSub = "Field.ReadAllText"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
ReadAllText = _ReadAll(pvFile, "ReadAllText")
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ReadAllText
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Const cstThisSub = "Field.setProperty"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function WriteAllBytes(ByVal Optional pvFile As Variant) As Boolean
|
||||
' Write the whole content of a Long Binary Field object to a file
|
||||
|
||||
Const cstThisSub = "Field.WriteAllBytes"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
WriteAllBytes = _WriteAll(pvFile, "WriteAllBytes")
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' WriteAllBytes
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function WriteAllText(ByVal Optional pvFile As Variant) As Boolean
|
||||
' Write the whole content of a Long Char Field object to a file
|
||||
|
||||
Const cstThisSub = "Field.WriteAllText"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
WriteAllText = _WriteAll(pvFile, "WriteAllText")
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' WriteAllText
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
Select Case _ParentType
|
||||
Case OBJTABLEDEF
|
||||
_PropertiesList =Array("DataType", "dbType", "DefaultValue" _
|
||||
, "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _
|
||||
, "TypeName" _
|
||||
)
|
||||
Case OBJQUERYDEF
|
||||
_PropertiesList = Array("DataType", "dbType", "DefaultValue" _
|
||||
, "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _
|
||||
, "TypeName" _
|
||||
)
|
||||
Case OBJRECORDSET
|
||||
_PropertiesList = Array("DataType", "DataUpdatable", "dbType", "DefaultValue" _
|
||||
, "Description" , "FieldSize", "Name", "ObjectType" _
|
||||
, "Size", "SourceTable", "TypeName", "Value" _
|
||||
)
|
||||
End Select
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "Field.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
Dim bCond1 As Boolean, bCond2 As Boolean, vValue As Variant, oValue As Object, sValue As String
|
||||
Dim oSize As Object, lSize As Long, bNullable As Boolean, bNull As Boolean
|
||||
Const cstMaxBinlength = 2 * 65535
|
||||
|
||||
_PropertyGet = EMPTY
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("DataType")
|
||||
_PropertyGet = Column.Type
|
||||
Case UCase("DbType")
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .BIT : _PropertyGet = dbBoolean
|
||||
Case .TINYINT : _PropertyGet = dbInteger
|
||||
Case .SMALLINT : _PropertyGet = dbLong
|
||||
Case .INTEGER : _PropertyGet = dbLong
|
||||
Case .BIGINT : _PropertyGet = dbBigInt
|
||||
Case .FLOAT : _PropertyGet = dbFloat
|
||||
Case .REAL : _PropertyGet = dbSingle
|
||||
Case .DOUBLE : _PropertyGet = dbDouble
|
||||
Case .NUMERIC : _PropertyGet = dbNumeric
|
||||
Case .DECIMAL : _PropertyGet = dbDecimal
|
||||
Case .CHAR : _PropertyGet = dbChar
|
||||
Case .VARCHAR : _PropertyGet = dbText
|
||||
Case .LONGVARCHAR : _PropertyGet = dbMemo
|
||||
Case .CLOB : _PropertyGet = dbMemo
|
||||
Case .DATE : _PropertyGet = dbDate
|
||||
Case .TIME : _PropertyGet = dbTime
|
||||
Case .TIMESTAMP : _PropertyGet = dbTimeStamp
|
||||
Case .BINARY : _PropertyGet = dbBinary
|
||||
Case .VARBINARY : _PropertyGet = dbVarBinary
|
||||
Case .LONGVARBINARY : _PropertyGet = dbLongBinary
|
||||
Case .BLOB : _PropertyGet = dbLongBinary
|
||||
Case .BOOLEAN : _PropertyGet = dbBoolean
|
||||
Case Else : _PropertyGet = dbUndefined
|
||||
End Select
|
||||
End With
|
||||
Case UCase("DataUpdatable")
|
||||
If Utils._hasUNOProperty(Column, "IsWritable") Then
|
||||
_PropertyGet = Column.IsWritable
|
||||
ElseIf Utils._hasUNOProperty(Column, "IsReadOnly") Then
|
||||
_PropertyGet = Not Column.IsReadOnly
|
||||
ElseIf Utils._hasUNOProperty(Column, "IsDefinitelyWritable") Then
|
||||
_PropertyGet = Column.IsDefinitelyWritable
|
||||
Else
|
||||
_PropertyGet = False
|
||||
End If
|
||||
If Utils._hasUNOProperty(Column, "IsAutoIncrement") Then
|
||||
If Column.IsAutoIncrement Then _PropertyGet = False ' Forces False if auto-increment (MSAccess)
|
||||
End If
|
||||
Case UCase("DefaultValue")
|
||||
' default value buffered to avoid multiple calls
|
||||
If Not _DefaultValueSet Then
|
||||
If Utils._hasUNOProperty(Column, "DefaultValue") Then ' Default value in database set via SQL statement
|
||||
_DefaultValue = Column.DefaultValue
|
||||
ElseIf Utils._hasUNOProperty(Column, "ControlDefault") Then ' Default value set in Base via table edition
|
||||
If IsEmpty(Column.ControlDefault) Then _DefaultValue = "" Else _DefaultValue = Column.ControlDefault
|
||||
Else
|
||||
_DefaultValue = ""
|
||||
End If
|
||||
_DefaultValueSet = True
|
||||
End If
|
||||
_PropertyGet = _DefaultValue
|
||||
Case UCase("Description")
|
||||
bCond1 = Utils._hasUNOProperty(Column, "Description")
|
||||
bCond2 = Utils._hasUNOProperty(Column, "HelpText")
|
||||
Select Case True
|
||||
Case ( bCond1 And bCond2 )
|
||||
If IsEmpty(Column.HelpText) Then _PropertyGet = Column.Description Else _PropertyGet = Column.HelpText
|
||||
Case ( bCond1 And ( Not bCond2 ) )
|
||||
_PropertyGet = Column.Description
|
||||
Case ( ( Not bCond1 ) And bCond2 )
|
||||
_PropertyGet = Column.HelpText
|
||||
Case Else
|
||||
_PropertyGet = ""
|
||||
End Select
|
||||
Case UCase("FieldSize")
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .VARCHAR, .LONGVARCHAR, .CLOB
|
||||
Set oSize = Column.getCharacterStream
|
||||
Case .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB
|
||||
Set oSize = Column.getBinaryStream
|
||||
Case Else
|
||||
Set oSize = Nothing
|
||||
End Select
|
||||
End With
|
||||
If Not IsNull(oSize) Then
|
||||
bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
|
||||
If bNullable Then
|
||||
If Column.wasNull() Then _PropertyGet = 0 Else _PropertyGet = CLng(oSize.getLength())
|
||||
Else
|
||||
_PropertyGet = CLng(oSize.getLength())
|
||||
End If
|
||||
oSize.closeInput()
|
||||
Else
|
||||
_PropertyGet = EMPTY
|
||||
End If
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Size")
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .LONGVARCHAR, .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB, .CLOB
|
||||
_PropertyGet = 0 ' Always 0 (MSAccess)
|
||||
Case Else
|
||||
If Utils._hasUNOProperty(Column, "Precision") Then _PropertyGet = Column.Precision Else _PropertyGet = 0
|
||||
End Select
|
||||
End With
|
||||
Case UCase("SourceField")
|
||||
Select Case _ParentType
|
||||
Case OBJTABLEDEF
|
||||
_PropertyGet = _Name
|
||||
Case OBJQUERYDEF ' RealName = not documented ?!?
|
||||
If Utils._hasUNOProperty(Column, "RealName") Then _PropertyGet = Column.RealName Else _PropertyGet = _Name
|
||||
End Select
|
||||
Case UCase("SourceTable")
|
||||
Select Case _ParentType
|
||||
Case OBJTABLEDEF
|
||||
_PropertyGet = _ParentName
|
||||
Case OBJQUERYDEF, OBJRECORDSET
|
||||
_PropertyGet = Column.TableName
|
||||
End Select
|
||||
Case UCase("TypeName")
|
||||
_PropertyGet = Column.TypeName
|
||||
Case UCase("Value")
|
||||
bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
|
||||
bNull = False
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .BIT, .BOOLEAN : vValue = Column.getBoolean() ' vbBoolean
|
||||
Case .TINYINT : vValue = Column.getShort() ' vbInteger
|
||||
Case .SMALLINT, .INTEGER: vValue = Column.getInt() ' vbLong
|
||||
Case .BIGINT : vValue = Column.getLong() ' vbBigint
|
||||
Case .FLOAT : vValue = Column.getFloat() ' vbSingle
|
||||
Case .REAL, .DOUBLE : vValue = Column.getDouble() ' vbDouble
|
||||
Case .NUMERIC, .DECIMAL
|
||||
If Utils._hasUNOProperty(Column, "Scale") Then
|
||||
If Column.Scale > 0 Then
|
||||
vValue = Column.getDouble()
|
||||
Else ' Try Long otherwise Double (CDec not implemented anymore in LO ?!?)
|
||||
On Local Error Resume Next ' Avoid overflow error
|
||||
' CLng checks local decimal point, getString does not !
|
||||
sValue = Join(Split(Column.getString(), "."), Utils._DecimalPoint())
|
||||
vValue = CLng(sValue)
|
||||
If Err <> 0 Then
|
||||
vValue = CDbl(sValue)
|
||||
Err.Clear
|
||||
On Local Error Goto Error_Function
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
vValue = CDbl(Column.getString())
|
||||
End If
|
||||
Case .CHAR : vValue = Column.getString()
|
||||
Case .VARCHAR : vValue = Column.getString() ' vbString
|
||||
Case .LONGVARCHAR, .CLOB
|
||||
Set oValue = Column.getCharacterStream()
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then
|
||||
lSize = CLng(oValue.getLength())
|
||||
oValue.closeInput()
|
||||
vValue = Column.getString() ' vbString
|
||||
Else
|
||||
oValue.closeInput()
|
||||
End If
|
||||
Case .DATE : Set oValue = Column.getDate() ' vbObject with members VarType Unsigned Short = 18
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day))
|
||||
Case .TIME : Set oValue = Column.getTime() ' vbObject with members VarType Unsigned Short = 18
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then vValue = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)', oValue.HundredthSeconds)
|
||||
Case .TIMESTAMP : Set oValue = Column.getTimeStamp()
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day)) _
|
||||
+ TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)', oValue.HundredthSeconds)
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
|
||||
Set oValue = Column.getBinaryStream()
|
||||
If bNullable Then bNull = Column.wasNull()
|
||||
If Not bNull Then
|
||||
lSize = CLng(oValue.getLength()) ' vbLong => equivalent to FieldSize
|
||||
If lSize > cstMaxBinlength Then Goto Trace_Length
|
||||
vValue = Array()
|
||||
oValue.readBytes(vValue, lSize)
|
||||
End If
|
||||
oValue.closeInput()
|
||||
Case Else
|
||||
vValue = Column.getString() 'GIVE STRING A TRY
|
||||
If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess)
|
||||
End Select
|
||||
If bNullable Then
|
||||
If Column.wasNull() Then vValue = Null 'getXXX must precede wasNull()
|
||||
End If
|
||||
End With
|
||||
_PropertyGet = vValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Trace_Length:
|
||||
TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(lSize, "GetChunk"))
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Dim cstThisSub As String
|
||||
cstThisSub = "Field.set" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertySet = True
|
||||
Dim iArgNr As Integer, vTemp As Variant
|
||||
Dim oParent As Object
|
||||
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("setProperty") : iArgNr = 3
|
||||
Case UCase("Field.setProperty") : iArgNr = 2
|
||||
Case UCase(cstThisSub) : iArgNr = 1
|
||||
End Select
|
||||
|
||||
If Not hasProperty(psProperty) Then Goto Trace_Error
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("DefaultValue")
|
||||
If _ParentType <> OBJTABLEDEF Then Goto Trace_Error
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
If Utils._hasUNOProperty(Column, "ControlDefault") Then ' Default value set in Base via table edition
|
||||
Column.ControlDefault = pvValue
|
||||
_DefaultValue = pvValue
|
||||
_DefaultValueSet = True
|
||||
End If
|
||||
Case UCase("Description")
|
||||
If _ParentType <> OBJTABLEDEF Then Goto Trace_Error
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
Column.HelpText = pvValue
|
||||
Case UCase("Value")
|
||||
If _ParentType <> OBJRECORDSET Then Goto Trace_Error ' Not on table- or querydefs ... !
|
||||
If Not Column.IsWritable Then Goto Trace_Error_Updatable
|
||||
If Column.IsReadOnly Then Goto Trace_Error_Updatable
|
||||
If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
|
||||
With com.sun.star.sdbc.DataType
|
||||
If IsNull(pvValue) Then
|
||||
If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then Column.updateNull() Else Goto Trace_Null
|
||||
Else
|
||||
Select Case Column.Type
|
||||
Case .BIT, .BOOLEAN
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
Column.updateBoolean(pvValue)
|
||||
Case .TINYINT
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < -128 Or pvValue > +127 Then Goto Trace_Error_Value
|
||||
Column.updateShort(CInt(pvValue))
|
||||
Case .SMALLINT
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < -32768 Or pvValue > 32767 Then Goto trace_Error_Value
|
||||
Column.updateInt(CLng(pvValue))
|
||||
Case .INTEGER
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < -2147483648 Or pvValue > 2147483647 Then Goto trace_Error_Value
|
||||
Column.updateInt(CLng(pvValue))
|
||||
Case .BIGINT
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
Column.updateLong(pvValue) ' No proper type conversion for HYPER data type
|
||||
Case .FLOAT
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If Abs(pvValue) < 3.402823E38 And Abs(pvValue) > 1.401298E-45 Then Column.updateFloat(CSng(pvValue)) Else Goto trace_Error_Value
|
||||
Case .REAL, .DOUBLE
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
|
||||
Column.updateDouble(CDbl(pvValue))
|
||||
Case .NUMERIC, .DECIMAL
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If Utils._hasUNOProperty(Column, "Scale") Then
|
||||
If Column.Scale > 0 Then
|
||||
'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
|
||||
Column.updateDouble(CDbl(pvValue))
|
||||
Else
|
||||
Column.updateString(CStr(pvValue))
|
||||
End If
|
||||
Else
|
||||
Column.updateString(CStr(pvValue))
|
||||
End If
|
||||
Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
If _Precision > 0 And Len(pvValue) > _Precision Then Goto Trace_Error_Length
|
||||
Column.updateString(pvValue) ' vbString
|
||||
Case .DATE
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
|
||||
vTemp = New com.sun.star.util.Date
|
||||
With vTemp
|
||||
.Day = Day(pvValue)
|
||||
.Month = Month(pvValue)
|
||||
.Year = Year(pvValue)
|
||||
End With
|
||||
Column.updateDate(vTemp)
|
||||
Case .TIME
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
|
||||
vTemp = New com.sun.star.util.Time
|
||||
With vTemp
|
||||
.Hours = Hour(pvValue)
|
||||
.Minutes = Minute(pvValue)
|
||||
.Seconds = Second(pvValue)
|
||||
'.HundredthSeconds = 0 ' replaced with Long nanoSeconds in LO 4.1 ??
|
||||
End With
|
||||
Column.updateTime(vTemp)
|
||||
Case .TIMESTAMP
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
|
||||
vTemp = New com.sun.star.util.DateTime
|
||||
With vTemp
|
||||
.Day = Day(pvValue)
|
||||
.Month = Month(pvValue)
|
||||
.Year = Year(pvValue)
|
||||
.Hours = Hour(pvValue)
|
||||
.Minutes = Minute(pvValue)
|
||||
.Seconds = Second(pvValue)
|
||||
'.HundredthSeconds = 0
|
||||
End With
|
||||
Column.updateTimestamp(vTemp)
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
|
||||
If Not IsArray(pvValue) Then Goto Trace_Error_Value
|
||||
If UBound(pvValue) < LBound(pvValue) Then Goto Trace_Error_Value
|
||||
If Not Utils._CheckArgument(pvValue(LBound(pvValue)), iArgNr, vbInteger, , False) Then Goto Trace_Error_Value
|
||||
Column.updateBytes(pvValue)
|
||||
Case Else
|
||||
Goto trace_Error
|
||||
End Select
|
||||
End If
|
||||
End With
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Null:
|
||||
TraceError(TRACEFATAL, ERRNOTNULLABLE, Utils._CalledSub(), 0, 1, _Name)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Update:
|
||||
TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Updatable:
|
||||
TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Length:
|
||||
TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(Len(pvValue), "AppendChunk"))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _ReadAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
|
||||
' Write the whole content of a file into a stream object
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_ReadAll = False
|
||||
|
||||
If _ParentType <> OBJRECORDSET Then Goto Trace_Error ' Not on table- or querydefs ... !
|
||||
If Not Column.IsWritable Then Goto Trace_Error_Updatable
|
||||
If Column.IsReadOnly Then Goto Trace_Error_Updatable
|
||||
If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
|
||||
|
||||
Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
|
||||
Dim lFileLength As Long, sBuffer As String, sMemo As String, iFile As Integer
|
||||
Const cstMaxLength = 64000
|
||||
sFile = ConvertToURL(psFile)
|
||||
|
||||
oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
If Not oSimpleFileAccess.exists(sFile) Then Goto Trace_File
|
||||
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
|
||||
If psMethod <> "ReadAllBytes" Then Goto Trace_Error
|
||||
Set oStream = oSimpleFileAccess.openFileRead(sFile)
|
||||
lFileLength = oStream.getLength()
|
||||
If lFileLength = 0 Then Goto Trace_File
|
||||
Column.updateBinaryStream(oStream, lFileLength)
|
||||
oStream.closeInput()
|
||||
Case .VARCHAR, .LONGVARCHAR, .CLOB
|
||||
If psMethod <> "ReadAllText" Then Goto Trace_Error
|
||||
sMemo = ""
|
||||
lFileLength = 0
|
||||
iFile = FreeFile()
|
||||
Open sFile For Input Access Read Shared As iFile
|
||||
Do While Not Eof(iFile)
|
||||
Line Input #iFile, sBuffer
|
||||
lFileLength = lFileLength + Len(sBuffer) + 1
|
||||
If lFileLength > cstMaxLength Then Exit Do
|
||||
sMemo = sMemo & sBuffer & vbNewLine
|
||||
Loop
|
||||
If lFileLength = 0 Or lFileLength > cstMaxLength Then
|
||||
Close #iFile
|
||||
Goto Trace_File
|
||||
End If
|
||||
sMemo = Left(sMemo, lFileLength - 1)
|
||||
Column.updateString(sMemo)
|
||||
'Column.updateCharacterStream(oStream, lFileLength) ' DOES NOT WORK ?!?
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
End With
|
||||
|
||||
_ReadAll = True
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
|
||||
Goto Exit_Function
|
||||
Trace_File:
|
||||
TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Goto Exit_Function
|
||||
Trace_Error_Update:
|
||||
TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Goto Exit_Function
|
||||
Trace_Error_Updatable:
|
||||
TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, _CalledSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' ReadAll
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _WriteAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
|
||||
' Write the whole content of a stream object to a file
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_WriteAll = False
|
||||
|
||||
Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
|
||||
sFile = ConvertToURL(psFile)
|
||||
|
||||
oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
With com.sun.star.sdbc.DataType
|
||||
Select Case Column.Type
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
|
||||
If psMethod <> "WriteAllBytes" Then Goto Trace_Error
|
||||
Set oStream = Column.getBinaryStream()
|
||||
Case .VARCHAR, .LONGVARCHAR, .CLOB
|
||||
If psMethod <> "WriteAllText" Then Goto Trace_Error
|
||||
Set oStream = Column.getCharacterStream()
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
End With
|
||||
|
||||
If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then
|
||||
If Column.wasNull() Then Goto Trace_Null
|
||||
End If
|
||||
If oStream.getLength() = 0 Then Goto Trace_Null
|
||||
On Local Error Goto Trace_File
|
||||
If oSimpleFileAccess.exists(sFile) Then oSimpleFileAccess.kill(sFile)
|
||||
oSimpleFileAccess.writeFile(sFile, oStream)
|
||||
On Local Error Goto Error_Function
|
||||
oStream.closeInput()
|
||||
|
||||
_WriteAll = True
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
|
||||
Goto Exit_Function
|
||||
Trace_File:
|
||||
TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Goto Exit_Function
|
||||
Trace_Null:
|
||||
TraceError(TRACEFATAL, ERRFIELDNULL, _CalledSub, 0)
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, _CalledSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' WriteAll
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,540 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="L10N" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function _GetLabel(ByVal psShortlabel As String, Optional ByVal psLocale As String) As String
|
||||
' Return the localized label corresponding with ShortLabel
|
||||
|
||||
If IsMissing(psLocale) Then psLocale = UCase(Left(_A2B_.Locale, 2)) Else psLocale = UCase(psLocale)
|
||||
On Local Error Goto Error_Function
|
||||
If Not Utils._InList(psLocale, Array( _
|
||||
"EN", "FR", "ES", "DE" _
|
||||
)) Then psLocale = "DEFAULT" ' If list incomplete a recursive call will be provided anyway
|
||||
|
||||
Dim sLocal As String
|
||||
sLocal = psShortLabel
|
||||
Select Case psLocale
|
||||
Case "EN", "DEFAULT"
|
||||
Select Case UCase(psShortlabel)
|
||||
Case "ERR" & ERRDBNOTCONNECTED : sLocal = "No active connection to a database found"
|
||||
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Arguments are missing or are not initialized"
|
||||
Case "ERR" & ERRWRONGARGUMENT : sLocal = "Argument nr. %0 [Value = '%1'] is invalid"
|
||||
Case "ERR" & ERRMAINFORM : sLocal = "Document '%0' does not contain any form"
|
||||
Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Form '%0' not identified in database Forms set"
|
||||
Case "ERR" & ERRFORMNOTFOUND : sLocal = "Form '%0' not found"
|
||||
Case "ERR" & ERRFORMNOTOPEN : sLocal = "Form '%0' is currently not open"
|
||||
Case "ERR" & ERRDFUNCTION : sLocal = "DFunction execution failed, SQL=%0"
|
||||
Case "ERR" & ERROPENFORM : sLocal = "Form '%0' could not be opened"
|
||||
Case "ERR" & ERRPROPERTY : sLocal = "Property '%0' not applicable in this context"
|
||||
Case "ERR" & ERRPROPERTYVALUE : sLocal = "Value '%0' is invalid for property '%1'"
|
||||
Case "ERR" & ERRINDEXVALUE : sLocal = "Out of array range or incorrect array size for property '%0'"
|
||||
Case "ERR" & ERRCOLLECTION : sLocal = "Out of array range"
|
||||
Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "Argument nr.%0 should be an array"
|
||||
Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Control '%0' not found in parent (form, grid or dialog) '%1'"
|
||||
Case "ERR" & ERRNOACTIVEFORM : sLocal = "No active form or control found"
|
||||
Case "ERR" & ERRDATABASEFORM : sLocal = "Form '%0' has no underlying dataset"
|
||||
Case "ERR" & ERRFOCUSINGRID : sLocal = "Control '%0' not found in gridcontrol '%1'"
|
||||
Case "ERR" & ERRNOGRIDINFORM : sLocal = "No gridcontrol found in form '%0'"
|
||||
Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() must be preceded by a successful FindRecord(...) call"
|
||||
Case "ERR" & ERRSQLSTATEMENT : sLocal = "SQL Error, SQL statement = '%0'"
|
||||
Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' not found"
|
||||
Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' could not be opened"
|
||||
Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' could not be closed"
|
||||
Case "ERR" & ERRACTION : sLocal = "Action not applicable in this context"
|
||||
Case "ERR" & ERRSENDMAIL : sLocal = "Mail service could not be activated"
|
||||
Case "ERR" & ERRFORMYETOPEN : sLocal = "Form %0 is already open"
|
||||
Case "ERR" & ERRMETHOD : sLocal = "Method '%0' not applicable in this context"
|
||||
Case "ERR" & ERRPROPERTYINIT : sLocal = "Property '%0' applicable but not initialized"
|
||||
Case "ERR" & ERRFILENOTCREATED : sLocal = "File '%0' could not be created"
|
||||
Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialog '%0' not found in the currently loaded libraries"
|
||||
Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Dialog unknown"
|
||||
Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialog already started"
|
||||
Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialog '%0' not active"
|
||||
Case "ERR" & ERRRECORDSETNODATA : sLocal = "Recordset delivered no data. Action on current record rejected"
|
||||
Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Recordset has been closed. Recordset action rejected"
|
||||
Case "ERR" & ERRRECORDSETRANGE : sLocal = "Current record out of range"
|
||||
Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Action rejected in a forward-only or not bookmarkable recordset"
|
||||
Case "ERR" & ERRFIELDNULL : sLocal = "Field is null or empty. Action rejected"
|
||||
Case "ERR" & ERRFILEACCESS : sLocal = "File access error on file '%0'"
|
||||
Case "ERR" & ERROVERFLOW : sLocal = "Field length (%0) exceeds maximum length. Use the '%1' method instead"
|
||||
Case "ERR" & ERRNOTACTIONQUERY : sLocal = "Query '%0' is not an action query"
|
||||
Case "ERR" & ERRNOTUPDATABLE : sLocal = "Database, recordset or field is read only"
|
||||
Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Recordset update sequence error"
|
||||
Case "ERR" & ERRNOTNULLABLE : sLocal = "Field '%0' must not contain a NULL value"
|
||||
Case "ERR" & ERRROWDELETED : sLocal = "Current row has been deleted by another process or user"
|
||||
Case "ERR" & ERRRECORDSETCLONE : sLocal = "Cloning a cloned Recordset is forbidden"
|
||||
Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Pre-existing query '%0' has been deleted"
|
||||
Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Pre-existing table '%0' has been deleted"
|
||||
Case "ERR" & ERRTABLECREATION : sLocal = "Table '%0' could not be created"
|
||||
Case "ERR" & ERRFIELDCREATION : sLocal = "Field '%0' could not be created"
|
||||
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Subform '%0' not found in parent form '%1'"
|
||||
Case "ERR" & ERRWINDOW : sLocal = "Current window is not a document"
|
||||
Case "ERR" & ERRCOMPATIBILITY : sLocal = "Field '%0' could not be converted due to incompatibility of field types between the respective database systems"
|
||||
Case "ERR" & ERRPRECISION : sLocal = "Field '%0' could not be loaded in record #%1 due to capacity shortage"
|
||||
Case "ERR" & ERRMODULENOTFOUND : sLocal = "Module '%0' not found in the currently loaded libraries"
|
||||
Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Procedure '%0' not found in module '%1'"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "OBJECT" : sLocal = "Object"
|
||||
Case "TABLE" : sLocal = "Table"
|
||||
Case "QUERY" : slocal = "Query"
|
||||
Case "FORM" : sLocal = "Form"
|
||||
Case "REPORT" : sLocal = "Report"
|
||||
Case "RECORDSET" : sLocal = "Recordset"
|
||||
Case "FIELD" : sLocal = "Field"
|
||||
Case "TEMPVAR" : sLocal = "Temporary variable"
|
||||
Case "COMMANDBAR" : sLocal = "Command bar"
|
||||
Case "COMMANDBARCONTROL" : sLocal = "Command bar control"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "ERR#" : sLocal = "Error #"
|
||||
Case "ERROCCUR" : sLocal = "occurred"
|
||||
Case "ERRLINE" : sLocal = "at line"
|
||||
Case "ERRIN" : sLocal = "in"
|
||||
Case "CALLTO" : sLocal = "a call to function"
|
||||
Case "SAVECONSOLE" : sLocal = "Save console"
|
||||
Case "SAVECONSOLEENTRIES" : sLocal = "The console entries have been saved successfully."
|
||||
Case "QUITSHORT" : sLocal = "Quit"
|
||||
Case "QUIT" : sLocal = "Do you really want to quit the application ? Changed data will be saved."
|
||||
Case "ENTERING" : sLocal = "Entering"
|
||||
Case "EXITING" : sLocal = "Exiting"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGTRACE_HELP" : sLocal = "Manage the console buffer and its entries"
|
||||
Case "DLGTRACE_TITLE" : sLocal = "Console"
|
||||
Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Clear the list and resize the circular buffer"
|
||||
Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Set max number of entries"
|
||||
Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Text can be selected, copied, ..."
|
||||
Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Log file is empty ---"
|
||||
Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Cancel and close the dialog"
|
||||
Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Cancel"
|
||||
Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Clear the list"
|
||||
Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Clear the list"
|
||||
Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "Register only logging requests above given level"
|
||||
Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Set minimal trace level"
|
||||
Case "DLGTRACE_CMDOK_HELP" : sLocal = "Validate"
|
||||
Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Choose a file and dump the actual list content in it"
|
||||
Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Dump to file"
|
||||
Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Actual size of list"
|
||||
Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Actual number of entries:"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGFORMAT_HELP" : sLocal = "Export the form"
|
||||
Case "DLGFORMAT_TITLE" : sLocal = "OutputTo"
|
||||
Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format in which the form should be exported"
|
||||
Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Select the output format"
|
||||
Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Validate your choice"
|
||||
Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Cancel and close the dialog"
|
||||
Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Cancel"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case Else : sLocal = ""
|
||||
End Select
|
||||
Case "FR"
|
||||
Select Case UCase(psShortlabel)
|
||||
Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Pas de connexion active trouvée à une banque de données"
|
||||
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Des arguments sont manquants ou non initialisés"
|
||||
Case "ERR" & ERRWRONGARGUMENT : sLocal = "L'argument n° %0 [Valeur = '%1'] n'est pas valable"
|
||||
Case "ERR" & ERRMAINFORM : sLocal = "Le document '%0' ne contient aucun formulaire"
|
||||
Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Le formulaire '%0' n'a pas pu être identifié parmi l'ensemble des formulaires de la Database"
|
||||
Case "ERR" & ERRFORMNOTFOUND : sLocal = "Formulaire '%0' non trouvé"
|
||||
Case "ERR" & ERRFORMNOTOPEN : sLocal = "Le formulaire '%0' n'est actuellement pas ouvert"
|
||||
Case "ERR" & ERRDFUNCTION : sLocal = "L'exécution de la ""fonction database"" a échoué, SQL=%0"
|
||||
Case "ERR" & ERROPENFORM : sLocal = "Le formulaire '%0' n'a pas pu être ouvert"
|
||||
Case "ERR" & ERRPROPERTY : sLocal = "La propriété '%0' n'est pas applicable dans ce contexte"
|
||||
Case "ERR" & ERRPROPERTYVALUE : sLocal = "La valeur '%0' est invalide pour la propriété '%1'"
|
||||
Case "ERR" & ERRINDEXVALUE : sLocal = "Indice invalide ou dimension erronée du tableau pour la propriété '%0'"
|
||||
Case "ERR" & ERRCOLLECTION : sLocal = "Indice de tableau invalide"
|
||||
Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "L'argument n°%0 doit être un tableau"
|
||||
Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Contrôle '%0' non trouvé dans le parent (formulaire, contrôle de table ou dialogue) '%1'"
|
||||
Case "ERR" & ERRNOACTIVEFORM : sLocal = "Pas de formulaire ou de contrôle actif"
|
||||
Case "ERR" & ERRDATABASEFORM : sLocal = "Le formulaire '%0' n'a pas de données sous-jacentes"
|
||||
Case "ERR" & ERRFOCUSINGRID : sLocal = "Contrôle '%0' non trouvé dans le contrôle de table '%1'"
|
||||
Case "ERR" & ERRNOGRIDINFORM : sLocal = "Aucun contrôle de table trouvé dans le formulaire '%0'"
|
||||
Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() doit être précédé par un appel réussi à FindRecord(...)"
|
||||
Case "ERR" & ERRSQLSTATEMENT : sLocal = "Erreur SQL, instruction SQL = '%0'"
|
||||
Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' non trouvé(e)"
|
||||
Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1': ouverture en échec"
|
||||
Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1': fermeture en échec"
|
||||
Case "ERR" & ERRACTION : sLocal = "Action non applicable dans ce contexte"
|
||||
Case "ERR" & ERRSENDMAIL : sLocal = "Le service de messagerie n'a pas pu être activé"
|
||||
Case "ERR" & ERRFORMYETOPEN : sLocal = "Le formulaire %0 est déjà ouvert"
|
||||
Case "ERR" & ERRMETHOD : sLocal = "La méthode '%0' n'est pas applicable dans ce contexte"
|
||||
Case "ERR" & ERRPROPERTYINIT : sLocal = "Propriété '%0' applicable mais non initialisée"
|
||||
Case "ERR" & ERRFILENOTCREATED : sLocal = "Erreur de création du fichier '%0'"
|
||||
Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialogue '%0' introuvable dans les librairies chargées actuellement"
|
||||
Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Boîte de dialogue inconnue"
|
||||
Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialogue déjà initialisé précédemment"
|
||||
Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialogue '%0' non initialisé"
|
||||
Case "ERR" & ERRRECORDSETNODATA : sLocal = "Recordset n'a pas fourni de données. Toute action sur les enregistrements est rejetée"
|
||||
Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Recordset a été clôturé. Action sur l'enregistrement courant est rejetée"
|
||||
Case "ERR" & ERRRECORDSETRANGE : sLocal = "L'enregistrement courant est hors cadre"
|
||||
Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Action rejetée car recordset lisible seulement vers l'avant ou n'acceptant pas de signets"
|
||||
Case "ERR" & ERRFIELDNULL : sLocal = "Champ nul ou vide. Action rejetée"
|
||||
Case "ERR" & ERRFILEACCESS : sLocal = "Erreur d'accès au fichier '%0'"
|
||||
Case "ERR" & ERROVERFLOW : sLocal = "La longueur du champ (%0) dépasse la taille maximale autorisée. Utiliser de préférence la méthode '%1'"
|
||||
Case "ERR" & ERRNOTACTIONQUERY : sLocal = "La requête '%0' n'est pas une requête d'action"
|
||||
Case "ERR" & ERRNOTUPDATABLE : sLocal = "La banque de données, le recordset ou le champ sont en lecture seulement"
|
||||
Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Erreur de séquence lors de la mise à jour d'un Recordset"
|
||||
Case "ERR" & ERRNOTNULLABLE : sLocal = "Le champ '%0' ne peut pas recevoir une valeur NULLe"
|
||||
Case "ERR" & ERRROWDELETED : sLocal = "L'enregistrement courant a été effacé par un autre processus ou un autre utilisateur"
|
||||
Case "ERR" & ERRRECORDSETCLONE : sLocal = "Le clonage d'un Recordset cloné est interdit"
|
||||
Case "ERR" & ERRQUERYDEFDELETED : sLocal = "La requête existante '%0' a été supprimée"
|
||||
Case "ERR" & ERRTABLEDEFDELETED : sLocal = "La table existante '%0' a été supprimée"
|
||||
Case "ERR" & ERRTABLECREATION : sLocal = "La table '%0' n'a pas pu être créée"
|
||||
Case "ERR" & ERRFIELDCREATION : sLocal = "Le champ '%0' n'a pas pu être créé"
|
||||
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Sous-formulaire '%0' non trouvé dans le formulaire parent '%1'"
|
||||
Case "ERR" & ERRWINDOW : sLocal = "La fenêtre courante n'est pas un document"
|
||||
Case "ERR" & ERRCOMPATIBILITY : sLocal = "Le champ '%0' n'a pas pu être converti à cause d'une incompatibilité entre les types de champs supportés par les systèmes de bases de données respectifs"
|
||||
Case "ERR" & ERRPRECISION : sLocal = "Le champ '%0' n'a pas pu être chargé dans l'enregistrement #%1 par manque de capacité"
|
||||
Case "ERR" & ERRMODULENOTFOUND : sLocal = "Le module '%0' est introuvable dans les librairies chargées actuellement"
|
||||
Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "La procédure '%0' est introuvable dans le module '%1'"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "OBJECT" : sLocal = "Objet"
|
||||
Case "TABLE" : sLocal = "Table"
|
||||
Case "QUERY" : slocal = "Requête"
|
||||
Case "FORM" : sLocal = "Formulaire"
|
||||
Case "REPORT" : sLocal = "Rapport"
|
||||
Case "RECORDSET" : sLocal = "Recordset"
|
||||
Case "FIELD" : sLocal = "Champ"
|
||||
Case "TEMPVAR" : sLocal = "Variable temporaire"
|
||||
Case "COMMANDBAR" : sLocal = "Barre de commande"
|
||||
Case "COMMANDBARCONTROL" : sLocal = "Elément de barre de commande"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "ERR#" : sLocal = "L'erreur #"
|
||||
Case "ERROCCUR" : sLocal = "s'est produite"
|
||||
Case "ERRLINE" : sLocal = "à la ligne"
|
||||
Case "ERRIN" : sLocal = "dans"
|
||||
Case "CALLTO" : sLocal = "un appel à la fonction"
|
||||
Case "SAVECONSOLE" : sLocal = "Sauver console"
|
||||
Case "SAVECONSOLEENTRIES" : sLocal = "Les entrées de la console ont été sauvées avec succès."
|
||||
Case "QUITSHORT" : sLocal = "Quitter"
|
||||
Case "QUIT" : sLocal = "Voulez-vous réellement quitter l'application ? Les données modifiées seront sauvées."
|
||||
Case "ENTERING" : sLocal = "Entrée dans"
|
||||
Case "EXITING" : sLocal = "Sortie de"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGTRACE_HELP" : sLocal = "Gestion du tampon de la console et toutes ses entrées"
|
||||
Case "DLGTRACE_TITLE" : sLocal = "Console"
|
||||
Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Effacer la liste et redimensionner le tampon circulaire"
|
||||
Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Définir le nombre maximum d'entrées"
|
||||
Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Le texte peut être sélectionné, copié, ..."
|
||||
Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Le fichier journal est vide ---"
|
||||
Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Annuler et fermer la boîte de dialogue"
|
||||
Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Annuler"
|
||||
Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Effacer la liste"
|
||||
Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Effacer la liste"
|
||||
Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "N'enregistrer que les demandes de journalisation à partir du niveau indiqué"
|
||||
Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Définir le niveau minimal d'enregistrement"
|
||||
Case "DLGTRACE_CMDOK_HELP" : sLocal = "Valider"
|
||||
Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Sélectionner un fichier et y vider le contenu actuel des traces enregistrées"
|
||||
Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Vider dans fichier"
|
||||
Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Taille actuelle de la liste"
|
||||
Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Nombre actuel d'entrées:"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGFORMAT_HELP" : sLocal = "Exporter le formulaire"
|
||||
Case "DLGFORMAT_TITLE" : sLocal = "OutputTo"
|
||||
Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format dans lequel le formulaire sera exporté"
|
||||
Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Selectionner le format de sortie"
|
||||
Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Valider votre choix"
|
||||
Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Annuler et fermer la boîte de dialogue"
|
||||
Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Annuler"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT")
|
||||
End Select
|
||||
'********************************************************
|
||||
'Translated by Iñigo Zuluaga
|
||||
'********************************************************
|
||||
Case "ES" '(España)
|
||||
Select Case UCase(psShortlabel)
|
||||
Case "ERR" & ERRDBNOTCONNECTED : sLocal = "No se ha encontrado una conexión activa a una base de datos"
|
||||
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Faltan argumentos o no están inicializados"
|
||||
Case "ERR" & ERRWRONGARGUMENT : sLocal = "El argumento nr. %0 [Value = '%1'] no es válido"
|
||||
Case "ERR" & ERRMAINFORM : sLocal = "El documento '%0' no contiene ningún formulario"
|
||||
Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "No se ha identificado el formulario '%0' en el conjunto de formularios de la base de datos"
|
||||
Case "ERR" & ERRFORMNOTFOUND : sLocal = "No se ha encontrado el formulario '%0'"
|
||||
Case "ERR" & ERRFORMNOTOPEN : sLocal = "El formulario '%0' no está abierto"
|
||||
Case "ERR" & ERRDFUNCTION : sLocal = "La ejecución de DFunction falló, SQL=%0"
|
||||
Case "ERR" & ERROPENFORM : sLocal = "El formulario '%0' no se puede abrir"
|
||||
Case "ERR" & ERRPROPERTY : sLocal = "La propiedad '%0' no es aplicable en este contexto"
|
||||
Case "ERR" & ERRPROPERTYVALUE : sLocal = "El valor '%0' es inválido para la propiedad '%1'"
|
||||
Case "ERR" & ERRINDEXVALUE : sLocal = "Fuera del rango de la matriz o tamaño incorrecto de la matriz para la propiedad '%0'"
|
||||
Case "ERR" & ERRCOLLECTION : sLocal = "Fuera del rango de la matriz"
|
||||
Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "El argumento nr.%0 debería ser una matriz"
|
||||
Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "El control '%0' not found in parent (formulario, control de tabla or diálogo) '%1'"
|
||||
Case "ERR" & ERRNOACTIVEFORM : sLocal = "No se ha encontrado un formulario o control activo"
|
||||
Case "ERR" & ERRDATABASEFORM : sLocal = "El formulario '%0' no tiene datos subyacentes"
|
||||
Case "ERR" & ERRFOCUSINGRID : sLocal = "No se ha encontrado el control '%0' en el control de tabla '%1'"
|
||||
Case "ERR" & ERRNOGRIDINFORM : sLocal = "No se ha encontrado un control de tabla en el formulario '%0'"
|
||||
Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() tiene que ser precedido por una llamada exitosa de FindRecord(...)"
|
||||
Case "ERR" & ERRSQLSTATEMENT : sLocal = "Error SQL, instrución SQL = '%0'"
|
||||
Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' no encontrado"
|
||||
Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' no se puede abrir"
|
||||
Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' no se puede abrir"
|
||||
Case "ERR" & ERRACTION : sLocal = "Acción no aplicable en este contexto"
|
||||
Case "ERR" & ERRSENDMAIL : sLocal = "No se puede activar el servicio de correo"
|
||||
Case "ERR" & ERRFORMYETOPEN : sLocal = "El formulario %0 ya está abierto"
|
||||
Case "ERR" & ERRMETHOD : sLocal = "El método '%0' no es aplicable en este contexto"
|
||||
Case "ERR" & ERRPROPERTYINIT : sLocal = "Propiedad '%0' aplicable pero no inicializada"
|
||||
Case "ERR" & ERRFILENOTCREATED : sLocal = "No se ha podido crear el archivo '%0'"
|
||||
Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "No se ha encontrado el diálogo '%0' en las bibliotecas cargadas actualmente"
|
||||
Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Diálogo desconocido"
|
||||
Case "ERR" & ERRDIALOGSTARTED : sLocal = "El diálogo ya está iniciado"
|
||||
Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "El diálogo '%0' no está activo"
|
||||
Case "ERR" & ERRRECORDSETNODATA : sLocal = "El Recordset no suministra datos. La acción en el registro actual rechazada"
|
||||
Case "ERR" & ERRRECORDSETCLOSED : sLocal = "El recorset se ha cerrado. Acción con el Recordset rechazada"
|
||||
Case "ERR" & ERRRECORDSETRANGE : sLocal = "Registro actual fuera de rango"
|
||||
Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Acción rechazada en un recorset legible sólo hacia adelante o que no admita marcadores"
|
||||
Case "ERR" & ERRFIELDNULL : sLocal = "El campo es nulo o vacío. Acción rechazada"
|
||||
Case "ERR" & ERRFILEACCESS : sLocal = "Error durante el acceso al archivo '%0'"
|
||||
Case "ERR" & ERROVERFLOW : sLocal = "La longitud del campo (%0) excede la longitud máxima. Reemplazar por el método '%1'"
|
||||
Case "ERR" & ERRNOTACTIONQUERY : sLocal = "La consulta '%0' no es una consulta de acción"
|
||||
Case "ERR" & ERRNOTUPDATABLE : sLocal = "La base de datos, el Recordset o el Campo es de sólo lectura"
|
||||
Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Error durante la secuencia de actualización del Recordset"
|
||||
Case "ERR" & ERRNOTNULLABLE : sLocal = "El campo '%0' no puede contener un valor NULL"
|
||||
Case "ERR" & ERRROWDELETED : sLocal = "La fila actual ha sido borrada por otro proceso o usuario"
|
||||
Case "ERR" & ERRRECORDSETCLONE : sLocal = "No se puede clonar un Recordset clonado"
|
||||
Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Se ha borrado la consulta pre-existente '%0'"
|
||||
Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Se ha borrado la tabla pre-existente '%0'"
|
||||
Case "ERR" & ERRTABLECREATION : sLocal = "No se ha podido crear la Tabla '%0'"
|
||||
Case "ERR" & ERRFIELDCREATION : sLocal = "No se ha podido crear el campo '%0'"
|
||||
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "No se ha encontrado el Subformulario '%0' en el subformulario padre '%1'"
|
||||
Case "ERR" & ERRWINDOW : sLocal = "La ventana actual no es un documento"
|
||||
Case "ERR" & ERRCOMPATIBILITY : sLocal = "El campo '%0' no se ha convertido debido a una incompatibilidad de los tipos de campo soportados entre las dos bases de datos"
|
||||
Case "ERR" & ERRPRECISION : sLocal = "El campo '%0' no se ha cargado en el registro #%1 por falta de capacidad"
|
||||
Case "ERR" & ERRMODULENOTFOUND : sLocal = "Module '%0' not found in the currently loaded libraries"
|
||||
Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Procedure '%0' not found in module '%1'"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "OBJECT" : sLocal = "Objeto"
|
||||
Case "TABLE" : sLocal = "Tabla"
|
||||
Case "QUERY" : slocal = "Consulta"
|
||||
Case "FORM" : sLocal = "Formulario"
|
||||
Case "REPORT" : sLocal = "Informe"
|
||||
Case "RECORDSET" : sLocal = "Recordset"
|
||||
Case "FIELD" : sLocal = "Campo"
|
||||
Case "TEMPVAR" : sLocal = "Variable temporal"
|
||||
Case "COMMANDBAR" : sLocal = "Barra de comandos"
|
||||
Case "COMMANDBARCONTROL" : sLocal = "Control de barra de comandos"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "ERR#" : sLocal = "Error #"
|
||||
Case "ERROCCUR" : sLocal = "ocurrido"
|
||||
Case "ERRLINE" : sLocal = "en línea"
|
||||
Case "ERRIN" : sLocal = "en"
|
||||
Case "CALLTO" : sLocal = "una llamada a la función"
|
||||
Case "SAVECONSOLE" : sLocal = "Guardar consola"
|
||||
Case "SAVECONSOLEENTRIES" : sLocal = "Las entradas de la consola han sido guardadas correctamente."
|
||||
Case "QUITSHORT" : sLocal = "Cerrar"
|
||||
Case "QUIT" : sLocal = "Quieres realmente cerrar la aplicación? los datos cambiados se guardarán."
|
||||
Case "ENTERING" : sLocal = "Entrando"
|
||||
Case "EXITING" : sLocal = "Saliendo"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGTRACE_HELP" : sLocal = "Gestión del buffer de la consola y sus entradas"
|
||||
Case "DLGTRACE_TITLE" : sLocal = "Consola"
|
||||
Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Limpiar la lista y redimensionar el buffer circular"
|
||||
Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Definir el número máximo de entradas"
|
||||
Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "El texto puede ser seleccionado, copiado, ..."
|
||||
Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- El archivo Histórico está vacío ---"
|
||||
Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Cancelar y cerrar el diálogo"
|
||||
Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Cancelar"
|
||||
Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Limpiar la lista"
|
||||
Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Limpiar la lista"
|
||||
Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "No registrar más que las peticiones de registro a partir de un nivel indicado"
|
||||
Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Definir el nivel mínimo de registro"
|
||||
Case "DLGTRACE_CMDOK_HELP" : sLocal = "Validar"
|
||||
Case "DLGTRACE_CMDOK_LABEL" : sLocal = "Aceptar"
|
||||
Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Elegir un archivo y guardar en él el contenido de la lista actual"
|
||||
Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Guardar en a archivo"
|
||||
Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Tamaño actual de la lista"
|
||||
Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Numero actual de entradas:"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGFORMAT_HELP" : sLocal = "Exportar el formulario"
|
||||
Case "DLGFORMAT_TITLE" : sLocal = "Exportar como"
|
||||
Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Formato en el que será ser exportado el formulario"
|
||||
Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Seleccionar el formato de salida"
|
||||
Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Validar su elección"
|
||||
Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "Aceptar"
|
||||
Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Cancelar y cerrar el diálogo"
|
||||
Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Cancelar"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT")
|
||||
End Select
|
||||
'********************************************************
|
||||
'Translated by Gisbert Friege
|
||||
'********************************************************
|
||||
Case "DE"
|
||||
Select Case UCase(psShortlabel)
|
||||
Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Keine aktive Verbindung zu einer Datenbank gefunden"
|
||||
Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Argumente fehlen oder sind nicht initialisiert"
|
||||
Case "ERR" & ERRWRONGARGUMENT : sLocal = "Argument Nr. %0 [Wert = '%1'] ist ungültig"
|
||||
Case "ERR" & ERRMAINFORM : sLocal = "Dokument '%0' enthält kein Formular"
|
||||
Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Formular '%0' nicht bei den Datenbank-Formularen erkannt"
|
||||
Case "ERR" & ERRFORMNOTFOUND : sLocal = "Formular '%0' nicht gefunden"
|
||||
Case "ERR" & ERRFORMNOTOPEN : sLocal = "Formular '%0' ist zur Zeit nicht offen"
|
||||
Case "ERR" & ERRDFUNCTION : sLocal = "DFunction Ausführung misslungen, SQL=%0"
|
||||
Case "ERR" & ERROPENFORM : sLocal = "Formular '%0' konnte nicht geöffnet werden"
|
||||
Case "ERR" & ERRPROPERTY : sLocal = "Eigenschaft '%0' in diesem Kontext nicht anwendbar"
|
||||
Case "ERR" & ERRPROPERTYVALUE : sLocal = "Wert '%0' ist ungültig für die Eigenschaft '%1'"
|
||||
Case "ERR" & ERRINDEXVALUE : sLocal = "Außerhalb des Array-Bereichs oder falsche Array-Größe für Eigenschaft '%0'"
|
||||
Case "ERR" & ERRCOLLECTION : sLocal = "Außerhalb des Array-Bereichs"
|
||||
Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "Argument Nr.%0 sollte ein Array sein"
|
||||
Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Steuerelement '%0' nicht gefunden in parent (Formular, Tabelle oder Dialog) '%1'"
|
||||
Case "ERR" & ERRNOACTIVEFORM : sLocal = "Kein aktives Formular oder Steuerelement gefunden"
|
||||
Case "ERR" & ERRDATABASEFORM : sLocal = "Formular '%0' basiert nicht auf einem Datensatz"
|
||||
Case "ERR" & ERRFOCUSINGRID : sLocal = "Steuerelement '%0' im Tabellen-Steuerelement '%1' nicht gefunden"
|
||||
Case "ERR" & ERRNOGRIDINFORM : sLocal = "Kein Tabellen-Steuerelement im Formular '%0' gefunden"
|
||||
Case "ERR" & ERRFINDRECORD : sLocal = "Bei FindNext() muss ein erfolgreicher FindRecord(...)-Aufruf vorhergehen"
|
||||
Case "ERR" & ERRSQLSTATEMENT : sLocal = "SQL Error, SQL statement = '%0'"
|
||||
Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' nicht gefunden"
|
||||
Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' konnte nicht geöffnet werden"
|
||||
Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' konnte nicht geschlossen werden"
|
||||
Case "ERR" & ERRACTION : sLocal = "Aktion in diesem Kontext nicht anwendbar"
|
||||
Case "ERR" & ERRSENDMAIL : sLocal = "Email-Dienst konnte nicht aktiviert werden"
|
||||
Case "ERR" & ERRFORMYETOPEN : sLocal = "Formular %0 ist schon offen"
|
||||
Case "ERR" & ERRMETHOD : sLocal = "Methode '%0' in diesem Kontext nicht anwendbar"
|
||||
Case "ERR" & ERRPROPERTYINIT : sLocal = "Eigenschaft '%0' anwendbar aber nicht initialisiert"
|
||||
Case "ERR" & ERRFILENOTCREATED : sLocal = "Datei '%0' konnte nicht erzeugt werden"
|
||||
Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialog '%0' nicht in den aktuell geladenen Bibliotheken gefunden"
|
||||
Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Dialog unbekannt"
|
||||
Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialog schon gestartet"
|
||||
Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialog '%0' nicht aktiv"
|
||||
Case "ERR" & ERRRECORDSETNODATA : sLocal = "Datensatz ergab keine Daten. Aktion auf aktuellem Datensatz verweigert"
|
||||
Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Datensatz wurde geschlossen. Datensatz-Aktion verweigert"
|
||||
Case "ERR" & ERRRECORDSETRANGE : sLocal = "Aktueller Datensatz außerhalb des Bereichs"
|
||||
Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Aktion verweigert auf einem nur vorwärts lesbaren oder keine Textmarken unterstützenden Datensatz"
|
||||
Case "ERR" & ERRFIELDNULL : sLocal = "Feld ist null oder leer. Aktion verweigert"
|
||||
Case "ERR" & ERRFILEACCESS : sLocal = "Dateizugriffs-Fehler bei Datei '%0'"
|
||||
Case "ERR" & ERROVERFLOW : sLocal = "Feldlänge (%0) überschreitet die maximale Länge. Verwende stattdessen die Methode '%1'"
|
||||
Case "ERR" & ERRNOTACTIONQUERY : sLocal = "Abfrage '%0' ist keine Aktionsabfrage"
|
||||
Case "ERR" & ERRNOTUPDATABLE : sLocal = "Datenbank, Datensatz oder Feld kann nur gelesen werden"
|
||||
Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Datensatz-Update Folgefehler"
|
||||
Case "ERR" & ERRNOTNULLABLE : sLocal = "Feld '%0' darf keinen NULL-Wert haben"
|
||||
Case "ERR" & ERRROWDELETED : sLocal = "Aktuelle Zeile wurde durch einen anderen Prozess oder Benutzer gelösch"
|
||||
Case "ERR" & ERRRECORDSETCLONE : sLocal = "Ein geklonter Datensatz kann nicht geklont werden"
|
||||
Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Bereits vorhandene Abfrage '%0' wurde gelöscht"
|
||||
Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Bereits vorhandene Tabelle '%0' wurde gelöscht"
|
||||
Case "ERR" & ERRTABLECREATION : sLocal = "Tabelle '%0' konnte nicht erzeugt werden"
|
||||
Case "ERR" & ERRFIELDCREATION : sLocal = "Feld '%0' konnte nicht erzeugt werden"
|
||||
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Unterformular '%0' nicht im Eltern-Formular '%1 gefunden"
|
||||
Case "ERR" & ERRWINDOW : sLocal = "Aktuelles Fenster ist kein Dokument"
|
||||
Case "ERR" & ERRCOMPATIBILITY : sLocal = "Feld '%0' konnte wegen inkompatibler Feldtypen der Datenbanksysteme nicht konvertiert werden"
|
||||
Case "ERR" & ERRPRECISION : sLocal = "Feld '%0' konnte wegen fehlender Speicherkapazität nicht in den Datensatz #%1 geladen werden"
|
||||
Case "ERR" & ERRMODULENOTFOUND : sLocal = "Modul '%0' nicht gefunden in den aktuell geladen Bibliotheken"
|
||||
Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Prozedur '%0' im Modul '%1' nicht gefunden"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "OBJECT" : sLocal = "Objekt"
|
||||
Case "TABLE" : sLocal = "Tabelle"
|
||||
Case "QUERY" : slocal = "Abfrage"
|
||||
Case "FORM" : sLocal = "Formular"
|
||||
Case "REPORT" : sLocal = "Report"
|
||||
Case "RECORDSET" : sLocal = "Datensatz"
|
||||
Case "FIELD" : sLocal = "Feld"
|
||||
Case "TEMPVAR" : sLocal = "Temporäre Variable"
|
||||
Case "COMMANDBAR" : sLocal = "Befehlsleiste"
|
||||
Case "COMMANDBARCONTROL" : sLocal = "Befehlsleisten-Steuerelement"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "ERR#" : sLocal = "Error #"
|
||||
Case "ERROCCUR" : sLocal = "aufgetreten"
|
||||
Case "ERRLINE" : sLocal = "in Zeile"
|
||||
Case "ERRIN" : sLocal = "in"
|
||||
Case "CALLTO" : sLocal = "ein Funktionsaufruf"
|
||||
Case "SAVECONSOLE" : sLocal = "Konsoleneingaben sichern"
|
||||
Case "SAVECONSOLEENTRIES" : sLocal = "Die Konsoleneingaben wurden erfolgreich gesichert."
|
||||
Case "QUITSHORT" : sLocal = "Beenden"
|
||||
Case "QUIT" : sLocal = "Wollen Sie wirklich die Anwendung beenden? Geänderte Daten werden gesichert."
|
||||
Case "ENTERING" : sLocal = "Beginne mit"
|
||||
Case "EXITING" : sLocal = "Verlasse"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGTRACE_HELP" : sLocal = "Verwalte den Konsolenpuffer und seine Eingaben"
|
||||
Case "DLGTRACE_TITLE" : sLocal = "Konsole"
|
||||
Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Leere die Liste und ändere die Größe des Umlaufpuffers"
|
||||
Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Setze maximale Anzahl von Eingaben"
|
||||
Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Text kann ausgewählt, kopiert, ... werden"
|
||||
Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Log Datei ist leer ---"
|
||||
Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Abbrechen und den Dialog schließen"
|
||||
Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Abbrechen"
|
||||
Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Leere die Liste"
|
||||
Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Leere die Liste"
|
||||
Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "Registriere nur Logging-Anfragen oberhalb des gegebenen Levels"
|
||||
Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Setze minimalen Fehlerbehandlungs-Level"
|
||||
Case "DLGTRACE_CMDOK_HELP" : sLocal = "Übernehmen"
|
||||
Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Wähle eine Datei und speichere darin den aktuellen Listeninhalt"
|
||||
Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Ausgabe in Datei"
|
||||
Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Aktuelle Länge der Liste"
|
||||
Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Aktuelle Anzahl von Einträgen:"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case "DLGFORMAT_HELP" : sLocal = "Exportiere das Formular"
|
||||
Case "DLGFORMAT_TITLE" : sLocal = "Export"
|
||||
Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format, in dem das Formular exportiert werden soll"
|
||||
Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Wähle das Ausgabe-Format"
|
||||
Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Auswahl übernehmen"
|
||||
Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK"
|
||||
Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Abbrechen und den Dialog schließen"
|
||||
Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Abbrechen"
|
||||
'----------------------------------------------------------------------------------------------------------------------
|
||||
Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT")
|
||||
End Select
|
||||
REM *******************************************************************************************************************************************
|
||||
REM *** ***
|
||||
REM *** ANY OTHER LANGUAGE TO BE INSERTED HERE ***
|
||||
REM *** ***
|
||||
REM *******************************************************************************************************************************************
|
||||
Case Else
|
||||
sLocal = _Getlabel(psShortLabel, "DEFAULT")
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
_Getlabel = sLocal
|
||||
Exit Function
|
||||
Error_Function:
|
||||
sLocal = psShortLabel
|
||||
GoTo Exit_Function
|
||||
End Function ' GetLabel V0.8.9
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _GetLabelArray(ByVal pvShortlabel As Variant, Optional ByVal psLocale As String) As Variant
|
||||
' Return the localized label corresponding with the ShortLabel array of strings
|
||||
|
||||
If IsMissing(psLocale) Then psLocale = UCase(Left(_GetLocale(), 2)) Else psLocale = UCase(psLocale)
|
||||
On Local Error Goto Error_Function
|
||||
|
||||
Dim vLocal() As Variant, i As integer
|
||||
vLocal = Array()
|
||||
|
||||
If Not IsArray(pvShortLabel) Then
|
||||
vLocal = _GetLabel(pvShortLabel, psLocale)
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
ReDim vLocal(LBound(pvShortLabel) To UBound(pvShortlabel))
|
||||
For i = LBound(pvShortLabel) To UBound(pvShortlabel)
|
||||
vLocal(i) = _GetLabel(pvShortLabel(i), psLocale)
|
||||
Next i
|
||||
|
||||
Exit_Function:
|
||||
_GetlabelArray = vLocal()
|
||||
Exit Function
|
||||
Error_Function:
|
||||
vLocal = Array()
|
||||
GoTo Exit_Function
|
||||
End Function ' GetLabelArray V0.8.9
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _GetLocale() as String
|
||||
'Return OO localization
|
||||
'Derived from Tools library
|
||||
|
||||
Dim oLocale as Object
|
||||
oLocale = _GetRegistryKeyContent("org.openoffice.Setup/L10N")
|
||||
_GetLocale = oLocale.getByName("ooLocale")
|
||||
End Function ' GetLocale V0.8.9
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,300 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Methods" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AddItem(Optional pvBox As Variant, ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
|
||||
' Add an item in a Listbox
|
||||
|
||||
Utils._SetCalledSub("AddItem")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
If IsMissing(pvBox) Or IsMissing(pvItem) Then Call _TraceArguments()
|
||||
If IsMissing(pvIndex) Then pvIndex = -1
|
||||
If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
|
||||
|
||||
AddItem = pvBox.AddItem(pvItem, pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("AddItem")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "AddItem", Erl)
|
||||
AddItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' AddItem V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(Optional pvObject As Variant, ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if pvObject has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
Dim vPropertiesList As Variant
|
||||
|
||||
Utils._SetCalledSub("hasProperty")
|
||||
If IsMissing(pvObject) Or IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
|
||||
hasProperty = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
|
||||
, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
|
||||
)) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvProperty, 2, vbString) Then Goto Exit_Function
|
||||
|
||||
hasProperty = pvObject.hasProperty(pvProperty)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("hasProperty")
|
||||
Exit Function
|
||||
End Function ' hasProperty V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Move(Optional pvObject As Object _
|
||||
, ByVal Optional pvLeft As Variant _
|
||||
, ByVal Optional pvTop As Variant _
|
||||
, ByVal Optional pvWidth As Variant _
|
||||
, ByVal Optional pvHeight As Variant _
|
||||
) As Variant
|
||||
' Execute Move method
|
||||
Utils._SetCalledSub("Move")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Move = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
|
||||
If IsMissing(pvLeft) Then Call _TraceArguments()
|
||||
If IsMissing(pvTop) Then pvTop = -1
|
||||
If IsMissing(pvWidth) Then pvWidth = -1
|
||||
If IsMissing(pvHeight) Then pvHeight = -1
|
||||
|
||||
Move = pvObject.Move(pvLeft, pvTop, pvWidth, pvHeight)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Move")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Move", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Move V.0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function OpenHelpFile()
|
||||
' Open the help file from the Help menu (IDE only)
|
||||
Const cstHelpFile = "http://www.access2base.com/access2base.html"
|
||||
|
||||
On Local Error Resume Next
|
||||
Call _ShellExecute(cstHelpFile)
|
||||
|
||||
End Function ' OpenHelpFile V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperties As Variant, oCounter As Variant, opProperty As Variant
|
||||
Dim vPropertiesList() As Variant
|
||||
|
||||
If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments()
|
||||
Utils._SetCalledSub("Properties")
|
||||
|
||||
Set vProperties = Nothing
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _
|
||||
, OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _
|
||||
)) Then Goto Exit_Function
|
||||
|
||||
If IsMissing(pvIndex) Then vProperties = pvObject.Properties Else vProperties = pvObject.Properties(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperties
|
||||
Utils._ResetCalledSub("Properties")
|
||||
Exit Function
|
||||
End Function ' Properties V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Refresh(Optional pvObject As Variant) As Boolean
|
||||
' Refresh data with its most recent value in the database in a form or subform
|
||||
Utils._SetCalledSub("Refresh")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Refresh = False
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
|
||||
Refresh = pvObject.Refresh()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Refresh")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Refresh", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Refresh V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function RemoveItem(Optional pvBox As Variant,ByVal Optional pvIndex) As Boolean
|
||||
' Remove an item from a Listbox
|
||||
' Index may be a string value or an index-position
|
||||
|
||||
Utils._SetCalledSub("RemoveItem")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
If IsMissing(pvBox) Or IsMissing(pvIndex) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
|
||||
|
||||
RemoveItem = pvBox.RemoveItem(pvIndex)
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("RemoveItem")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "RemoveItem", Erl)
|
||||
RemoveItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' RemoveItem V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Requery(Optional pvObject As Variant) As Boolean
|
||||
' Refresh data displayed in a form, subform, combobox or listbox
|
||||
Utils._SetCalledSub("Requery")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL, OBJSUBFORM)) Then Goto Exit_Function
|
||||
|
||||
Requery = pvObject.Requery()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Requery")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Requery", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Requery V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function SetFocus(Optional pvObject As Variant) As Boolean
|
||||
' Execute SetFocus method
|
||||
Utils._SetCalledSub("setFocus")
|
||||
If IsMissing(pvObject) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL)) Then Goto Exit_Function
|
||||
|
||||
SetFocus = pvObject.setFocus()
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SetFocus")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SetFocus", Erl)
|
||||
Goto Exit_Function
|
||||
Error_Grid:
|
||||
TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(pvObject._Name, ocGrid._Name))
|
||||
Goto Exit_Function
|
||||
End Function ' SetFocus V0.9.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _OptionGroup(ByVal pvGroupName As Variant _
|
||||
, ByVal psParentType As String _
|
||||
, poComponent As Object _
|
||||
, poParent As Object _
|
||||
) As Variant
|
||||
' Return either an error or an object of type OPTIONGROUP based on its name
|
||||
|
||||
If IsMissing(pvGroupName) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Set _OptionGroup = Nothing
|
||||
|
||||
If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean
|
||||
Dim vOptionButtons() As Variant, sGroupName As String
|
||||
Dim lXY() As Long, iIndex() As Integer ' Two indexes X-Y coordinates
|
||||
Dim oView As Object, oDatabaseForm As Object, vControls As Variant
|
||||
|
||||
Const cstPixels = 10 ' Tolerance on coordinates when drawn approximately
|
||||
|
||||
bFound = False
|
||||
Select Case psParentType
|
||||
Case CTLPARENTISFORM
|
||||
'poParent is a forms collection, find the appropriate database form
|
||||
For i = 0 To poParent.Count - 1
|
||||
Set oDatabaseForm = poParent.getByIndex(i)
|
||||
If Not IsNull(oDatabaseForm) Then
|
||||
For j = 0 To oDatabaseForm.GroupCount - 1 ' Does a group with the right name exist ?
|
||||
oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
|
||||
If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next j
|
||||
If bFound Then Exit For
|
||||
End If
|
||||
If bFound Then Exit For
|
||||
Next i
|
||||
Case CTLPARENTISSUBFORM
|
||||
'poParent is already a database form
|
||||
Set oDatabaseForm = poParent
|
||||
For j = 0 To oDatabaseForm.GroupCount - 1 ' Does a group with the right name exist ?
|
||||
oDatabaseForm.getGroup(j, vOptionButtons, sGroupName)
|
||||
If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next j
|
||||
End Select
|
||||
|
||||
If bFound Then
|
||||
|
||||
ogGroup = New Optiongroup
|
||||
ogGroup._This = ogGroup
|
||||
ogGroup._Name = sGroupName
|
||||
ogGroup._ButtonsGroup = vOptionButtons
|
||||
ogGroup._Count = UBound(vOptionButtons) + 1
|
||||
ogGroup._ParentType = psParentType
|
||||
ogGroup._MainForm = oDatabaseForm.Name
|
||||
Set ogGroup._ParentComponent = poComponent
|
||||
|
||||
ReDim lXY(1, ogGroup._Count - 1)
|
||||
ReDim iIndex(ogGroup._Count - 1)
|
||||
For i = 0 To ogGroup._Count - 1 ' Find the position of each radiobutton
|
||||
Set oView = poComponent.CurrentController.getControl(ogGroup._ButtonsGroup(i))
|
||||
lXY(0, i) = oView.PosSize.X
|
||||
lXY(1, i) = oView.PosSize.Y
|
||||
Next i
|
||||
For i = 0 To ogGroup._Count - 1 ' Sort them on XY coordinates
|
||||
If i = 0 Then
|
||||
iIndex(0) = 0
|
||||
Else
|
||||
iIndex(i) = i
|
||||
For j = i - 1 To 0 Step -1
|
||||
If lXY(1, i) - lXY(1, j) < - cstPixels Or ( Abs(lXY(1, i) - lXY(1, j)) <= cstPixels And lXY(0, i) - lXY(0, j) < - cstPixels ) Then
|
||||
iIndex(i) = iIndex(j)
|
||||
iIndex(j) = iIndex(j) + 1
|
||||
End If
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
ogGroup._ButtonsIndex = iIndex()
|
||||
|
||||
Set _OptionGroup = ogGroup
|
||||
|
||||
Else
|
||||
|
||||
Set _OptionGroup = Nothing
|
||||
TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
|
||||
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err,"_OptionGroup", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' _OptionGroup V1.1.0
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,722 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be MODULE
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Library As Object ' com.sun.star.container.XNameAccess
|
||||
Private _LibraryName As String
|
||||
Private _Storage As String ' GLOBAL or DOCUMENT
|
||||
Private _Script As String ' Full script (string with vbLf's)
|
||||
Private _Lines As Variant ' Array of script lines
|
||||
Private _CountOfLines As Long
|
||||
Private _ProcsParsed As Boolean ' To test before use of proc arrays
|
||||
Private _ProcNames() As Variant ' All procedure names
|
||||
Private _ProcDecPositions() As Variant ' All procedure declarations
|
||||
Private _ProcEndPositions() As Variant ' All end procedure statements
|
||||
Private _ProcTypes() As Variant ' One of the vbext_pk_* constants
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJMODULE
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
Set _Library = Nothing
|
||||
_LibraryName = ""
|
||||
_Storage = ""
|
||||
_Script = ""
|
||||
_Lines = Array()
|
||||
_CountOfLines = 0
|
||||
_ProcsParsed = False
|
||||
_ProcNames = Array()
|
||||
_ProcDecPositions = Array()
|
||||
_ProcEndPositions = Array()
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get CountOfDeclarationLines() As Long
|
||||
CountOfDeclarationLines = _PropertyGet("CountOfDeclarationLines")
|
||||
End Property ' CountOfDeclarationLines (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get CountOfLines() As Long
|
||||
CountOfLines = _PropertyGet("CountOfLines")
|
||||
End Property ' CountOfLines (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Lines(Optional ByVal pvLine As Variant, Optional ByVal pvNumLines As Variant) As String
|
||||
' Returns a string containing the contents of a specified line or lines in a standard module or a class module
|
||||
|
||||
Const cstThisSub = "Module.Lines"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim sLines As String, lLine As Long
|
||||
sLines = ""
|
||||
|
||||
If IsMissing(pvLine) Or IsMissing(pvNumLines) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function
|
||||
If Not Utils._CheckArgument(pvNumLines, 1, _AddNumeric()) Then GoTo Exit_Function
|
||||
|
||||
lLine = pvLine
|
||||
Do While lLine < _CountOfLines And lLine < pvLine + pvNumLines
|
||||
sLines = sLines & _Lines(lLine - 1) & vbLf
|
||||
lLine = lLine + 1
|
||||
Loop
|
||||
If Len(sLines) > 0 Then sLines = Left(sLines, Len(sLines) - 1)
|
||||
|
||||
Exit_Function:
|
||||
Lines = sLines
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' Lines
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ProcBodyLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
|
||||
' Return the number of the line at which the body of a specified procedure begins
|
||||
|
||||
Const cstThisSub = "Module.ProcBodyLine"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim iIndex As Integer
|
||||
|
||||
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
|
||||
If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
|
||||
|
||||
iIndex = _FindProcIndex(pvProc, pvProcType)
|
||||
If iIndex >= 0 Then ProcBodyLine = _LineOfPosition(_ProcDecPositions(iIndex)) Else ProcBodyLine = iIndex
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ProcBodyline
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ProcCountLines(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
|
||||
' Return the number of lines in the specified procedure
|
||||
|
||||
Const cstThisSub = "Module.ProcCountLines"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim iIndex As Integer, lStart As Long, lEnd As Long
|
||||
|
||||
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
|
||||
If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
|
||||
|
||||
iIndex = _FindProcIndex(pvProc, pvProcType)
|
||||
lStart = ProcStartLine(pvProc, pvProcType)
|
||||
lEnd = _LineOfPosition(_ProcEndPositions(iIndex))
|
||||
ProcCountLines = lEnd - lStart + 1
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ProcCountLines
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ProcOfLine(Optional ByVal pvLine As Variant, Optional ByRef pvProcType As Variant) As String
|
||||
' Return the name and type of the procedure containing line pvLine
|
||||
|
||||
Const cstThisSub = "Module.ProcOfLine"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim sProcedure As String, iProc As Integer, lLineDec As Long, lLineEnd As Long
|
||||
|
||||
If IsMissing(pvLine) Or IsMissing(pvProcType) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function
|
||||
If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
|
||||
|
||||
If Not _ProcsParsed Then _ParseProcs()
|
||||
|
||||
sProcedure = ""
|
||||
For iProc = 0 To UBound(_ProcNames)
|
||||
lLineEnd = _LineOfPosition(_ProcEndPositions(iProc))
|
||||
If pvLine <= lLineEnd Then
|
||||
lLineDec = _LineOfPosition(_ProcDecPositions(iProc))
|
||||
If pvLine < lLineDec Then ' Line between 2 procedures
|
||||
sProcedure = ""
|
||||
Else
|
||||
sProcedure = _ProcNames(iProc)
|
||||
pvProcType = _ProcTypes(iProc)
|
||||
End If
|
||||
Exit For
|
||||
End If
|
||||
Next iProc
|
||||
|
||||
Exit_Function:
|
||||
ProcOfLine = sProcedure
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ProcOfline
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function ProcStartLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
|
||||
' Return the number of the line at which the specified procedure begins
|
||||
|
||||
Const cstThisSub = "Module.ProcStartLine"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim lLine As Long, lIndex As Long, sLine As String
|
||||
|
||||
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function
|
||||
If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
|
||||
|
||||
lLine = ProcBodyLine(pvProc, pvProcType)
|
||||
' Search baclIndexward for comment lines
|
||||
lIndex = lLine - 1
|
||||
Do While lIndex > 0
|
||||
sLine = _Trim(_Lines(lIndex - 1))
|
||||
If UCase(Left(sLine, 4)) = "REM " Or Left(sLine, 1) = "'" Then
|
||||
lLine = lIndex
|
||||
Else
|
||||
Exit Do
|
||||
End If
|
||||
lIndex = lIndex - 1
|
||||
Loop
|
||||
|
||||
ProcStartLine = lLine
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' ProcStartLine
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Const cstThisSub = "Module.Properties"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get pType() As String
|
||||
pType = _PropertyGet("Type")
|
||||
End Property ' Type (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Find(Optional ByVal pvTarget As Variant _
|
||||
, Optional ByRef pvStartLine As Variant _
|
||||
, Optional ByRef pvStartColumn As Variant _
|
||||
, Optional ByRef pvEndLine As Variant _
|
||||
, Optional ByRef pvEndColumn As Variant _
|
||||
, Optional ByVal pvWholeWord As Boolean _
|
||||
, Optional ByVal pvMatchCase As Boolean _
|
||||
, Optional ByVal pvPatternSearch As Boolean _
|
||||
) As Boolean
|
||||
' Finds specified text in the module
|
||||
' xxLine and xxColumn arguments are mainly to return the position of the found string
|
||||
' If they are initialized but nonsense, the function returns False
|
||||
|
||||
Const cstThisSub = "Module.Find"
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Dim bFound As Boolean, lPosition As Long, lStartLine As Long, lStartColumn As Long, lStartPosition As Long
|
||||
Dim lEndLine As Long, lEndColumn As Long, lEndPosition As Long
|
||||
Dim sMatch As String, vOptions As Variant, sPattern As String
|
||||
Dim i As Integer, sSpecChar As String
|
||||
|
||||
Const cstSpecialCharacters = "\[^$.|?*+()"
|
||||
|
||||
bFound = False
|
||||
|
||||
If IsMissing(pvTarget) Or IsMissing(pvStartLine) Or IsMissing(pvStartColumn) Or IsMissing(pvEndLine) Or IsMissing(pvEndColumn) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvTarget, 1, vbString) Then GoTo Exit_Function
|
||||
If Len(pvTarget) = 0 Then GoTo Exit_Function
|
||||
If Not IsEmpty(pvStartLine) Then
|
||||
If Not Utils._CheckArgument(pvStartLine, 2, _AddNumeric()) Then GoTo Exit_Function
|
||||
End If
|
||||
If Not IsEmpty(pvStartColumn) Then
|
||||
If Not Utils._CheckArgument(pvStartColumn, 3, _AddNumeric()) Then GoTo Exit_Function
|
||||
End If
|
||||
If Not IsEmpty(pvEndLine) Then
|
||||
If Not Utils._CheckArgument(pvEndLine, 4, _AddNumeric()) Then GoTo Exit_Function
|
||||
End If
|
||||
If Not IsEmpty(pvEndColumn) Then
|
||||
If Not Utils._CheckArgument(pvEndColumn, 5, _AddNumeric()) Then GoTo Exit_Function
|
||||
End If
|
||||
If IsMissing(pvWholeWord) Then pvWholeWord = False
|
||||
If Not Utils._CheckArgument(pvWholeWord, 6, vbBoolean) Then GoTo Exit_Function
|
||||
If IsMissing(pvMatchCase) Then pvMatchCase = False
|
||||
If Not Utils._CheckArgument(pvMatchCase, 7, vbBoolean) Then GoTo Exit_Function
|
||||
If IsMissing(pvPatternSearch) Then pvPatternSearch = False
|
||||
If Not Utils._CheckArgument(pvPatternSearch, 8, vbBoolean) Then GoTo Exit_Function
|
||||
|
||||
' Initialize starting values
|
||||
If IsEmpty(pvStartLine) Then lStartLine = 1 Else lStartLine = pvStartLine
|
||||
If lStartLine <= 0 Or lStartLine > UBound(_Lines) + 1 Then GoTo Exit_Function
|
||||
If IsEmpty(pvStartColumn) Then lStartColumn = 1 Else lStartColumn = pvStartColumn
|
||||
If lStartColumn <= 0 Then GoTo Exit_Function
|
||||
If lStartColumn > 1 And lStartColumn > Len(_Lines(lStartLine + 1)) Then GoTo Exit_Function
|
||||
lStartPosition = _PositionOfLine(lStartline) + lStartColumn - 1
|
||||
If IsEmpty(pvEndLine) Then lEndLine = UBound(_Lines) + 1 Else lEndLine = pvEndLine
|
||||
If lEndLine < lStartLine Or lEndLine > UBound(_Lines) + 1 Then GoTo Exit_Function
|
||||
If IsEmpty(pvEndColumn) Then lEndColumn = Len(_Lines(lEndLine - 1)) Else lEndColumn = pvEndColumn
|
||||
If lEndColumn < 0 Then GoTo Exit_Function
|
||||
If lEndColumn = 0 Then lEndColumn = 1
|
||||
If lEndColumn > Len(_Lines(lEndLine - 1)) + 1 Then GoTo Exit_Function
|
||||
lEndPosition = _PositionOfLine(lEndline) + lEndColumn - 1
|
||||
|
||||
If pvMatchCase Then
|
||||
Set vOptions = _A2B_.SearchOptions
|
||||
vOptions.transliterateFlags = 0
|
||||
End If
|
||||
|
||||
' Define pattern to search for
|
||||
sPattern = pvTarget
|
||||
' Protect special characters in regular expressions
|
||||
For i = 1 To Len(cstSpecialCharacters)
|
||||
sSpecChar = Mid(cstSpecialCharacters, i, 1)
|
||||
sPattern = Replace(sPattern, sSpecChar, "\" & sSpecChar)
|
||||
Next i
|
||||
If pvPatternSearch Then sPattern = Replace(Replace(sPattern, "\*", ".*"), "\?", ".")
|
||||
If pvWholeWord Then sPattern = "\b" & sPattern & "\b"
|
||||
|
||||
lPosition = lStartPosition
|
||||
sMatch = Utils._RegexSearch(_Script, sPattern, lPosition)
|
||||
' Re-establish default options for later searches
|
||||
If pvMatchCase Then vOptions.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
|
||||
|
||||
' Found within requested bounds ?
|
||||
If sMatch <> "" And lPosition >= lStartPosition And lPosition <= lEndPosition Then
|
||||
pvStartLine = _LineOfPosition(lPosition)
|
||||
pvStartColumn = lPosition - _PositionOfLine(pvStartLine) + 1
|
||||
pvEndLine = _LineOfPosition(lPosition + Len(sMatch) - 1)
|
||||
If pvEndLine > pvStartLine Then
|
||||
pvEndColumn = lPosition + Len(sMatch) - 1 - _PositionOfLine(pvEndLine)
|
||||
Else
|
||||
pvEndColumn = pvStartColumn + Len(sMatch) - 1
|
||||
End If
|
||||
bFound = True
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Find = bFound
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Module.Find", Erl)
|
||||
bFound = False
|
||||
GoTo Exit_Function
|
||||
End Function ' Find
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Const cstThisSub = "Module.Properties"
|
||||
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM --------------------------------Mid(a._Script, iCtl, 25)---------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
Const cstThisSub = "Module.hasProperty"
|
||||
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _BeginStatement(ByVal plStart As Long) As Long
|
||||
' Return the position in _Script of the beginning of the current statement as defined by plStart
|
||||
|
||||
Dim sProc As String, iProc As Integer, iType As Integer
|
||||
Dim lPosition As Long, lPrevious As Long, sFind As String
|
||||
|
||||
sProc = ProcOfLine(_LineOfPosition(plStart), iType)
|
||||
iProc = _FindProcIndex(sProc, iType)
|
||||
If iProc < 0 Then lPosition = 1 Else lPosition = _ProcDecPositions(iProc)
|
||||
|
||||
sFind = "Any"
|
||||
Do While lPosition < plStart And sFind <> ""
|
||||
lPrevious = lPosition
|
||||
sFind = _FindPattern("%^\w", lPosition)
|
||||
If sFind = "" Then Exit Do
|
||||
Loop
|
||||
|
||||
_BeginStatement = lPrevious
|
||||
|
||||
End Function ' _EndStatement
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _EndStatement(ByVal plStart As Long) As Long
|
||||
' Return the position in _Script of the end of the current statement as defined by plStart
|
||||
' plStart is assumed not to be in the middle of a comment or a string
|
||||
|
||||
Dim sMatch As String, lPosition As Long
|
||||
lPosition = plStart
|
||||
sMatch = _FindPattern("%$", lPosition)
|
||||
_EndStatement = lPosition
|
||||
|
||||
End Function ' _EndStatement
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _FindPattern(ByVal psPattern As Variant, Optional ByRef plStart As Long) As String
|
||||
' Find first occurrence of any of the patterns in |-delimited string psPattern
|
||||
' Special escapes
|
||||
' - for word breaks: "%B" (f.i. for searching "END%BFUNCTION")
|
||||
' - for statement start: "%^" (f.i. for searching "%^END%BFUNCTION"). Necessarily first 2 characters of pattern
|
||||
' - for statement end: "%$". Pattern should not contain anything else
|
||||
' If quoted string searched, pattern should start and end with a double quote
|
||||
' Return "" if none found, otherwise returns the matching string
|
||||
' plStart = start position of _Script to search (starts at 1)
|
||||
' In output plStart contains the first position of the matching string or is left unchanged
|
||||
' To search again the same or another pattern => plStart = plStart + Len(matching string)
|
||||
' Comments and strings are skipped
|
||||
|
||||
' Common patterns
|
||||
Const cstComment = "('|\bREM\b)[^\n]*$"
|
||||
Const cstString = """[^""\n]*"""
|
||||
Const cstBeginStatement = "(^|:|\bthen\b|\belse\b|\n)[ \t]*"
|
||||
Const cstEndStatement = "[ \t]*($|:|\bthen\b|\belse\b|\n)"
|
||||
Const cstContinuation = "[ \t]_\n"
|
||||
Const cstWordBreak = "\b[ \t]+(_\n[ \t]*)?\b"
|
||||
Const cstAlt = "|"
|
||||
|
||||
Dim sRegex As String, lStart As Long, bContinue As Boolean, sMatch As String
|
||||
Dim bEndStatement As Boolean, bQuote As Boolean
|
||||
|
||||
If psPattern = "%$" Then
|
||||
sRegex = cstEndStatement
|
||||
Else
|
||||
sRegex = psPattern
|
||||
If Left(psPattern, 2) = "%^" Then sRegex = cstBeginStatement & Right(sRegex, Len(sregex) - 2)
|
||||
sregex = Replace(sregex, "%B", cstWordBreak)
|
||||
End If
|
||||
' Add all to ignore patterns to regex. If pattern = quoted string do not add cstString
|
||||
If Len(psPattern) > 2 And Left(psPattern, 1) = """" And Right(psPattern, 1) = """" Then
|
||||
bQuote = True
|
||||
sRegex = sRegex & cstAlt & cstComment & cstAlt & cstContinuation
|
||||
Else
|
||||
bQuote = False
|
||||
sRegex = sRegex & cstAlt & cstComment & cstAlt & cstString & cstAlt & cstContinuation
|
||||
End If
|
||||
|
||||
If IsMissing(plStart) Then plStart = 1
|
||||
lStart = plStart
|
||||
|
||||
bContinue = True
|
||||
Do While bContinue
|
||||
bEndStatement = False
|
||||
sMatch = Utils._RegexSearch(_Script, sRegex, lStart)
|
||||
Select Case True
|
||||
Case sMatch = ""
|
||||
bContinue = False
|
||||
Case Left(sMatch, 1) = "'"
|
||||
bEndStatement = True
|
||||
Case Left(sMatch, 1) = """"
|
||||
If bQuote Then
|
||||
plStart = lStart
|
||||
bContinue = False
|
||||
End If
|
||||
Case Left(smatch, 1) = ":" Or Left(sMatch, 1) = vbLf
|
||||
If psPattern = "%$" Then
|
||||
bEndStatement = True
|
||||
Else
|
||||
bContinue = False
|
||||
plStart = lStart + 1
|
||||
sMatch = Right(sMatch, Len(sMatch) - 1)
|
||||
End If
|
||||
Case UCase(Left(sMatch, 4)) = "REM " Or UCase(Left(sMatch, 4)) = "REM" & vbTab Or UCase(Left(sMatch, 4)) = "REM" & vbNewLine
|
||||
bEndStatement = True
|
||||
Case UCase(Left(sMatch, 4)) = "THEN" Or UCase(Left(sMatch, 4)) = "ELSE"
|
||||
If psPattern = "%$" Then
|
||||
bEndStatement = True
|
||||
Else
|
||||
bContinue = False
|
||||
plStart = lStart + 4
|
||||
sMatch = Right(sMatch, Len(sMatch) - 4)
|
||||
End If
|
||||
Case sMatch = " _" & vbLf
|
||||
Case Else ' Found
|
||||
plStart = lStart
|
||||
bContinue = False
|
||||
End Select
|
||||
If bEndStatement And psPattern = "%$" Then
|
||||
bContinue = False
|
||||
plStart = lStart - 1
|
||||
sMatch = ""
|
||||
End If
|
||||
lStart = lStart + Len(sMatch)
|
||||
Loop
|
||||
|
||||
_FindPattern = sMatch
|
||||
|
||||
End Function ' _FindPattern
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _FindProcIndex(ByVal psProc As String, ByVal piType As Integer) As Integer
|
||||
' Return index of entry in _Procnames corresponding with pvProc
|
||||
|
||||
Dim i As Integer, iIndex As Integer
|
||||
|
||||
If Not _ProcsParsed Then _ParseProcs
|
||||
|
||||
iIndex = -1
|
||||
For i = 0 To UBound(_ProcNames)
|
||||
If UCase(psProc) = UCase(_ProcNames(i)) And piType = _ProcTypes(i) Then
|
||||
iIndex = i
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If iIndex < 0 Then TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, Utils._CalledSub(), 0, , Array(psProc, _Name))
|
||||
|
||||
Exit_Function:
|
||||
_FindProcIndex = iIndex
|
||||
Exit Function
|
||||
End Function ' _FindProcIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub _Initialize()
|
||||
|
||||
_Script = Replace(_Script, vbCr, "")
|
||||
_Lines = Split(_Script, vbLf)
|
||||
_CountOfLines = UBound(_Lines) + 1
|
||||
|
||||
End Sub ' _Initialize
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _LineOfPosition(ByVal plPosition) As Long
|
||||
' Return the line number of a position in _Script
|
||||
|
||||
Dim lLine As Long, lLength As Long
|
||||
' Start counting from start or end depending on how close position is
|
||||
If plPosition <= Len(_Script) / 2 Then
|
||||
lLength = 0
|
||||
For lLine = 0 To UBound(_Lines)
|
||||
lLength = lLength + Len(_Lines(lLine)) + 1 ' + 1 for line feed
|
||||
If lLength >= plPosition Then
|
||||
_LineOfPosition = lLine + 1
|
||||
Exit Function
|
||||
End If
|
||||
Next lLine
|
||||
Else
|
||||
If Right(_Script, 1) = vbLf Then lLength = Len(_Script) + 1 Else lLength = Len(_Script)
|
||||
For lLine = UBound(_Lines) To 0 Step -1
|
||||
lLength = lLength - Len(_Lines(lLine)) - 1 ' - 1 for line feed
|
||||
If lLength <= plPosition Then
|
||||
_LineOfPosition = lLine + 1
|
||||
Exit Function
|
||||
End If
|
||||
Next lLine
|
||||
End If
|
||||
|
||||
End Function ' _LineOfPosition
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub _ParseProcs()
|
||||
' Fills the Proc arrays: name, start and end position
|
||||
' Executed at first request needing this processing
|
||||
|
||||
Dim lPosition As Long, iProc As Integer, sDecProc As String, sEndProc As String, sNameProc As String, sType As String
|
||||
Const cstDeclaration = "%^(private%B|public%B)?\b(property%Bget|property%Blet|property%Bset|function|sub)\b"
|
||||
Const cstEnd = "%^end%B(property|function|sub)\b"
|
||||
Const cstName = "\w*" '"[A-Za-z_][A-Za-z_0-9]*"
|
||||
|
||||
If _ProcsParsed Then Exit Sub ' Do not redo if already done
|
||||
_ProcNames = Array()
|
||||
_ProcDecPositions = Array()
|
||||
_ProcEndPositions = Array()
|
||||
_ProcTypes = Array()
|
||||
|
||||
lPosition = 1
|
||||
iProc = -1
|
||||
sDecProc = "???"
|
||||
Do While sDecProc <> ""
|
||||
' Identify Function/Sub declaration string
|
||||
sDecProc = _FindPattern(cstDeclaration, lPosition)
|
||||
If sDecProc <> "" Then
|
||||
iProc = iProc + 1
|
||||
ReDim Preserve _ProcNames(0 To iProc)
|
||||
ReDim Preserve _ProcDecPositions(0 To iProc)
|
||||
ReDim Preserve _ProcEndPositions(0 To iProc)
|
||||
ReDim Preserve _ProcTypes(0 To iProc)
|
||||
_ProcDecPositions(iProc) = lPosition
|
||||
lPosition = lPosition + Len(sDecProc)
|
||||
' Identify procedure type
|
||||
Select Case True
|
||||
Case InStr(UCase(sDecProc), "FUNCTION") > 0 : _ProcTypes(iProc) = vbext_pk_Proc
|
||||
Case InStr(UCase(sDecProc), "SUB") > 0 : _ProcTypes(iProc) = vbext_pk_Proc
|
||||
Case InStr(UCase(sDecProc), "GET") > 0 : _ProcTypes(iProc) = vbext_pk_Get
|
||||
Case InStr(UCase(sDecProc), "LET") > 0 : _ProcTypes(iProc) = vbext_pk_Let
|
||||
Case InStr(UCase(sDecProc), "SET") > 0 : _ProcTypes(iProc) = vbext_pk_Set
|
||||
End Select
|
||||
' Identify name of Function/Sub
|
||||
sNameProc = _FindPattern(cstName, lPosition)
|
||||
If sNameProc = "" Then Exit Do ' Should never happen
|
||||
_ProcNames(iProc) = sNameProc
|
||||
lPosition = lPosition + Len(sNameProc)
|
||||
' Identify End statement
|
||||
sEndProc = _FindPattern(cstEnd, lPosition)
|
||||
If sEndProc = "" Then Exit Do ' Should never happen
|
||||
_ProcEndPositions(iProc) = lPosition
|
||||
lPosition = lPosition + Len(sEndProc)
|
||||
End If
|
||||
Loop
|
||||
|
||||
_ProcsParsed = True
|
||||
|
||||
End Sub
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PositionOfLine(ByVal plLine) As Long
|
||||
' Return the position of the first character of the given line in _Script
|
||||
|
||||
Dim lLine As Long, lPosition As Long
|
||||
' Start counting from start or end depending on how close line is
|
||||
If plLine <= (UBound(_Lines) + 1) / 2 Then
|
||||
lPosition = 0
|
||||
For lLine = 0 To plLine - 1
|
||||
lPosition = lPosition + 1 ' + 1 for line feed
|
||||
If lLine < plLine - 1 Then lPosition = lPosition + Len(_Lines(lLine))
|
||||
Next lLine
|
||||
Else
|
||||
lPosition = Len(_Script) + 2 ' Anticipate an ending null-string and a line feed
|
||||
For lLine = UBound(_Lines) To plLine - 1 Step -1
|
||||
lPosition = lPosition - Len(_Lines(lLine)) - 1 ' - 1 for line feed
|
||||
Next lLine
|
||||
End If
|
||||
|
||||
_PositionOfLine = lPosition
|
||||
|
||||
End Function ' _LineOfPosition
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
_PropertiesList = Array("CountOfDeclarationLines", "CountOfLines", "Name", "ObjectType", "Type")
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
Dim cstThisSub As String
|
||||
Const cstDot = "."
|
||||
|
||||
Dim sText As String
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
cstThisSub = "Module.get" & psProperty
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
_PropertyGet = Null
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("CountOfDeclarationLines")
|
||||
If Not _ProcsParsed Then _ParseProcs()
|
||||
If UBound(_ProcNames) >= 0 Then
|
||||
_PropertyGet = ProcStartLine(_ProcNames(0), _ProcTypes(0)) - 1
|
||||
Else
|
||||
_PropertyGet = _CountOfLines
|
||||
End If
|
||||
Case UCase("CountOfLines")
|
||||
_PropertyGet = _CountOfLines
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Storage & cstDot & _LibraryName & cstDot & _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Type")
|
||||
' Find option statement before any procedure declaration
|
||||
sText = _FindPattern("%^option%Bclassmodule\b|\bfunction\b|\bsub\b|\bproperty\b")
|
||||
If UCase(Left(sText, 6)) = "OPTION" Then _PropertyGet = acClassModule Else _PropertyGet = acStandardModule
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Module._PropertyGet", Erl)
|
||||
_PropertyGet = Null
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,315 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="OptionGroup" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be FORM
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _ParentType As String
|
||||
Private _ParentComponent As Object
|
||||
Private _MainForm As String
|
||||
Private _DocEntry As Integer
|
||||
Private _DbEntry As Integer
|
||||
Private _ButtonsGroup() As Variant
|
||||
Private _ButtonsIndex() As Variant
|
||||
Private _Count As Long
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJOPTIONGROUP
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_ParentType = ""
|
||||
_ParentComponent = Nothing
|
||||
_DocEntry = -1
|
||||
_DbEntry = -1
|
||||
_ButtonsGroup = Array()
|
||||
_ButtonsIndex = Array()
|
||||
_Count = 0
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Count() As Variant
|
||||
Count = _PropertyGet("Count")
|
||||
End Property ' Count (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
Public Function pName() As String ' For compatibility with < V0.9.0
|
||||
pName = _PropertyGet("Name")
|
||||
End Function ' pName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
Property Let Value(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Value", pvValue)
|
||||
End Property ' Value (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Return a Control object with name or index = pvIndex
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("OptionGroup.Controls")
|
||||
|
||||
Dim ocControl As Variant, iArgNr As Integer, i As Integer
|
||||
Dim oCounter As Object
|
||||
|
||||
Set ocControl = Nothing
|
||||
|
||||
If IsMissing(pvIndex) Then ' No argument, return Collection object
|
||||
Set oCounter = New Collect
|
||||
Set oCounter._This = oCounter
|
||||
oCounter._CollType = COLLCONTROLS
|
||||
Set oCounter._Parent = _This
|
||||
oCounter._Count = _Count
|
||||
Set Controls = oCounter
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
|
||||
If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If pvIndex < 0 Or pvIndex > _Count - 1 Then Goto Trace_Error_Index
|
||||
|
||||
' Start building the ocControl object
|
||||
' Determine exact name
|
||||
Set ocControl = New Control
|
||||
Set ocControl._This = ocControl
|
||||
Set ocControl._Parent = _This
|
||||
ocControl._ParentType = CTLPARENTISGROUP
|
||||
|
||||
ocControl._Shortcut = ""
|
||||
For i = 0 To _Count - 1
|
||||
If _ButtonsIndex(i) = pvIndex Then
|
||||
Set ocControl.ControlModel = _ButtonsGroup(i)
|
||||
Select Case _ParentType
|
||||
Case CTLPARENTISDIALOG : ocControl._Name = _ButtonsGroup(i).Name
|
||||
Case Else : ocControl._Name = _Name ' OptionGroup and individual radio buttons share the same name
|
||||
End Select
|
||||
ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
ocControl._FormComponent = _ParentComponent
|
||||
ocControl._ClassId = acRadioButton
|
||||
Select Case _ParentType
|
||||
Case CTLPARENTISDIALOG : Set ocControl.ControlView = _ParentComponent.getControl(ocControl._Name)
|
||||
Case Else : Set ocControl.ControlView = _ParentComponent.CurrentController.getControl(ocControl.ControlModel)
|
||||
End Select
|
||||
|
||||
ocControl._Initialize()
|
||||
ocControl._DocEntry = _DocEntry
|
||||
ocControl._DbEntry = _DbEntry
|
||||
Set Controls = ocControl
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.Controls")
|
||||
Exit Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "OptionGroup.Controls", Erl)
|
||||
Set Controls = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("OptionGroup.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("OptionGroup.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("OptionGroup.setProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("OptionGroup.setProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
_PropertiesList = Array("Count", "Name", "ObjectType", "Value")
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("OptionGroup.get" & psProperty)
|
||||
|
||||
'Execute
|
||||
Dim oDatabase As Object, vBookmark As Variant
|
||||
Dim iValue As Integer, i As Integer
|
||||
_PropertyGet = EMPTY
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Count")
|
||||
_PropertyGet = _Count
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
iValue = -1
|
||||
For i = 0 To _Count - 1 ' Find the selected RadioButton
|
||||
If _ButtonsGroup(i).State = 1 Then
|
||||
iValue = _ButtonsIndex(i)
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
_PropertyGet = iValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "OptionGroup._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
|
||||
Utils._SetCalledSub("OptionGroup.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
'Execute
|
||||
Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Value")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
If pvValue < 0 Or pvValue > _Count - 1 Then Goto Trace_Error_Value
|
||||
For i = 0 To _Count - 1
|
||||
_ButtonsGroup(i).State = 0
|
||||
If _ButtonsIndex(i) = pvValue Then iRadioIndex = i
|
||||
Next i
|
||||
_ButtonsGroup(iRadioIndex).State = 1
|
||||
Set oModel = _ButtonsGroup(iRadioIndex)
|
||||
If Utils._hasUNOProperty(oModel, "DataField") Then
|
||||
If Not IsNull(oModel.Datafield) And Not IsEmpty(oModel.Datafield) Then
|
||||
If oModel.Datafield <> "" And Utils._hasUNOMethod(oModel, "commit") Then oModel.commit() ' f.i. checkboxes have no commit method ?? [PASTIM]
|
||||
End If
|
||||
End If
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("OptionGroup.set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "OptionGroup._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,577 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="PropertiesSet" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setAbsolutePosition(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAbsolutePosition")
|
||||
setAbsolutePosition = PropertiesSet._setProperty(pvObject, "AbsolutePosition", pvValue)
|
||||
End Function ' setAbsolutePosition
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setAllowAdditions(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowAdditions")
|
||||
setAllowAdditions = PropertiesSet._setProperty(pvObject, "AllowAdditions", pvValue)
|
||||
End Function ' setAllowAdditions
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setAllowDeletions(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowDeletions")
|
||||
setAllowDeletions = PropertiesSet._setProperty(pvObject, "AllowDeletions", pvValue)
|
||||
End Function ' setAllowDeletions
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setAllowEdits(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowEdits")
|
||||
setAllowEdits = PropertiesSet._setProperty(pvObject, "AllowEdits", pvValue)
|
||||
End Function ' setAllowEdits
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setBackColor(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBackColor")
|
||||
setBackColor = PropertiesSet._setProperty(pvObject, "BackColor", pvValue)
|
||||
End Function ' setBackColor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setBookmark(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBookmark")
|
||||
setBookmark = PropertiesSet._setProperty(pvObject, "Bookmark", pvValue)
|
||||
End Function ' setBookmark
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setBorderColor (Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBorderColor")
|
||||
setBorderColor = PropertiesSet._setProperty(pvObject, "BorderColor", pvValue)
|
||||
End Function ' setBorderColor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setBorderStyle(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBorderStyle")
|
||||
setBorderStyle = PropertiesSet._setProperty(pvObject, "BorderStyle", pvValue)
|
||||
End Function ' setBorderStyle
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setCancel(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCancel")
|
||||
setCancel = PropertiesSet._setProperty(pvObject, "Cancel", pvValue)
|
||||
End Function ' setCancel
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setCaption(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCaption")
|
||||
setCaption = PropertiesSet._setProperty(pvObject, "Caption", pvValue)
|
||||
End Function ' setCaption
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setControlTipText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setControlTipText")
|
||||
setControlTipText = PropertiesSet._setProperty(pvObject, "ControlTipText", pvValue)
|
||||
End Function ' setControlTipText
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setCurrentRecord(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCurrentRecord")
|
||||
setCurrentRecord = PropertiesSet._setProperty(pvObject, "CurrentRecord", pvValue)
|
||||
End Function ' setCurrentRecord
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setDefault(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDefault")
|
||||
setDefault = PropertiesSet._setProperty(pvObject, "Default", pvValue)
|
||||
End Function ' setDefault
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setDefaultValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDefaultValue")
|
||||
setDefaultValue = PropertiesSet._setProperty(pvObject, "DefaultValue", pvValue)
|
||||
End Function ' setDefaultValue
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setDescription(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDescription")
|
||||
setDescription = PropertiesSet._setProperty(pvObject, "Description", pvValue)
|
||||
End Function ' setDescription
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setEnabled(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setEnabled")
|
||||
setEnabled = PropertiesSet._setProperty(pvObject, "Enabled", pvValue)
|
||||
End Function ' setEnabled
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFilter(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFilter")
|
||||
setFilter = PropertiesSet._setProperty(pvObject, "Filter", pvValue)
|
||||
End Function ' setFilter
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFilterOn(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFilterOn")
|
||||
setFilterOn = PropertiesSet._setProperty(pvObject, "FilterOn", pvValue)
|
||||
End Function ' setFilterOn
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontBold(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontBold")
|
||||
setFontBold = PropertiesSet._setProperty(pvObject, "FontBold", pvValue)
|
||||
End Function ' setFontBold
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontItalic(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontItalic")
|
||||
setFontItalic = PropertiesSet._setProperty(pvObject, "FontItalic", pvValue)
|
||||
End Function ' setFontItalic
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontName(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontName")
|
||||
setFontName = PropertiesSet._setProperty(pvObject, "FontName", pvValue)
|
||||
End Function ' setFontName
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontSize(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontSize")
|
||||
setFontSize = PropertiesSet._setProperty(pvObject, "FontSize", pvValue)
|
||||
End Function ' setFontSize
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontUnderline(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontUnderline")
|
||||
setFontUnderline = PropertiesSet._setProperty(pvObject, "FontUnderline", pvValue)
|
||||
End Function ' setFontUnderline
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setFontWeight(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontWeight")
|
||||
setFontWeight = PropertiesSet._setProperty(pvObject, "FontWeight", pvValue)
|
||||
End Function ' setFontWeight
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setForeColor(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setForeColor")
|
||||
setForeColor = PropertiesSet._setProperty(pvObject, "ForeColor", pvValue)
|
||||
End Function ' setForeColor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setHeight(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setHeight")
|
||||
setHeight = PropertiesSet._setProperty(pvObject, "Height", pvValue)
|
||||
End Function ' setHeight
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setListIndex(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setListIndex")
|
||||
setListIndex = PropertiesSet._setProperty(pvObject, "ListIndex", pvValue)
|
||||
End Function ' setListIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setLocked(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setLocked")
|
||||
setLocked = PropertiesSet._setProperty(pvObject, "Locked", pvValue)
|
||||
End Function ' setLocked
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setMultiSelect(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setMultiSelect")
|
||||
setMultiSelect = PropertiesSet._setProperty(pvObject, "MultiSelect", pvValue)
|
||||
End Function ' setMultiSelect
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setOnAction(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOnAction")
|
||||
setOnAction = PropertiesSet._setProperty(pvObject, "OnAction", pvValue)
|
||||
End Function ' setOnAction
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setOptionValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOptionValue")
|
||||
setOptionValue = PropertiesSet._setProperty(pvObject, "OptionValue", pvValue)
|
||||
End Function ' setOptionValue
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setOrderBy(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOrderBy")
|
||||
setOrderBy = PropertiesSet._setProperty(pvObject, "OrderBy", pvValue)
|
||||
End Function ' setOrderBy
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setOrderByOn(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOrderByOn")
|
||||
setOrderByOn = PropertiesSet._setProperty(pvObject, "OrderByOn", pvValue)
|
||||
End Function ' setOrderByOn
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setPage(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setPage")
|
||||
setPage = PropertiesSet._setProperty(pvObject, "Page", pvValue)
|
||||
End Function ' setPage V0.9.1
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(Optional pvItem As Variant, ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("setProperty")
|
||||
If IsMissing(pvItem) Or IsMissing(psProperty) Or IsMissing(pvValue) Or IsEmpty(pvItem) Then Call _TraceArguments()
|
||||
If IsMissing(pvIndex) Then
|
||||
setProperty = PropertiesSet._setProperty(pvItem, psProperty, pvValue)
|
||||
Else
|
||||
setProperty = PropertiesSet._setProperty(pvItem, psProperty, pvValue, pvIndex)
|
||||
End If
|
||||
Utils._ResetCalledSub("setProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setRecordSource(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRecordSource")
|
||||
setRecordSource = PropertiesSet._setProperty(pvObject, "RecordSource", pvValue)
|
||||
End Function ' setRecordSource
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setRequired(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRequired")
|
||||
setRequired = PropertiesSet._setProperty(pvObject, "Required", pvValue)
|
||||
End Function ' setRequired
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setRowSource(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRowSource")
|
||||
setRowSource = PropertiesSet._setProperty(pvObject, "RowSource", pvValue)
|
||||
End Function ' setRowSource
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setRowSourceType(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRowSourceType")
|
||||
setRowSourceType = PropertiesSet._setProperty(pvObject, "RowSourceType", pvValue)
|
||||
End Function ' setRowSourceType
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setSelected(Optional pvObject As Variant, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Then Call _TraceArguments("setSelected")
|
||||
If IsEmpty(pvObject) Then Call _TraceArguments("setSelected")
|
||||
If IsMissing(pvIndex) Then
|
||||
setSelected = PropertiesSet._setProperty(pvObject, "Selected", pvValue)
|
||||
Else
|
||||
setSelected = PropertiesSet._setProperty(pvObject, "Selected", pvValue, pvIndex)
|
||||
End If
|
||||
End Function ' setSelected
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setSelLength(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelLength")
|
||||
setSelLength = PropertiesSet._setProperty(pvObject, "SelLength", pvValue)
|
||||
End Function ' setSelLength
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setSelStart(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelStart")
|
||||
setSelStart = PropertiesSet._setProperty(pvObject, "SelStart", pvValue)
|
||||
End Function ' setSelStart
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setSelText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelText")
|
||||
setSelText = PropertiesSet._setProperty(pvObject, "SelText", pvValue)
|
||||
End Function ' setSelText
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setSpecialEffect(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSpecialEffect")
|
||||
setSpecialEffect = PropertiesSet._setProperty(pvObject, "SpecialEffect", pvValue)
|
||||
End Function ' setSpecialEffect
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTabIndex(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTabIndex")
|
||||
setTabIndex = PropertiesSet._setProperty(pvObject, "TabIndex", pvValue)
|
||||
End Function ' setTabIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTabStop(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTabStop")
|
||||
setTabStop = PropertiesSet._setProperty(pvObject, "TabStop", pvValue)
|
||||
End Function ' setTabStop
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTag(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTag")
|
||||
setTag = PropertiesSet._setProperty(pvObject, "Tag", pvValue)
|
||||
End Function ' setTag
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTextAlign(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTextAlign")
|
||||
setTextAlign = PropertiesSet._setProperty(pvObject, "TextAlign", pvValue)
|
||||
End Function ' setTextAlign
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTooltipText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTooltipText")
|
||||
setTooltipText = PropertiesSet._setProperty(pvObject, "TooltipText", pvValue)
|
||||
End Function ' setTooltipText
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setTripleState(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTripleState")
|
||||
setTripleState = PropertiesSet._setProperty(pvObject, "TripleState", pvValue)
|
||||
End Function ' setTripleState
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setVisible(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms and controls
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setVisible")
|
||||
setVisible = PropertiesSet._setProperty(pvObject, "Visible", pvValue)
|
||||
End Function ' setVisible
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setWidth(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Only for open forms
|
||||
If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setWidth")
|
||||
setWidth = PropertiesSet._setProperty(pvObject, "Width", pvValue)
|
||||
End Function ' setWidth
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private Function _CheckProperty(pvObject As Object, ByVal psProperty As String) As Boolean
|
||||
' Return False if psProperty not within the PropertyValues set of pvItem
|
||||
|
||||
Dim i As Integer, oPropertyValues As Variant, oProperty As Variant
|
||||
oPropertyValues = pvObject.PropertyValues
|
||||
|
||||
For i = LBound(oPropertyValues) To UBound(oPropertyValues)
|
||||
oProperty = oPropertyValues(i)
|
||||
If UCase(oProperty.Name) = UCase(psProperty) Then
|
||||
_CheckProperty = True
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
|
||||
_CheckProperty = False
|
||||
Exit Function
|
||||
|
||||
End Function ' CheckProperty V0.7.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
'pvItem must be an object and have the requested property
|
||||
If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function
|
||||
'Check Index argument
|
||||
If Not IsMissing(pvIndex) Then
|
||||
If Not Utils._CheckArgument(pvIndex, 4, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
End If
|
||||
'Execute
|
||||
Dim iArgNr As Integer, lFormat As Long
|
||||
Dim i As Integer, iCount As Integer, iSelectedItems() As Integer, bListboxBound As Boolean
|
||||
Dim odbDatabase As Object, vNames As Variant, bFound As Boolean, sName As String, oModel As Object
|
||||
Dim ocButton As Variant, iRadioIndex As Integer
|
||||
_setProperty = True
|
||||
If _A2B_.CalledSub = "setProperty" Then iArgNr = 3 Else iArgNr = 2
|
||||
If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error_Control
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("AbsolutePosition")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function
|
||||
pvItem.AbsolutePosition = pvValue
|
||||
Case UCase("AllowAdditions")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.AllowAdditions = pvValue
|
||||
Case UCase("AllowDeletions")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.AllowDeletions = pvValue
|
||||
Case UCase("AllowEdits")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.AllowEdits = pvValue
|
||||
Case UCase("BackColor")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.BackColor = pvValue
|
||||
Case UCase("Bookmark")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJRECORDSET)) Then Goto Exit_Function
|
||||
pvItem.Bookmark = pvValue
|
||||
Case UCase("BorderColor")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.BorderColor = pvValue
|
||||
Case UCase("BorderStyle")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.BorderColor = pvValue
|
||||
Case UCase("Cancel")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Cancel = pvValue
|
||||
Case UCase("Caption")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
|
||||
pvItem.Caption = pvValue
|
||||
Case UCase("ControlTipText")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.ControlTipText = pvValue
|
||||
Case UCase("CurrentRecord")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.CurrentRecord = pvValue
|
||||
Case UCase("Default")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Default = pvValue
|
||||
Case UCase("DefaultValue")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJFIELD)) Then Goto Exit_Function
|
||||
pvItem.DefaultValue = pvValue
|
||||
Case UCase("Description")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function
|
||||
pvItem.DefaultValue = pvValue
|
||||
Case UCase("Enabled")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Enabled = pvValue
|
||||
Case UCase("Filter")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM, OBJRECORDSET)) Then Goto Exit_Function
|
||||
pvItem.Filter = pvValue
|
||||
Case UCase("FilterOn")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.FilterOn = pvValue
|
||||
Case UCase("FontBold")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontBold = pvValue
|
||||
Case UCase("FontItalic")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontItalic = pvValue
|
||||
Case UCase("FontName")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontName = pvValue
|
||||
Case UCase("FontSize")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontSize = pvValue
|
||||
Case UCase("FontUnderline")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontUnderline = pvValue
|
||||
Case UCase("FontWeight")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.FontWeight = pvValue
|
||||
Case UCase("ForeColor")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.ForeColor = pvValue
|
||||
Case UCase("Height")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
|
||||
pvItem.Height = pvValue
|
||||
Case UCase("ListIndex")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.ListIndex = pvValue
|
||||
Case UCase("Locked")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Locked = pvValue
|
||||
Case UCase("MultiSelect")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.MultiSelect = pvValue
|
||||
Case UCase("OnAction")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
|
||||
pvItem.OnAction = pvValue
|
||||
Case UCase("OptionValue")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.OptionValue = pvValue
|
||||
Case UCase("OrderBy")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.OrderBy = pvValue
|
||||
Case UCase("OrderByOn")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.OrderByOn = pvValue
|
||||
Case UCase("Page")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function
|
||||
pvItem.Page = pvValue
|
||||
Case UCase("RecordSource")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
|
||||
pvItem.RecordSource = pvValue
|
||||
Case UCase("Required")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Required = pvValue
|
||||
Case UCase("RowSource")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.RowSource = pvValue
|
||||
Case UCase("RowSourceType") ' Refresh done when RowSource changes, not RowSourceType
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.RowSourceType = pvValue
|
||||
Case UCase("Selected")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
If IsMissing(pvIndex) Then pvItem.Selected = pvValue Else pvItem.SelectedI(pvValue, pvIndex)
|
||||
Case UCase("SelLength")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.SelLength = pvValue
|
||||
Case UCase("SelStart")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.SelStart = pvValue
|
||||
Case UCase("SelText")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.SelText = pvValue
|
||||
Case UCase("SpecialEffect")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.SpecialEffect = pvValue
|
||||
Case UCase("TabIndex")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.TabIndex = pvValue
|
||||
Case UCase("TabStop")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.TabStop = pvValue
|
||||
Case UCase("Tag")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.Tag = pvValue
|
||||
Case UCase("TextAlign")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.TextAlign = pvValue
|
||||
Case UCase("TooltipText")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function
|
||||
pvItem.TooltipText = pvValue
|
||||
Case UCase("TripleState")
|
||||
If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function
|
||||
pvItem.TripleState = pvValue
|
||||
Case UCase("Value")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function
|
||||
pvItem.Value = pvValue
|
||||
Case UCase("Visible")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function
|
||||
pvItem.Visible = pvValue
|
||||
Case UCase("Width")
|
||||
If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function
|
||||
pvItem.Width = pvValue
|
||||
Case Else
|
||||
Goto Trace_Error_Control
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error_Form:
|
||||
TraceError(TRACEFATAL, ERRFORMNOTFOUND, Utils._CalledSub(), 0, 1, pvItem._Name)
|
||||
_setProperty = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Control:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_setProperty = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_setProperty = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_setProperty = Nothing
|
||||
Goto Exit_Function
|
||||
Trace_Error_Array:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYNOTARRAY, Utils._CalledSub(), 0, 1, iArgNr)
|
||||
_setProperty = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "_setProperty", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' _setProperty V0.9.1
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,152 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Property" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be PROPERTY
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Value As Variant
|
||||
Private _ParentDatabase As Object
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJPROPERTY
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_Value = Null
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
Public Function pName() As String ' For compatibility with < V0.9.0
|
||||
pName = _PropertyGet("Name")
|
||||
End Function ' pName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Property.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Property.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Name", "ObjectType", "Value")
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("Property.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
_PropertyGet = _Value
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Property.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Property._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,613 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Python" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub DebugPrint(ParamArray pvArgs() As Variant)
|
||||
|
||||
'Print arguments unconditionally in console
|
||||
'Arguments are separated by a TAB (simulated by spaces)
|
||||
'Some pvArgs might be missing: a TAB is still generated
|
||||
|
||||
Dim vVarTypes() As Variant, i As Integer
|
||||
Const cstTab = 5
|
||||
On Local Error Goto Exit_Sub ' Never interrupt processing
|
||||
Utils._SetCalledSub("DebugPrint")
|
||||
vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObject, vbVariant, vbByte, vbArray + vbByte))
|
||||
|
||||
If UBound(pvArgs) >= 0 Then
|
||||
For i = 0 To UBound(pvArgs)
|
||||
If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = "[TYPE?]"
|
||||
Next i
|
||||
End If
|
||||
|
||||
Dim sOutput As String, sArg As String
|
||||
sOutput = ""
|
||||
For i = 0 To UBound(pvArgs)
|
||||
sArg = Replace(Utils._CStr(pvArgs(i), _A2B_.DebugPrintShort), "\;", ";")
|
||||
' Add argument to output
|
||||
If i = 0 Then
|
||||
sOutput = sArg
|
||||
Else
|
||||
sOutput = sOutput & Space(cstTab - (Len(sOutput) Mod cstTab)) & sArg
|
||||
End If
|
||||
Next i
|
||||
|
||||
TraceLog(TRACEANY, sOutput, False)
|
||||
|
||||
Exit_Sub:
|
||||
Utils._ResetCalledSub("DebugPrint")
|
||||
Exit Sub
|
||||
End Sub ' DebugPrint V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PYTHON WRAPPERS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PythonEventsWrapper(Optional poEvent As Variant) As Variant
|
||||
' Python wrapper when Application.Events() method is invoked
|
||||
' The ParamArray mechanism empties UNO objects when they are member of the arguments list
|
||||
' As a workaround, the Application.Events function is executed directly
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Exit_Function ' Do never interrupt
|
||||
PythonEventsWrapper = Null
|
||||
|
||||
Dim vReturn As Variant, vArray As Variant
|
||||
Const cstObject = 1
|
||||
|
||||
vReturn = Application.Events(poEvent)
|
||||
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)
|
||||
|
||||
PythonEventsWrapper = vArray
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PythonEventsWrapper V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PythonWrapper(ByVal pvCallType As Variant _
|
||||
, ByVal pvObject As Variant _
|
||||
, ByVal pvScript As Variant _
|
||||
, ParamArray pvArgs() As Variant _
|
||||
) As Variant
|
||||
' Called from Python to apply
|
||||
' - on object with entry pvObject in PythonCache
|
||||
' Conventionally: -1 = Application
|
||||
' -2 = DoCmd
|
||||
' - a script pvScript which type is described by pvCallType
|
||||
' - with arguments pvArgs(0)... (max. 8 for object methods)
|
||||
' The value returned by the method/property is encapsulated in an array
|
||||
' [0] => 0 = scalar or array returned by the method
|
||||
' => 1 = basic object returned by the method
|
||||
' => 2 = a null value
|
||||
' [1] => the object reference or the returned value (complemented with arguments passed by reference, if any) or Null
|
||||
' [2] => the object type or Null
|
||||
' [3] => the object name, if any
|
||||
' or, when pvCallType == vbUNO, as the UNO object returned by the property
|
||||
|
||||
Dim vReturn As Variant, vArray As Variant
|
||||
Dim vObject As Variant, sScript As String, sModule As String
|
||||
Dim i As Integer, iNbArgs As Integer, vArg As Variant, vArgs() As Variant
|
||||
|
||||
Const cstApplication = -1, cstDoCmd = -2
|
||||
Const cstScalar = 0, cstObject = 1, cstNull = 2, cstUNO = 3
|
||||
|
||||
'Conventional special values
|
||||
Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++", cstSymMissing = "+++MISSING+++"
|
||||
|
||||
'https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13-8d35-e98cfe98729a
|
||||
'Determines the pvCallType
|
||||
Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Error_Function
|
||||
PythonWrapper = Null
|
||||
|
||||
'Reinterpret arguments one by one into vArgs, examine iso-dates and conventional NoArgs/Empty/Null values
|
||||
iNbArgs = -1
|
||||
vArgs = Array()
|
||||
If UBound(pvArgs) >= 0 Then
|
||||
For i = 0 To UBound(pvArgs)
|
||||
vArg = pvArgs(i)
|
||||
If i = 0 And VarType(vArg) = vbString Then
|
||||
If vArg = cstNoArgs Then Exit For
|
||||
End If
|
||||
If VarType(vArg) = vbString Then
|
||||
If vArg = cstSymEmpty Then
|
||||
vArg = Empty
|
||||
ElseIf vArg = cstSymNull Then
|
||||
vArg = Null
|
||||
ElseIf vArg = cstSymMissing Then
|
||||
Exit For ' Next arguments must be missing also
|
||||
Else
|
||||
vArg = _CDate(vArg)
|
||||
End If
|
||||
End If
|
||||
iNbArgs = iNbArgs + 1
|
||||
ReDim Preserve vArgs(iNbArgs)
|
||||
vArgs(iNbArgs) = vArg
|
||||
Next i
|
||||
End If
|
||||
|
||||
'Check pvObject
|
||||
Select Case pvObject ' Always numeric
|
||||
Case cstApplication
|
||||
sModule = "Application"
|
||||
Select Case pvScript
|
||||
Case "AllDialogs" : If iNbArgs < 0 Then vReturn = Application.AllDialogs() Else vReturn = Application.AllDialogs(vArgs(0))
|
||||
Case "AllForms" : If iNbArgs < 0 Then vReturn = Application.AllForms() Else vReturn = Application.AllForms(vArgs(0))
|
||||
Case "AllModules" : If iNbArgs < 0 Then vReturn = Application.AllModules() Else vReturn = Application.AllModules(vArgs(0))
|
||||
Case "CloseConnection"
|
||||
vReturn = Application.CloseConnection()
|
||||
Case "CommandBars" : If iNbArgs < 0 Then vReturn = Application.CommandBars() Else vReturn = Application.CommandBars(vArgs(0))
|
||||
Case "CurrentDb" : vReturn = Application.CurrentDb()
|
||||
Case "CurrentUser" : vReturn = Application.CurrentUser()
|
||||
Case "DAvg" : vReturn = Application.DAvg(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DCount" : vReturn = Application.DCount(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DLookup" : vReturn = Application.DLookup(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case "DMax" : vReturn = Application.DMax(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DMin" : vReturn = Application.DMin(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DStDev" : vReturn = Application.DStDev(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DStDevP" : vReturn = Application.DStDevP(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DSum" : vReturn = Application.DSum(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DVar" : vReturn = Application.DVar(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "DVarP" : vReturn = Application.DVarP(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "Forms" : If iNbArgs < 0 Then vReturn = Application.Forms() Else vReturn = Application.Forms(vArgs(0))
|
||||
Case "getObject" : vReturn = Application.getObject(vArgs(0))
|
||||
Case "getValue" : vReturn = Application.getValue(vArgs(0))
|
||||
Case "HtmlEncode" : vReturn = Application.HtmlEncode(vArgs(0), vArgs(1))
|
||||
Case "OpenDatabase" : vReturn = Application.OpenDatabase(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case "ProductCode" : vReturn = Application.ProductCode()
|
||||
Case "setValue" : vReturn = Application.setValue(vArgs(0), vArgs(1))
|
||||
Case "SysCmd" : vReturn = Application.SysCmd(vArgs(0), vArgs(1), vARgs(2))
|
||||
Case "TempVars" : If iNbArgs < 0 Then vReturn = Application.TempVars() Else vReturn = Application.TempVars(vArgs(0))
|
||||
Case "Version" : vReturn = Application.Version()
|
||||
Case Else
|
||||
GoTo Error_Proc
|
||||
End Select
|
||||
Case cstDoCmd
|
||||
sModule = "DoCmd"
|
||||
Select Case pvScript
|
||||
Case "ApplyFilter" : vReturn = DoCmd.ApplyFilter(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "Close" : vReturn = DoCmd.mClose(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "CopyObject" : vReturn = DoCmd.CopyObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case "FindNext" : vReturn = DoCmd.FindNext()
|
||||
Case "FindRecord" : vReturn = DoCmd.FindRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
|
||||
Case "GetHiddenAttribute"
|
||||
vReturn = DoCmd.GetHiddenAttribute(vArgs(0), vArgs(1))
|
||||
Case "GoToControl" : vReturn = DoCmd.GoToControl(vArgs(0))
|
||||
Case "GoToRecord" : vReturn = DoCmd.GoToRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case "Maximize" : vReturn = DoCmd.Maximize()
|
||||
Case "Minimize" : vReturn = DoCmd.Minimize()
|
||||
Case "MoveSize" : vReturn = DoCmd.MoveSize(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case "OpenForm" : vReturn = DoCmd.OpenForm(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
|
||||
Case "OpenQuery" : vReturn = DoCmd.OpenQuery(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "OpenReport" : vReturn = DoCmd.OpenReport(vArgs(0), vArgs(1))
|
||||
Case "OpenSQL" : vReturn = DoCmd.OpenSQL(vArgs(0), vArgs(1))
|
||||
Case "OpenTable" : vReturn = DoCmd.OpenTable(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "OutputTo" : vReturn = DoCmd.OutputTo(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
|
||||
Case "Quit" : _A2B_.CalledSub = "Quit" : GoTo Error_Action
|
||||
Case "RunApp" : vReturn = DoCmd.RunApp(vArgs(0))
|
||||
Case "RunCommand" : vReturn = DoCmd.RunCommand(vArgs(0))
|
||||
Case "RunSQL" : vReturn = DoCmd.RunSQL(vArgs(0), vArgs(1))
|
||||
Case "SelectObject" : vReturn = DoCmd.SelectObject(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "SendObject" : vReturn = DoCmd.SendObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7), vArgs(8), vArgs(9))
|
||||
Case "SetHiddenAttribute"
|
||||
vReturn = DoCmd.SetHiddenAttribute(vArgs(0), vArgs(1), vArgs(2))
|
||||
Case "SetOrderBy" : vReturn = DoCmd.SetOrderBy(vArgs(0), vArgs(1))
|
||||
Case "ShowAllRecords"
|
||||
vReturn = DoCmd.ShowAllRecords()
|
||||
Case Else
|
||||
GoTo Error_Proc
|
||||
End Select
|
||||
Case Else
|
||||
' Locate targeted object
|
||||
If pvObject > UBound(_A2B_.PythonCache) Or pvObject < 0 Then GoTo Error_Object
|
||||
Set vObject = _A2B_.PythonCache(pvObject)
|
||||
If IsNull(vObject) Then
|
||||
If pvScript = "Dispose" Then GoTo Exit_Function Else GoTo Error_Object
|
||||
End If
|
||||
' Preprocessing
|
||||
sScript = pvScript
|
||||
sModule = vObject._Type
|
||||
Select Case sScript
|
||||
Case "Add"
|
||||
If vObject._Type = "COLLECTION" And vObject._CollType = COLLTABLEDEFS Then vArgs = Array(_A2B_.PythonCache(vArgs(0)))
|
||||
Case "Close"
|
||||
sSCript = "mClose"
|
||||
Case "Type"
|
||||
sScript = "pType"
|
||||
Case Else
|
||||
End Select
|
||||
' Execute method
|
||||
Select Case UBound(vArgs) ' Dirty but ... CallByName does not support an array of arguments or return values
|
||||
Case -1
|
||||
If pvCallType = vbUNO Then
|
||||
With vObject
|
||||
Select Case sScript ' List all properties that should be called directly (UNO)
|
||||
Case "BoundField" : vReturn = .BoundField
|
||||
Case "Column" : vReturn = .Column
|
||||
Case "Connection" : vReturn = .Connection
|
||||
case "ContainerWindow" : vReturn = .ContainerWindow
|
||||
Case "ControlModel" : vReturn = .ControlModel
|
||||
Case "ControlView" : vReturn = .ControlView
|
||||
Case "DatabaseForm" : vReturn = .DatabaseForm
|
||||
Case "Document" : vReturn = .Document
|
||||
Case "FormsCollection" : vReturn = .FormsCollection
|
||||
Case "LabelControl" : vReturn = .LabelControl
|
||||
Case "MetaData" : vReturn = .MetaData
|
||||
Case "ParentComponent" : vReturn = .ParentComponent
|
||||
Case "Query" : vReturn = .Query
|
||||
Case "RowSet" : vReturn = .RowSet
|
||||
Case "Table" : vReturn = .Table
|
||||
Case "UnoDialog" : vReturn = .UnoDialog
|
||||
Case Else
|
||||
End Select
|
||||
End With
|
||||
ElseIf sScript = "ItemData" Then ' List all properties that should be called directly (arrays not supported by CallByName)
|
||||
vReturn = vObject.ItemData
|
||||
ElseIf sScript = "LinkChildFields" Then
|
||||
vReturn = vObject.LinkChildFields
|
||||
ElseIf sScript = "LinkMasterFields" Then
|
||||
vReturn = vObject.LinkMasterFields
|
||||
ElseIf sScript = "OpenArgs" Then
|
||||
vReturn = vObject.OpenArgs
|
||||
ElseIf sScript = "Selected" Then
|
||||
vReturn = vObject.Selected
|
||||
ElseIf sScript = "Value" Then
|
||||
vReturn = vObject.Value
|
||||
Else
|
||||
vReturn = CallByName(vObject, sScript, pvCallType)
|
||||
End If
|
||||
Case 0
|
||||
Select Case sScript
|
||||
Case "AppendChunk" ' Arg is a vector, not supported by CallByName
|
||||
vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
|
||||
Case "GetRows" ' Returns an array, not supported by CallByName
|
||||
vReturn = vObject.GetRows(vArgs(0), True) ' Force iso dates
|
||||
Case Else
|
||||
vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0))
|
||||
End Select
|
||||
Case 1
|
||||
Select Case sScript
|
||||
Case "GetChunk" ' Returns a vector, not supported by CallByName
|
||||
vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
|
||||
Case Else
|
||||
vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1))
|
||||
End Select
|
||||
Case 2 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2))
|
||||
Case 3 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3))
|
||||
Case 4 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4))
|
||||
Case 5 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5))
|
||||
Case 6 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
|
||||
Case 7 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
|
||||
End Select
|
||||
' Postprocessing
|
||||
Select Case pvScript
|
||||
Case "Close", "Dispose", "Terminate"
|
||||
Set _A2B_.PythonCache(pvObject) = Nothing
|
||||
Case "Move", "MoveFirst", "MoveLast", "MoveNext", "MovePrevious" ' Pass the new BOF, EOF values (binary format)
|
||||
If vObject._Type = "RECORDSET" Then
|
||||
vReturn = (Iif(vObject.BOF, 1, 0) * 2 + Iif(vObject.EOF, 1, 0)) * Iif(vReturn, 1, -1)
|
||||
End If
|
||||
Case "Find" ' Store in array the arguments passed by reference
|
||||
If vObject._Type = "MODULE" And vReturn = True Then
|
||||
vReturn = Array(vReturn, vArgs(1), vArgs(2), vArgs(3), vArgs(4))
|
||||
End If
|
||||
Case "ProcOfLine" ' Store in array the arguments passed by reference
|
||||
vReturn = Array(vReturn, vArgs(1))
|
||||
Case Else
|
||||
End Select
|
||||
End Select
|
||||
|
||||
' Structure the returned array
|
||||
If pvCallType = vbUNO Then
|
||||
vArray = vReturn
|
||||
Else
|
||||
If IsNull(vReturn) Then
|
||||
vArray = Array(cstNull, Null, Null)
|
||||
ElseIf IsObject(vReturn) Then
|
||||
Select Case vReturn._Type
|
||||
Case "COLLECTION", "COMMANDBARCONTROL", "EVENT"
|
||||
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)
|
||||
Case Else
|
||||
vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type, vReturn.Name)
|
||||
End Select
|
||||
Else
|
||||
If VarType(vReturn) = vbDate Then
|
||||
vArray = Array(cstScalar, _CStr(vReturn), Null)
|
||||
ElseIf VarType(vReturn) = vbBigint Then ' Could happen for big integer database fields
|
||||
vArray = Array(cstScalar, CLng(vReturn), Null)
|
||||
Else
|
||||
vArray = Array(cstScalar, vReturn, Null)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
PythonWrapper = vArray
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "PythonWrapper", Erl)
|
||||
GoTo Exit_Function
|
||||
Error_Object:
|
||||
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, "Python Wrapper (" & pvScript & ")", 0, , Array(_GetLabel("OBJECT"), "#" & pvObject))
|
||||
GoTo Exit_Function
|
||||
Error_Action:
|
||||
TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
|
||||
GoTo Exit_Function
|
||||
Error_Proc:
|
||||
TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, "Python Wrapper", 0, , Array(pvScript, sModule))
|
||||
GoTo Exit_Function
|
||||
End Function ' PythonWrapper V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PYTHON HELPER FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyConvertFromUrl(ByVal pvFile As Variant) As String
|
||||
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
PyConvertFromUrl = ""
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
PyConvertFromUrl = ConvertFromUrl(pvFile)
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyConvertFromUrl V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyConvertToUrl(ByVal pvFile As Variant) As String
|
||||
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
PyConvertToUrl = ""
|
||||
If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
PyConvertToUrl = ConvertToUrl(pvFile)
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyConvertToUrl V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyCreateUnoService(ByVal pvService As Variant) As Variant
|
||||
' Convenient function to create a UNO service in Python
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
Set PyCreateUnoService = Nothing
|
||||
If Not Utils._CheckArgument(pvService, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
Set PyCreateUnoService = CreateUnoService(pvService)
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyCreateUnoService V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyDateAdd(ByVal pvAdd As Variant _
|
||||
, ByVal pvCount As Variant _
|
||||
, ByVal pvDate As Variant _
|
||||
) As Variant
|
||||
' Convenient shortcut to useful and easy-to-use Basic date functions
|
||||
|
||||
Dim vDate As Variant, vNewDate As Variant
|
||||
On Local Error GoTo Exit_Function
|
||||
PyDateAdd = Null
|
||||
|
||||
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvCount, 2, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvDate, 3, vbString) Then Goto Exit_Function
|
||||
|
||||
vDate = _CDate(pvDate)
|
||||
vNewDate = DateAdd(pvAdd, pvCount, vDate)
|
||||
If VarType(vNewDate) = vbDate Then PyDateAdd = _CStr(vNewDate) Else PyDateAdd = vNewDate
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyDateAdd V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyDateDiff(ByVal pvAdd As Variant _
|
||||
, ByVal pvDate1 As Variant _
|
||||
, ByVal pvDate2 As Variant _
|
||||
, ByVal pvWeekStart As Variant _
|
||||
, ByVal pvYearStart As Variant _
|
||||
) As Variant
|
||||
' Convenient shortcut to useful and easy-to-use Basic date functions
|
||||
|
||||
Dim vDate1 As Variant, vDate2 As Variant
|
||||
On Local Error GoTo Exit_Function
|
||||
PyDateDiff = Null
|
||||
|
||||
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvDate1, 2, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvDate2, 3, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvWeekStart, 5, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
|
||||
vDate1 = _CDate(pvDate1)
|
||||
vDate2 = _CDate(pvDate2)
|
||||
PyDateDiff = DateDiff(pvAdd, vDate1, vDate2, pvWeekStart, pvYearStart)
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyDateDiff V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyDatePart(ByVal pvAdd As Variant _
|
||||
, ByVal pvDate As Variant _
|
||||
, ByVal pvWeekStart As Variant _
|
||||
, ByVal pvYearStart As Variant _
|
||||
) As Variant
|
||||
' Convenient shortcut to useful and easy-to-use Basic date functions
|
||||
|
||||
Dim vDate As Variant
|
||||
On Local Error GoTo Exit_Function
|
||||
PyDatePart = Null
|
||||
|
||||
If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvDate, 2, vbString) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvWeekStart, 3, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
|
||||
vDate = _CDate(pvDate)
|
||||
PyDatePart = DatePart(pvAdd, vDate, pvWeekStart, pvYearStart)
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyDatePart V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyDateValue(ByVal pvDate As Variant) As Variant
|
||||
' Convenient shortcut to useful and easy-to-use Basic date functions
|
||||
|
||||
Dim vDate As Variant
|
||||
On Local Error GoTo Exit_Function
|
||||
PyDateValue = Null
|
||||
If Not Utils._CheckArgument(pvDate, 1, vbString) Then Goto Exit_Function
|
||||
|
||||
vDate = DateValue(pvDate)
|
||||
If VarType(vDate) = vbDate Then PyDateValue = _CStr(vDate) Else PyDateValue = vDate
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyDateValue V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyFormat(ByVal pvValue As Variant, pvFormat As Variant) As String
|
||||
' Convenient function to format numbers or dates
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
PyFormat = ""
|
||||
If Not Utils._CheckArgument(pvValue, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
pvValue = _CDate(pvValue)
|
||||
If IsEmpty(pvFormat) Then
|
||||
PyFormat = Str(pvValue)
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvFormat, 2, vbString) Then Goto Exit_Function
|
||||
PyFormat = Format(pvValue, pvFormat)
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyFormat V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyGetGUIType() As Variant
|
||||
|
||||
PyGetGUIType = GetGUIType()
|
||||
|
||||
End Function ' PyGetGUIType V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyGetSystemTicks() As Variant
|
||||
|
||||
PyGetSystemTicks = GetSystemTicks()
|
||||
|
||||
End Function ' PyGetSystemTicks V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyGlobalScope(ByVal pvLib As Variant) As Variant
|
||||
|
||||
Select Case pvLib
|
||||
Case "Basic"
|
||||
PyGlobalScope = GlobalScope.BasicLibraries()
|
||||
Case "Dialog"
|
||||
PyGlobalScope = GlobalScope.DialogLibraries()
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
End Function ' PyGlobalScope V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyInputBox(ByVal pvText As Variant _
|
||||
, ByVal pvTitle As Variant _
|
||||
, ByVal pvDefault As Variant _
|
||||
, ByVal pvXPos As Variant _
|
||||
, ByVal pvYPos As Variant _
|
||||
) As Variant
|
||||
' Convenient function to open input box from Python
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
PyInputBox = Null
|
||||
|
||||
If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
|
||||
If IsEmpty(pvTitle) Then pvTitle = ""
|
||||
If Not Utils._CheckArgument(pvTitle, 2, vbString) Then Goto Exit_Function
|
||||
If IsEmpty(pvDefault) Then pvDefault = ""
|
||||
If Not Utils._CheckArgument(pvDefault, 3, vbString) Then Goto Exit_Function
|
||||
|
||||
If IsEmpty(pvXPos) Or IsEmpty(pvYPos) Then
|
||||
PyInputBox = InputBox(pvText, pvTitle, pvDefault)
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvXPos, 4, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvYPos, 5, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
PyInputBox = InputBox(pvText, pvTitle, pvDefault, pvXPos, pvYPos)
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyInputBox V6.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyMsgBox(ByVal pvText As Variant _
|
||||
, ByVal pvType As Variant _
|
||||
, ByVal pvDialogTitle As Variant _
|
||||
) As Variant
|
||||
' Convenient function to open message box from Python
|
||||
|
||||
On Local Error GoTo Exit_Function
|
||||
PyMsgBox = Null
|
||||
|
||||
If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
|
||||
If IsEmpty(pvType) Then pvType = 0
|
||||
If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
If IsEmpty(pvDialogTitle) Then
|
||||
PyMsgBox = MsgBox(pvText, pvType)
|
||||
Else
|
||||
If Not Utils._CheckArgument(pvDialogTitle, 3, vbString) Then Goto Exit_Function
|
||||
PyMsgBox = MsgBox(pvText, pvType, pvDialogTitle)
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' PyMsgBox V6.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function PyTimer() As Long
|
||||
' Convenient function to call Timer from Python
|
||||
|
||||
PyTimer = Timer
|
||||
|
||||
End Function ' PyTimer V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _CDate(ByVal pvValue As Variant) As Variant
|
||||
' Return a Date type if iso date, otherwise return input
|
||||
|
||||
Dim vValue As Variant
|
||||
vValue = pvValue
|
||||
If VarType(pvValue) = vbString Then
|
||||
If pvValue <> "" And IsDate(pvValue) Then vValue = CDate(pvValue) ' IsDate("") gives True !?
|
||||
End If
|
||||
_CDate = vValue
|
||||
|
||||
End Function
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,311 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Root_" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- FOR INTERNAL USE ONLY ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private ErrorHandler As Boolean
|
||||
Private MinimalTraceLevel As Integer
|
||||
Private TraceLogs() As Variant
|
||||
Private TraceLogCount As Integer
|
||||
Private TraceLogLast As Integer
|
||||
Private TraceLogMaxEntries As Integer
|
||||
Private LastErrorCode As Integer
|
||||
Private LastErrorLevel As String
|
||||
Private ErrorText As String
|
||||
Private ErrorLongText As String
|
||||
Private CalledSub As String
|
||||
Private DebugPrintShort As Boolean
|
||||
Private Introspection As Object ' com.sun.star.beans.Introspection
|
||||
Private VersionNumber As String ' Actual Access2Base version number
|
||||
Private Locale As String
|
||||
Private ExcludeA2B As Boolean
|
||||
Private TextSearch As Object
|
||||
Private SearchOptions As Variant
|
||||
Private FindRecord As Object
|
||||
Private StatusBar As Object
|
||||
Private Dialogs As Object ' Collection
|
||||
Private TempVars As Object ' Collection
|
||||
Private CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
|
||||
Private PythonCache() As Variant ' Array of objects created in Python scripts
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
VersionNumber = Access2Base_Version
|
||||
ErrorHandler = True
|
||||
MinimalTraceLevel = 0
|
||||
TraceLogs() = Array()
|
||||
TraceLogCount = 0
|
||||
TraceLogLast = 0
|
||||
TraceLogMaxEntries = 0
|
||||
LastErrorCode = 0
|
||||
LastErrorLevel = ""
|
||||
ErrorText = ""
|
||||
ErrorLongText = ""
|
||||
CalledSub = ""
|
||||
DebugPrintShort = True
|
||||
Locale = L10N._GetLocale()
|
||||
ExcludeA2B = True
|
||||
Set Introspection = CreateUnoService("com.sun.star.beans.Introspection")
|
||||
Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
|
||||
SearchOptions = New com.sun.star.util.SearchOptions
|
||||
With SearchOptions
|
||||
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
|
||||
.searchFlag = 0
|
||||
.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
|
||||
End With
|
||||
Set FindRecord = Nothing
|
||||
Set StatusBar = Nothing
|
||||
Set Dialogs = New Collection
|
||||
Set TempVars = New Collection
|
||||
CurrentDoc = Array()
|
||||
ReDim CurrentDoc(0 To 0)
|
||||
Set CurrentDoc(0) = Nothing
|
||||
PythonCache = Array()
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AddPython(ByRef pvObject As Variant) As Long
|
||||
' Store the object as a new entry in PythonCache and return its entry number
|
||||
|
||||
Dim lVars As Long, vObject As Variant
|
||||
|
||||
lVars = UBound(PythonCache) + 1
|
||||
ReDim Preserve PythonCache(0 To lVars)
|
||||
PythonCache(lVars) = pvObject
|
||||
|
||||
AddPython = lVars
|
||||
|
||||
End Function ' AddPython V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub CloseConnection()
|
||||
' Close all connections established by current document to free memory.
|
||||
' - if Base document => close the one concerned database connection
|
||||
' - if non-Base documents => close the connections of each individual standalone form
|
||||
|
||||
Dim i As Integer, iCurrentDoc As Integer
|
||||
Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
|
||||
|
||||
If ErrorHandler Then On Local Error Goto Error_Sub
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Sub
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Sub
|
||||
iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found
|
||||
If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore
|
||||
|
||||
vDocContainer = CurrentDocument(iCurrentDoc)
|
||||
With vDocContainer
|
||||
If Not .Active Then GoTo Exit_Sub ' e.g. if multiple calls to CloseConnection()
|
||||
For i = 0 To UBound(.DbContainers)
|
||||
If Not IsNull(.DbContainers(i).Database) Then
|
||||
.DbContainers(i).Database.Dispose()
|
||||
Set .DbContainers(i).Database = Nothing
|
||||
End If
|
||||
TraceLog(TRACEANY, UCase(CalledSub) & " " & .URL & Iif(i = 0, "", " Form=" & .DbContainers(i).FormName), False)
|
||||
Set .DbContainers(i) = Nothing
|
||||
Next i
|
||||
.DbContainers = Array()
|
||||
.URL = ""
|
||||
.DbConnect = 0
|
||||
.Active = False
|
||||
Set .Document = Nothing
|
||||
End With
|
||||
CurrentDoc(iCurrentDoc) = vDocContainer
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
TraceError(TRACEABORT, Err, CalledSub, Erl, False) ' No error message addressed to the user, only stored in console
|
||||
GoTo Exit_Sub
|
||||
End Sub ' CloseConnection
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDb() As Object
|
||||
' Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
|
||||
|
||||
Dim iCurrentDoc As Integer
|
||||
|
||||
Set CurrentDb = Nothing
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Function
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Function
|
||||
iCurrentDoc = CurrentDocIndex(, False) ' False = no abort
|
||||
If iCurrentDoc >= 0 Then
|
||||
If UBound(CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' CurrentDb
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
|
||||
' Returns the entry in CurrentDoc(...) referring to the current document
|
||||
|
||||
Dim i As Integer, bFound As Boolean, sURL As String
|
||||
Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
|
||||
|
||||
bFound = False
|
||||
CurrentDocIndex = -1
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If UBound(CurrentDoc) < 0 Then Goto Trace_Error
|
||||
For i = 1 To UBound(CurrentDoc) ' [0] reserved to database .odb document
|
||||
If IsMissing(pvURL) Then ' Not on 1 single line ?!?
|
||||
If Utils._hasUNOProperty(ThisComponent, "URL") Then
|
||||
sURL = ThisComponent.URL
|
||||
Else
|
||||
Exit For ' f.i. ThisComponent = Basic IDE ...
|
||||
End If
|
||||
Else
|
||||
sURL = pvURL ' To support the SelectObject action
|
||||
End If
|
||||
If CurrentDoc(i).Active And CurrentDoc(i).URL = sURL Then
|
||||
CurrentDocIndex = i
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
If Not bFound Then
|
||||
If IsNull(CurrentDoc(0)) Then GoTo Trace_Error
|
||||
With CurrentDoc(0)
|
||||
If Not .Active Then GoTo Trace_Error
|
||||
If IsNull(.Document) Then GoTo Trace_Error
|
||||
End With
|
||||
CurrentDocIndex = 0
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
If IsMissing(pbAbort) Then pbAbort = True
|
||||
If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1
|
||||
Goto Exit_Function
|
||||
End Function ' CurrentDocIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
|
||||
' Returns the CurrentDoc(...) referring to the current document or to the argument
|
||||
|
||||
Dim iDocIndex As Integer
|
||||
If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex(, False) Else iDocIndex = piDocIndex
|
||||
If iDocIndex >= 0 And iDocIndex <= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
|
||||
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dump()
|
||||
' For debugging purposes
|
||||
Dim i As Integer, j As Integer, vCurrentDoc As Variant
|
||||
On Local Error Resume Next
|
||||
|
||||
DebugPrint "Version", VersionNumber
|
||||
DebugPrint "TraceLevel", MinimalTraceLevel
|
||||
DebugPrint "TraceCount", TraceLogCount
|
||||
DebugPrint "CalledSub", CalledSub
|
||||
If IsArray(CurrentDoc) Then
|
||||
For i = 0 To UBound(CurrentDoc)
|
||||
vCurrentDoc = CurrentDoc(i)
|
||||
If Not IsNull(vCurrentDoc) Then
|
||||
DebugPrint i, "URL", vCurrentDoc.URL
|
||||
For j = 0 To UBound(vCurrentDoc.DbContainers)
|
||||
DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName
|
||||
DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasItem(psCollType As String, ByVal psName As String) As Boolean
|
||||
' Return True if psName if in the collection
|
||||
|
||||
Dim oItem As Object
|
||||
On Local Error Goto Error_Function ' Whatever ErrorHandler !
|
||||
|
||||
hasItem = True
|
||||
Select Case psCollType
|
||||
Case COLLALLDIALOGS
|
||||
Set oItem = Dialogs.Item(UCase(psName))
|
||||
Case COLLTEMPVARS
|
||||
Set oItem = TempVars.Item(UCase(psName))
|
||||
Case Else
|
||||
hasItem = False
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function: ' Item by key aborted
|
||||
hasItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' hasItem
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
|
||||
REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
|
||||
REM With 2 arguments return the corresponding entry in Root
|
||||
|
||||
Dim odbDatabase As Variant
|
||||
If IsMissing(piDocEntry) Then
|
||||
Set odbDatabase = CurrentDb()
|
||||
Else
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If piDocEntry < 0 Or piDbEntry < 0 Then Goto Trace_Error
|
||||
If piDocEntry > UBound(CurrentDoc) Then Goto Trace_Error
|
||||
If piDbEntry > UBound(CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error
|
||||
Set odbDatabase = CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database
|
||||
End If
|
||||
If IsNull(odbDatabase) Then GoTo Trace_Error
|
||||
|
||||
Exit_Function:
|
||||
Set _CurrentDb = odbDatabase
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
|
||||
Goto Exit_Function
|
||||
End Function ' _CurrentDb
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,757 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SubForm" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be SUBFORM
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Shortcut As String
|
||||
Private _Name As String
|
||||
Private _MainForm As String
|
||||
Private _DocEntry As Integer
|
||||
Private _DbEntry As Integer
|
||||
Private _OrderBy As String
|
||||
Public ParentComponent As Object ' com.sun.star.text.TextDocument
|
||||
Public DatabaseForm As Object ' com.sun.star.form.component.DataForm and com.sun.star.sdb.ResultSet (a.o.)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJSUBFORM
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Shortcut = ""
|
||||
_Name = ""
|
||||
_MainForm = ""
|
||||
_DocEntry = -1
|
||||
_DbEntry = -1
|
||||
_OrderBy = ""
|
||||
Set ParentComponent = Nothing
|
||||
Set DatabaseForm = Nothing
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get AllowAdditions() As Variant
|
||||
AllowAdditions = _PropertyGet("AllowAdditions")
|
||||
End Property ' AllowAdditions (get)
|
||||
|
||||
Property Let AllowAdditions(ByVal pvValue As Variant)
|
||||
Call _PropertySet("AllowAdditions", pvValue)
|
||||
End Property ' AllowAdditions (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get AllowDeletions() As Variant
|
||||
AllowDeletions = _PropertyGet("AllowDeletions")
|
||||
End Property ' AllowDeletions (get)
|
||||
|
||||
Property Let AllowDeletions(ByVal pvValue As Variant)
|
||||
Call _PropertySet("AllowDeletions", pvValue)
|
||||
End Property ' AllowDeletions (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get AllowEdits() As Variant
|
||||
AllowEdits = _PropertyGet("AllowEdits")
|
||||
End Property ' AllowEdits (get)
|
||||
|
||||
Property Let AllowEdits(ByVal pvValue As Variant)
|
||||
Call _PropertySet("AllowEdits", pvValue)
|
||||
End Property ' AllowEdits (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get CurrentRecord() As Variant
|
||||
CurrentRecord = _PropertyGet("CurrentRecord")
|
||||
End Property ' CurrentRecord (get)
|
||||
|
||||
Property Let CurrentRecord(ByVal pvValue As Variant)
|
||||
Call _PropertySet("CurrentRecord", pvValue)
|
||||
End Property ' CurrentRecord (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Filter() As Variant
|
||||
Filter = _PropertyGet("Filter")
|
||||
End Property ' Filter (get)
|
||||
|
||||
Property Let Filter(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Filter", pvValue)
|
||||
End Property ' Filter (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get FilterOn() As Variant
|
||||
FilterOn = _PropertyGet("FilterOn")
|
||||
End Property ' FilterOn (get)
|
||||
|
||||
Property Let FilterOn(ByVal pvValue As Variant)
|
||||
Call _PropertySet("FilterOn", pvValue)
|
||||
End Property ' FilterOn (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get LinkChildFields(ByVal Optional pvIndex As Variant) As Variant
|
||||
If IsMissing(pvIndex) Then LinkChildFields = _PropertyGet("LinkChildFields") Else LinkChildFields = _PropertyGet("LinkChildFields", pvIndex)
|
||||
End Property ' LinkChildFields (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get LinkMasterFields(ByVal Optional pvIndex As Variant) As Variant
|
||||
If IsMissing(pvIndex) Then LinkMasterFields = _PropertyGet("LinkMasterFields") Else LinkMasterFields = _PropertyGet("LinkMasterFields", pvIndex)
|
||||
End Property ' LinkMasterFields (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
Public Function pName() As String ' For compatibility with < V0.9.0
|
||||
pName = _PropertyGet("Name")
|
||||
End Function ' pName (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnApproveCursorMove() As Variant
|
||||
OnApproveCursorMove = _PropertyGet("OnApproveCursorMove")
|
||||
End Property ' OnApproveCursorMove (get)
|
||||
|
||||
Property Let OnApproveCursorMove(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnApproveCursorMove", pvValue)
|
||||
End Property ' OnApproveCursorMove (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnApproveParameter() As Variant
|
||||
OnApproveParameter = _PropertyGet("OnApproveParameter")
|
||||
End Property ' OnApproveParameter (get)
|
||||
|
||||
Property Let OnApproveParameter(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnApproveParameter", pvValue)
|
||||
End Property ' OnApproveParameter (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnApproveReset() As Variant
|
||||
OnApproveReset = _PropertyGet("OnApproveReset")
|
||||
End Property ' OnApproveReset (get)
|
||||
|
||||
Property Let OnApproveReset(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnApproveReset", pvValue)
|
||||
End Property ' OnApproveReset (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnApproveRowChange() As Variant
|
||||
OnApproveRowChange = _PropertyGet("OnApproveRowChange")
|
||||
End Property ' OnApproveRowChange (get)
|
||||
|
||||
Property Let OnApproveRowChange(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnApproveRowChange", pvValue)
|
||||
End Property ' OnApproveRowChange (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnApproveSubmit() As Variant
|
||||
OnApproveSubmit = _PropertyGet("OnApproveSubmit")
|
||||
End Property ' OnApproveSubmit (get)
|
||||
|
||||
Property Let OnApproveSubmit(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnApproveSubmit", pvValue)
|
||||
End Property ' OnApproveSubmit (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnConfirmDelete() As Variant
|
||||
OnConfirmDelete = _PropertyGet("OnConfirmDelete")
|
||||
End Property ' OnConfirmDelete (get)
|
||||
|
||||
Property Let OnConfirmDelete(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnConfirmDelete", pvValue)
|
||||
End Property ' OnConfirmDelete (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnCursorMoved() As Variant
|
||||
OnCursorMoved = _PropertyGet("OnCursorMoved")
|
||||
End Property ' OnCursorMoved (get)
|
||||
|
||||
Property Let OnCursorMoved(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnCursorMoved", pvValue)
|
||||
End Property ' OnCursorMoved (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnErrorOccurred() As Variant
|
||||
OnErrorOccurred = _PropertyGet("OnErrorOccurred")
|
||||
End Property ' OnErrorOccurred (get)
|
||||
|
||||
Property Let OnErrorOccurred(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnErrorOccurred", pvValue)
|
||||
End Property ' OnErrorOccurred (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnLoaded() As Variant
|
||||
OnLoaded = _PropertyGet("OnLoaded")
|
||||
End Property ' OnLoaded (get)
|
||||
|
||||
Property Let OnLoaded(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnLoaded", pvValue)
|
||||
End Property ' OnLoaded (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnReloaded() As Variant
|
||||
OnReloaded = _PropertyGet("OnReloaded")
|
||||
End Property ' OnReloaded (get)
|
||||
|
||||
Property Let OnReloaded(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnReloaded", pvValue)
|
||||
End Property ' OnReloaded (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnReloading() As Variant
|
||||
OnReloading = _PropertyGet("OnReloading")
|
||||
End Property ' OnReloading (get)
|
||||
|
||||
Property Let OnReloading(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnReloading", pvValue)
|
||||
End Property ' OnReloading (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnResetted() As Variant
|
||||
OnResetted = _PropertyGet("OnResetted")
|
||||
End Property ' OnResetted (get)
|
||||
|
||||
Property Let OnResetted(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnResetted", pvValue)
|
||||
End Property ' OnResetted (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnRowChanged() As Variant
|
||||
OnRowChanged = _PropertyGet("OnRowChanged")
|
||||
End Property ' OnRowChanged (get)
|
||||
|
||||
Property Let OnRowChanged(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnRowChanged", pvValue)
|
||||
End Property ' OnRowChanged (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnUnloaded() As Variant
|
||||
OnUnloaded = _PropertyGet("OnUnloaded")
|
||||
End Property ' OnUnloaded (get)
|
||||
|
||||
Property Let OnUnloaded(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnUnloaded", pvValue)
|
||||
End Property ' OnUnloaded (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OnUnloading() As Variant
|
||||
OnUnloading = _PropertyGet("OnUnloading")
|
||||
End Property ' OnUnloading (get)
|
||||
|
||||
Property Let OnUnloading(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OnUnloading", pvValue)
|
||||
End Property ' OnUnloading (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
|
||||
' Return either an error or an object of type OPTIONGROUP based on its name
|
||||
|
||||
Const cstThisSub = "SubForm.OptionGroup"
|
||||
Dim ogGroup As Object
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvGroupName) Then Call _TraceArguments()
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISSUBFORM, ParentComponent, DatabaseForm)
|
||||
If Not IsNull(ogGroup) Then
|
||||
ogGroup._DocEntry = _DocEntry
|
||||
ogGroup._DbEntry = _DbEntry
|
||||
End If
|
||||
Set OptionGroup = ogGroup
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' OptionGroup V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OrderBy() As Variant
|
||||
OrderBy = _PropertyGet("OrderBy")
|
||||
End Property ' OrderBy (get) V1.2.0
|
||||
|
||||
Property Let OrderBy(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OrderBy", pvValue)
|
||||
End Property ' OrderBy (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get OrderByOn() As Variant
|
||||
OrderByOn = _PropertyGet("OrderByOn")
|
||||
End Property ' OrderByOn (get) V1.2.0
|
||||
|
||||
Property Let OrderByOn(ByVal pvValue As Variant)
|
||||
Call _PropertySet("OrderByOn", pvValue)
|
||||
End Property ' OrderByOn (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Parent() As Object
|
||||
|
||||
Utils._SetCalledSub("SubForm.getParent")
|
||||
On Error Goto Error_Function
|
||||
|
||||
Set Parent = _Parent
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SubForm.getParent")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm.getParent", Erl)
|
||||
Set Parent = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Parent
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Recordset() As Object
|
||||
Recordset = _PropertyGet("Recordset")
|
||||
End Property ' Recordset (get) V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get RecordSource() As Variant
|
||||
RecordSource = _PropertyGet("RecordSource")
|
||||
End Property ' RecordSource (get)
|
||||
|
||||
Property Let RecordSource(ByVal pvValue As Variant)
|
||||
Call _PropertySet("RecordSource", pvValue)
|
||||
End Property ' RecordSource (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
|
||||
' Return a Control object with name or index = pvIndex
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("SubForm.Controls")
|
||||
|
||||
Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
|
||||
Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
|
||||
Dim j As Integer
|
||||
|
||||
Set ocControl = Nothing
|
||||
iControlCount = DatabaseForm.getCount()
|
||||
|
||||
If IsMissing(pvIndex) Then ' No argument, return Collection pseudo-object
|
||||
Set oCounter = New Collect
|
||||
Set oCounter._This = oCounter
|
||||
oCounter._CollType = COLLCONTROLS
|
||||
oCounter._Parent = _This
|
||||
oCounter._Count = iControlCount
|
||||
Set Controls = oCounter
|
||||
Goto Exit_Function
|
||||
End If
|
||||
|
||||
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
||||
|
||||
' Start building the ocControl object
|
||||
' Determine exact name
|
||||
Set ocControl = New Control
|
||||
Set ocControl._This = ocControl
|
||||
Set ocControl._Parent = _This
|
||||
ocControl._ParentType = CTLPARENTISSUBFORM
|
||||
sParentShortcut = _Shortcut
|
||||
sControls() = DatabaseForm.getElementNames()
|
||||
|
||||
Select Case VarType(pvIndex)
|
||||
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
|
||||
If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index
|
||||
ocControl._Name = sControls(pvIndex)
|
||||
Case vbString ' Check control name validity (non case sensitive)
|
||||
bFound = False
|
||||
sIndex = UCase(Utils._Trim(pvIndex))
|
||||
For i = 0 To iControlCount - 1
|
||||
If UCase(sControls(i)) = sIndex Then
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
|
||||
End Select
|
||||
|
||||
With ocControl
|
||||
._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name)
|
||||
Set .ControlModel = DatabaseForm.getByName(._Name)
|
||||
._ImplementationName = .ControlModel.getImplementationName()
|
||||
._FormComponent = ParentComponent
|
||||
If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId
|
||||
If ._ClassId > 0 And ._ClassId <> acHiddenControl Then
|
||||
Set .ControlView = ParentComponent.CurrentController.getControl(.ControlModel)
|
||||
End If
|
||||
|
||||
._Initialize()
|
||||
._DocEntry = _DocEntry
|
||||
._DbEntry = _DbEntry
|
||||
End With
|
||||
Set Controls = ocControl
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SubForm.Controls")
|
||||
Exit Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Trace_NotFound:
|
||||
TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name))
|
||||
Set Controls = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm.Controls", Erl)
|
||||
Set Controls = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Controls V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("SubForm.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("SubForm.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Refresh() As Boolean
|
||||
' Refresh data with its most recent value in the database in a form or subform
|
||||
Utils._SetCalledSub("SubForm.Refresh")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Refresh = False
|
||||
|
||||
Dim oSet As Object
|
||||
Set oSet = DatabaseForm.createResultSet()
|
||||
If Not IsNull(oSet) Then
|
||||
oSet.refreshRow()
|
||||
Refresh = True
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set oSet = Nothing
|
||||
Utils._ResetCalledSub("SubForm.Refresh")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm.Refresh", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Refresh
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Requery() As Boolean
|
||||
' Refresh data displayed in a form, subform, combobox or listbox
|
||||
Utils._SetCalledSub("SubForm.Requery")
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Requery = False
|
||||
|
||||
DatabaseForm.reload()
|
||||
Requery = True
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SubForm.Requery")
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm.Requery", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' Requery
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("SubForm.setProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("SubForm.setProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private Function _GetListener(ByVal psProperty As String) As String
|
||||
' Return the X...Listener corresponding with the property in argument
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("OnApproveCursorMove")
|
||||
_GetListener = "XRowSetApproveListener"
|
||||
Case UCase("OnApproveParameter")
|
||||
_GetListener = "XDatabaseParameterListener"
|
||||
Case UCase("OnApproveReset"), UCase("OnResetted")
|
||||
_GetListener = "XResetListener"
|
||||
Case UCase("OnApproveRowChange")
|
||||
_GetListener = "XRowSetApproveListener"
|
||||
Case UCase("OnApproveSubmit")
|
||||
_GetListener = "XSubmitListener"
|
||||
Case UCase("OnConfirmDelete")
|
||||
_GetListener = "XConfirmDeleteListener"
|
||||
Case UCase("OnCursorMoved"), UCase("OnRowChanged")
|
||||
_GetListener = "XRowSetListener"
|
||||
Case UCase("OnErrorOccurred")
|
||||
_GetListener = "XSQLErrorListener"
|
||||
Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading")
|
||||
_GetListener = "XLoadListener"
|
||||
End Select
|
||||
|
||||
End Function ' _GetListener V1.7.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
|
||||
_PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "CurrentRecord" _
|
||||
, "Filter", "FilterOn", "LinkChildFields", "LinkMasterFields", "Name" _
|
||||
, "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _
|
||||
, "OnApproveReset", "OnApproveRowChange", "OnApproveSubmit", "OnConfirmDelete" _
|
||||
, "OnCursorMoved", "OnErrorOccurred", "OnLoaded", "OnReloaded", "OnReloading" _
|
||||
, "OnResetted", "OnRowChanged", "OnUnloaded", "OnUnloading", "OrderBy" _
|
||||
, "OrderByOn", "Parent", "RecordSource" _
|
||||
) ' Recordset removed
|
||||
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("SubForm.get" & psProperty)
|
||||
Dim iArgNr As Integer
|
||||
If Not IsMissing(pvIndex) Then
|
||||
Select Case UCase(_A2B_.CalledSub)
|
||||
Case UCase("getProperty") : iArgNr = 3
|
||||
Case UCase("SubForm.getProperty") : iArgNr = 2
|
||||
Case UCase("SubForm.get" & psProperty) : iArgNr = 1
|
||||
End Select
|
||||
If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function
|
||||
End If
|
||||
|
||||
'Execute
|
||||
Dim oDatabase As Object, vBookmark As Variant, oObject As Object
|
||||
_PropertyGet = EMPTY
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("AllowAdditions")
|
||||
_PropertyGet = DatabaseForm.AllowInserts
|
||||
Case UCase("AllowDeletions")
|
||||
_PropertyGet = DatabaseForm.AllowDeletes
|
||||
Case UCase("AllowEdits")
|
||||
_PropertyGet = DatabaseForm.AllowUpdates
|
||||
Case UCase("CurrentRecord")
|
||||
_PropertyGet = DatabaseForm.Row
|
||||
Case UCase("Filter")
|
||||
_PropertyGet = DatabaseForm.Filter
|
||||
Case UCase("FilterOn")
|
||||
_PropertyGet = DatabaseForm.ApplyFilter
|
||||
Case UCase("LinkChildFields")
|
||||
If Utils._hasUNOProperty(DatabaseForm, "DetailFields") Then
|
||||
If IsMissing(pvIndex) Then
|
||||
_PropertyGet = DatabaseForm.DetailFields
|
||||
Else
|
||||
If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.DetailFields) Then Goto trace_Error_Index
|
||||
_PropertyGet = DatabaseForm.DetailFields(pvIndex)
|
||||
End If
|
||||
End If
|
||||
Case UCase("LinkMasterFields")
|
||||
If Utils._hasUNOProperty(DatabaseForm, "MasterFields") Then
|
||||
If IsMissing(pvIndex) Then
|
||||
_PropertyGet = DatabaseForm.MasterFields
|
||||
Else
|
||||
If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.MasterFields) Then Goto trace_Error_Index
|
||||
_PropertyGet = DatabaseForm.MasterFields(pvIndex)
|
||||
End If
|
||||
End If
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
|
||||
, UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
|
||||
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
|
||||
, UCase("OnUnloaded"), UCase("OnUnloading")
|
||||
_PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name)
|
||||
Case UCase("OrderBy")
|
||||
_PropertyGet = _OrderBy
|
||||
Case UCase("OrderByOn")
|
||||
If DatabaseForm.Order = "" Then _PropertyGet = False Else _PropertyGet = True
|
||||
Case UCase("Parent") ' Only for indirect access from property object
|
||||
_PropertyGet = Parent
|
||||
Case UCase("Recordset")
|
||||
If DatabaseForm.Command = "" Then Goto Trace_Error ' No underlying data ??
|
||||
Set oObject = New Recordset
|
||||
With DatabaseForm
|
||||
Set oObject._This = oObject
|
||||
oObject._CommandType = .CommandType
|
||||
oObject._Command = .Command
|
||||
oObject._ParentName = _Name
|
||||
oObject._ParentType = _Type
|
||||
Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry)
|
||||
Set oObject._ParentDatabase = oDatabase
|
||||
Set oObject._ParentDatabase.Connection = .ActiveConnection
|
||||
oObject._ForwardOnly = ( .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY )
|
||||
oObject._PassThrough = ( .EscapeProcessing = False )
|
||||
oObject._ReadOnly = ( .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY )
|
||||
Call oObject._Initialize()
|
||||
End With
|
||||
With oDatabase
|
||||
.RecordsetMax = .RecordsetMax + 1
|
||||
oObject._Name = Format(.RecordsetMax, "0000000")
|
||||
.RecordsetsColl.Add(oObject, UCase(oObject._Name))
|
||||
End With
|
||||
Set _PropertyGet = oObject
|
||||
Case UCase("RecordSource")
|
||||
_PropertyGet = DatabaseForm.Command
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SubForm.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Trace_Error_Index:
|
||||
TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = EMPTY
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm._PropertyGet", Erl)
|
||||
_PropertyGet = EMPTY
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
|
||||
Utils._SetCalledSub("SubForm.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
'Execute
|
||||
Dim iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "SubForm.") Then iArgNr = 1 Else iArgNr = 2
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("AllowAdditions")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.AllowInserts = pvValue
|
||||
DatabaseForm.reload()
|
||||
Case UCase("AllowDeletions")
|
||||
If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.AllowDeletes = pvValue
|
||||
DatabaseForm.reload()
|
||||
Case UCase("AllowEdits")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.AllowUpdates = pvValue
|
||||
DatabaseForm.reload()
|
||||
Case UCase("CurrentRecord")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.absolute(pvValue)
|
||||
Case UCase("Filter")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
|
||||
Case UCase("FilterOn")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.ApplyFilter = pvValue
|
||||
DatabaseForm.reload()
|
||||
Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _
|
||||
, UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _
|
||||
, UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _
|
||||
, UCase("OnUnloaded"), UCase("OnUnloading")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
If Not Utils._RegisterEventScript(DatabaseForm _
|
||||
, psProperty _
|
||||
, _GetListener(psProperty) _
|
||||
, pvValue, _Name _
|
||||
) Then GoTo Trace_Error
|
||||
Case UCase("OrderBy")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
_OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
|
||||
Case UCase("OrderByOn")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
|
||||
If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = ""
|
||||
DatabaseForm.reload()
|
||||
Case UCase("RecordSource")
|
||||
If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
|
||||
DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue)
|
||||
DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND
|
||||
DatabaseForm.Filter = ""
|
||||
DatabaseForm.reload()
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("SubForm.set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "SubForm._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,195 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="TempVar" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be TEMPVAR
|
||||
Private _This As Object ' Workaround for absence of This builtin function
|
||||
Private _Parent As Object
|
||||
Private _Name As String
|
||||
Private _Value As Variant
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
_Type = OBJTEMPVAR
|
||||
Set _This = Nothing
|
||||
Set _Parent = Nothing
|
||||
_Name = ""
|
||||
_Value = Null
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get Name() As String
|
||||
Name = _PropertyGet("Name")
|
||||
End Property ' Name (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get Value() As Variant
|
||||
Value = _PropertyGet("Value")
|
||||
End Property ' Value (get)
|
||||
|
||||
Property Let Value(ByVal pvValue As Variant)
|
||||
Call _PropertySet("Value", pvValue)
|
||||
End Property ' Value (set)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("TempVar.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("TempVar.getProperty")
|
||||
|
||||
End Function ' getProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
||||
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
||||
|
||||
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
||||
Exit Function
|
||||
|
||||
End Function ' hasProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' a Property object otherwise
|
||||
|
||||
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
||||
vPropertiesList = _PropertiesList()
|
||||
sObject = Utils._PCase(_Type)
|
||||
If IsMissing(pvIndex) Then
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
|
||||
Else
|
||||
vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
|
||||
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Set Properties = vProperty
|
||||
Exit Function
|
||||
End Function ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
|
||||
' Return True if property setting OK
|
||||
Utils._SetCalledSub("TempVar.getProperty")
|
||||
setProperty = _PropertySet(psProperty, pvValue)
|
||||
Utils._ResetCalledSub("TempVar.getProperty")
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Name", "ObjectType", "Value")
|
||||
End Function ' _PropertiesList
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
||||
' Return property value of the psProperty property name
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Utils._SetCalledSub("TempVar.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Name")
|
||||
_PropertyGet = _Name
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case UCase("Value")
|
||||
_PropertyGet = _Value
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("TempVar.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "TempVar._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
|
||||
|
||||
Utils._SetCalledSub("TempVar.set" & psProperty)
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
_PropertySet = True
|
||||
|
||||
'Execute
|
||||
Dim iArgNr As Integer
|
||||
|
||||
If _IsLeft(_A2B_.CalledSub, "TempVar.") Then iArgNr = 1 Else iArgNr = 2
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Value")
|
||||
_Value = pvValue
|
||||
_A2B_.TempVars.Item(UCase(_Name)).Value = pvValue
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("TempVar.set" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Trace_Error_Value:
|
||||
TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
|
||||
_PropertySet = False
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "TempVar._PropertySet", Erl)
|
||||
_PropertySet = False
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertySet
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,14 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Test" script:language="StarBasic">Option Explicit
|
||||
'Option Compatible
|
||||
|
||||
Sub Main
|
||||
Dim a, b()
|
||||
_ErrorHandler(False)
|
||||
' DebugPrint vbLF
|
||||
' TraceConsole()
|
||||
exit sub
|
||||
End Sub
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,438 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Trace" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
Public Const cstLogMaxEntries = 99
|
||||
|
||||
REM Typical Usage
|
||||
REM TraceLog("INFO", "The OK button was pressed")
|
||||
REM
|
||||
REM Typical Usage for error logging
|
||||
REM Sub MySub()
|
||||
REM On Local Error GoTo Error_Sub
|
||||
REM ...
|
||||
REM Exit_Sub:
|
||||
REM Exit Sub
|
||||
REM Error_Sub:
|
||||
REM TraceError("ERROR", Err, "MySub", Erl)
|
||||
REM GoTo Exit_Sub
|
||||
REM End Sub
|
||||
REM
|
||||
REM To display the current logged traces and/or to set parameters
|
||||
REM TraceConsole()
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceConsole()
|
||||
' Display the Trace dialog with current trace log values and parameter choices
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
|
||||
Dim sLineBreak As String, oTraceDialog As Object
|
||||
sLineBreak = vbNewLine
|
||||
|
||||
Set oTraceDialog = CreateUnoDialog(Utils._GetDialogLib().dlgTrace)
|
||||
oTraceDialog.Title = _GetLabel("DLGTRACE_TITLE")
|
||||
oTraceDialog.Model.HelpText = _GetLabel("DLGTRACE_HELP")
|
||||
|
||||
Dim oEntries As Object, oTraceLog As Object, oClear As Object, oMinLevel As Object, oNbEntries As Object, oDump As Object
|
||||
Dim oControl As Object
|
||||
Dim i As Integer, sText As String, iOKCancel As Integer
|
||||
|
||||
Set oNbEntries = oTraceDialog.Model.getByName("numNbEntries")
|
||||
oNbEntries.Value = _A2B_.TraceLogCount
|
||||
oNbEntries.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblNbEntries")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLNBENTRIES_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
|
||||
|
||||
Set oEntries = oTraceDialog.Model.getByName("numEntries")
|
||||
If _A2B_.TraceLogMaxEntries = 0 Then _A2B_.TraceLogMaxEntries = cstLogMaxEntries
|
||||
oEntries.Value = _A2B_.TraceLogMaxEntries
|
||||
oEntries.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblEntries")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLENTRIES_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
|
||||
|
||||
Set oDump = oTraceDialog.Model.getByName("cmdDump")
|
||||
oDump.Enabled = 0
|
||||
oDump.Label = _GetLabel("DLGTRACE_CMDDUMP_LABEL")
|
||||
oDump.HelpText = _GetLabel("DLGTRACE_CMDDUMP_HELP")
|
||||
|
||||
Set oTraceLog = oTraceDialog.Model.getByName("txtTraceLog")
|
||||
oTraceLog.HelpText = _GetLabel("DLGTRACE_TXTTRACELOG_HELP")
|
||||
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
|
||||
oTraceLog.HardLineBreaks = True
|
||||
sText = ""
|
||||
If _A2B_.TraceLogCount > 0 Then
|
||||
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
|
||||
Do
|
||||
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
|
||||
If Len(_A2B_.TraceLogs(i)) > 11 Then
|
||||
sText = sText & Right(_A2B_.TraceLogs(i), Len(_A2B_.TraceLogs(i)) - 11) & sLineBreak ' Skip date in display
|
||||
End If
|
||||
Loop While i <> _A2B_.TraceLogLast
|
||||
oDump.Enabled = 1 ' Enable DumpToFile only if there is something to dump
|
||||
End If
|
||||
If Len(sText) > 0 Then sText = Left(sText, Len(sText) - Len(sLineBreak)) ' Skip last linefeed
|
||||
oTraceLog.Text = sText
|
||||
Else
|
||||
oTraceLog.Text = _GetLabel("DLGTRACE_TXTTRACELOG_TEXT")
|
||||
End If
|
||||
|
||||
Set oClear = oTraceDialog.Model.getByName("chkClear")
|
||||
oClear.State = 0 ' Unchecked
|
||||
oClear.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblClear")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLCLEAR_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
|
||||
|
||||
Set oMinLevel = oTraceDialog.Model.getByName("cboMinLevel")
|
||||
If _A2B_.MinimalTraceLevel = 0 Then _A2B_.MinimalTraceLevel = _TraceLevel(TRACEERRORS)
|
||||
oMinLevel.Text = _TraceLevel(_A2B_.MinimalTraceLevel)
|
||||
oMinLevel.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("lblMinLevel")
|
||||
oControl.Label = _GetLabel("DLGTRACE_LBLMINLEVEL_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("cmdOK")
|
||||
oControl.Label = _GetLabel("DLGTRACE_CMDOK_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_CMDOK_HELP")
|
||||
|
||||
Set oControl = oTraceDialog.Model.getByName("cmdCancel")
|
||||
oControl.Label = _GetLabel("DLGTRACE_CMDCANCEL_LABEL")
|
||||
oControl.HelpText = _GetLabel("DLGTRACE_CMDCANCEL_HELP")
|
||||
|
||||
iOKCancel = oTraceDialog.Execute()
|
||||
|
||||
Select Case iOKCancel
|
||||
Case 1 ' OK
|
||||
If oClear.State = 1 Then
|
||||
_A2B_.TraceLogs() = Array() ' Erase logged traces
|
||||
_A2B_.TraceLogCount = 0
|
||||
End If
|
||||
If oMinLevel.Text <> "" Then _A2B_.MinimalTraceLevel = _TraceLevel(oMinLevel.Text)
|
||||
If oEntries.Value <> 0 And oEntries.Value <> _A2B_.TraceLogMaxEntries Then
|
||||
_A2B_.TraceLogs() = Array()
|
||||
_A2B_.TraceLogMaxEntries = oEntries.Value
|
||||
End If
|
||||
Case 0 ' Cancel
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Exit_Sub:
|
||||
If Not IsNull(oTraceDialog) Then oTraceDialog.Dispose()
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceConsole V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceError(ByVal psErrorLevel As String _
|
||||
, ByVal piErrorCode As Integer _
|
||||
, ByVal psErrorProc As String _
|
||||
, ByVal piErrorLine As Integer _
|
||||
, ByVal Optional pvMsgBox As Variant _
|
||||
, ByVal Optional pvArgs As Variant _
|
||||
)
|
||||
' Store error code and description in trace rolling buffer
|
||||
' Display error message if errorlevel >= ERROR
|
||||
' Stop program execution if errorlevel = FATAL or ABORT
|
||||
|
||||
On Local Error Resume Next
|
||||
If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
|
||||
|
||||
Dim sErrorText As String, sErrorDesc As String, oDb As Object, bMsgBox As Boolean
|
||||
sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
|
||||
sErrorText = _GetLabel("ERR#") & CStr(piErrorCode) _
|
||||
& " (" & sErrorDesc & ") " & _GetLabel("ERROCCUR") _
|
||||
& Iif(piErrorLine > 0, " " & _GetLabel("ERRLINE") & " " & CStr(piErrorLine), "") _
|
||||
& Iif(psErrorProc <> "", " " & _GetLabel("ERRIN") & " " & psErrorProc, Iif(_A2B_.CalledSub = "", "", " " & _Getlabel("ERRIN") & " " & _A2B_.CalledSub))
|
||||
With _A2B_
|
||||
.LastErrorCode = piErrorCode
|
||||
.LastErrorLevel = psErrorLevel
|
||||
.ErrorText = sErrorDesc
|
||||
.ErrorLongText = sErrorText
|
||||
.CalledSub = ""
|
||||
End With
|
||||
If VarType(pvMsgBox) = vbError Then
|
||||
bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
|
||||
ElseIf IsMissing(pvMsgBox) Then
|
||||
bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
|
||||
Else
|
||||
bMsgBox = pvMsgBox
|
||||
End If
|
||||
TraceLog(psErrorLevel, sErrorText, bMsgBox)
|
||||
|
||||
' Unexpected error detected in user program or in Access2Base
|
||||
If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
|
||||
If psErrorLevel = TRACEFATAL Then
|
||||
Set oDb = _A2B_.CurrentDb()
|
||||
If Not IsNull(oDb) Then oDb.CloseAllrecordsets()
|
||||
End If
|
||||
Stop
|
||||
End If
|
||||
|
||||
End Sub ' TraceError V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function TraceErrorCode() As Variant
|
||||
' Return the last encountered error code, level, description in an array
|
||||
' UNPUBLISHED
|
||||
|
||||
Dim vError As Variant
|
||||
|
||||
With _A2B_
|
||||
vError = Array( _
|
||||
.LastErrorCode _
|
||||
, .LastErrorLevel _
|
||||
, .ErrorText _
|
||||
, .ErrorLongText _
|
||||
)
|
||||
End With
|
||||
TraceErrorCode = vError
|
||||
|
||||
End Function ' TraceErrorCode V6.3
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceLevel(ByVal Optional psTraceLevel As String)
|
||||
' Set trace level to argument
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
Select Case True
|
||||
Case IsMissing(psTraceLevel) : psTraceLevel = "ERROR"
|
||||
Case psTraceLevel = "" : psTraceLevel = "ERROR"
|
||||
Case Utils._InList(UCase(psTraceLevel), Array( _
|
||||
TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT _
|
||||
))
|
||||
Case Else : Goto Exit_Sub
|
||||
End Select
|
||||
_A2B_.MinimalTraceLevel = _TraceLevel(psTraceLevel)
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceLevel V0.9.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub TraceLog(ByVal psTraceLevel As String _
|
||||
, ByVal psText As String _
|
||||
, ByVal Optional pbMsgBox As Boolean _
|
||||
)
|
||||
' Store Text in trace log (circular buffer)
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Sub
|
||||
Dim vTraceLogs() As String, sTraceLevel As String
|
||||
|
||||
With _A2B_
|
||||
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS)
|
||||
If _TraceLevel(psTraceLevel) < .MinimalTraceLevel Then Exit Sub
|
||||
|
||||
If UBound(.TraceLogs) = -1 Then ' Initialize TraceLog
|
||||
If .TraceLogMaxEntries = 0 Then .TraceLogMaxEntries = cstLogMaxEntries
|
||||
|
||||
Redim vTraceLogs(0 To .TraceLogMaxEntries - 1)
|
||||
.TraceLogs = vTraceLogs
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = -1
|
||||
If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS) ' Set default value
|
||||
End If
|
||||
|
||||
.TraceLogLast = .TraceLogLast + 1
|
||||
If .TraceLogLast > UBound(.TraceLogs) Then .TraceLogLast = LBound(.TraceLogs) ' Circular buffer
|
||||
If Len(psTraceLevel) > 7 Then sTraceLevel = Left(psTraceLevel, 7) Else sTraceLevel = psTraceLevel & Spc(8 - Len(psTraceLevel))
|
||||
.TraceLogs(.TraceLogLast) = Format(Now(), "YYYY-MM-DD hh:mm:ss") & " " & sTraceLevel & psText
|
||||
If .TraceLogCount <= UBound(.TraceLogs) Then .TraceLogCount = .TraceLogCount + 1 ' # of active entries
|
||||
End With
|
||||
|
||||
If IsMissing(pbMsgBox) Then pbMsgBox = True
|
||||
Dim iMsgBox As Integer
|
||||
If pbMsgBox Then
|
||||
Select Case psTraceLevel
|
||||
Case TRACEINFO: iMsgBox = vbInformation
|
||||
Case TRACEERRORS, TRACEWARNING: iMsgBox = vbExclamation
|
||||
Case TRACEFATAL, TRACEABORT: iMsgBox = vbCritical
|
||||
Case Else: iMsgBox = vbInformation
|
||||
End Select
|
||||
MsgBox psText, vbOKOnly + iMsgBox, psTraceLevel
|
||||
End If
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
With _A2B_
|
||||
.TraceLogs() = Array()
|
||||
.TraceLogCount = 0
|
||||
.TraceLogLast = 0
|
||||
End With
|
||||
GoTo Exit_Sub
|
||||
End Sub ' TraceLog V0.9.5
|
||||
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private Sub _DumpToFile(oEvent As Object)
|
||||
' Execute the Dump To File command from the Trace dialog
|
||||
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
|
||||
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Error_Sub
|
||||
|
||||
Dim sPath as String, iFileNumber As Integer, i As Integer
|
||||
|
||||
sPath = _PromptFilePicker("txt")
|
||||
If sPath <> "" Then ' Save button pressed
|
||||
If UBound(_A2B_.TraceLogs) >= 0 Then ' Array yet initialized
|
||||
iFileNumber = FreeFile()
|
||||
Open sPath For Append Access Write Lock Read As iFileNumber
|
||||
If _A2B_.TraceLogCount > 0 Then
|
||||
If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast
|
||||
Do
|
||||
If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0
|
||||
Print #iFileNumber _A2B_.TraceLogs(i)
|
||||
Loop While i <> _A2B_.TraceLogLast
|
||||
End If
|
||||
Close iFileNumber
|
||||
MsgBox _GetLabel("SAVECONSOLEENTRIES"), vbOK + vbInformation, _GetLabel("SAVECONSOLE")
|
||||
End If
|
||||
End If
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
TraceError("ERROR", Err, "DumpToFile", Erl)
|
||||
GoTo Exit_Sub
|
||||
End Sub ' DumpToFile V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean
|
||||
' Indicate if error handler is activated or not
|
||||
' When argument present set error handler
|
||||
If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
|
||||
If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck
|
||||
_ErrorHandler = _A2B_.ErrorHandler
|
||||
Exit Function
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _ErrorMessage(ByVal piErrorNumber As Integer, Optional ByVal pvArgs As Variant) As String
|
||||
' Return error message corresponding to ErrorNumber (standard or not)
|
||||
' and replaces %0, %1, ... , %9 by psArgs(0), psArgs(1), ...
|
||||
|
||||
Dim sErrorMessage As String, i As Integer, sErrLabel
|
||||
_ErrorMessage = ""
|
||||
If piErrorNumber > ERRINIT Then
|
||||
sErrLabel = "ERR" & piErrorNumber
|
||||
sErrorMessage = _Getlabel(sErrLabel)
|
||||
If Not IsMissing(pvArgs) Then
|
||||
If Not IsArray(pvArgs) Then
|
||||
sErrorMessage = Join(Split(sErrorMessage, "%0"), Utils._CStr(pvArgs, False))
|
||||
Else
|
||||
For i = LBound(pvArgs) To UBound(pvArgs)
|
||||
sErrorMessage = Join(Split(sErrorMessage, "%" & i), Utils._CStr(pvArgs(i), False))
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
sErrorMessage = Error(piErrorNumber)
|
||||
' Most (or all?) error messages terminate with a "."
|
||||
If Len(sErrorMessage) > 1 And Right(sErrorMessage, 1) = "." Then sErrorMessage = Left(sErrorMessage, Len(sErrorMessage)-1)
|
||||
End If
|
||||
|
||||
_ErrorMessage = sErrorMessage
|
||||
Exit Function
|
||||
|
||||
End Function ' ErrorMessage V0.8.9
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _PromptFilePicker(ByVal psSuffix As String) As String
|
||||
' Prompt for output file name
|
||||
' Return "" if Cancel
|
||||
' Modified from Andrew Pitonyak's Base Macro Programming §10.4
|
||||
|
||||
If _ErrorHandler() Then On Local Error GoTo Error_Function
|
||||
|
||||
Dim oFileDialog as Object, oUcb as object, oPath As Object
|
||||
Dim iAccept as Integer, sInitPath as String
|
||||
|
||||
Set oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION))
|
||||
Set oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
|
||||
oFileDialog.appendFilter("*." & psSuffix, "*." & psSuffix)
|
||||
oFileDialog.appendFilter("*.*", "*.*")
|
||||
oFileDialog.setCurrentFilter("*." & psSuffix)
|
||||
Set oPath = createUnoService("com.sun.star.util.PathSettings")
|
||||
sInitPath = oPath.Work ' Probably My Documents
|
||||
If oUcb.Exists(sInitPath) Then oFileDialog.SetDisplayDirectory(sInitPath)
|
||||
|
||||
iAccept = oFileDialog.Execute()
|
||||
|
||||
_PromptFilePicker = ""
|
||||
If iAccept = 1 Then ' Save button pressed
|
||||
_PromptFilePicker = oFileDialog.Files(0)
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
If Not IsEmpty(oFileDialog) And Not IsNull(oFileDialog) Then oFileDialog.Dispose()
|
||||
Exit Function
|
||||
Error_Function:
|
||||
TraceError("ERROR", Err, "PromptFilePicker", Erl)
|
||||
GoTo Exit_Function
|
||||
End Function ' PromptFilePicker V0.8.5
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub _TraceArguments(Optional psCall As String)
|
||||
' Process the ERRMISSINGARGUMENTS error
|
||||
' psCall is present if error detected before call to _SetCalledSub
|
||||
|
||||
If Not IsMissing(psCall) Then Utils._SetCalledSub(psCall)
|
||||
TraceError(TRACEFATAL, ERRMISSINGARGUMENTS, Utils._CalledSub(), 0)
|
||||
Exit Sub
|
||||
|
||||
End Sub ' TraceArguments
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _TraceLevel(ByVal pvTraceLevel As Variant) As Variant
|
||||
' Convert string trace level to numeric value or the opposite
|
||||
|
||||
Dim vTraces As Variant, i As Integer
|
||||
vTraces = Array(TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT, TRACEANY)
|
||||
|
||||
Select Case VarType(pvTraceLevel)
|
||||
Case vbString
|
||||
_TraceLevel = 4 ' 4 = Default
|
||||
For i = 0 To UBound(vTraces)
|
||||
If UCase(pvTraceLevel) = UCase(vTraces(i)) Then
|
||||
_TraceLevel = i + 1
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
|
||||
If pvTraceLevel < 1 Or pvTraceLevel > UBound(vTraces) + 1 Then _TraceLevel = TRACEERRORS Else _TraceLevel = vTraces(pvTraceLevel - 1)
|
||||
End Select
|
||||
|
||||
End Function ' TraceLevel
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,331 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UtilProperty" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
'**********************************************************************
|
||||
' UtilProperty module
|
||||
'
|
||||
' Module of utilities to manipulate arrays of PropertyValue's.
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' Copyright (c) 2003-2004 Danny Brewer
|
||||
' d29583@groovegarden.com
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' If you make changes, please append to the change log below.
|
||||
'
|
||||
' Change Log
|
||||
' Danny Brewer Revised 2004-02-25-01
|
||||
' Jean-Pierre Ledure Adapted to Access2Base coding conventions
|
||||
' PropValuesToStr rewritten and addition of StrToPropValues
|
||||
' Bug corrected on date values
|
||||
' Addition of support of 2-dimensional arrays
|
||||
' Support of empty arrays to allow JSON conversions
|
||||
'**********************************************************************
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Const cstHEADER = "### PROPERTYVALUES ###"
|
||||
Private Const cstEMPTYARRAY = "### EMPTY ARRAY ###"
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
|
||||
' Create and return a new com.sun.star.beans.PropertyValue.
|
||||
|
||||
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
|
||||
|
||||
If Not IsMissing(psName) Then oPropertyValue.Name = psName
|
||||
If Not IsMissing(pvValue) Then oPropertyValue.Value = _CheckPropertyValue(pvValue)
|
||||
_MakePropertyValue() = oPropertyValue
|
||||
|
||||
End Function ' _MakePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _CheckPropertyValue(ByRef pvValue As Variant) As Variant
|
||||
' Date BASIC variables give error. Change them to strings
|
||||
' Empty arrays should be replaced by cstEMPTYARRAY
|
||||
|
||||
If VarType(pvValue) = vbDate Then
|
||||
_CheckPropertyValue = Utils._CStr(pvValue, False)
|
||||
ElseIf IsArray(pvValue) Then
|
||||
If UBound(pvValue, 1) < LBound(pvValue, 1) Then _CheckPropertyValue = cstEMPTYARRAY Else _CheckPropertyValue = pvValue
|
||||
Else
|
||||
_CheckPropertyValue = pvValue
|
||||
End If
|
||||
|
||||
End Function ' _CheckPropertyValue
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
|
||||
' Return the number of PropertyValue's in an array.
|
||||
' Parameters:
|
||||
' pvPropertyValuesArray - an array of PropertyValue's, that is an array of com.sun.star.beans.PropertyValue.
|
||||
' Returns zero if the array contains no elements.
|
||||
|
||||
Dim iNumProperties As Integer
|
||||
If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1
|
||||
_NumPropertyValues() = iNumProperties
|
||||
|
||||
End Function ' _NumPropertyValues V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindPropertyIndex(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String ) As Integer
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the index in the array of PropertyValue's and returns it, or returns -1 if it was not found.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer, vProp As Variant
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
If UCase(vProp.Name) = UCase(psPropName) Then
|
||||
_FindPropertyIndex() = i
|
||||
Exit Function
|
||||
EndIf
|
||||
Next i
|
||||
_FindPropertyIndex() = -1
|
||||
|
||||
End Function ' _FindPropertyIndex V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the PropertyValue and returns it, or returns Null if not found.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
_FindProperty() = vProp
|
||||
EndIf
|
||||
|
||||
End Function ' _FindProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _GetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, Optional pvDefaultValue) As Variant
|
||||
' Get the value of a particular named property from an array of PropertyValue's.
|
||||
' vDefaultValue - This value is returned if the property is not found in the array.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Variant, i As Integer, j As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vValue = vProp.Value ' get the value from the PropertyValue
|
||||
If VarType(vValue) = vbString Then
|
||||
If vValue = cstEMPTYARRAY Then _GetPropertyValue() = Array() Else _GetPropertyValue() = vValue
|
||||
ElseIf IsArray(vValue) Then
|
||||
If IsArray(vValue(0)) Then ' Array of arrays
|
||||
vMatrix = Array()
|
||||
ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0)))
|
||||
For i = 0 To UBound(vValue)
|
||||
For j = 0 To UBound(vValue(0))
|
||||
vMatrix(i, j) = vValue(i)(j)
|
||||
Next j
|
||||
Next i
|
||||
_GetPropertyValue() = vMatrix
|
||||
Else
|
||||
_GetPropertyValue() = vValue ' Simple vector OK
|
||||
End If
|
||||
Else
|
||||
_GetPropertyValue() = vValue
|
||||
End If
|
||||
Else
|
||||
If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
|
||||
_GetPropertyValue() = pvDefaultValue
|
||||
EndIf
|
||||
|
||||
End Function ' _GetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _SetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, ByVal pvValue As Variant)
|
||||
' Set the value of a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
|
||||
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
' Found, the PropertyValue is already in the array. Just modify its value.
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vProp.Value = _CheckPropertyValue(pvValue) ' set the property value.
|
||||
pvPropertyValuesArray(iPropIndex) = vProp ' put it back into array
|
||||
Else
|
||||
' Not found, the array contains no PropertyValue with this name. Append new element to array.
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
If iNumProperties = 0 Then
|
||||
pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue))
|
||||
Else
|
||||
' Make array larger.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties)
|
||||
' Assign new PropertyValue
|
||||
pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue)
|
||||
EndIf
|
||||
EndIf
|
||||
|
||||
End Sub ' _SetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String)
|
||||
' Delete a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
|
||||
|
||||
End Sub ' _DeletePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteIndexedProperty(ByRef pvPropertyValuesArray As Variant, ByVal piPropIndex As Integer)
|
||||
' Delete a particular indexed property from an array of PropertyValue's.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
' Did we find it?
|
||||
If piPropIndex < 0 Then
|
||||
' Do nothing
|
||||
ElseIf iNumProperties = 1 Then
|
||||
' Just return a new empty array
|
||||
pvPropertyValuesArray = Array()
|
||||
Else
|
||||
' If it is NOT the last item in the array, then shift other elements down into it's position.
|
||||
If piPropIndex < iNumProperties - 1 Then
|
||||
' Bump items down lower in the array.
|
||||
For i = piPropIndex To iNumProperties - 2
|
||||
pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1)
|
||||
Next i
|
||||
EndIf
|
||||
' Redimension the array to have one fewer element.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
|
||||
EndIf
|
||||
|
||||
End Sub ' _DeleteIndexedProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _PropValuesToStr(ByRef pvPropertyValuesArray As Variant) As String
|
||||
' Return a string with dumped content of the array of PropertyValue's.
|
||||
' SYNTAX:
|
||||
' NameOfProperty = This is a string (or 12 or 2016-12-31 12:05 or 123.45 or -0.12E-05 ...)
|
||||
' NameOfArray = (10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' NameOfMatrix = (2,10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' A;B;C;D;E;F;G;H;I;J
|
||||
' Semicolons and backslashes are escaped with a backslash (see _CStr and _CVar functions)
|
||||
|
||||
Dim iNumProperties As Integer, sResult As String, i As Integer, j As Integer, vProp As Variant
|
||||
Dim sName As String, vValue As Variant, iType As Integer
|
||||
Dim cstLF As String
|
||||
|
||||
cstLF = vbLf()
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
sResult = cstHEADER & cstLF
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
sName = vProp.Name
|
||||
vValue = vProp.Value
|
||||
iType = VarType(vValue)
|
||||
Select Case iType
|
||||
Case < vbArray ' Scalar
|
||||
sResult = sResult & sName & " = " & Utils._CStr(vValue, False) & cstLF
|
||||
Case Else ' Vector or matrix
|
||||
If uBound(vValue, 1) < 0 Then
|
||||
sResult = sResult & sName & " = (0)" & cstLF
|
||||
' 1-dimension but vector of vectors must also be considered
|
||||
ElseIf VarType(vValue(0)) >= vbArray Then
|
||||
sResult = sResult & sName & " = (" & UBound(vValue) + 1 & "," & UBound(vValue(0)) + 1 & ")" & cstLF
|
||||
For j = 0 To UBound(vValue)
|
||||
sResult = sResult & Utils._CStr(vValue(j), False) & cstLF
|
||||
Next j
|
||||
Else
|
||||
sResult = sResult & sName & " = (" & UBound(vValue, 1) + 1 & ")" & cstLF
|
||||
sResult = sResult & Utils._CStr(vValue, False) & cstLF
|
||||
End If
|
||||
End Select
|
||||
Next i
|
||||
|
||||
_PropValuesToStr() = Left(sResult, Len(sResult) - 1) ' Remove last LF
|
||||
|
||||
End Function ' _PropValuesToStr V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _StrToPropValues(psString) As Variant
|
||||
' Return an array of PropertyValue's rebuilt from the string parameter
|
||||
|
||||
Dim vString() As Variant, i As Integer,iArray As Integer, iRows As Integer, iCols As Integer
|
||||
Dim lPosition As Long, sName As String, vValue As Variant, vResult As Variant, sDim As String
|
||||
Dim lSearch As Long
|
||||
Dim cstLF As String
|
||||
Const cstEqualArray = " = (", cstEqual = " = "
|
||||
|
||||
cstLF = Chr(10)
|
||||
_StrToPropValues = Array()
|
||||
vResult = Array()
|
||||
|
||||
If psString = "" Then Exit Function
|
||||
vString = Split(psString, cstLF)
|
||||
If UBound(vString) <= 0 Then Exit Function ' There must be at least one name-value pair
|
||||
If vString(0) <> cstHEADER Then Exit Function ' Check origin
|
||||
|
||||
iArray = -1
|
||||
For i = 1 To UBound(vString)
|
||||
If vString(i) <> "" Then ' Skip empty lines
|
||||
If iArray < 0 Then ' Not busy with array row
|
||||
lPosition = 1
|
||||
sName = Utils._RegexSearch(vString(i), "^\b\w+\b", lPosition) ' Identifier
|
||||
If sName = "" Then Exit Function
|
||||
If InStr(vString(i), cstEqualArray) = lPosition + Len(sName) Then ' Start array processing
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+\)", lSearch) ' e.g. (10)
|
||||
If sDim = "(0)" Then ' Empty array
|
||||
iRows = -1
|
||||
vValue = Array()
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
ElseIf sDim <> "" Then ' Vector with content
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
iRows = 0
|
||||
ReDim vValue(0 To iCols - 1)
|
||||
iArray = 0
|
||||
Else ' Matrix with content
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+,", lSearch) ' e.g. (10,
|
||||
iRows = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
sDim = Utils._RegexSearch(vString(i), ",[0-9]+\)", lSearch) ' e.g. ,20)
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
ReDim vValue(0 To iRows - 1)
|
||||
iArray = 0
|
||||
End If
|
||||
ElseIf InStr(vString(i), cstEqual) = lPosition + Len(sName) Then
|
||||
vValue = Utils._CVar(Mid(vString(i), Len(sName) + Len(cstEqual) + 1))
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
Exit Function
|
||||
End If
|
||||
Else ' Line is an array row
|
||||
If iRows = 0 Then
|
||||
vValue = Utils._CVar(vString(i), True) ' Keep dates as strings
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
vValue(iArray) = Utils._CVar(vString(i), True)
|
||||
If iArray < iRows - 1 Then
|
||||
iArray = iArray + 1
|
||||
Else
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
_StrToPropValues = vResult
|
||||
|
||||
End Function
|
||||
|
||||
</script:module>
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,25 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_License" script:language="StarBasic">
|
||||
' Copyright 2012-2017 Jean-Pierre LEDURE
|
||||
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
' Access2Base is distributed in the hope that it will be useful,
|
||||
' but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
' Access2Base is free software; you can redistribute it and/or modify it under the terms of either (at your option):
|
||||
'
|
||||
' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not
|
||||
' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ .
|
||||
'
|
||||
' 2) The GNU Lesser General Public License as published by
|
||||
' the Free Software Foundation, either version 3 of the License, or
|
||||
' (at your option) any later version. If a copy of the LGPL was not
|
||||
' distributed with this file, see http://www.gnu.org/licenses/ .
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,395 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="acConstants" script:language="StarBasic">
|
||||
REM =======================================================================================================================
|
||||
REM === The Access2Base library is a part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on http://www.access2base.com ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM Access2Base -----------------------------------------------------
|
||||
Global Const Access2Base_Version = "7.1.0" ' Alignment on LibreOffice versions
|
||||
|
||||
REM AcCloseSave
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSaveNo = 2
|
||||
Global Const acSavePrompt = 0
|
||||
Global Const acSaveYes = 1
|
||||
|
||||
REM AcFormView
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDesign = 1
|
||||
Global Const acNormal = 0
|
||||
Global Const acPreview = 2
|
||||
|
||||
REM AcFormOpenDataMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFormAdd = 0
|
||||
Global Const acFormEdit = 1
|
||||
Global Const acFormPropertySettings = -1
|
||||
Global Const acFormReadOnly = 2
|
||||
|
||||
REM acView
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acViewDesign = 1
|
||||
Global Const acViewNormal = 0
|
||||
Global Const acViewPreview = 2
|
||||
|
||||
REM acOpenDataMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acAdd = 0
|
||||
Global Const acEdit = 1
|
||||
Global Const acReadOnly = 2
|
||||
|
||||
REM AcObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDefault = -1
|
||||
Global Const acDiagram = 8
|
||||
Global Const acForm = 2
|
||||
Global Const acQuery = 1
|
||||
Global Const acReport = 3
|
||||
Global Const acTable = 0
|
||||
' Unexisting in MS/Access
|
||||
Global Const acBasicIDE = 101
|
||||
Global Const acDatabaseWindow = 102
|
||||
Global Const acDocument = 111
|
||||
Global Const acWelcome = 112
|
||||
' Subtype if acDocument
|
||||
Global Const docWriter = "Writer"
|
||||
Global Const docCalc = "Calc"
|
||||
Global Const docImpress = "Impress"
|
||||
Global Const docDraw = "Draw"
|
||||
Global Const docMath = "Math"
|
||||
|
||||
REM AcWindowMode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acDialog = 3
|
||||
Global Const acHidden = 1
|
||||
Global Const acIcon = 2
|
||||
Global Const acWindowNormal = 0
|
||||
|
||||
REM VarType constants
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbEmpty = 0
|
||||
Global Const vbNull = 1
|
||||
Global Const vbInteger = 2
|
||||
Global Const vbLong = 3
|
||||
Global Const vbSingle = 4
|
||||
Global Const vbDouble = 5
|
||||
Global Const vbCurrency = 6
|
||||
Global Const vbDate = 7
|
||||
Global Const vbString = 8
|
||||
Global Const vbObject = 9
|
||||
Global Const vbError = 10
|
||||
Global Const vbBoolean = 11
|
||||
Global Const vbVariant = 12
|
||||
Global Const vbByte = 17
|
||||
Global Const vbUShort = 18
|
||||
Global Const vbULong = 19
|
||||
Global Const vbBigint = 35
|
||||
Global Const vbDecimal = 37
|
||||
Global Const vbArray = 8192
|
||||
|
||||
REM MsgBox constants
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbOKOnly = 0 ' OK button only (default)
|
||||
Global Const vbOKCancel = 1 ' OK and Cancel buttons
|
||||
Global Const vbAbortRetryIgnore = 2 ' Abort, Retry, and Ignore buttons
|
||||
Global Const vbYesNoCancel = 3 ' Yes, No, and Cancel buttons
|
||||
Global Const vbYesNo = 4 ' Yes and No buttons
|
||||
Global Const vbRetryCancel = 5 ' Retry and Cancel buttons
|
||||
Global Const vbCritical = 16 ' Critical message
|
||||
Global Const vbQuestion = 32 ' Warning query
|
||||
Global Const vbExclamation = 48 ' Warning message
|
||||
Global Const vbInformation = 64 ' Information message
|
||||
Global Const vbDefaultButton1 = 128 ' First button is default (default) (VBA: 0)
|
||||
Global Const vbDefaultButton2 = 256 ' Second button is default
|
||||
Global Const vbDefaultButton3 = 512 ' Third button is default
|
||||
Global Const vbApplicationModal = 0 ' Application modal message box (default)
|
||||
REM MsgBox Return Values
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbOK = 1 ' OK button pressed
|
||||
Global Const vbCancel = 2 ' Cancel button pressed
|
||||
Global Const vbAbort = 3 ' Abort button pressed
|
||||
Global Const vbRetry = 4 ' Retry button pressed
|
||||
Global Const vbIgnore = 5 ' Ignore button pressed
|
||||
Global Const vbYes = 6 ' Yes button pressed
|
||||
Global Const vbNo = 7 ' No button pressed
|
||||
|
||||
REM Dialogs Return Values
|
||||
REM ------------------------------------------------------------------
|
||||
Global Const dlgOK = 1 ' OK button pressed
|
||||
Global Const dlgCancel = 0 ' Cancel button pressed
|
||||
|
||||
REM Control Types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acCheckBox = 5
|
||||
Global Const acComboBox = 7
|
||||
Global Const acCommandButton = 2 : Global Const acToggleButton = 122
|
||||
Global Const acCurrencyField = 18
|
||||
Global Const acDateField = 15
|
||||
Global Const acFileControl = 12
|
||||
Global Const acFixedLine = 24 ' FREE ENTRY (USEFUL IN DIALOGS)
|
||||
Global Const acFixedText = 10 : Global Const acLabel = 10
|
||||
Global Const acFormattedField = 1 ' FREE ENTRY TAKEN TO NOT CONFUSE WITH acTextField
|
||||
Global Const acGridControl = 11
|
||||
Global Const acGroupBox = 8 : Global Const acOptionGroup = 8
|
||||
Global Const acHiddenControl = 13
|
||||
Global Const acImageButton = 4
|
||||
Global Const acImageControl = 14 : Global Const acImage = 14
|
||||
Global Const acListBox = 6
|
||||
Global Const acNavigationBar = 22
|
||||
Global Const acNumericField = 17
|
||||
Global Const acPatternField = 19
|
||||
Global Const acProgressBar = 23 ' FREE ENTRY (USEFUL IN DIALOGS)
|
||||
Global Const acRadioButton = 3 : Global Const acOptionButton = 3
|
||||
Global Const acScrollBar = 20
|
||||
Global Const acSpinButton = 21
|
||||
Global Const acSubform = 112
|
||||
Global Const acTextField = 9 : Global Const acTextBox = 9
|
||||
Global Const acTimeField = 16
|
||||
|
||||
REM AcRecord
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFirst = 2
|
||||
Global Const acGoTo = 4
|
||||
Global Const acLast = 3
|
||||
Global Const acNewRec = 5
|
||||
Global Const acNext = 1
|
||||
Global Const acPrevious = 0
|
||||
|
||||
REM FindRecord
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acAnywhere = 0
|
||||
Global Const acEntire = 1
|
||||
Global Const acStart = 2
|
||||
Global Const acDown = 1
|
||||
Global Const acSearchAll = 2
|
||||
Global Const acUp = 0
|
||||
Global Const acAll = 0
|
||||
Global Const acCurrent = -1
|
||||
|
||||
REM AcDataObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acActiveDataObject = -1
|
||||
Global Const acDataForm = 2
|
||||
Global Const acDataQuery = 1
|
||||
Global Const acDataServerView = 7
|
||||
Global Const acDataStoredProcedure = 9
|
||||
Global Const acDataTable = 0
|
||||
|
||||
REM AcQuitOption
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acQuitPrompt = 0
|
||||
Global Const acQuitSaveAll = 1
|
||||
Global Const acQuitSaveNone = 2
|
||||
|
||||
REM AcCommand
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acCmdAboutMicrosoftAccess = 35
|
||||
Global Const acCmdAboutOpenOffice = 35
|
||||
Global Const acCmdAboutLibreOffice = 35
|
||||
Global Const acCmdVisualBasicEditor = 525
|
||||
Global Const acCmdBringToFront = 52
|
||||
Global Const acCmdClose = 58
|
||||
Global Const acCmdToolbarsCustomize = 165
|
||||
Global Const acCmdChangeToCommandButton = 501
|
||||
Global Const acCmdChangeToCheckBox = 231
|
||||
Global Const acCmdChangeToComboBox = 230
|
||||
Global Const acCmdChangeToTextBox = 227
|
||||
Global Const acCmdChangeToLabel = 228
|
||||
Global Const acCmdChangeToImage = 234
|
||||
Global Const acCmdChangeToListBox = 229
|
||||
Global Const acCmdChangeToOptionButton = 233
|
||||
Global Const acCmdCopy = 190
|
||||
Global Const acCmdCut = 189
|
||||
Global Const acCmdCreateRelationship = 150
|
||||
Global Const acCmdDelete = 337
|
||||
Global Const acCmdDatabaseProperties = 256
|
||||
Global Const acCmdSQLView = 184
|
||||
Global Const acCmdRemove = 366
|
||||
Global Const acCmdDesignView = 183
|
||||
Global Const acCmdFormView = 281
|
||||
Global Const acCmdNewObjectForm = 136
|
||||
Global Const acCmdNewObjectTable = 134
|
||||
Global Const acCmdNewObjectView = 350
|
||||
Global Const acCmdOpenDatabase = 25
|
||||
Global Const acCmdNewObjectQuery = 135
|
||||
Global Const acCmdShowAllRelationships = 149
|
||||
Global Const acCmdNewObjectReport = 137
|
||||
Global Const acCmdSelectAll = 333
|
||||
Global Const acCmdRemoveTable = 84
|
||||
Global Const acCmdOpenTable = 221
|
||||
Global Const acCmdRename = 143
|
||||
Global Const acCmdDeleteRecord = 223
|
||||
Global Const acCmdApplyFilterSort = 93
|
||||
Global Const acCmdSnapToGrid = 62
|
||||
Global Const acCmdViewGrid = 63
|
||||
Global Const acCmdInsertHyperlink = 259
|
||||
Global Const acCmdMaximumRecords = 508
|
||||
Global Const acCmdObjectBrowser = 200
|
||||
Global Const acCmdPaste = 191
|
||||
Global Const acCmdPasteSpecial = 64
|
||||
Global Const acCmdPrint = 340
|
||||
Global Const acCmdPrintPreview = 54
|
||||
Global Const acCmdSaveRecord = 97
|
||||
Global Const acCmdFind = 30
|
||||
Global Const acCmdUndo = 292
|
||||
Global Const acCmdRefresh = 18
|
||||
Global Const acCmdRemoveFilterSort = 144
|
||||
Global Const acCmdRunMacro = 31
|
||||
Global Const acCmdSave = 20
|
||||
Global Const acCmdSaveAs = 21
|
||||
Global Const acCmdSelectAllRecords = 109
|
||||
Global Const acCmdSendToBack = 53
|
||||
Global Const acCmdSortDescending = 164
|
||||
Global Const acCmdSortAscending = 163
|
||||
Global Const acCmdTabOrder = 41
|
||||
Global Const acCmdDatasheetView = 282
|
||||
Global Const acCmdZoomSelection = 371
|
||||
|
||||
REM AcSendObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSendForm = 2
|
||||
Global Const acSendNoObject = -1
|
||||
Global Const acSendQuery = 1
|
||||
Global Const acSendReport = 3
|
||||
Global Const acSendTable = 0
|
||||
|
||||
REM AcOutputObjectType
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acOutputTable = 0
|
||||
Global Const acOutputQuery = 1
|
||||
Global Const acOutputForm = 2
|
||||
Global Const acOutputArray = -1
|
||||
|
||||
REM AcEncoding
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acUTF8Encoding = 76
|
||||
|
||||
REM AcFormat
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acFormatPDF = "writer_pdf_Export"
|
||||
Global Const acFormatODT = "writer8"
|
||||
Global Const acFormatDOC = "MS Word 97"
|
||||
Global Const acFormatHTML = "HTML"
|
||||
Global Const acFormatODS = "calc8"
|
||||
Global Const acFormatXLS = "MS Excel 97"
|
||||
Global Const acFormatXLSX = "Calc MS Excel 2007 XML"
|
||||
Global Const acFormatTXT = "Text - txt - csv (StarCalc)"
|
||||
|
||||
REM AcExportQuality
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acExportQualityPrint = 0
|
||||
Global Const acExportQualityScreen = 1
|
||||
|
||||
REM AcSysCmdAction
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acSysCmdAccessDir = 9
|
||||
Global Const acSysCmdAccessVer = 7
|
||||
Global Const acSysCmdClearHelpTopic = 11
|
||||
Global Const acSysCmdClearStatus = 5
|
||||
Global Const acSysCmdGetObjectState = 10
|
||||
Global Const acSysCmdGetWorkgroupFile = 13
|
||||
Global Const acSysCmdIniFile = 8
|
||||
Global Const acSysCmdInitMeter = 1
|
||||
Global Const acSysCmdProfile = 12
|
||||
Global Const acSysCmdRemoveMeter = 3
|
||||
Global Const acSysCmdRuntime = 6
|
||||
Global Const acSysCmdSetStatus = 4
|
||||
Global Const acSysCmdUpdateMeter = 2
|
||||
|
||||
REM Type property
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbBigInt = 16
|
||||
Global Const dbBinary = 9
|
||||
Global Const dbBoolean = 1
|
||||
Global Const dbByte = 2
|
||||
Global Const dbChar = 18
|
||||
Global Const dbCurrency = 5
|
||||
Global Const dbDate = 8
|
||||
Global Const dbDecimal = 20
|
||||
Global Const dbDouble = 7
|
||||
Global Const dbFloat = 21
|
||||
Global Const dbGUID = 15
|
||||
Global Const dbInteger = 3
|
||||
Global Const dbLong = 4
|
||||
Global Const dbLongBinary = 11 ' (OLE Object)
|
||||
Global Const dbMemo= 12
|
||||
Global Const dbNumeric = 19
|
||||
Global Const dbSingle = 6
|
||||
Global Const dbText = 10
|
||||
Global Const dbTime = 22
|
||||
Global Const dbTimeStamp = 23
|
||||
Global Const dbVarBinary = 17
|
||||
Global Const dbUndefined = -1
|
||||
|
||||
REM Attributes property
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbAutoIncrField = 16
|
||||
Global Const dbDescending = 1
|
||||
Global Const dbFixedField = 1
|
||||
Global Const dbHyperlinkField = 32768
|
||||
Global Const dbSystemField = 8192
|
||||
Global Const dbUpdatableField = 32
|
||||
Global Const dbVariableField = 2
|
||||
|
||||
REM OpenRecordset
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbOpenForwardOnly = 8
|
||||
Global Const dbSQLPassThrough = 64
|
||||
Global Const dbReadOnly = 4
|
||||
|
||||
REM Query types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbQAction = 240
|
||||
Global Const dbQAppend = 64
|
||||
Global Const dbQDDL = 4 '96
|
||||
Global Const dbQDelete = 32
|
||||
Global Const dbQMakeTable = 128 '80
|
||||
Global Const dbQSelect = 0
|
||||
Global Const dbQSetOperation = 8 '128
|
||||
Global Const dbQSQLPassThrough = 1 '112
|
||||
Global Const dbQUpdate = 16 '48
|
||||
|
||||
REM Edit mode
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const dbEditNone = 0
|
||||
Global Const dbEditInProgress = 1
|
||||
Global Const dbEditAdd = 2
|
||||
|
||||
REM Toolbars
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const msoBarTypeNormal = 0 ' Usual toolbar
|
||||
Global Const msoBarTypeMenuBar = 1 ' Menu bar
|
||||
Global Const msoBarTypePopup = 2 ' Shortcut menu
|
||||
Global Const msoBarTypeStatusBar = 11 ' Status bar
|
||||
Global Const msoBarTypeFloater = 12 ' Floating window
|
||||
|
||||
Global Const msoControlButton = 1 ' Command button
|
||||
Global Const msoControlPopup = 10 ' Popup, submenu
|
||||
|
||||
REM New Lines
|
||||
REM -----------------------------------------------------------------
|
||||
Public Function vbCr() As String : vbCr = Chr(13) : End Function
|
||||
Public Function vbLf() As String : vbLf = Chr(10) : End Function
|
||||
Public Function vbNewLine() As String
|
||||
Const cstWindows = 1
|
||||
If GetGuiType() = cstWindows Then vbNewLine = vbCR & vbLF Else vbNewLine = vbLF
|
||||
End Function ' vbNewLine V1.4.0
|
||||
Public Function vbTab() As String : vbTab = Chr(9) : End Function
|
||||
|
||||
REM Module types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const acClassModule = 1
|
||||
Global Const acStandardModule = 0
|
||||
|
||||
REM (Module) procedure types
|
||||
REM -----------------------------------------------------------------
|
||||
Global Const vbext_pk_Get = 1 ' A Property Get procedure
|
||||
Global Const vbext_pk_Let = 2 ' A Property Let procedure
|
||||
Global Const vbext_pk_Proc = 0 ' A Sub or Function procedure
|
||||
Global Const vbext_pk_Set = 3 ' A Property Set procedure
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Access2Base" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="dlgTrace"/>
|
||||
<library:element library:name="dlgFormat"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,19 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgFormat" dlg:left="246" dlg:top="119" dlg:width="153" dlg:height="40" dlg:help-text="Export the form" dlg:closeable="true" dlg:moveable="true" dlg:title="OutputTo">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:combobox dlg:id="cboFormat" dlg:tab-index="0" dlg:left="4" dlg:top="18" dlg:width="71" dlg:height="8" dlg:help-text="Format in which the form should be exported" dlg:value="PDF" dlg:spin="true">
|
||||
<dlg:menupopup>
|
||||
<dlg:menuitem dlg:value="PDF"/>
|
||||
<dlg:menuitem dlg:value="ODT"/>
|
||||
<dlg:menuitem dlg:value="DOC"/>
|
||||
<dlg:menuitem dlg:value="HTML"/>
|
||||
</dlg:menupopup>
|
||||
</dlg:combobox>
|
||||
<dlg:text dlg:id="lblFormat" dlg:tab-index="1" dlg:left="4" dlg:top="7" dlg:width="100" dlg:height="9" dlg:help-text="Format in which the form should be exported" dlg:value="Select the output format"/>
|
||||
<dlg:button dlg:id="cmdOK" dlg:tab-index="2" dlg:left="111" dlg:top="5" dlg:width="35" dlg:height="12" dlg:help-text="Validate your choice" dlg:default="true" dlg:value="OK" dlg:button-type="ok">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Access2Base.Trace._TraceOK?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="3" dlg:left="111" dlg:top="20" dlg:width="35" dlg:height="12" dlg:help-text="Cancel and close the dialog" dlg:value="Cancel" dlg:button-type="cancel"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,33 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="dlgTrace" dlg:left="81" dlg:top="63" dlg:width="438" dlg:height="154" dlg:help-text="Manage the console file and its entries" dlg:closeable="true" dlg:moveable="true" dlg:title="Console">
|
||||
<dlg:styles>
|
||||
<dlg:style dlg:style-id="0" dlg:font-name="Courier New" dlg:font-stylename="Regular" dlg:font-family="modern"/>
|
||||
<dlg:style dlg:style-id="1" dlg:look="simple"/>
|
||||
<dlg:style dlg:style-id="2" dlg:background-color="0xe6e6e6" dlg:border="none"/>
|
||||
</dlg:styles>
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblEntries" dlg:tab-index="3" dlg:left="265" dlg:top="134" dlg:width="130" dlg:height="9" dlg:help-text="Clear the list and resize the circular buffer" dlg:value="Set max number of entries" dlg:align="right"/>
|
||||
<dlg:numericfield dlg:id="numEntries" dlg:tab-index="4" dlg:left="399" dlg:top="129" dlg:width="28" dlg:height="16" dlg:help-text="Clear the list and resize the circular buffer" dlg:decimal-accuracy="0" dlg:value="20" dlg:value-min="5" dlg:value-max="999" dlg:spin="true"/>
|
||||
<dlg:textfield dlg:style-id="0" dlg:id="txtTraceLog" dlg:tab-index="0" dlg:left="9" dlg:top="20" dlg:width="360" dlg:height="105" dlg:help-text="Text can be selected, copied, ..." dlg:hscroll="true" dlg:vscroll="true" dlg:multiline="true" dlg:readonly="true" dlg:value="--- Log file is empty ---"/>
|
||||
<dlg:checkbox dlg:style-id="1" dlg:id="chkClear" dlg:tab-index="5" dlg:left="58" dlg:top="133" dlg:width="6" dlg:height="9" dlg:help-text="Clear the list" dlg:value="Clear" dlg:checked="false"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="6" dlg:left="381" dlg:top="38" dlg:width="40" dlg:height="12" dlg:help-text="Cancel and close the dialog" dlg:value="Cancel" dlg:button-type="cancel"/>
|
||||
<dlg:text dlg:id="lblClear" dlg:tab-index="7" dlg:left="9" dlg:top="133" dlg:width="46" dlg:height="9" dlg:help-text="Clear the list" dlg:value="Clear the list" dlg:align="right"/>
|
||||
<dlg:text dlg:id="lblMinLevel" dlg:tab-index="8" dlg:left="74" dlg:top="133" dlg:width="130" dlg:height="9" dlg:help-text="Register only logging requests above given level" dlg:value="Set minimal trace level" dlg:align="right"/>
|
||||
<dlg:combobox dlg:id="cboMinLevel" dlg:tab-index="9" dlg:left="209" dlg:top="133" dlg:width="50" dlg:height="9" dlg:help-text="Register only logging requests above given level" dlg:spin="true">
|
||||
<dlg:menupopup>
|
||||
<dlg:menuitem dlg:value="DEBUG"/>
|
||||
<dlg:menuitem dlg:value="INFO"/>
|
||||
<dlg:menuitem dlg:value="WARNING"/>
|
||||
<dlg:menuitem dlg:value="ERROR"/>
|
||||
<dlg:menuitem dlg:value="ABORT"/>
|
||||
</dlg:menupopup>
|
||||
</dlg:combobox>
|
||||
<dlg:button dlg:id="cmdOK" dlg:tab-index="1" dlg:left="381" dlg:top="20" dlg:width="40" dlg:height="12" dlg:help-text="Validate" dlg:default="true" dlg:value="OK" dlg:button-type="ok"/>
|
||||
<dlg:button dlg:id="cmdDump" dlg:tab-index="2" dlg:left="381" dlg:top="68" dlg:width="40" dlg:height="31" dlg:help-text="Choose a file and dump the actual list content in it" dlg:value="Dump to file" dlg:multiline="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Access2Base.Trace._DumpToFile?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="lblNbEntries" dlg:tab-index="10" dlg:left="9" dlg:top="10" dlg:width="105" dlg:height="7" dlg:help-text="Actual size of list" dlg:value="Actual number of entries:"/>
|
||||
<dlg:numericfield dlg:style-id="2" dlg:id="numNbEntries" dlg:tab-index="11" dlg:left="123" dlg:top="9" dlg:width="17" dlg:height="9" dlg:help-text="Actual size of list" dlg:readonly="true" dlg:decimal-accuracy="0" dlg:value="0"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,34 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Access2Base" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="Application"/>
|
||||
<library:element library:name="Methods"/>
|
||||
<library:element library:name="acConstants"/>
|
||||
<library:element library:name="Test"/>
|
||||
<library:element library:name="Trace"/>
|
||||
<library:element library:name="DoCmd"/>
|
||||
<library:element library:name="Utils"/>
|
||||
<library:element library:name="Database"/>
|
||||
<library:element library:name="PropertiesSet"/>
|
||||
<library:element library:name="Collect"/>
|
||||
<library:element library:name="PropertiesGet"/>
|
||||
<library:element library:name="Form"/>
|
||||
<library:element library:name="Python"/>
|
||||
<library:element library:name="_License"/>
|
||||
<library:element library:name="SubForm"/>
|
||||
<library:element library:name="L10N"/>
|
||||
<library:element library:name="OptionGroup"/>
|
||||
<library:element library:name="Event"/>
|
||||
<library:element library:name="Property"/>
|
||||
<library:element library:name="Control"/>
|
||||
<library:element library:name="Dialog"/>
|
||||
<library:element library:name="Field"/>
|
||||
<library:element library:name="DataDef"/>
|
||||
<library:element library:name="Recordset"/>
|
||||
<library:element library:name="TempVar"/>
|
||||
<library:element library:name="Root_"/>
|
||||
<library:element library:name="UtilProperty"/>
|
||||
<library:element library:name="CommandBar"/>
|
||||
<library:element library:name="CommandBarControl"/>
|
||||
<library:element library:name="Module"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,368 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CommonLang" script:language="StarBasic">REM ***** BASIC *****
|
||||
|
||||
|
||||
' Column A has the index 1
|
||||
Public Const SBCOLUMNNAME1 = 3 ' Stock names, sheet 1
|
||||
Public Const SBCOLUMNID1 = 4 ' Stock ID, sheet 1
|
||||
Public Const SBCOLUMNQUANTITY1 = 5 ' Stock quantity sheet 1
|
||||
Public Const SBCOLUMNRATE1 = 7 ' Price for stocks, sheet 1
|
||||
Public Const SBCOLUMNNAME2 = 3 ' Stock names, sheet 2
|
||||
Public Const SBCOLUMNDATE2 = 4 ' Transaction dates, sheet 2
|
||||
Public Const SBCOLUMNQUANTITY2 = 5 ' Transaction quantity, sheet 2
|
||||
Public Const SBCOLUMNRATE2 = 6 ' Price for stocks, sheet 2
|
||||
Public Const SBCOLUMNPROVPERCENT2 = 7 ' Provision in %, sheet 2
|
||||
Public Const SBCOLUMNPROVMIN2 = 8 ' Minimum provision, sheet 2
|
||||
Public Const SBCOLUMNPROVFIX2 = 9 ' Fixed provision, sheet 2
|
||||
Public Const SBCOLUMNPROCEEDS2 = 12 ' Profit, sheet 2
|
||||
Public Const SBCOLUMNQTYSOLD2 = 14 ' Quantity sold, sheet 2
|
||||
Public Const SBCOLUMNQTYREST2 = 15 ' Quantity not sold yet, sheet 2
|
||||
Public Const SBCOLUMNPRCREST2 = 16 ' Proportional price for quantity not sold yet, sheet 2
|
||||
Public Const SBCOLUMNREALPROC2 = 17 ' Realized proceeds, sheet 2
|
||||
Public Const SBCOLUMNDIVIDEND2 = 18 ' Dividend paid, sheet 2
|
||||
Public Const SBCOLUMNREALPROFIT2 = 19 ' Realized profit, sheet 2
|
||||
Public Const SBROWFIRSTTRANSACT2 = 8 ' First data row, sheet 2
|
||||
Public Const SBROWHEADER1 = 6 ' Headline, sheet 1
|
||||
Public Const SBMSGOK = 0
|
||||
Public Const SBMSGYESNO = 4
|
||||
Public Const SBMSGSTOP = 16
|
||||
Public Const SBMSGQUESTION = 32
|
||||
Public Const SBMSGDEFAULTBTN2 = 256
|
||||
Public Const SBHASID = 1 ' 0 = no ID, 1 = stocks have an ID
|
||||
Public Const SBDIALOGSELL = 1 ' Step for main dialog
|
||||
Public Const SBDIALOGBUY = 2 ' Step for main dialog
|
||||
Public Const SBBINARY = 0
|
||||
Public TransactMode as Integer
|
||||
Public Const LIFO = -1
|
||||
Public Const FIFO = 1
|
||||
|
||||
Public Const HANDLEDIVIDEND = 1
|
||||
Public Const HANDLESPLIT = 2
|
||||
|
||||
Global oDocument as Object
|
||||
Global oDocFormats() as Object
|
||||
Global oController as Object
|
||||
Global oFirstSheet as Object
|
||||
Global oBankSheet as Object
|
||||
Global oMovementSheet as Object
|
||||
Global sDocLanguage as String
|
||||
Global sDocCountry as String
|
||||
Global oSheets as Object
|
||||
Global oDocLocale as New com.sun.star.lang.Locale
|
||||
Global bEnableMarket as Boolean
|
||||
Global bEnableInternet as Boolean
|
||||
Global oMarketModel as Object
|
||||
Global oInternetModel as Object
|
||||
|
||||
Global sCurCurrency$, sCurExtension$, sCurChartSource$, sCurStockIDLabel$, sCurSeparator$
|
||||
|
||||
Public oNumberFormatter as Object
|
||||
Public bDebugmode as Boolean
|
||||
Global GlobListindex as Integer
|
||||
Public blabla() as String
|
||||
Public SplitDate as Date
|
||||
Public oChartSheet as Object
|
||||
Public oBackgroundSheet as Object
|
||||
Public Const SBDATECOLUMN = 3
|
||||
Public Const SBVALUECOLUMN = 4
|
||||
Public Const SBSTARTROW = 25
|
||||
Public Const SBCHARTPERIOD = 14
|
||||
Public Const SBINTERVAL = "d"
|
||||
Public sColumnHeader as String
|
||||
Public StartDate as Date
|
||||
Public EndDate as Date
|
||||
Public iCurRow as Integer
|
||||
Public iMaxRow as Integer
|
||||
Public iStartDay as Integer
|
||||
Public iStartMonth as Integer
|
||||
Public iStartYear as Integer
|
||||
Public iEndDay as Integer
|
||||
Public iEndMonth as Integer
|
||||
Public iEndYear as Integer
|
||||
Public oStatusLine as Object
|
||||
Public Today as Date
|
||||
Public sInterval as String
|
||||
Public ShortMonths(11,1)
|
||||
Public iStep as Integer
|
||||
Public sDepotCurrency as String
|
||||
Public iValueCol as Integer
|
||||
|
||||
Public DlgReference as Object
|
||||
Public DlgTransaction as Object
|
||||
Public DlgStockRates as Object
|
||||
Public DlgStartUp as Object
|
||||
Public TransactModel as Object
|
||||
Public StockRatesModel as Object
|
||||
Public StartUpModel as Object
|
||||
Public StockRatesTitle(1 To 3)
|
||||
Public TransactTitle(1 To 2)
|
||||
Public NullList()
|
||||
Public sStartupWelcome$, sStartupChooseMarket$, sStartupHint$
|
||||
|
||||
Public sMarket(7,10) as String
|
||||
Public sCountryMarket(7,10) as String
|
||||
|
||||
Public cDlgCaption1$, cDlgCaption2$
|
||||
Public sMsgError$, sMsgNoName$, sMsgNoQuantity$, sMsgNoDividend$, sMsgNoExchangeRate$
|
||||
Public sMsgNoValidExchangeDate$, sMsgWrongExchangeDate$, sMsgSellTooMuch$, sMsgConfirm$
|
||||
Public sMsgFreeStock$, sMsgTotalLoss$, sMsgEndDatebeforeNow$, sMsgStartDatebeforeEndDate$
|
||||
|
||||
Public sOk$, sCancel$
|
||||
Public sMsgAuthorization$, sMsgDeleteAll$
|
||||
Public SellMethod$
|
||||
Public cSplit$
|
||||
Global HistoryChartSource as String
|
||||
Public DateCellStyle as String
|
||||
Public CurrCellStyle as String
|
||||
Public sStartDate$, sEndDate$, sHistory$
|
||||
Public sInsertStockname$
|
||||
Public sProductname$, sTitle$
|
||||
Public sInsertStocks$, sStockname$, sNoInternetUpdate$, sMarketplace$, sNoInternetDataAvailable$
|
||||
Public sCheckInternetSettings as String
|
||||
|
||||
Sub LoadLanguage()
|
||||
LoadDepotDialogs()
|
||||
Select Case sDocLanguage
|
||||
Case "de"
|
||||
LoadGermanLanguage()
|
||||
Case "en"
|
||||
LoadEnglishLanguage()
|
||||
Case "fr"
|
||||
LoadFrenchLanguage()
|
||||
Case "it"
|
||||
LoadItalianLanguage()
|
||||
Case "es"
|
||||
LoadSpanishLanguage()
|
||||
Case "sv"
|
||||
LoadSwedishLanguage()
|
||||
Case "ja"
|
||||
LoadJapaneseLanguage()
|
||||
Case "ko"
|
||||
LoadKoreanLanguage()
|
||||
Case "zh"
|
||||
If sDocCountry = "CN" Then
|
||||
LoadChineseSimpleLanguage()
|
||||
Else
|
||||
LoadChineseTradLanguage()
|
||||
End If
|
||||
End Select
|
||||
InitializeStartUpModel()
|
||||
End Sub
|
||||
|
||||
Sub CompleteMarketList()
|
||||
Dim EuroIndex as Integer
|
||||
Dim LocCountry as String
|
||||
Dim LocLanguage as String
|
||||
Dim sLangList() as String
|
||||
Dim sCountryList() as String
|
||||
Dim sExtensionList() as String
|
||||
Dim MaxIndex as Integer
|
||||
Dim bIsLocale as Boolean
|
||||
|
||||
GlobListIndex = -1
|
||||
For n = 0 To 5
|
||||
LocLanguage = sMarket(n,6)
|
||||
LocCountry = sMarket(n,7)
|
||||
If Instr(1,LocLanguage,";",SBBINARY) = 0 Then
|
||||
bIsLocale = CheckDocLocale(LocLanguage, LocCountry)
|
||||
Else
|
||||
EuroIndex = 0
|
||||
sLangList() = ArrayoutofString(LocLanguage, ";", MaxIndex)
|
||||
sCountryList() = ArrayoutofString(LocCountry, ";", MaxIndex)
|
||||
sExtensionList() = ArrayoutofString(sMarket(n,8), ";", MaxIndex)
|
||||
For m = 0 To MaxIndex
|
||||
bIsLocale = CheckDocLocale(sLangList(m), sCountryList(m))
|
||||
If bIsLocale Then
|
||||
EuroIndex = m
|
||||
Exit For
|
||||
End If
|
||||
Next m
|
||||
sMarket(n,6) = sLangList(EuroIndex)
|
||||
sMarket(n,7) = sCountryList(EuroIndex)
|
||||
sMarket(n,8) = sExtensionList(EuroIndex)
|
||||
End If
|
||||
If bIsLocale Then
|
||||
GlobListIndex = n
|
||||
Exit For
|
||||
End If
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
Sub LocalizedCurrencies()
|
||||
If GlobListIndex = -1 Then
|
||||
sCountryMarket(0,0) = "Euro"
|
||||
sCountryMarket(0,1) = chr(8364)
|
||||
sCountryMarket(0,2) = "Paris"
|
||||
sCountryMarket(0,3) = "http://fr.finance.yahoo.com/d/quotes.csv?s=<StockID>.PA&f=s4l1t1c1ghov&e=.csv"
|
||||
sCountryMarket(0,5) = "Code"
|
||||
sCountryMarket(0,6) = "fr"
|
||||
sCountryMarket(0,7) = "FR"
|
||||
sCountryMarket(0,8) = "40C"
|
||||
sCountryMarket(0,9) = "59/9"
|
||||
sCountryMarket(0,10) = "1"
|
||||
|
||||
sCountryMarket(1,0) = "Euro"
|
||||
sCountryMarket(1,1) = chr(8364)
|
||||
sCountryMarket(1,2) = "Milano"
|
||||
sCountryMarket(1,3) = "http://it.finance.yahoo.com/d/quotes.csv?s=<StockID>.MI&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(1,5) = "Codice"
|
||||
sCountryMarket(1,6) = "it"
|
||||
sCountryMarket(1,7) = "IT"
|
||||
sCountryMarket(1,8) = "410"
|
||||
sCountryMarket(1,9) = "44"
|
||||
sCountryMarket(1,10) = "1"
|
||||
|
||||
sCountryMarket(2,0) = "Euro"
|
||||
sCountryMarket(2,1) = chr(8364)
|
||||
sCountryMarket(2,2) = "Madrid"
|
||||
sCountryMarket(2,3) = "http://es.finance.yahoo.com/d/quotes.csv?s=<StockID>&m=MC&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(2,5) = "Simbolo"
|
||||
sCountryMarket(2,6) = "es"
|
||||
sCountryMarket(2,7) = "ES"
|
||||
sCountryMarket(2,8) = "40A"
|
||||
sCountryMarket(2,9) = "44"
|
||||
sCountryMarket(2,10) = "1"
|
||||
|
||||
sCountryMarket(3,0) = "Dansk krone"
|
||||
sCountryMarket(3,1) = "kr"
|
||||
sCountryMarket(3,2) = "København"
|
||||
sCountryMarket(3,3) = "http://dk.finance.yahoo.com/d/quotes.csv?s=<StockID.CO&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(3,5) = "Aktiesymbol"
|
||||
sCountryMarket(3,6) = "da"
|
||||
sCountryMarket(3,7) = "DK"
|
||||
sCountryMarket(3,8) = "406"
|
||||
sCountryMarket(3,9) = "44"
|
||||
sCountryMarket(3,10) = "1"
|
||||
|
||||
sCountryMarket(4,0) = "Svensk krona"
|
||||
sCountryMarket(4,1) = "kr"
|
||||
sCountryMarket(4,2) = "Stockholm"
|
||||
sCountryMarket(4,3) = "http://se.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&f=sl1d1t1c1ohgv&e=.c"
|
||||
sCountryMarket(4,5) = "Kod"
|
||||
sCountryMarket(4,6) = "sv"
|
||||
sCountryMarket(4,7) = "SE"
|
||||
sCountryMarket(4,8) = "41D"
|
||||
sCountryMarket(4,9) = "44"
|
||||
sCountryMarket(4,10) = "1"
|
||||
|
||||
' Taiwan Dollar
|
||||
sCountryMarket(5,0) = "新臺幣"
|
||||
sCountryMarket(5,1) = "￥"
|
||||
sCountryMarket(5,2) = "代號"
|
||||
sCountryMarket(5,3) = "http://tw.finance.yahoo.com/d/quotes.csv?s=<StockID>.TW&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(5,5) = "代號"
|
||||
sCountryMarket(5,6) = "zh"
|
||||
sCountryMarket(5,7) = "TW"
|
||||
sCountryMarket(5,8) = "404"
|
||||
sCountryMarket(5,9) = "44"
|
||||
sCountryMarket(5,10) = "1"
|
||||
|
||||
' Chinese Yuan
|
||||
sCountryMarket(6,0) = "人民币"
|
||||
sCountryMarket(6,1) = "￥"
|
||||
sCountryMarket(6,2) = "代号"
|
||||
sCountryMarket(6,3) = "http://cn.finance.yahoo.com/d/quotes.csv?s=<StockID>.SS&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(6,5) = "代号"
|
||||
sCountryMarket(6,6) = "zh"
|
||||
sCountryMarket(6,7) = "CN"
|
||||
sCountryMarket(6,8) = "804"
|
||||
sCountryMarket(6,9) = "44"
|
||||
sCountryMarket(6,10) = "1"
|
||||
|
||||
' korean Won
|
||||
sCountryMarket(7,0) = "한국 원화"
|
||||
sCountryMarket(7,1) = "￦"
|
||||
sCountryMarket(7,2) = "서울"
|
||||
sCountryMarket(7,3) = "http://kr.finance.yahoo.com/d/quotes.csv?s=<StockID>.KS&f=snl1d1t1c1ohgv&e=.csv"
|
||||
sCountryMarket(7,5) = "종목 코드"
|
||||
sCountryMarket(7,6) = "ko"
|
||||
sCountryMarket(7,7) = "KR"
|
||||
sCountryMarket(7,8) = "412"
|
||||
sCountryMarket(7,9) = "44"
|
||||
sCountryMarket(7,10) = "2"
|
||||
|
||||
|
||||
' sCountryMarket(5,0) = "Российский рубль"
|
||||
' sCountryMarket(5,1) = "р."
|
||||
' sCountryMarket(5,2) = ""
|
||||
' sCountryMarket(5,3) = ""
|
||||
' sCountryMarket(5,5) = ""
|
||||
' sCountryMarket(5,6) = "ru"
|
||||
' sCountryMarket(5,7) = "RU"
|
||||
' sCountryMarket(5,8) = "-419"
|
||||
' sCountryMarket(5,9) = ""
|
||||
'
|
||||
' sCountryMarket(6,0) = "Złoty polski"
|
||||
' sCountryMarket(6,1) = "zł"
|
||||
' sCountryMarket(6,2) = ""
|
||||
' sCountryMarket(6,3) = ""
|
||||
' sCountryMarket(6,5) = "" 'Still Todo!!
|
||||
' sCountryMarket(6,6) = "pl"
|
||||
' sCountryMarket(6,7) = "PL"
|
||||
' sCountryMarket(6,8) = "-415"
|
||||
' sCountryMarket(6,9) = ""
|
||||
'
|
||||
' sCountryMarket(7,0) = "Türkische Lira"
|
||||
' sCountryMarket(7,1) = "TL"
|
||||
' sCountryMarket(7,2) = ""
|
||||
' sCountryMarket(7,3) = ""
|
||||
' sCountryMarket(7,5) = "" 'Still Todo!!
|
||||
' sCountryMarket(7,6) = "tr"
|
||||
' sCountryMarket(7,7) = "TR"
|
||||
' sCountryMarket(7,8) = "-41F"
|
||||
' sCountryMarket(7,9) = ""
|
||||
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
' Dim sCountryMarket(6,9) as String
|
||||
|
||||
For n = 0 To Ubound(sCountryMarket(),1)
|
||||
If sDocLanguage = sCountryMarket(n,6) and sDocCountry = sCountryMarket(n,7) Then
|
||||
GlobListIndex = 6
|
||||
For m = 0 To 10
|
||||
sMarket(6,m) = sCountryMarket(n,m)
|
||||
Next m
|
||||
Exit For
|
||||
End If
|
||||
Next n
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Sub LoadDepotDialogs()
|
||||
DlgTransaction = LoadDialog("Depot", "Dialog2")
|
||||
DlgStockRates = LoadDialog("Depot", "Dialog3")
|
||||
DlgStartUp = LoadDialog("Depot", "Dialog4")
|
||||
TransactModel = DlgTransaction.Model
|
||||
StockRatesModel = DlgStockRates.Model
|
||||
StartUpModel = DlgStartUp.Model
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeStartUpModel()
|
||||
With StartUpModel
|
||||
.lblWelcome.Label = sStartupWelcome & Chr(13) & chr(13) & sStartUpChooseMarket
|
||||
sStartUpHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
.lblHint.Label = sStartupHint
|
||||
' .cmdGoOn.Enabled = Ubound(StartUpModel.lstMarkets.SelectedItems()) <> -1
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,195 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Currency" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
Dim bDoUnLoad as Boolean
|
||||
|
||||
|
||||
Sub Startup()
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
Dim ListString as String
|
||||
Dim MarketListBoxControl as Object
|
||||
Initialize(False)
|
||||
MarketListBoxControl = DlgStartUp.GetControl("lstMarkets")
|
||||
a = 0
|
||||
For i = 0 To Ubound(sMarket(),1)
|
||||
ListString = sMarket(i,0)
|
||||
If sMarket(i,0) <> "" Then
|
||||
If sMarket(i,3) = "" Then
|
||||
ListString = ListString & " (" & sNoInternetUpdate & ")"
|
||||
Else
|
||||
ListString = ListString & " (" & sMarketplace & " " & sMarket(i,2) & ")"
|
||||
End If
|
||||
MarketListBoxControl.AddItem(ListString, a)
|
||||
a = a + 1
|
||||
End If
|
||||
Next i
|
||||
MarketListBoxControl.SelectItemPos(GlobListIndex, True)
|
||||
DlgStartUp.Title = sDepotCurrency
|
||||
DlgStartUp.Model.cmdGoOn.DefaultButton = True
|
||||
DlgStartUp.GetControl("lstMarkets").SetFocus()
|
||||
DlgStartUp.Execute()
|
||||
DlgStartUp.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EnableGoOnButton()
|
||||
StartUpModel.cmdGoOn.Enabled = True
|
||||
StartUpModel.cmdGoOn.DefaultButton = True
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CloseStartUpDialog()
|
||||
DlgStartUp.EndExecute()
|
||||
' oDocument.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DisposeDocument()
|
||||
If bDoUnload Then
|
||||
oDocument.Dispose()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChooseMarket(Optional aEvent)
|
||||
Dim Index as Integer
|
||||
Dim bIsDocLanguage as Boolean
|
||||
Dim bIsDocCountry as Boolean
|
||||
oInternetModel = GetControlModel(oDocument.Sheets(0), "CmdInternet")
|
||||
If Not IsMissing(aEvent) Then
|
||||
Index = StartupModel.lstMarkets.SelectedItems(0)
|
||||
oInternetModel.Tag = Index
|
||||
Else
|
||||
Index = oInternetModel.Tag
|
||||
End If
|
||||
oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory")
|
||||
sCurCurrency = sMarket(Index,1)
|
||||
If Index = 0 Then
|
||||
HistoryChartSource = sMarket(Index,4)
|
||||
End If
|
||||
sCurStockIDLabel = sMarket(Index,5)
|
||||
sCurExtension = sMarket(Index,8)
|
||||
iValueCol = Val(sMarket(Index,10))
|
||||
If Instr(sCurExtension,";") <> 0 Then
|
||||
' Take the german extension as the stock place is Frankfurt
|
||||
sCurExtension = "407"
|
||||
End If
|
||||
sCurChartSource = sMarket(Index,3)
|
||||
bIsDocLanguage = Instr(1, sMarket(Index,6), sDocLanguage, SBBINARY) <> 0
|
||||
bIsDocCountry = Instr(1, sMarket(Index,7), sDocCountry, SBBINARY) <> 0 OR SDocCountry = ""
|
||||
sCurSeparator = sMarket(Index,9)
|
||||
TransactModel.txtRate.CurrencySymbol = sCurCurrency
|
||||
TransactModel.txtFix.CurrencySymbol = sCurCurrency
|
||||
TransactModel.txtMinimum.CurrencySymbol = sCurCurrency
|
||||
bEnableMarket = Index = 0
|
||||
bEnableInternet = sCurChartSource <> ""
|
||||
oMarketModel.Enabled = bEnableMarket
|
||||
oInternetModel.Enabled = bEnableInternet
|
||||
If Not IsMissing(aEvent) Then
|
||||
ConvertStylesCurrencies()
|
||||
bDoUnload = False
|
||||
DlgStartUp.EndExecute()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertStylesCurrencies()
|
||||
Dim m as integer
|
||||
Dim aStyleFormat as Object
|
||||
Dim StyleName as String
|
||||
Dim bAddToList as Boolean
|
||||
Dim oStyle as Object
|
||||
Dim oStyles as Object
|
||||
UnprotectSheets(oSheets)
|
||||
oFirstSheet.GetCellByPosition(SBCOLUMNID1, SBROWHEADER1).SetString(sCurStockIDLabel)
|
||||
oStyles = oDocument.StyleFamilies.GetbyIndex(0)
|
||||
For m = 0 To oStyles.count-1
|
||||
oStyle = oStyles.GetbyIndex(m)
|
||||
StyleName = oStyle.Name
|
||||
bAddToList = CheckFormatType(oStyle)
|
||||
If bAddToList Then
|
||||
SwitchNumberFormat(ostyle, oDocFormats, sCurCurrency, sCurExtension)
|
||||
End If
|
||||
Next m
|
||||
ProtectSheets(oSheets)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String, sNewExtension as String)
|
||||
Dim nFormatLanguage as Integer
|
||||
Dim nFormatDecimals as Integer
|
||||
Dim nFormatLeading as Integer
|
||||
Dim bFormatLeading as Integer
|
||||
Dim bFormatNegRed as Integer
|
||||
Dim bFormatThousands as Integer
|
||||
Dim aNewStr as String
|
||||
Dim iNumberFormat as Long
|
||||
Dim sSimpleStr as String
|
||||
Dim nSimpleKey as Long
|
||||
Dim aFormat()
|
||||
Dim oLocale as New com.sun.star.lang.Locale
|
||||
' Numberformat with the new Symbol as Base for new Format
|
||||
sSimpleStr = "0 [$" & sNewSymbol & "-" & sNewExtension & "]"
|
||||
nSimpleKey = Numberformat(oFormats, sSimpleStr, oDocLocale)
|
||||
On Local Error Resume Next
|
||||
iNumberFormat = oObject.NumberFormat
|
||||
If Err <> 0 Then
|
||||
Msgbox "Error Reading the Number Format"
|
||||
Resume CLERROR
|
||||
End If
|
||||
|
||||
On Local Error GoTo NOKEY
|
||||
aFormat() = oFormats.getByKey(iNumberFormat)
|
||||
On Local Error GoTo 0
|
||||
' set new currency format with according settings
|
||||
nFormatDecimals = aFormat.Decimals
|
||||
nFormatLeading = aFormat.LeadingZeros
|
||||
bFormatNegRed = aFormat.NegativeRed
|
||||
bFormatThousands = aFormat.ThousandsSeparator
|
||||
oLocale = aFormat.Locale
|
||||
aNewStr = oFormats.generateFormat(nSimpleKey, oLocale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
|
||||
oObject.NumberFormat = Numberformat(oFormats, aNewStr, oLocale)
|
||||
NOKEY:
|
||||
If Err <> 0 Then
|
||||
Resume CLERROR
|
||||
End If
|
||||
CLERROR:
|
||||
End Sub
|
||||
|
||||
|
||||
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Variant )
|
||||
Dim nRetkey
|
||||
nRetKey = oFormats.queryKey(aFormatStr, oLocale, True)
|
||||
If nRetKey = -1 Then
|
||||
nRetKey = oFormats.addNew( aFormatStr, oLocale )
|
||||
If nRetKey = -1 Then nRetKey = 0
|
||||
End If
|
||||
Numberformat = nRetKey
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckFormatType(oStyle as Object)
|
||||
Dim oFormatofObject as Object
|
||||
oFormatofObject = oDocFormats.getByKey(oStyle.NumberFormat)
|
||||
CheckFormatType = INT(oFormatOfObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
|
||||
End Function</script:module>
|
||||
@@ -0,0 +1,517 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Depot" script:language="StarBasic">Option Explicit
|
||||
|
||||
|
||||
Sub Initialize(Optional bChooseMarketPlace as Boolean)
|
||||
Dim bEnableHistory as Boolean
|
||||
GlobalScope.BasicLibraries.LoadLibrary("Tools")
|
||||
' oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory")
|
||||
' bEnableHistory = oMarketModel.Enabled
|
||||
ToggleWindow(False)
|
||||
Today = Date()
|
||||
bDebugmode = False
|
||||
oDocument = ThisComponent
|
||||
oController = oDocument.GetCurrentController
|
||||
oSheets = oDocument.Sheets
|
||||
oFirstSheet = oSheets(0)
|
||||
oMovementSheet = oSheets(1)
|
||||
oBankSheet = oSheets(2)
|
||||
oDocFormats = oDocument.NumberFormats
|
||||
oNumberFormatter = CreateUnoService("com.sun.star.util.NumberFormatter")
|
||||
oNumberFormatter.AttachNumberFormatsSupplier(oDocument)
|
||||
oDocLocale = oDocument.CharLocale
|
||||
sDocLanguage = oDocLocale.Language
|
||||
sDocCountry = oDocLocale.Country
|
||||
LoadLanguage()
|
||||
ToggleWindow(True)
|
||||
' oMarketModel.Enabled = bEnableHistory
|
||||
If Not IsMissing(bChooseMarketPlace) Then
|
||||
If bChoosemarketPlace Then
|
||||
ChooseMarket()
|
||||
End If
|
||||
Else
|
||||
ChooseMarket()
|
||||
End If
|
||||
If Not IsMissing(bChooseMarketPlace) Then
|
||||
If bChooseMarketPlace Then
|
||||
oMarketModel.Enabled = bEnableMarket
|
||||
oInternetModel.Enabled = bEnableInternet
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Buy()
|
||||
Initialize(True)
|
||||
FillListbox(DlgTransaction.GetControl("lstBuyStocks"), TransactTitle(SBDIALOGBUY), False)
|
||||
SetupTransactionControls(SBDIALOGBUY)
|
||||
EnableTransactionControls(False)
|
||||
DlgTransaction.Execute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Sell()
|
||||
Initialize(True)
|
||||
If FillListbox(DlgTransaction.GetControl("lstSellStocks"), TransactTitle(SBDIALOGSELL), True) Then
|
||||
SetupTransactionControls(SBDIALOGSELL)
|
||||
EnableTransactionControls(False)
|
||||
DlgTransaction.Execute()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub Reset()
|
||||
Dim TransactionCount as Integer
|
||||
Dim StockCount, iStartRow, i as Integer
|
||||
Dim oRows, oRange as Object
|
||||
Dim StockName as String
|
||||
Initialize(True)
|
||||
' Delete transactions and reset overview
|
||||
If MsgBox(sMsgDeleteAll, SBMSGYESNO+SBMSGQUESTION+SBMSGDEFAULTBTN2, sMsgAuthorization) = 6 Then
|
||||
' Assumption: If and only if there is an overview, then there are transactions, too
|
||||
UnprotectSheets(oSheets)
|
||||
StockCount = GetStocksCount(iStartRow)
|
||||
|
||||
For i = 1 To StockCount
|
||||
StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, iStartRow + i).String
|
||||
If oSheets.HasbyName(StockName) Then
|
||||
oSheets.RemoveByName(StockName)
|
||||
End If
|
||||
Next
|
||||
oDocument.AddActionLock
|
||||
RemoveStockRows(oFirstSheet, iStartRow + 1, StockCount)
|
||||
TransactionCount = GetTransactionCount(iStartRow)
|
||||
RemoveStockRows(oMovementSheet, iStartRow + 2, TransactionCount)
|
||||
ProtectSheets(oSheets)
|
||||
oDocument.RemoveActionLock
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub TransactionOk
|
||||
Dim Sold as Long
|
||||
Dim RestQuantity, Value, PartialValue, Profit
|
||||
Dim iNewRow as Integer, iRow as Integer
|
||||
Dim iStockRow as Long, iRestQuantity as Long
|
||||
Dim oNameCell as Object
|
||||
Dim CellStockName as String, SelStockName as String
|
||||
Dim CurRate as Double
|
||||
Dim TransactDate as Date
|
||||
Dim LocStockName as String
|
||||
' Check for rate entered
|
||||
If TransactModel.txtRate.Value = 0 Then
|
||||
If TransactModel.Step = SBDIALOGBUY Then
|
||||
If MsgBox(sMsgFreeStock, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then
|
||||
Exit Sub
|
||||
End If
|
||||
Else
|
||||
If MsgBox(sMsgTotalLoss, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
CurRate = TransactModel.txtRate.Value
|
||||
TransactDate = CDateFromUNODate(TransactModel.txtDate.Date)
|
||||
DlgTransaction.EndExecute()
|
||||
UnprotectSheets(oSheets)
|
||||
|
||||
iNewRow = DuplicateRow(oMovementSheet, "HiddenRow3")
|
||||
|
||||
If TransactModel.Step = SBDIALOGBUY Then
|
||||
CellStockName = TransactModel.lstBuyStocks.Text
|
||||
If Instr(1,CellStockName,"$") <> 0 Then
|
||||
CellStockName = "'" & CellStockName & "'"
|
||||
End If
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = TransactModel.txtQuantity.Value
|
||||
Else
|
||||
CellStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem()
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = -TransactModel.txtQuantity.Value
|
||||
End If
|
||||
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iNewRow).Value = CDateFromUNODate(TransactModel.txtDate.Date)
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNRATE2, iNewRow).Value = TransactModel.txtRate.Value
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNPROVPERCENT2, iNewRow).Value = TransactModel.txtCommission.EffectiveValue
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNPROVMIN2, iNewRow).Value = TransactModel.txtMinimum.Value
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNPROVFIX2, iNewRow).Value = TransactModel.txtFix.Value
|
||||
|
||||
' Buy stocks: Update overview for new stocks
|
||||
If TransactModel.Step = SBDIALOGBUY Then
|
||||
iStockRow = GetStockRowIndex(CellStockName)
|
||||
If iStockRow = -1 Then
|
||||
iNewRow = DuplicateRow(oFirstSheet, "HiddenRow2")
|
||||
oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, iNewRow).String = CellStockName
|
||||
oFirstSheet.GetCellByPosition(SBCOLUMNID1, iNewRow).String = TransactModel.txtStockID.Text
|
||||
iStockRow = GetStockRowIndex(CellStockName)
|
||||
End If
|
||||
' Sell stocks: Get transaction value, then update Transaction sheet
|
||||
ElseIf TransactModel.Step = SBDIALOGSELL Then
|
||||
Profit = oMovementSheet.GetCellByPosition(SBCOLUMNPROCEEDS2, iNewRow).Value
|
||||
Value = Profit
|
||||
Sold = TransactModel.txtQuantity.Value
|
||||
SelStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem()
|
||||
' Go to first name
|
||||
If TransactMode = FIFO Then
|
||||
iRow = SBROWFIRSTTRANSACT2
|
||||
Else
|
||||
iRow = iNewRow-1
|
||||
End If
|
||||
|
||||
' Check that no transaction after split date exists else cancel split
|
||||
Do While Sold > 0
|
||||
oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
|
||||
CellStockName = oNameCell.String
|
||||
If CellStockName = SelStockName Then
|
||||
' Update transactions: Note quantity sold
|
||||
RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value
|
||||
' If there still is a rest left ...
|
||||
If RestQuantity > 0 Then
|
||||
If RestQuantity < Sold Then
|
||||
' Recalculate profit of new transaction
|
||||
Profit = Profit - oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value
|
||||
AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, RestQuantity)
|
||||
PartialValue = RestQuantity / Sold * Value
|
||||
AddValueToCellContent(SBCOLUMNREALPROC2, iRow, PartialValue)
|
||||
Sold = Sold - RestQuantity
|
||||
Value = Value - PartialValue
|
||||
Else
|
||||
' Recalculate profit of neTransactModel.lstBuyStocks.Textw transaction
|
||||
PartialValue = oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value
|
||||
Profit = Profit - PartialValue/RestQuantity * Sold
|
||||
' Update sold shares cell
|
||||
AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, Sold)
|
||||
' Update sales turnover cell
|
||||
AddValueToCellContent(SBCOLUMNREALPROC2, iRow, Value)
|
||||
' Update variables for rest of transaction
|
||||
Sold = 0
|
||||
Value = 0
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
iRow = iRow + TransactMode
|
||||
Loop
|
||||
oMovementSheet.GetCellByPosition(SBCOLUMNREALPROFIT2,iNewRow).Value = Profit
|
||||
iStockRow = GetStockRowIndex(SelStockName)
|
||||
iRestQuantity = oFirstSheet.GetCellbyPosition(SBCOLUMNQUANTITY1, iStockRow).Value
|
||||
' If iRestQuantity = 0 Then
|
||||
' If oSheets.HasbyName(SelStockName) Then
|
||||
' oSheets.RemoveByName(SelStockName)
|
||||
' End If
|
||||
' Else
|
||||
|
||||
' End If
|
||||
End If
|
||||
InsertCurrentValue(CurRate, iStockRow,TransactDate)
|
||||
ProtectSheets(oSheets)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectStockname(aEvent as Object)
|
||||
Dim iCurRow as Integer
|
||||
Dim CurStockName as String
|
||||
With TransactModel
|
||||
' Find row with stock name
|
||||
If TransactModel.Step = SBDIALOGBUY Then
|
||||
CurStockName = .lstBuyStocks.Text
|
||||
iCurRow = GetStockRowIndex(CurStockName)
|
||||
.txtQuantity.ValueMax = 10000000
|
||||
Else
|
||||
Dim ListBoxList() as String
|
||||
ListBoxList() = GetSelectedListboxItems(aEvent.Source.getModel())
|
||||
CurStockName = ListBoxList(0)
|
||||
' CurStockName = DlgTransaction.GetControl(aEvent.Source.getModel.Name).GetSelectedItem()
|
||||
iCurRow = GetStockRowIndex(CurStockName)
|
||||
Dim fdouble as Double
|
||||
fdouble = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value
|
||||
.txtQuantity.Value = fdouble
|
||||
.txtQuantity.ValueMax = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value
|
||||
.txtRate.Value = oFirstSheet.GetCellbyPosition(SBCOLUMNRATE1, iCurRow).Value
|
||||
End If
|
||||
.txtStockID.Enabled = .Step = SBDIALOGBUY
|
||||
.lblStockID.Enabled = .Step = SBDIALOGBUY
|
||||
' Default settings for quantity and rate
|
||||
.txtStockID.Text = GetStockID(CurStockName, iCurRow)
|
||||
End With
|
||||
EnableTransactionControls(CurStockName <> "")
|
||||
TransactModel.cmdGoOn.DefaultButton = True
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub HandleStocks(Mode as Integer, oDialog as Object)
|
||||
Dim DividendPerShare, DividendTotal, RestQuantity, OldValue
|
||||
Dim SelStockName, CellStockName as String
|
||||
Dim oNameCell as Object, oDateCell as Object
|
||||
Dim iRow as Integer
|
||||
Dim oDividendCell as Object
|
||||
Dim Amount
|
||||
Dim OldNumber, NewNumber as Integer
|
||||
Dim NoteText as String
|
||||
Dim TotalStocksCount as Long
|
||||
Dim oModel as Object
|
||||
oDocument.AddActionLock
|
||||
oDialog.EndExecute()
|
||||
oModel = oDialog.Model
|
||||
SelStockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
|
||||
Select Case Mode
|
||||
Case HANDLEDIVIDEND
|
||||
Dim bTakeTotal as Boolean
|
||||
' Update transactions: Enter dividend paid for all Buy transactions not sold completely
|
||||
bTakeTotal = oModel.optTotal.State = 1
|
||||
If bTakeTotal Then
|
||||
DividendTotal = oModel.txtDividend.Value
|
||||
iRow = GetStockRowIndex(SelStockName)
|
||||
TotalStocksCount = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1,iRow).Value
|
||||
DividendPerShare = DividendTotal/TotalStocksCount
|
||||
Else
|
||||
DividendPerShare = oModel.txtDividend.Value
|
||||
End If
|
||||
|
||||
Case HANDLESPLIT
|
||||
' Store entered values in variables
|
||||
OldNumber = oModel.txtOldRate.Value
|
||||
NewNumber = oModel.txtNewRate.Value
|
||||
SplitDate = CDateFromUNODate(oModel.txtDate.Date)
|
||||
iRow = SBROWFIRSTTRANSACT2
|
||||
NoteText = cSplit & SplitDate & ", " & oModel.txtOldRate.Value & oModel.lblColon.Label & oModel.txtNewRate.Value
|
||||
Do
|
||||
oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
|
||||
CellStockName = oNameCell.String
|
||||
If CellStockName = SelStockName Then
|
||||
oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow)
|
||||
If oDateCell.Value >= SplitDate Then
|
||||
MsgBox sMsgWrongExchangeDate, SBMSGOK + SBMSGSTOP, sMsgError
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
iRow = iRow + 1
|
||||
Loop Until CellStockName = ""
|
||||
End Select
|
||||
iRow = SBROWFIRSTTRANSACT2
|
||||
UnprotectSheets(oSheets)
|
||||
Do
|
||||
oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
|
||||
CellStockName = oNameCell.String
|
||||
If CellStockName = SelStockName Then
|
||||
Select Case Mode
|
||||
Case HANDLEDIVIDEND
|
||||
RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value
|
||||
If RestQuantity > 0 Then
|
||||
oDividendCell = oMovementSheet.GetCellByPosition(SBCOLUMNDIVIDEND2, iRow)
|
||||
OldValue = oDividendCell.Value
|
||||
oDividendCell.Value = OldValue + RestQuantity * DividendPerShare
|
||||
End If
|
||||
Case HANDLESPLIT
|
||||
oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow)
|
||||
SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQUANTITY2, iRow, NoteText)
|
||||
SplitCellValue(oMovementSheet, OldNumber, NewNumber, SBCOLUMNRATE2, iRow, "")
|
||||
SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQTYSOLD2, iRow, "")
|
||||
End Select
|
||||
End If
|
||||
iRow = iRow + 1
|
||||
Loop Until CellStockName = ""
|
||||
If Mode = HANDLESPLIT Then
|
||||
CalculateChartafterSplit(SelStockName, NewNumber, OldNumber, NoteText, SplitDate)
|
||||
End If
|
||||
oDocument.CalculateAll()
|
||||
ProtectSheets(oSheets)
|
||||
oDocument.RemoveActionLock
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CancelStockRate()
|
||||
DlgStockRates.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CancelTransaction()
|
||||
DlgTransaction.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CommitStockRate()
|
||||
Dim CurStep as Integer
|
||||
CurStep = StockRatesModel.Step
|
||||
Select Case CurStep
|
||||
Case 1
|
||||
' Check for quantity entered
|
||||
If StockRatesModel.txtDividend.Value = 0 Then
|
||||
MsgBox sMsgNoDividend, SBMSGSTOP+SBMSGSTOP, sMsgError
|
||||
Exit Sub
|
||||
End If
|
||||
HandleStocks(HANDLEDIVIDEND, DlgStockRates)
|
||||
Case 2
|
||||
HandleStocks(HANDLESPLIT, DlgStockRates)
|
||||
Case 3
|
||||
InsertCompanyHistory()
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EnableTransactionControls(bEnable as Boolean)
|
||||
With TransactModel
|
||||
.lblQuantity.Enabled = bEnable
|
||||
.txtQuantity.Enabled = bEnable
|
||||
.lblRate.Enabled = bEnable
|
||||
.txtRate.Enabled = bEnable
|
||||
.lblDate.Enabled = bEnable
|
||||
.txtDate.Enabled = bEnable
|
||||
.lblCommission.Enabled = bEnable
|
||||
.txtCommission.Enabled = bEnable
|
||||
.lblMinimum.Enabled = bEnable
|
||||
.txtMinimum.Enabled = bEnable
|
||||
.lblFix.Enabled = bEnable
|
||||
.txtFix.Enabled = bEnable
|
||||
If TransactModel.Step = SBDIALOGSELL Then
|
||||
.cmdGoOn.Enabled = Ubound(TransactModel.lstSellStocks.SelectedItems()) > -1
|
||||
DlgTransaction.GetControl("lstSellStocks").SetFocus()
|
||||
Else
|
||||
.cmdGoOn.Enabled = TransactModel.lstBuyStocks.Text <> ""
|
||||
DlgTransaction.GetControl("lstBuyStocks").SetFocus()
|
||||
End If
|
||||
If bEnable Then
|
||||
TransactModel.cmdGoOn.DefaultButton = True
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetupTransactionControls(CurStep as Integer)
|
||||
DlgReference = DlgTransaction
|
||||
With TransactModel
|
||||
.txtDate.Date = CDateToUNODate(Date())
|
||||
.txtDate.DateMax = CDateToUNODate(Date())
|
||||
.txtStockID.Enabled = False
|
||||
.lblStockID.Enabled = False
|
||||
.lblStockID.Label = sCurStockIDLabel
|
||||
.txtRate.CurrencySymbol = sCurCurrency
|
||||
.txtFix.CurrencySymbol = sCurCurrency
|
||||
.Step = CurStep
|
||||
End With
|
||||
DlgTransaction.Title = TransactTitle(CurStep)
|
||||
CellValuetoControl(oBankSheet, TransactModel.txtCommission, "ProvisionPercent")
|
||||
CellValuetoControl(oBankSheet, TransactModel.txtMinimum, "ProvisionMinimum")
|
||||
CellValuetoControl(oBankSheet, TransactModel.txtFix, "ProvisionFix")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddShortCuttoControl()
|
||||
Dim SelCompany as String
|
||||
Dim iRow, SelIndex as Integer
|
||||
SelIndex = DlgTransaction.GetControl("lstBuyStocks").GetSelectedItemPos()
|
||||
If SelIndex <> -1 Then
|
||||
SelCompany = TransactModel.lstBuyStocks.StringItemList(SelIndex)
|
||||
iRow = GetStockRowIndex(SelCompany)
|
||||
If iRow <> -1 Then
|
||||
TransactModel.txtStockID.Text = oFirstSheet.GetCellByPosition(SBCOLUMNID1,iRow).String
|
||||
TransactModel.txtRate.Value = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1,iRow).Value
|
||||
Else
|
||||
TransactModel.txtStockID.Text = ""
|
||||
TransactModel.txtRate.Value = 0
|
||||
End If
|
||||
Else
|
||||
TransactModel.txtStockID.Text = ""
|
||||
TransactModel.txtRate.Value = 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub OpenStockRatePage(aEvent)
|
||||
Dim CurStep as Integer
|
||||
Initialize(True)
|
||||
CurStep = aEvent.Source.Model.Tag
|
||||
If FillListbox(DlgStockRates.GetControl("lstStockNames"), StockRatesTitle(CurStep), True) Then
|
||||
StockRatesModel.Step = CurStep
|
||||
ToggleStockRateControls(False, CurStep)
|
||||
InitializeStockRatesControls(CurStep)
|
||||
DlgStockRates.Execute()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectStockNameForRates()
|
||||
Dim StockName as String
|
||||
StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
|
||||
If StockName <> "" Then
|
||||
StockRatesModel.txtStockID.Text = GetStockID(StockName)
|
||||
ToggleStockRateControls(True, StockRatesModel.Step)
|
||||
End If
|
||||
StockRatesModel.cmdGoOn.DefaultButton = True
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleStockRateControls(bDoEnable as Boolean, CurStep as Integer)
|
||||
With StockRatesModel
|
||||
.lblStockID.Enabled = False
|
||||
.txtStockID.Enabled = False
|
||||
.cmdGoOn.Enabled = Ubound(StockRatesModel.lstStockNames.SelectedItems()) <> -1
|
||||
Select Case CurStep
|
||||
Case 1
|
||||
.optPerShare.Enabled = bDoEnable
|
||||
.optTotal.Enabled = bDoEnable
|
||||
.lblDividend.Enabled = bDoEnable
|
||||
.txtDividend.Enabled = bDoEnable
|
||||
Case 2
|
||||
.lblExchangeRate.Enabled = bDoEnable
|
||||
.lblDate.Enabled = bDoEnable
|
||||
.lblColon.Enabled = bDoEnable
|
||||
.txtOldRate.Enabled = bDoEnable
|
||||
.txtNewRate.Enabled = bDoEnable
|
||||
.txtDate.Enabled = bDoEnable
|
||||
Case 3
|
||||
.lblStartDate.Enabled = bDoEnable
|
||||
.lblEndDate.Enabled = bDoEnable
|
||||
.txtStartDate.Enabled = bDoEnable
|
||||
.txtEndDate.Enabled = bDoEnable
|
||||
.hlnInterval.Enabled = bDoEnable
|
||||
.optDaily.Enabled = bDoEnable
|
||||
.optWeekly.Enabled = bDoEnable
|
||||
End Select
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeStockRatesControls(CurStep as Integer)
|
||||
DlgReference = DlgStockRates
|
||||
DlgStockRates.Title = StockRatesTitle(CurStep)
|
||||
With StockRatesModel
|
||||
.txtStockID.Text = ""
|
||||
.lblStockID.Label = sCurStockIDLabel
|
||||
Select Case CurStep
|
||||
Case 1
|
||||
.txtDividend.Value = 0
|
||||
.optPerShare.State = 1
|
||||
.txtDividend.CurrencySymbol = sCurCurrency
|
||||
Case 2
|
||||
.txtOldRate.Value = 1
|
||||
.txtNewRate.Value = 1
|
||||
.txtDate.Date = CDateToUNODate(Date())
|
||||
Case 3
|
||||
.txtStartDate.DateMax = CDateToUNODate(CDate(Date())-1)
|
||||
.txtEndDate.DateMax = CDateToUNODate(CDate(Date())-1)
|
||||
.txtStartDate.Date = CDateToUNODate(CDate(Date())-8)
|
||||
.txtEndDate.Date = CDateToUNODate(CDate(Date())-1)
|
||||
.optDaily.State = 1
|
||||
End Select
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,53 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="Dialog2" dlg:tab-index="0" dlg:left="91" dlg:top="24" dlg:width="220" dlg:height="128" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_DIALOG_SELLBUY" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblStockNames" dlg:tab-index="0" dlg:left="6" dlg:top="6" dlg:width="102" dlg:height="8" dlg:value="lblStockNames"/>
|
||||
<dlg:menulist dlg:id="lstSellStocks" dlg:tab-index="1" dlg:left="6" dlg:top="17" dlg:width="102" dlg:height="12" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_1_LSTSELLSTOCKS" dlg:spin="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Depot.Depot.SelectStockname?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:combobox dlg:id="lstBuyStocks" dlg:tab-index="2" dlg:left="6" dlg:top="17" dlg:width="102" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_2_LSTBUYSTOCKS" dlg:spin="true">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Depot.Depot.SelectStockname?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:combobox>
|
||||
<dlg:text dlg:id="lblStockID" dlg:tab-index="3" dlg:left="150" dlg:top="6" dlg:width="66" dlg:height="8" dlg:value="lblStockID"/>
|
||||
<dlg:textfield dlg:id="txtStockID" dlg:tab-index="4" dlg:left="150" dlg:top="17" dlg:width="40" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTSTOCKID_SELLBUY"/>
|
||||
<dlg:text dlg:id="lblQuantity" dlg:tab-index="5" dlg:left="6" dlg:top="36" dlg:width="57" dlg:height="8" dlg:value="lblQuantity"/>
|
||||
<dlg:numericfield dlg:id="txtQuantity" dlg:tab-index="6" dlg:left="6" dlg:top="47" dlg:width="46" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTQUANTITY" dlg:decimal-accuracy="0" dlg:value-min="1"/>
|
||||
<dlg:currencyfield dlg:id="txtRate" dlg:tab-index="7" dlg:left="68" dlg:top="47" dlg:width="40" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTRATE" dlg:value-min="0"/>
|
||||
<dlg:datefield dlg:id="txtDate" dlg:tab-index="8" dlg:left="150" dlg:top="47" dlg:width="50" dlg:height="12" dlg:tag="Dialog2" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTDATE" dlg:strict-format="true" dlg:spin="true">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Depot.tools.CheckInputDate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:datefield>
|
||||
<dlg:text dlg:id="lblRate" dlg:tab-index="9" dlg:left="68" dlg:top="36" dlg:width="77" dlg:height="8" dlg:value="lblRate"/>
|
||||
<dlg:text dlg:id="lblDate" dlg:tab-index="10" dlg:left="150" dlg:top="37" dlg:width="66" dlg:height="8" dlg:value="lblDate"/>
|
||||
<dlg:formattedfield dlg:id="txtCommission" dlg:tab-index="11" dlg:left="6" dlg:top="90" dlg:width="40" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTCOMMISSION" dlg:format-code="0,00%" dlg:format-locale="de;DE"/>
|
||||
<dlg:text dlg:id="lblCommission" dlg:tab-index="12" dlg:left="6" dlg:top="79" dlg:width="60" dlg:height="8" dlg:value="lblCommission"/>
|
||||
<dlg:currencyfield dlg:id="txtFix" dlg:tab-index="13" dlg:left="68" dlg:top="90" dlg:width="40" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTFIX" dlg:value-min="0"/>
|
||||
<dlg:currencyfield dlg:id="txtMinimum" dlg:tab-index="14" dlg:left="150" dlg:top="90" dlg:width="40" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTMINIMUM" dlg:value-min="0"/>
|
||||
<dlg:text dlg:id="lblFix" dlg:tab-index="15" dlg:left="68" dlg:top="79" dlg:width="71" dlg:height="8" dlg:value="lblFix"/>
|
||||
<dlg:text dlg:id="lblMinimum" dlg:tab-index="16" dlg:left="150" dlg:top="79" dlg:width="66" dlg:height="8" dlg:value="lblMinimum"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="17" dlg:left="58" dlg:top="109" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDCANCEL_SELLBUY" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Depot.CancelTransaction?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="18" dlg:left="111" dlg:top="109" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDGOON_SELLBUY" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Depot.TransactionOk?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:fixedline dlg:id="hlnCommission" dlg:tab-index="19" dlg:left="6" dlg:top="66" dlg:width="210" dlg:height="8" dlg:value="hlnCommission"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,62 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="Dialog3" dlg:left="161" dlg:top="81" dlg:width="176" dlg:height="119" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_DIALOG_SPLIT" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblStockNames" dlg:tab-index="0" dlg:left="6" dlg:top="6" dlg:width="98" dlg:height="8" dlg:value="lblStockNames"/>
|
||||
<dlg:menulist dlg:id="lstStockNames" dlg:tab-index="1" dlg:left="5" dlg:top="17" dlg:width="102" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_LSTSTOCKNAMES" dlg:spin="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Depot.Depot.SelectStockNameForRates?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:textfield dlg:id="txtStockID" dlg:tab-index="2" dlg:left="120" dlg:top="17" dlg:width="50" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_TXTSTOCKID_SPLIT"/>
|
||||
<dlg:datefield dlg:id="txtStartDate" dlg:tab-index="3" dlg:left="63" dlg:top="37" dlg:width="50" dlg:height="12" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_3_TXTSTARTDATE" dlg:spin="true">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Depot.tools.CheckInputDate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:datefield>
|
||||
<dlg:datefield dlg:id="txtEndDate" dlg:tab-index="4" dlg:left="63" dlg:top="53" dlg:width="50" dlg:height="12" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_3_TXTENDDATE" dlg:spin="true">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Depot.tools.CheckInputDate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:datefield>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optDaily" dlg:tab-index="5" dlg:left="12" dlg:top="83" dlg:width="75" dlg:height="10" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_3_OPTDAILY" dlg:value="optDaily"/>
|
||||
<dlg:radio dlg:id="optWeekly" dlg:tab-index="6" dlg:left="101" dlg:top="83" dlg:width="69" dlg:height="10" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_3_OPTWEEKLY" dlg:value="optWeekly"/>
|
||||
</dlg:radiogroup>
|
||||
<dlg:datefield dlg:id="txtDate" dlg:tab-index="7" dlg:left="71" dlg:top="73" dlg:width="50" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_2_TXTDATE" dlg:spin="true">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Depot.tools.CheckInputDate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:datefield>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optPerShare" dlg:tab-index="8" dlg:left="6" dlg:top="37" dlg:width="69" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_1_OPTPERSHARE" dlg:value="optPerShare"/>
|
||||
<dlg:radio dlg:id="optTotal" dlg:tab-index="9" dlg:left="6" dlg:top="51" dlg:width="69" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_1_OPTTOTAL" dlg:value="optTotal"/>
|
||||
</dlg:radiogroup>
|
||||
<dlg:currencyfield dlg:id="txtDividend" dlg:tab-index="10" dlg:left="6" dlg:top="80" dlg:width="50" dlg:height="12" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_1_TXTDIVIDEND" dlg:value-min="0" dlg:spin="true"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="11" dlg:left="41" dlg:top="98" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDCANCEL_SPLIT" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Depot.CancelStockRate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="12" dlg:left="94" dlg:top="98" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDGOON_SPLIT" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Depot.CommitStockRate?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="lblStockID" dlg:tab-index="13" dlg:left="120" dlg:top="6" dlg:width="50" dlg:height="8" dlg:value="lblStockID"/>
|
||||
<dlg:text dlg:id="lblDividend" dlg:tab-index="14" dlg:left="6" dlg:top="68" dlg:width="73" dlg:height="8" dlg:page="1" dlg:value="lblDividend"/>
|
||||
<dlg:text dlg:id="lblExchangeRate" dlg:tab-index="15" dlg:left="6" dlg:top="39" dlg:width="92" dlg:height="8" dlg:page="2" dlg:value="lblExchangeRate"/>
|
||||
<dlg:text dlg:id="lblColon" dlg:tab-index="16" dlg:left="40" dlg:top="55" dlg:width="5" dlg:height="8" dlg:page="2" dlg:value=" :"/>
|
||||
<dlg:text dlg:id="lblDate" dlg:tab-index="17" dlg:left="5" dlg:top="75" dlg:width="66" dlg:height="8" dlg:page="2" dlg:value="lblDate"/>
|
||||
<dlg:fixedline dlg:id="hlnInterval" dlg:tab-index="18" dlg:left="6" dlg:top="72" dlg:width="164" dlg:height="8" dlg:page="3" dlg:value="hlnInterval"/>
|
||||
<dlg:text dlg:id="lblStartDate" dlg:tab-index="19" dlg:left="6" dlg:top="39" dlg:width="53" dlg:height="8" dlg:page="3" dlg:value="lblStartDate"/>
|
||||
<dlg:text dlg:id="lblEndDate" dlg:tab-index="20" dlg:left="6" dlg:top="55" dlg:width="53" dlg:height="8" dlg:page="3" dlg:value="lblEndDate"/>
|
||||
<dlg:numericfield dlg:id="txtOldRate" dlg:tab-index="21" dlg:left="6" dlg:top="53" dlg:width="30" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_2_TXTOLDRATE" dlg:decimal-accuracy="0" dlg:value-min="1" dlg:spin="true"/>
|
||||
<dlg:numericfield dlg:id="txtNewRate" dlg:tab-index="22" dlg:left="50" dlg:top="53" dlg:width="30" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_2_TXTNEWRATE" dlg:decimal-accuracy="0" dlg:value-min="1" dlg:spin="true"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,34 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="Dialog4" dlg:left="161" dlg:top="81" dlg:width="160" dlg:height="120" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_DIALOG_HISTORY" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblWelcome" dlg:tab-index="0" dlg:left="6" dlg:top="6" dlg:width="148" dlg:height="49" dlg:value="lblWelcome" dlg:multiline="true"/>
|
||||
<dlg:text dlg:id="lblHint" dlg:tab-index="1" dlg:left="6" dlg:top="73" dlg:width="148" dlg:height="26" dlg:value="lblHint" dlg:multiline="true"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="2" dlg:left="28" dlg:top="100" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDCANCEL_HISTORY" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Currency.CloseStartUpDialog?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="3" dlg:left="84" dlg:top="100" dlg:width="52" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_0_CMDGOON_HISTORY" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Depot.Currency.ChooseMarket?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:menulist dlg:id="lstMarkets" dlg:tab-index="4" dlg:left="6" dlg:top="57" dlg:width="148" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGDEPOT_LSTMARKETS" dlg:spin="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Depot.Currency.EnableGoOnButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,356 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Internet" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
Public sNewSheetName as String
|
||||
|
||||
Function CheckHistoryControls()
|
||||
Dim bLocGoOn as Boolean
|
||||
Dim Firstdate as Date
|
||||
Dim LastDate as Date
|
||||
LastDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date)
|
||||
FirstDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date)
|
||||
bLocGoOn = FirstDate <> 0 And LastDate <> 0
|
||||
If bLocGoOn Then
|
||||
If FirstDate >= LastDate Then
|
||||
Msgbox(sMsgStartDatebeforeEndDate,16, sProductname)
|
||||
bLocGoOn = False
|
||||
End If
|
||||
End If
|
||||
CheckHistoryControls = bLocGoon
|
||||
End Function
|
||||
|
||||
|
||||
Sub InsertCompanyHistory()
|
||||
Dim StockName as String
|
||||
Dim CurRow as Integer
|
||||
Dim sMsgInternetError as String
|
||||
Dim CurRate as Double
|
||||
Dim oCell as Object
|
||||
Dim sStockID as String
|
||||
Dim ChartSource as String
|
||||
If CheckHistoryControls() Then
|
||||
StartDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date)
|
||||
EndDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date)
|
||||
DlgStockRates.EndExecute()
|
||||
If StockRatesModel.optDaily.State = 1 Then
|
||||
sInterval = "d"
|
||||
iStep = 1
|
||||
ElseIf StockRatesModel.optWeekly.State = 1 Then
|
||||
sInterval = "w"
|
||||
iStep = 7
|
||||
StartDate = StartDate - WeekDay(StartDate) + 2
|
||||
EndDate = EndDate - WeekDay(EndDate) + 2
|
||||
End If
|
||||
iEndDay = Day(EndDate)
|
||||
iEndMonth = Month(EndDate)
|
||||
iEndYear = Year(EndDate)
|
||||
iStartDay = Day(StartDate)
|
||||
iStartMonth = Month(StartDate)
|
||||
iStartYear = Year(StartDate)
|
||||
' oDocument.AddActionLock()
|
||||
UnprotectSheets(oSheets)
|
||||
InitializeStatusline("", 10, 1)
|
||||
oBackGroundSheet = oSheets.GetbyName("Background")
|
||||
StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
|
||||
CurRow = GetStockRowIndex(Stockname)
|
||||
sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, CurRow).String
|
||||
ChartSource = ReplaceString(HistoryChartSource, sStockID, "<StockID>")
|
||||
ChartSource = ReplaceString(ChartSource, iStartDay, "<StartDay>")
|
||||
ChartSource = ReplaceString(ChartSource, cStr(iStartMonth-1), "<StartMonth>")
|
||||
ChartSource = ReplaceString(ChartSource, iStartYear, "<StartYear>")
|
||||
ChartSource = ReplaceString(ChartSource, iEndDay, "<EndDay>")
|
||||
ChartSource = ReplaceString(ChartSource, cStr(iEndMonth-1), "<EndMonth>")
|
||||
ChartSource = ReplaceString(ChartSource, iEndYear, "<EndYear>")
|
||||
ChartSource = ReplaceString(ChartSource, sInterval, "<interval>")
|
||||
oStatusLine.SetValue(2)
|
||||
If GetCurrentRate(ChartSource, CurRate, 1) Then
|
||||
oStatusLine.SetValue(8)
|
||||
UpdateValue(StockName, Today, CurRate)
|
||||
oStatusLine.SetValue(9)
|
||||
UpdateChart(StockName)
|
||||
oStatusLine.SetValue(10)
|
||||
Else
|
||||
sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings
|
||||
Msgbox(sMsgInternetError, 16, sProductname)
|
||||
End If
|
||||
ProtectSheets(oSheets)
|
||||
oStatusLine.End
|
||||
If oSheets.HasbyName(sNewSheetName) Then
|
||||
oController.ActiveSheet = oSheets.GetByName(sNewSheetName)
|
||||
End If
|
||||
' oDocument.RemoveActionLock()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub InternetUpdate()
|
||||
Dim i as Integer
|
||||
Dim StocksCount as Integer
|
||||
Dim iStartRow as Integer
|
||||
Dim sUrl as String
|
||||
Dim StockName as String
|
||||
Dim CurRate as Double
|
||||
Dim oCell as Object
|
||||
Dim sMsgInternetError as String
|
||||
Dim sStockID as String
|
||||
Dim ChartSource as String
|
||||
' oDocument.AddActionLock()
|
||||
Initialize(True)
|
||||
UnprotectSheets(oSheets)
|
||||
StocksCount = GetStocksCount(iStartRow)
|
||||
InitializeStatusline("", StocksCount + 1, 1)
|
||||
Today = CDate(Date)
|
||||
For i = iStartRow + 1 To iStartRow + StocksCount
|
||||
StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, i).String
|
||||
sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
|
||||
ChartSource = ReplaceString(sCurChartSource, sStockID, "<StockID>")
|
||||
If GetCurrentRate(ChartSource, CurRate, 0) Then
|
||||
InsertCurrentValue(CurRate, i, Now)
|
||||
Else
|
||||
sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings
|
||||
Msgbox(sMsgInternetError, 16, sProductname)
|
||||
End If
|
||||
oStatusline.SetValue(i - iStartRow + 1)
|
||||
Next
|
||||
ProtectSheets(oSheets)
|
||||
oStatusLine.End
|
||||
' oDocument.RemoveActionLock
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function GetCurrentRate(sUrl as String, fValue As Double, iValueRow as Integer) as Boolean
|
||||
Dim sFilter As String
|
||||
Dim sOptions As String
|
||||
Dim oLinkSheet As Object
|
||||
Dim sDate as String
|
||||
If oSheets.hasByName("Link") Then
|
||||
oLinkSheet = oSheets.getByName("Link")
|
||||
Else
|
||||
oLinkSheet = oDocument.createInstance("com.sun.star.sheet.Spreadsheet")
|
||||
oSheets.insertByName("Link", oLinkSheet)
|
||||
oLinkSheet.IsVisible = False
|
||||
End If
|
||||
|
||||
sFilter = "Text - txt - csv (StarCalc)"
|
||||
sOptions = sCurSeparator & ",34,SYSTEM,1,1/10/2/10/3/10/4/10/5/10/6/10/7/10/8/10/9/10"
|
||||
|
||||
oLinkSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
|
||||
oLinkSheet.link(sUrl, "", sFilter, sOptions, 1 )
|
||||
fValue = oLinkSheet.getCellByPosition(iValueCol, iValueRow).Value
|
||||
If fValue = 0 Then
|
||||
Dim sValue as String
|
||||
sValue = oLinkSheet.getCellByPosition(1, iValueRow).String
|
||||
sValue = ReplaceString(sValue, ".",",")
|
||||
fValue = Val(sValue)
|
||||
End If
|
||||
GetCurrentRate = fValue <> 0
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Sub UpdateValue(ByVal sName As String, fDate As Double, fValue As Double )
|
||||
Dim oSheet As Object
|
||||
Dim iColumn As Long
|
||||
Dim iRow As Long
|
||||
Dim i as Long
|
||||
Dim oCell As Object
|
||||
Dim LastDate as Date
|
||||
Dim bLeaveLoop as Boolean
|
||||
Dim RemoveCount as Long
|
||||
Dim iLastRow as Long
|
||||
Dim iLastLinkRow as Long
|
||||
Dim dDate as Date
|
||||
Dim CurDate as Date
|
||||
Dim oLinkSheet as Object
|
||||
Dim StartIndex as Long
|
||||
Dim iCellValue as Long
|
||||
' Insert Sheet with Company - Chart
|
||||
sName = CheckNewSheetname(oSheets, sName)
|
||||
If NOT oSheets.hasByName(sName) Then
|
||||
oSheets.CopybyName("Background", sName, oSheets.Count)
|
||||
oSheet = oSheets.getByName(sName)
|
||||
iCurRow = SBSTARTROW
|
||||
iMaxRow = iCurRow
|
||||
oCell = oSheet.getCellByPosition(SBDATECOLUMN, iCurRow)
|
||||
oCell.Value = fDate
|
||||
End If
|
||||
sNewSheetName = sName
|
||||
oLinkSheet = oSheets.GetByName("Link")
|
||||
oSheet = oSheets.getByName(sName)
|
||||
iLastRow = GetLastUsedRow(oSheet)- 2
|
||||
iLastLinkRow = GetLastUsedRow(oLinkSheet)
|
||||
iCurRow = iLastRow
|
||||
bLeaveLoop = False
|
||||
RemoveCount = 0
|
||||
' Delete all Cells in Date Area
|
||||
Do
|
||||
oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
|
||||
If oCell.CellStyle = sColumnHeader Then
|
||||
bLeaveLoop = True
|
||||
StartIndex = iCurRow
|
||||
iCurRow = iCurRow + 1
|
||||
Else
|
||||
RemoveCount = RemoveCount + 1
|
||||
iCurRow = iCurRow - 1
|
||||
End If
|
||||
Loop Until bLeaveLoop
|
||||
If RemoveCount > 1 Then
|
||||
oSheet.Rows.RemoveByIndex(iCurRow, RemoveCount-1)
|
||||
End If
|
||||
For i = 1 To iLastLinkRow
|
||||
oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
|
||||
iCellValue = oLinkSheet.GetCellByPosition(0,i).Value
|
||||
If iCellValue > 0 Then
|
||||
oCell.SetValue(oLinkSheet.GetCellByPosition(0,i).Value)
|
||||
Else
|
||||
oCell.SetValue(StringToDate(oLinkSheet.GetCellByPosition(0,i).String))
|
||||
End If
|
||||
oCell = oSheet.GetCellbyPosition(SBVALUECOLUMN,iCurRow)
|
||||
oCell.SetValue(oLinkSheet.GetCellByPosition(4,i).Value)
|
||||
If i < iLastLinkRow Then
|
||||
iCurRow = iCurRow + 1
|
||||
oSheet.Rows.InsertByIndex(iCurRow,1)
|
||||
End If
|
||||
Next i
|
||||
iMaxRow = iCurRow
|
||||
End Sub
|
||||
|
||||
|
||||
Function StringToDate(DateString as String) as Date
|
||||
Dim ShortMonths(11)
|
||||
Dim DateList() as String
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
ShortMonths(0) = "Jan"
|
||||
ShortMonths(1) = "Feb"
|
||||
ShortMonths(2) = "Mar"
|
||||
ShortMonths(3) = "Apr"
|
||||
ShortMonths(4) = "May"
|
||||
ShortMonths(5) = "Jun"
|
||||
ShortMonths(6) = "Jul"
|
||||
ShortMonths(7) = "Aug"
|
||||
ShortMonths(8) = "Sep"
|
||||
ShortMonths(9) = "Oct"
|
||||
ShortMonths(10) = "Nov"
|
||||
ShortMonths(11) = "Dec"
|
||||
For i = 0 To 11
|
||||
DateString = ReplaceString(DateString,CStr(i+1),ShortMonths(i))
|
||||
Next i
|
||||
DateString = ReplaceString(DateString, ".", "-")
|
||||
StringToDate = CDate(DateString)
|
||||
End Function
|
||||
|
||||
|
||||
Sub UpdateChart(sName As String)
|
||||
Dim oSheet As Object
|
||||
Dim oCell As Object, oCursor As Object
|
||||
Dim oChartRange As Object
|
||||
Dim oEmbeddedChart As Object, oCharts As Object
|
||||
Dim oChart As Object, oDiagram As Object
|
||||
Dim oYAxis As Object, oXAxis As Object
|
||||
Dim fMin As Double, fMax As Double
|
||||
Dim nDateFormat As Long
|
||||
Dim aPos As Variant
|
||||
Dim aSize As Variant
|
||||
Dim oContainerChart as Object
|
||||
Dim mRangeAddresses(0) as New com.sun.star.table.CellRangeAddress
|
||||
mRangeAddresses(0).Sheet = GetSheetIndex(oSheets, sNewSheetName)
|
||||
mRangeAddresses(0).StartColumn = SBDATECOLUMN
|
||||
mRangeAddresses(0).StartRow = SBSTARTROW-1
|
||||
mRangeAddresses(0).EndColumn = SBVALUECOLUMN
|
||||
mRangeAddresses(0).EndRow = iMaxRow
|
||||
|
||||
oSheet = oDocument.Sheets.getByName(sNewSheetName)
|
||||
oCharts = oSheet.Charts
|
||||
|
||||
If Not oCharts.hasElements Then
|
||||
oSheet.GetCellbyPosition(2,2).SetString(sName)
|
||||
oChartRange = oSheet.getCellRangeByPosition(SBDATECOLUMN,6,5,SBSTARTROW-3)
|
||||
aPos = oChartRange.Position
|
||||
aSize = oChartRange.Size
|
||||
|
||||
Dim oRectangleShape As New com.sun.star.awt.Rectangle
|
||||
oRectangleShape.X = aPos.X
|
||||
oRectangleShape.Y = aPos.Y
|
||||
oRectangleShape.Width = aSize.Width
|
||||
oRectangleShape.Height = aSize.Height
|
||||
oCharts.addNewByName(sName, oRectangleShape, mRangeAddresses(), True, False)
|
||||
oContainerChart = oCharts.getByName(sName)
|
||||
oChart = oContainerChart.EmbeddedObject
|
||||
oChart.Title.String = ""
|
||||
oChart.HasLegend = False
|
||||
oChart.diagram = oChart.createInstance("com.sun.star.chart.XYDiagram")
|
||||
oDiagram = oChart.Diagram
|
||||
oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
|
||||
oChart.Area.LineStyle = com.sun.star.drawing.LineStyle.SOLID
|
||||
oXAxis = oDiagram.XAxis
|
||||
oXAxis.TextBreak = False
|
||||
nDateFormat = oXAxis.NumberFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocLocale)
|
||||
|
||||
oYAxis = oDiagram.getYAxis()
|
||||
oYAxis.AutoOrigin = True
|
||||
Else
|
||||
oChart = oCharts(0)
|
||||
oChart.Ranges = mRangeAddresses()
|
||||
oChart.HasRowHeaders = False
|
||||
oEmbeddedChart = oChart.EmbeddedObject
|
||||
oDiagram = oEmbeddedChart.Diagram
|
||||
oXAxis = oDiagram.XAxis
|
||||
End If
|
||||
oXAxis.AutoStepMain = False
|
||||
oXAxis.AutoStepHelp = False
|
||||
oXAxis.StepMain = iStep
|
||||
oXAxis.StepHelp = iStep
|
||||
fMin = oSheet.getCellByPosition(SBDATECOLUMN,SBSTARTROW).Value
|
||||
fMax = oSheet.getCellByPosition(SBDATECOLUMN,iMaxRow).Value
|
||||
oXAxis.Min = fMin
|
||||
oXAxis.Max = fMax
|
||||
oXAxis.AutoMin = False
|
||||
oXAxis.AutoMax = False
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CalculateChartafterSplit(SheetName, NewNumber, OldNumber, NoteText, SplitDate)
|
||||
Dim oSheet as Object
|
||||
Dim i as Integer
|
||||
Dim oValueCell as Object
|
||||
Dim oDateCell as Object
|
||||
Dim bLeaveLoop as Boolean
|
||||
If oSheets.HasbyName(SheetName) Then
|
||||
oSheet = oSheets.GetbyName(SheetName)
|
||||
i = 0
|
||||
bLeaveLoop = False
|
||||
Do
|
||||
oValueCell = oSheet.GetCellbyPosition(SBVALUECOLUMN, SBSTARTROW + i)
|
||||
If oValueCell.CellStyle = CurrCellStyle Then
|
||||
SplitCellValue(oSheet, OldNumber, NewNumber, SBVALUECOLUMN, SBSTARTROW + i, "")
|
||||
i = i + 1
|
||||
Else
|
||||
bLeaveLoop = True
|
||||
End If
|
||||
Loop Until bLeaveLoop
|
||||
oDateCell = oSheet.GetCellbyPosition(SBDATECOLUMN, SBSTARTROW + i-1)
|
||||
oDateCell.Annotation.SetString(NoteText)
|
||||
End If
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_de" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadGermanLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "Abbrechen"
|
||||
sColumnHeader = "Spaltenkopf"
|
||||
sInsertStockName = "Bitte fügen Sie zunächst einige Aktien in Ihr Depot ein!"
|
||||
sTitle = "<PRODUCTNAME>: Aktienverwaltung"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Eingabefehler"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Bitte geben Sie eine Stückzahl größer als 0 ein"
|
||||
sMsgNoDividend = "Bitte geben Sie eine Dividende je Stück oder eine Gesamtdividende ein"
|
||||
sMsgNoExchangeRate = "Bitte geben Sie eine korrekte Umtauschrate ein (alte Aktien -> neue Aktien)."
|
||||
sMsgNoValidExchangeDate = "Bitte geben Sie ein gültiges Datum für den Aktiensplitt ein."
|
||||
sMsgWrongExchangeDate = "Splitt nicht möglich, da bereits Transaktionen nach dem Splitt-Datum existieren."
|
||||
sMsgSellTooMuch = "So viele Aktien können Sie nicht verkaufen. Maximum: "
|
||||
sMsgConfirm = "Bestätigung erforderlich"
|
||||
sMsgFreeStock = "Beabsichtigen Sie die Eingabe von Gratisaktien?"
|
||||
sMsgTotalLoss = "Beabsichtigen Sie die Eingabe eines Totalverlustes?"
|
||||
sMsgAuthorization = "Sicherheitsabfrage"
|
||||
sMsgDeleteAll = "Wollen Sie alle Bewegungen löschen und die Depotübersicht rücksetzen?"
|
||||
cSplit = "Aktiensplitt am "
|
||||
sHistory = "Historie"
|
||||
TransactTitle(1) = "Aktien verkaufen"
|
||||
TransactTitle(2) = "Aktien kaufen"
|
||||
StockRatesTitle(1) = "Dividendenzahlung"
|
||||
StockRatesTitle(2) = "Aktiensplitt"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Depotwährung"
|
||||
sStockName = "Aktienname"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Ergebnis Datum"
|
||||
CurrCellStyle = "Ergebnis Euro mit Dezimalen"
|
||||
sStartDate = "Startdatum:"
|
||||
sEndDate = "Enddatum:"
|
||||
sStartUpWelcome = "Diese Vorlage ermöglicht Ihnen eine effiziente Verwaltung Ihres Aktiendepots"
|
||||
sStartUpChooseMarket = "Wählen Sie zunächst Ihre Referenz-Währung und damit den Börsenplatz für das Internet Update aus!"
|
||||
sStartUpHint = "Leider steht Ihnen die <History>- Funktion nur für den amerikanischen Markt zur Verfügung!"
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "ohne Internet Update"
|
||||
sMarketPlace = "Börsenplatz:"
|
||||
sNoInternetDataAvailable = "Internet-Kurse konnten nicht empfangen werden!"
|
||||
sCheckInternetSettings = "Mögliche Ursachen sind: <BR> Ihre Internet Einstellungen müssen überprüft werden.<BR> Sie haben eine falsche Kennung (z.B. Symbol, WKN) für die Aktie eingegeben."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "Das Enddatum muss vor dem heutigen Tag liegen!"
|
||||
sMsgStartDatebeforeEndDate = "Das Startdatum muss vor dem Enddatum liegen!"
|
||||
|
||||
sMarket(0,0) = "Amerikanischer Dollar"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "New York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Symbol"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Frankfurt"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "WKN"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "Englisches Pfund"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "London"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Symbol"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Japanischer Yen"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokyo"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Code"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Hongkong Dollar"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hongkong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Nummer"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Australischer Dollar"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sydney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Symbol"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Menge"
|
||||
.lblRate.Label = "Kurs"
|
||||
.lblDate.Label = "Transaktionsdatum"
|
||||
.hlnCommission.Label = "Sonstige Ausgaben"
|
||||
.lblCommission.Label = "Provision"
|
||||
.lblMinimum.Label = "Mindestprovision"
|
||||
.lblFix.Label = "Festbetrag/Spesen"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Dividende/Aktie"
|
||||
.optTotal.Label = "Dividende gesamt"
|
||||
.lblDividend.Label = "Betrag"
|
||||
.lblExchangeRate.Label = "Umtauschrate (alt->neu)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Umtauschdatum:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Täglich"
|
||||
.optWeekly.Label = "~Wöchentlich"
|
||||
.hlnInterval.Label = "Zeitraum"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_en" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadEnglishLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "Cancel"
|
||||
sColumnHeader = "Column Header"
|
||||
sInsertStockName = "Please enter shares in your portfolio."
|
||||
sTitle = "<PRODUCTNAME>: Stocks Manager"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Input Error"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Please enter a quantity larger than 0"
|
||||
sMsgNoDividend = "Please enter the dividend per share or the total dividend"
|
||||
sMsgNoExchangeRate = "Please enter the correct exchange rate (old shares -> new shares)"
|
||||
sMsgNoValidExchangeDate = "Please enter a valid date for the split."
|
||||
sMsgWrongExchangeDate = "Splitting not possible, as transactions already exist after the split date."
|
||||
sMsgSellTooMuch = "You cannot sell that many shares. Maximum: "
|
||||
sMsgConfirm = "Confirmation Required"
|
||||
sMsgFreeStock = "Do you intend to enter free shares?"
|
||||
sMsgTotalLoss = "Do you intend to enter a total loss?"
|
||||
sMsgAuthorization = "Security Query"
|
||||
sMsgDeleteAll = "Do you want to delete all movements and reset the portfolio overview?"
|
||||
cSplit = "Stock split on "
|
||||
sHistory = "History"
|
||||
TransactTitle(1) = "StarOffice Stocks Manager: Selling Shares"
|
||||
TransactTitle(2) = "StarOffice Stocks Manager: Buying Shares"
|
||||
StockRatesTitle(1) = "StarOffice Stocks Manager: Dividend Payment"
|
||||
StockRatesTitle(2) = "Stock Split"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Portfolio Currency"
|
||||
sStockName = "Name of Stock"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Result Date"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "Start date:"
|
||||
sEndDate = "End date:"
|
||||
sStartUpWelcome = "This template enables you to manage your stock portfolio efficiently."
|
||||
sStartUpChooseMarket = "First, select your reference currency and thus the stock exchange for the Internet update."
|
||||
sStartUpHint = "Unfortunately, the only <History> function available to you is that for the American market."
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "without Internet update"
|
||||
sMarketPlace = "Stock exchange:"
|
||||
sNoInternetDataAvailable = "No prices could be received from the Internet!"
|
||||
sCheckInternetSettings = "Possible causes could be: <BR>Your Internet settings have to be modified. <BR>The Symbol (e.g. Code, Ticker Symbol) entered for the stock was incorrect."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "The end date has to be before today's date."
|
||||
sMsgStartDatebeforeEndDate = "The start date has to be before the end date."
|
||||
|
||||
sMarket(0,0) = "American Dollar"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "New York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Symbol"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Frankfurt"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "Ticker Symbol"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "British Pound"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "London"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Symbol"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Japanese Yen"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokyo"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Code"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Hong Kong Dollar"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hong Kong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Number"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Australian Dollar"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sydney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Symbol"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Quantity"
|
||||
.lblRate.Label = "Price"
|
||||
.lblDate.Label = "Transaction Date"
|
||||
.hlnCommission.Label = "Other expenditures"
|
||||
.lblCommission.Label = "Commission"
|
||||
.lblMinimum.Label = "Min. Commission"
|
||||
.lblFix.Label = "Fixed Costs/Charges"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Dividends/Stocks"
|
||||
.optTotal.Label = "Total Dividends"
|
||||
.lblDividend.Label = "Amount"
|
||||
.lblExchangeRate.Label = "Exchange Rate (old->new)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Exchange Date:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Daily"
|
||||
.optWeekly.Label = "~Weekly"
|
||||
.hlnInterval.Label = "Time period"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_es" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadSpanishLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~Aceptar"
|
||||
sCancel = "Cancelar"
|
||||
sColumnHeader = "Título de columna"
|
||||
sInsertStockName = "Introduzca primero algunas acciones en su depósito."
|
||||
sTitle = "<PRODUCTNAME>: Administración de acciones"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Error de entrada"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Indique una cantidad mayor que 0"
|
||||
sMsgNoDividend = "Indique un dividendo por unidad o un dividendo total"
|
||||
sMsgNoExchangeRate = "Indique aquí un cambio correcto (acción vieja -> nueva acción)"
|
||||
sMsgNoValidExchangeDate = "Indique una fecha correcta para el fraccionamiento de la acción."
|
||||
sMsgWrongExchangeDate = "El fraccionamiento no es posible porque existen transacciones después de la fecha de fraccionamiento."
|
||||
sMsgSellTooMuch = "No puede vender tantas acciones. Como máximo: "
|
||||
sMsgConfirm = "Confirmación necesaria"
|
||||
sMsgFreeStock = "¿Tiene previsto considerar acciones gratis?"
|
||||
sMsgTotalLoss = "¿Tiene previsto introducir una pérdida total?"
|
||||
sMsgAuthorization = "Pregunta de seguridad"
|
||||
sMsgDeleteAll = "¿Desea borrar todos los movimientos y reiniciar el balance de depósito?"
|
||||
cSplit = "Fraccionamiento el "
|
||||
sHistory = "Historia"
|
||||
TransactTitle(1) = "Vender acciones"
|
||||
TransactTitle(2) = "Comprar acciones"
|
||||
StockRatesTitle(1) = "Pago de dividendos"
|
||||
StockRatesTitle(2) = "Fraccionamiento"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Moneda del depósito"
|
||||
sStockName = "Nombre de la acción"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Resultado Fecha"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "Fecha de inicio:"
|
||||
sEndDate = "Fecha final:"
|
||||
sStartUpWelcome = "Esta plantilla le permite administrar eficientemente su depósito de acciones"
|
||||
sStartUpChooseMarket = "Seleccione primero la moneda de referencia y la plaza bursátil para la actualización a través de Internet."
|
||||
sStartUpHint = "La función <History> está disponible únicamente para el mercado americano."
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "Sin actualización por Internet"
|
||||
sMarketPlace = "Plaza bursátil:"
|
||||
sNoInternetDataAvailable = "No se pudieron recibir las cotizaciones por Internet."
|
||||
sCheckInternetSettings = "Causas posibles: <BR> Debe comprobar la configuración de Internet.<BR> Ha indicado un código incorrecto (p.ej. número, símbolo, etc.) para la acción."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "La fecha final debe ser anterior a la fecha de hoy."
|
||||
sMsgStartDatebeforeEndDate = "La fecha inicial debe ser anterior a la fecha final."
|
||||
|
||||
sMarket(0,0) = "Dólar estadounidense"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "Nueva York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Símbolo"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Frankfurt"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "Código"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "Libra esterlina"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "Londres"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Símbolo"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Yen japonés"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokio"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Código"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Dólar hongkonés"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hong Kong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Número"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Dólar australiano"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sidney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Símbolo"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Cantidad"
|
||||
.lblRate.Label = "Cotización"
|
||||
.lblDate.Label = "Fecha de operación"
|
||||
.hlnCommission.Label = "Otros gastos"
|
||||
.lblCommission.Label = "Provisión"
|
||||
.lblMinimum.Label = "Provisión mínima"
|
||||
.lblFix.Label = "Cantidad fija/comisión"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Dividendos/Acción"
|
||||
.optTotal.Label = "Dividendos totales"
|
||||
.lblDividend.Label = "Importe"
|
||||
.lblExchangeRate.Label = "Cambio (vieja->nueva)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Fecha de cambio:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Diario"
|
||||
.optWeekly.Label = "~Semanal"
|
||||
.hlnInterval.Label = "Periodo"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_fr" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadFrenchLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "Annuler"
|
||||
sColumnHeader = "En-tête de colonne"
|
||||
sInsertStockName = "Saisissez quelques actions dans votre portefeuille !"
|
||||
sTitle = "<PRODUCTNAME> : Gestion d'actions"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Erreur de saisie"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Saisissez une quantité supérieure à 0 !"
|
||||
sMsgNoDividend = "Vous devez saisir le montant des dividendes perçus (soit les dividendes par action, soit la somme totale perçue)."
|
||||
sMsgNoExchangeRate = "Saisissez un taux correct de conversion (anciennes actions -> nouvelles actions)."
|
||||
sMsgNoValidExchangeDate = "Saisissez une date correcte pour le split d'action."
|
||||
sMsgWrongExchangeDate = "Split impossible car il y a déjà eu des transactions après la date du split !"
|
||||
sMsgSellTooMuch = "Impossible de vendre autant d'actions ! Maximum : "
|
||||
sMsgConfirm = "Confirmation required"
|
||||
sMsgFreeStock = "S'agit-il d'actions gratuites ?"
|
||||
sMsgTotalLoss = "Prévoyez-vous une perte totale ?"
|
||||
sMsgAuthorization = "Requête de sécurité"
|
||||
sMsgDeleteAll = "Voulez-vous supprimer tous les mouvements et remettre le portefeuille d'actions à zéro ?"
|
||||
cSplit = "Split d'action le "
|
||||
sHistory = "Historique"
|
||||
TransactTitle(1) = "Vente d'actions"
|
||||
TransactTitle(2) = "Achat d'actions"
|
||||
StockRatesTitle(1) = "Versement des dividendes"
|
||||
StockRatesTitle(2) = "Split d'action"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Monnaie du portefeuille"
|
||||
sStockName = "Nom de l'action"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Résultat date"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "Date de début :"
|
||||
sEndDate = "Date de fin :"
|
||||
sStartUpWelcome = "Utilisez ce modèle pour une gestion efficiente de votre portefeuille d'actions !"
|
||||
sStartUpChooseMarket = "Commencez par choisir une monnaie de référence et ainsi la place boursière pour la mise à jour Internet !"
|
||||
sStartUpHint = "La fonction <History> n'est cependant disponible que pour le marché américain."
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "Sans mise à jour Internet"
|
||||
sMarketPlace = "Place boursière :"
|
||||
sNoInternetDataAvailable = "Réception des cours Internet impossible !"
|
||||
sCheckInternetSettings = "Causes possibles : <BR> Problème de paramétrage Internet : vérifiez les paramètres !<BR> Vous avez saisi un identificateur (par ex. symbole ou code) incorrect pour l'action."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "La date spécifiée pour la fin doit précéder celle de ce jour !"
|
||||
sMsgStartDatebeforeEndDate = "La date spécifiée pour le début doit succéder à celle de ce jour !"
|
||||
|
||||
sMarket(0,0) = "Dollar Américain"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "New York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Symbole"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Francfort"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "Code"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "Livre Sterling"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "Londres"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Symbole"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Yen Japonais"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokyo"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Code"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Dollar de Hong Kong"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hong Kong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Numéro"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Dollar Australien"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sydney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Symbole"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Quantité"
|
||||
.lblRate.Label = "Cours"
|
||||
.lblDate.Label = "Date de transaction"
|
||||
.hlnCommission.Label = "Dépenses diverses"
|
||||
.lblCommission.Label = "Commission"
|
||||
.lblMinimum.Label = "Commission minimale"
|
||||
.lblFix.Label = "Montant fixe/frais"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Dividende/action"
|
||||
.optTotal.Label = "Dividende total"
|
||||
.lblDividend.Label = "Montant"
|
||||
.lblExchangeRate.Label = "Taux de conversion (ancien->nouveau)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Date de la conversion:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Quotidien"
|
||||
.optWeekly.Label = "~Hebdomadaire"
|
||||
.hlnInterval.Label = "Période"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_it" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadItalianLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "Annulla"
|
||||
sColumnHeader = "Intestazione colonna"
|
||||
sInsertStockName = "Inserite un nome di azioni"
|
||||
sTitle = "<PRODUCTNAME>: Gestione delle azioni"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Errore dati immessi"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Inserite il numero delle azioni"
|
||||
sMsgNoDividend = "Inserite un dividendo a unità oppure un dividendo totale"
|
||||
sMsgNoExchangeRate = "Indicate un corretto tasso di cambio (vecchie azioni -> nuove azioni)."
|
||||
sMsgNoValidExchangeDate = "Indicate la data di frazionamento delle azioni."
|
||||
sMsgWrongExchangeDate = "Il frazionamento non è possibile perché sono ancora in atto transazioni dopo la data indicata."
|
||||
sMsgSellTooMuch = "Non potete vendere così tante azioni. Massimo: "
|
||||
sMsgConfirm = "È necessaria una conferma"
|
||||
sMsgFreeStock = "Confermate la digitazione di azioni gratuite?"
|
||||
sMsgTotalLoss = "Confermate la digitazione di perdita totale?"
|
||||
sMsgAuthorization = "Domanda di sicurezza"
|
||||
sMsgDeleteAll = "Eliminare tutti i movimenti e ripristinare la panoramica dei depositi?"
|
||||
cSplit = "Frazionamento delle azioni il: "
|
||||
sHistory = "Cronologia"
|
||||
TransactTitle(1) = "Vendita di azioni"
|
||||
TransactTitle(2) = "Acquisto di azioni"
|
||||
StockRatesTitle(1) = "Pagamento dei dividendi"
|
||||
StockRatesTitle(2) = "Frazionamento azioni"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Valuta deposito"
|
||||
sStockName = "Nome delle azioni"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Risultato data"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "Data d'inizio:"
|
||||
sEndDate = "Data finale:"
|
||||
sStartUpWelcome = "Questo modello vi permette una gestione efficace delle vostre azioni."
|
||||
sStartUpChooseMarket = "Selezionate la valuta di riferimento e la Borsa per il collegamento Internet."
|
||||
sStartUpHint = "La funzione <History> è disponibile solo per il mercato americano."
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "Senza aggiornamento Internet"
|
||||
sMarketPlace = "Borsa:"
|
||||
sNoInternetDataAvailable = "Impossibile ricevere le quotazioni Internet"
|
||||
sCheckInternetSettings = "Possibili cause: <BR> le impostazioni Internet devono essere modificate.<BR> Avete indicato un indice (ad es. simbolo o codice) errato per le azioni."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "La data finale dev'essere anteriore alla data odierna."
|
||||
sMsgStartDatebeforeEndDate = "La data d'inizio deve precedere la data finale."
|
||||
|
||||
sMarket(0,0) = "Dollaro USA"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "New York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Simbolo"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Francoforte"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "Numero identificazione titoli"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "Sterlina inglese"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "Londra"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Simbolo"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Yen"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokyo"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Codice"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Dollaro Hong Kong"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hong Kong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Numero"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Dollaro australiano"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sydney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Simbolo"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Quantità"
|
||||
.lblRate.Label = "Quotazione"
|
||||
.lblDate.Label = "Data della transazione"
|
||||
.hlnCommission.Label = "Spese extra"
|
||||
.lblCommission.Label = "Commissioni"
|
||||
.lblMinimum.Label = "Commissione minima"
|
||||
.lblFix.Label = "Importo fisso/Spese"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Dividendo/Azione"
|
||||
.optTotal.Label = "Dividendo totale"
|
||||
.lblDividend.Label = "Importo"
|
||||
.lblExchangeRate.Label = "Tasso di cambio (vecchio->nuovo)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Data di cambio:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Giornaliero"
|
||||
.optWeekly.Label = "~Settimanale"
|
||||
.hlnInterval.Label = "Durata"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_ja" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadJapaneseLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "キャンセル"
|
||||
sColumnHeader = "列番号"
|
||||
sInsertStockName = "最初に株の銘柄を入力してください。"
|
||||
sTitle = "<PRODUCTNAME>: 株管理"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "入力フィールド"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "0 より大きな額を入力してください。"
|
||||
sMsgNoDividend = "１株当たりの配当金額または総配当金額を入力してください。"
|
||||
sMsgNoExchangeRate = "交換比率（旧株->新株）を入力してください。"
|
||||
sMsgNoValidExchangeDate = "株式分割日を入力してください。"
|
||||
sMsgWrongExchangeDate = "分割日以降に取引がすでに存在するので、分割できません。"
|
||||
sMsgSellTooMuch = "売却できる株式数を超えています。最大値: "
|
||||
sMsgConfirm = "ご確認ください"
|
||||
sMsgFreeStock = "無料株式を入力しますか?"
|
||||
sMsgTotalLoss = "全損の入力を行いますか?"
|
||||
sMsgAuthorization = "確認ダイアログ"
|
||||
sMsgDeleteAll = "すべての移動を取り消し、ポートフォリオの概要をリセットしますか?"
|
||||
cSplit = "株式分割日 "
|
||||
sHistory = "履歴"
|
||||
TransactTitle(1) = "株を買う"
|
||||
TransactTitle(2) = "株を買う"
|
||||
StockRatesTitle(1) = "配当額"
|
||||
StockRatesTitle(2) = "株式分割"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "ポートフォリオの通貨"
|
||||
sStockName = "株式名"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "結果（日付）"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "開始日:"
|
||||
sEndDate = "終了日:"
|
||||
sStartUpWelcome = "このテンプレートを使えば、株式のポートフォリオをより効率的に管理できます。"
|
||||
sStartUpChooseMarket = "まず、インターネットにより情報を更新する基準通貨と、対応する証券取引所を選択します。"
|
||||
sStartUpHint = "残念ながら、<History> 機能を使用できるのは米国市場に限られています。"
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "インターネットによる情報の更新を行いません"
|
||||
sMarketPlace = "証券取引所:"
|
||||
sNoInternetDataAvailable = "インターネットから株価情報を受信できない場合があります!"
|
||||
sCheckInternetSettings = "考えられる原因は次のとおりです。<BR>インターネット設定の変更が必要です。<BR>入力した株式のが間違っています。"
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "終了日は、今日の日付より前であることが必要です。"
|
||||
sMsgStartDatebeforeEndDate = "開始日は、終了日より前であることが必要です。"
|
||||
|
||||
sMarket(0,0) = "米ドル"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "ニューヨーク"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "シンボル"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "ユーロ"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "フランクフルト"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "銘柄コード"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "英ポンド"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "ロンドン"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "シンボル"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "日本円"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "東京"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "コード"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "香港ドル"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "香港"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "番号"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "オーストリア・ドル"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "シドニー"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "シンボル"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "株数"
|
||||
.lblRate.Label = "価格"
|
||||
.lblDate.Label = "取引日"
|
||||
.hlnCommission.Label = "その他の経費n"
|
||||
.lblCommission.Label = "手数料"
|
||||
.lblMinimum.Label = "最低手数料"
|
||||
.lblFix.Label = "固定費/諸経費"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "配当金/株式数"
|
||||
.optTotal.Label = "配当金の総額"
|
||||
.lblDividend.Label = "金額"
|
||||
.lblExchangeRate.Label = "交換比率（旧株->新株）"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "交換日:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~毎日"
|
||||
.optWeekly.Label = "~毎週"
|
||||
.hlnInterval.Label = "期間"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_ko" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadKoreanLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "~확인"
|
||||
sCancel = "취소"
|
||||
sColumnHeader = "열 머리글"
|
||||
sInsertStockName = "주식 종목을 삽입해주십시오."
|
||||
sTitle = "<PRODUCTNAME>: 주식 매수"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "입력 오류"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "0 이하의 매수를 입력해주십시오."
|
||||
sMsgNoDividend = "한 주당 배당분 또는 총배당분을 입력해주십시오."
|
||||
sMsgNoExchangeRate = "정확한 환율을 입력해주십시오 (구주를 신주로 소급 시)."
|
||||
sMsgNoValidExchangeDate = "유효한 배당 결제일을 입력해주십시오."
|
||||
sMsgWrongExchangeDate = "배당 기준일이 경과하여 배당할 수 없습니다."
|
||||
sMsgSellTooMuch = "이렇게 많은 주식을 팔 수 없습니다. 최대 매도수: "
|
||||
sMsgConfirm = "확인 필요"
|
||||
sMsgFreeStock = "공짜 주식을 입력하시겠습니까?"
|
||||
sMsgTotalLoss = "주가 폭락세를 입력하시겠습니까?"
|
||||
sMsgAuthorization = "안정성 조회"
|
||||
sMsgDeleteAll = "모든 주가 움직임을 삭제하고 계좌 현황을 원래대로 하시겠습니까?"
|
||||
cSplit = "주식 배당일 "
|
||||
sHistory = "내역"
|
||||
TransactTitle(1) = "주식 관리: 주식 매도"
|
||||
TransactTitle(2) = "주식 관리: 주식 매수"
|
||||
StockRatesTitle(1) = "주식 관리: 배당금 지불"
|
||||
StockRatesTitle(2) = "주식 관리: 주식 배분"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "주식 계좌 통화"
|
||||
sStockName = "주식 종목명"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "결과, 날짜"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "매매일:"
|
||||
sEndDate = "만기일:"
|
||||
sStartUpWelcome = "이 템플릿을 사용하여 주식 투자 관리를 효율적으로 할 수 있습니다."
|
||||
sStartUpChooseMarket = "인터넷 업데이트를 위해 우선 관련 통화와 증권 장소를 선택하십시오."
|
||||
sStartUpHint = "<내역> 기능은 미국 시장용으로만 사용할 수 있습니다."
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "인터넷 업데이트 없음"
|
||||
sMarketPlace = "증권 장소:"
|
||||
sNoInternetDataAvailable = "인터넷 시세는 받을 수 없었습니다."
|
||||
sCheckInternetSettings = "원인: <BR> 인터넷 설정을 점검해야만 합니다.<BR> 옳지 않은 암호<예를 들어 잘못된 문자 또는 종목 코드>를 입력했습니다."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "만기일은 오늘 날짜 전에 기입되어야 합니다."
|
||||
sMsgStartDatebeforeEndDate = "매매일은 만기일 전에 기입되어야 합니다."
|
||||
|
||||
sMarket(0,0) = "미국 달러"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "뉴욕"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "기호"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "유로"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "프랑크푸르트"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "WKN"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "영국 파운드"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "런던"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "기호"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "엔화"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "도쿄"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "코드"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "홍콩 달러"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "홍콩"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "번호"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "호주 달러"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "시드니"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "기호"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "수량"
|
||||
.lblRate.Label = "시세"
|
||||
.lblDate.Label = "배당 결산일"
|
||||
.hlnCommission.Label = "기타 지출"
|
||||
.lblCommission.Label = "수수료"
|
||||
.lblMinimum.Label = "최저 수수료"
|
||||
.lblFix.Label = "약정 금액/기타 경비"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "배당분/주"
|
||||
.optTotal.Label = "배당분 합계"
|
||||
.lblDividend.Label = "금액"
|
||||
.lblExchangeRate.Label = "환율(구주->신주)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "환율일자"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~매일"
|
||||
.optWeekly.Label = "~매주"
|
||||
.hlnInterval.Label = "기간"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,174 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_sv" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadSwedishLanguage()
|
||||
sProductname = GetProductname
|
||||
sOK = "~OK"
|
||||
sCancel = "Avbryt"
|
||||
sColumnHeader = "Kolumnhuvud"
|
||||
sInsertStockName = "Infoga först några aktier i Din portfölj!"
|
||||
sTitle = "<PRODUCTNAME>: Aktieförvaltning"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "Inmatningsfel"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "Var vänlig och mata in ett större antal än 0"
|
||||
sMsgNoDividend = "Var vänlig och mata in utdelning per styck eller den totala utdelningen"
|
||||
sMsgNoExchangeRate = "Var vänlig och mata in en korrekt omräkningskurs (gamla aktier -> nya aktier)."
|
||||
sMsgNoValidExchangeDate = "Var vänlig och mata in ett giltigt datum för aktiesplitten."
|
||||
sMsgWrongExchangeDate = "Split är inte möjlig eftersom det redan finns transaktioner efter splitdatum."
|
||||
sMsgSellTooMuch = "Så många aktier kan Du inte sälja. Maximum: "
|
||||
sMsgConfirm = "Bekräftelse krävs"
|
||||
sMsgFreeStock = "Avser Du att mata in gratisaktier?"
|
||||
sMsgTotalLoss = "Avser Du att mata in en totalförlust?"
|
||||
sMsgAuthorization = "Säkerhetskontroll"
|
||||
sMsgDeleteAll = "Vill Du ta bort alla rörelser och återställa portföljöversikten?"
|
||||
cSplit = "Aktiesplit den "
|
||||
sHistory = "Historik"
|
||||
TransactTitle(1) = "Sälja aktier"
|
||||
TransactTitle(2) = "Köpa aktier"
|
||||
StockRatesTitle(1) = "Aktieutdelning"
|
||||
StockRatesTitle(2) = "Aktiesplit"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "Portföljvaluta"
|
||||
sStockName = "Aktienamn"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "Resultat datum"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "Startdatum:"
|
||||
sEndDate = "Slutdatum:"
|
||||
sStartUpWelcome = "Med hjälp av den här mallen kan Du förvalta Din aktieportfölj effektivt"
|
||||
sStartUpChooseMarket = "Välj först Din referensvaluta och därigenom börs för Internet-uppdateringen!"
|
||||
sStartUpHint = "Tyvärr är <History>-funktionen bara tillgänglig för den amerikanska marknaden!"
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "utan Internet-uppdatering"
|
||||
sMarketPlace = "Börs:"
|
||||
sNoInternetDataAvailable = "Det gick inte att ta emot Internet-kurser!"
|
||||
sCheckInternetSettings = "Detta kan bero på att: <BR> Dina Internet-inställningar måste ändras.<BR> Du har angivit ett felaktigt ID (t.ex. symbol, värdepappersnr.) för aktien."
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "Slutdatum måste ligga före idag!"
|
||||
sMsgStartDatebeforeEndDate = "Startdatum måste ligga före slutdatum!"
|
||||
|
||||
sMarket(0,0) = "Amerikansk dollar"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "New York"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "Symbol"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "Euro"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "Frankfurt"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "Värdepappersnr"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "Engelskt pund"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "London"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "Symbol"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "Japansk yen"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "Tokyo"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "Kod"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "Hongkongdollar"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "Hongkong"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "Nummer"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "Australisk dollar"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "Sydney"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "Symbol"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "Antal"
|
||||
.lblRate.Label = "Kurs"
|
||||
.lblDate.Label = "Transaktionsdatum"
|
||||
.hlnCommission.Label = "Övriga utgifter"
|
||||
.lblCommission.Label = "Provision"
|
||||
.lblMinimum.Label = "Minimiprovision"
|
||||
.lblFix.Label = "Fast belopp/omkostnader"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "Utdelning per aktie"
|
||||
.optTotal.Label = "Utdelning totalt"
|
||||
.lblDividend.Label = "Belopp"
|
||||
.lblExchangeRate.Label = "Omräkningskurs (gammal->ny)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "Omräkningsdatum:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "~Dagligen"
|
||||
.optWeekly.Label = "~Varje vecka"
|
||||
.hlnInterval.Label = "Period"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_tw" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadChineseTradLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "確定"
|
||||
sCancel = "取消"
|
||||
sColumnHeader = "欄標簽"
|
||||
sInsertStockName = "請先填入股票名稱!"
|
||||
sTitle = "<PRODUCTNAME>: 股票管理"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "輸入無效"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "請輸入大於0的交易股數"
|
||||
sMsgNoDividend = "請輸入每股股息金額或股息總額"
|
||||
sMsgNoExchangeRate = "請鍵入正確的換算比率(舊股票 -> 新股票)。"
|
||||
sMsgNoValidExchangeDate = "請輸入股票分割的日期。"
|
||||
sMsgWrongExchangeDate = "無法分割股票，因為分割日期之後已經買進或賣出股票。"
|
||||
sMsgSellTooMuch = "最多能出售的股票數： "
|
||||
sMsgConfirm = "需要确認"
|
||||
sMsgFreeStock = "需要輸入一個贈送的股票？"
|
||||
sMsgTotalLoss = "要輸入一個全部損失的股票？"
|
||||
sMsgAuthorization = "安全詢問"
|
||||
sMsgDeleteAll = "您要刪除所有的交易資料，重新建立一個股票一覽表？"
|
||||
cSplit = "股票分割的日期 "
|
||||
sHistory = "紀錄"
|
||||
TransactTitle(1) = "出售股票"
|
||||
TransactTitle(2) = "購買股票"
|
||||
StockRatesTitle(1) = "支付股息"
|
||||
StockRatesTitle(2) = "股票分割"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "股票的貨幣"
|
||||
sStockName = "股票名稱"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "結果 日期"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "交割日期："
|
||||
sEndDate = "到期日期："
|
||||
sStartUpWelcome = "這個樣式用於高效能地管理股票交易。"
|
||||
sStartUpChooseMarket = "請先選一個參照的貨幣和一個可直接從 Internet 更新資料的贈券交易所。"
|
||||
sStartUpHint = "很遺憾，<History>-功能僅適用於美國的交易所。"
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "不透過 internet 更新"
|
||||
sMarketPlace = "證券交易所："
|
||||
sNoInternetDataAvailable = "無法接受 Internet 股票價格!"
|
||||
sCheckInternetSettings = "可能的原因：<BR>Internet 設定不正確，需要重新設定。<BR>輸入了一個錯誤的股票代碼。"
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "到期日期必須是在今日之前！"
|
||||
sMsgStartDatebeforeEndDate = "交割日期必須是在到期日期之前！"
|
||||
|
||||
sMarket(0,0) = "美元"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "紐約"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "股票符號"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "歐元"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "法蘭克福"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "股代碼"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "英鎊"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "倫敦"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "股票符號"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "日元"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "東京"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "代碼"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "港幣"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "香港"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "編號"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "澳元"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "悉尼"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "股票符號"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "數量"
|
||||
.lblRate.Label = "股票價格"
|
||||
.lblDate.Label = "交易日期"
|
||||
.hlnCommission.Label = "其它的支出費用"
|
||||
.lblCommission.Label = "手續費"
|
||||
.lblMinimum.Label = "最低手續費"
|
||||
.lblFix.Label = "固定金額/費用"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "每股股息"
|
||||
.optTotal.Label = "股息總計"
|
||||
.lblDividend.Label = "金額"
|
||||
.lblExchangeRate.Label = "轉換比率(舊股票 -> 新股票)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "轉換日期:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "每日"
|
||||
.optWeekly.Label = "每週"
|
||||
.hlnInterval.Label = "時間週期"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,175 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Lang_zh" script:language="StarBasic">Option Explicit
|
||||
|
||||
Sub LoadChineseSimpleLanguage()
|
||||
|
||||
sProductname = GetProductname
|
||||
sOK = "确定"
|
||||
sCancel = "取消"
|
||||
sColumnHeader = "列标题"
|
||||
sInsertStockName = "请首先往您的帐号内输入一些股票名称！"
|
||||
sTitle = "<PRODUCTNAME>：股票管理"
|
||||
sTitle = ReplaceString(sTitle, sProductName, "<PRODUCTNAME>")
|
||||
sMsgError = "输入错误"
|
||||
sMsgNoName = sInsertStockname
|
||||
sMsgNoQuantity = "请输入大于0的交易股数"
|
||||
sMsgNoDividend = "请输入每股的红利金额或红利总额"
|
||||
sMsgNoExchangeRate = "请输入一个正确的兑换率(旧股-> 新股)。"
|
||||
sMsgNoValidExchangeDate = "请输入拆股生效日期。"
|
||||
sMsgWrongExchangeDate = "因为在拆股生效后已经进行了股票交易，所以无法拆股。"
|
||||
sMsgSellTooMuch = "您最多能出售的股票数为： "
|
||||
sMsgConfirm = "需要确认"
|
||||
sMsgFreeStock = "您想要输入赠送股票？"
|
||||
sMsgTotalLoss = "您想要输入总亏损值？"
|
||||
sMsgAuthorization = "安全查询"
|
||||
sMsgDeleteAll = "您要删除所有的交易信息并重新建立股票帐号一览表吗？"
|
||||
cSplit = "股票拆股日期 "
|
||||
sHistory = "记录"
|
||||
TransactTitle(1) = "出售股票"
|
||||
TransactTitle(2) = "购买股票"
|
||||
StockRatesTitle(1) = "支付红利"
|
||||
StockRatesTitle(2) = "股票拆股"
|
||||
StockRatesTitle(3) = sHistory
|
||||
sDepotCurrency = "股票交易的货币"
|
||||
sStockName = "股票名称"
|
||||
TransactMode = LIFO ' Possible values: "FIFO" and "LIFO"
|
||||
DateCellStyle = "结果 日期"
|
||||
CurrCellStyle = "1"
|
||||
sStartDate = "起始日期："
|
||||
sEndDate = "终止日期："
|
||||
sStartUpWelcome = "这个样式能够帮助您有效地管理自己的股票帐号"
|
||||
sStartUpChooseMarket = "请首先选择采用的参考货币以及要直接用国际互联网来更新资料的证券交易所！"
|
||||
sStartUpHint = "很遗憾，<History>功能仅可供美国市场使用！"
|
||||
sStartupHint = ReplaceString(sStartUpHint, sHistory, "<History>")
|
||||
sNoInternetUpdate = "不通过国际互联网更新"
|
||||
sMarketPlace = "交易所："
|
||||
sNoInternetDataAvailable = "无法获得国际互联网上的行情！"
|
||||
sCheckInternetSettings = "可能的原因是：<BR>您的国际互联网设定不正确，需要重新设定。<BR>输入了一个错误的股票号码。"
|
||||
sCheckInternetSettings = ReplaceString(sCheckInternetSettings, chr(13), "<BR>")
|
||||
|
||||
sMsgEndDatebeforeNow = "终止日期必须在今天之前！"
|
||||
sMsgStartDatebeforeEndDate = "起始日期必须在终止日期之前！"
|
||||
|
||||
sMarket(0,0) = "美元"
|
||||
sMarket(0,1) = "$"
|
||||
sMarket(0,2) = "纽约"
|
||||
sMarket(0,3) = "http://finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(0,4) = "http://ichart.finance.yahoo.com/table.csv?" &_
|
||||
"s=<StockID>&d=<EndMonth>&e=<EndDay>&f=<Endyear>&g=d&" &_
|
||||
"a=<StartMonth>&b=<StartDay>&c=<Startyear>&ignore=.csv"
|
||||
sMarket(0,5) = "图标"
|
||||
sMarket(0,6) = "en"
|
||||
sMarket(0,7) = "US"
|
||||
sMarket(0,8) = "409"
|
||||
sMarket(0,9) = "44"
|
||||
sMarket(0,10) = "1"
|
||||
|
||||
sMarket(1,0) = "欧元"
|
||||
sMarket(1,1) = chr(8364)
|
||||
sMarket(1,2) = "法兰克福"
|
||||
sMarket(1,3) = "http://de.finance.yahoo.com/d/quotes.csv?s=<StockID>.F&f=sl1t1c1ghpv&e=.csv"
|
||||
sMarket(1,5) = "代码"
|
||||
sMarket(1,6) = "de;nl;pt;el"
|
||||
sMarket(1,7) = "DE;NL;PT;GR"
|
||||
sMarket(1,8) = "407;413;816;408"
|
||||
sMarket(1,9) = "59/9"
|
||||
sMarket(1,10) = "1"
|
||||
|
||||
sMarket(2,0) = "英镑"
|
||||
sMarket(2,1) = "£"
|
||||
sMarket(2,2) = "伦敦"
|
||||
sMarket(2,3) = "http://uk.finance.yahoo.com/d/quotes.csv?s=<StockID>.L&m=*&f=sl1t1c1ghov&e=.csv"
|
||||
sMarket(2,5) = "股票代码"
|
||||
sMarket(2,6) = "en"
|
||||
sMarket(2,7) = "GB"
|
||||
sMarket(2,8) = "809"
|
||||
sMarket(2,9) = "44"
|
||||
sMarket(2,10) = "1"
|
||||
|
||||
sMarket(3,0) = "日元"
|
||||
sMarket(3,1) = "¥"
|
||||
sMarket(3,2) = "东京"
|
||||
sMarket(3,3) = ""
|
||||
sMarket(3,5) = "代码"
|
||||
sMarket(3,6) = "ja"
|
||||
sMarket(3,7) = "JP"
|
||||
sMarket(3,8) = "411"
|
||||
sMarket(3,9) = ""
|
||||
sMarket(3,10) = ""
|
||||
|
||||
sMarket(4,0) = "港币"
|
||||
sMarket(4,1) = "HK$"
|
||||
sMarket(4,2) = "香港"
|
||||
sMarket(4,3) = "http://hk.finance.yahoo.com/d/quotes.csv?s=<StockID>.HK&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(4,5) = "编号"
|
||||
sMarket(4,6) = "zh"
|
||||
sMarket(4,7) = "HK"
|
||||
sMarket(4,8) = "C04"
|
||||
sMarket(4,9) = "44"
|
||||
sMarket(4,10) = "1"
|
||||
|
||||
sMarket(5,0) = "澳元"
|
||||
sMarket(5,1) = "$"
|
||||
sMarket(5,2) = "悉尼"
|
||||
sMarket(5,3) = "http://au.finance.yahoo.com/d/quotes.csv?s=<StockID>&f=sl1d1t1c1ohgv&e=.csv"
|
||||
sMarket(5,5) = "股票代码"
|
||||
sMarket(5,6) = "en"
|
||||
sMarket(5,7) = "AU"
|
||||
sMarket(5,8) = "C09"
|
||||
sMarket(5,9) = "44"
|
||||
sMarket(5,10) = "1"
|
||||
|
||||
' ****************************End of the default subset*********************************
|
||||
CompleteMarketList()
|
||||
|
||||
LocalizedCurrencies()
|
||||
|
||||
With TransactModel
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblQuantity.Label = "数量"
|
||||
.lblRate.Label = "股票牌价"
|
||||
.lblDate.Label = "交易日期"
|
||||
.hlnCommission.Label = "其它支出费用"
|
||||
.lblCommission.Label = "手续费"
|
||||
.lblMinimum.Label = "最低手续费"
|
||||
.lblFix.Label = "固定金额/费用"
|
||||
.cmdGoOn.Label = sOK
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
|
||||
With StockRatesModel
|
||||
.optPerShare.Label = "每股红利"
|
||||
.optTotal.Label = "红利总计"
|
||||
.lblDividend.Label = "金额"
|
||||
.lblExchangeRate.Label = "兑换率(旧->新)"
|
||||
.lblColon.Label = ":"
|
||||
.lblDate.Label = "兑换日期:"
|
||||
.lblStockNames.Label = sStockname
|
||||
.lblStartDate.Label = sStartDate
|
||||
.lblEndDate.Label = sEndDate
|
||||
.optDaily.Label = "每天"
|
||||
.optWeekly.Label = "每周"
|
||||
.hlnInterval.Label = "时间周期"
|
||||
.cmdGoOn.Label = sOk
|
||||
.cmdCancel.Label = sCancel
|
||||
End With
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,7 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Depot" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="Dialog2"/>
|
||||
<library:element library:name="Dialog3"/>
|
||||
<library:element library:name="Dialog4"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,19 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Depot" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="Depot"/>
|
||||
<library:element library:name="CommonLang"/>
|
||||
<library:element library:name="Currency"/>
|
||||
<library:element library:name="Internet"/>
|
||||
<library:element library:name="Lang_de"/>
|
||||
<library:element library:name="tools"/>
|
||||
<library:element library:name="Lang_en"/>
|
||||
<library:element library:name="Lang_fr"/>
|
||||
<library:element library:name="Lang_it"/>
|
||||
<library:element library:name="Lang_es"/>
|
||||
<library:element library:name="Lang_sv"/>
|
||||
<library:element library:name="Lang_zh"/>
|
||||
<library:element library:name="Lang_tw"/>
|
||||
<library:element library:name="Lang_ko"/>
|
||||
<library:element library:name="Lang_ja"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,217 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
Sub RemoveSheet()
|
||||
If oSheets.HasbyName("Link") then
|
||||
oSheets.RemovebyName("Link")
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeStatusLine(StatusText as String, MaxValue as Integer, FirstValue as Integer)
|
||||
oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
|
||||
oStatusLine.Start(StatusText, MaxValue)
|
||||
oStatusline.SetValue(FirstValue)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MakeRangeVisible(oSheet as Object, RangeName as String, BIsVisible as Boolean)
|
||||
Dim oRangeAddress, oColumns as Object
|
||||
Dim i, iStartColumn, iEndColumn as Integer
|
||||
oRangeAddress = oSheet.GetCellRangeByName(RangeName).RangeAddress
|
||||
iStartColumn = oRangeAddress.StartColumn
|
||||
iEndColumn = oRangeAddress.EndColumn
|
||||
oColumns = oSheet.Columns
|
||||
For i = iStartColumn To iEndColumn
|
||||
oSheet.Columns(i).IsVisible = bIsVisible
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetRowIndex(oSheet as Object, RowName as String)
|
||||
Dim oRange as Object
|
||||
oRange = oSheet.GetCellRangeByName(RowName)
|
||||
GetRowIndex = oRange.RangeAddress.StartRow
|
||||
End Function
|
||||
|
||||
|
||||
Function GetTransactionCount(iStartRow as Integer)
|
||||
Dim iEndRow as Integer
|
||||
iStartRow = GetRowIndex(oMovementSheet, "ColumnsToHide")
|
||||
iEndRow = GetRowIndex(oMovementSheet, "HiddenRow3" )
|
||||
GetTransactionCount = iEndRow -iStartRow - 2
|
||||
End Function
|
||||
|
||||
|
||||
Function GetStocksCount(iStartRow as Integer)
|
||||
Dim iEndRow as Integer
|
||||
iStartRow = GetRowIndex(oFirstSheet, "HiddenRow1")
|
||||
iEndRow = GetRowIndex(oFirstSheet, "HiddenRow2")
|
||||
GetStocksCount = iEndRow -iStartRow - 1
|
||||
End Function
|
||||
|
||||
|
||||
Function FillListbox(ListboxControl as Object, MsgTitle as String, bShowMessage) as Boolean
|
||||
Dim i, StocksCount as Integer
|
||||
Dim iStartRow as Integer
|
||||
Dim oCell as Object
|
||||
' Add stock names to empty list box
|
||||
StocksCount = GetStocksCount(iStartRow)
|
||||
If StocksCount > 0 Then
|
||||
ListboxControl.Model.StringItemList() = NullList()
|
||||
For i = 1 To StocksCount
|
||||
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
|
||||
ListboxControl.AddItem(oCell.String, i-1)
|
||||
Next
|
||||
FillListbox() = True
|
||||
Else
|
||||
If bShowMessage Then
|
||||
Msgbox(sInsertStockName, 16, MsgTitle)
|
||||
FillListbox() = False
|
||||
End If
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub CellValuetoControl(oSheet, oControl as Object, CellName as String)
|
||||
Dim oCell as Object
|
||||
Dim StringValue
|
||||
oCell = GetCellByName(oSheet, CellName)
|
||||
If oControl.PropertySetInfo.HasPropertyByName("EffectiveValue") Then
|
||||
oControl.EffectiveValue = oCell.Value
|
||||
Else
|
||||
oControl.Value = oCell.Value
|
||||
End If
|
||||
' If oCell.FormulaResultType = 1 Then
|
||||
' StringValue = oNumberFormatter.GetInputString(oCell.NumberFormat, oCell.Value)
|
||||
' oControl.Text = DeleteStr(StringValue, "%")
|
||||
' Else
|
||||
' oControl.Text = oCell.String
|
||||
' End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RemoveStockRows(oSheet as Object, iStartRow, RowCount as Integer)
|
||||
If RowCount > 0 Then
|
||||
oSheet.Rows.RemoveByIndex(iStartRow, RowCount)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddValueToCellContent(iCellCol, iCellRow as Integer, AddValue)
|
||||
Dim oCell as Object
|
||||
Dim OldValue
|
||||
oCell = oMovementSheet.GetCellByPosition(iCellCol, iCellRow)
|
||||
OldValue = oCell.Value
|
||||
oCell.Value = OldValue + AddValue
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckInputDate(aEvent as Object)
|
||||
Dim oRefDialog as Object
|
||||
Dim oRefModel as Object
|
||||
Dim oDateModel as Object
|
||||
oDateModel = aEvent.Source.Model
|
||||
oRefModel = DlgReference.GetControl("cmdGoOn").Model
|
||||
oRefModel.Enabled = oDateModel.Date <> 0
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' Updates the cell with the CurrentValue after checking if the
|
||||
' Newdate is later than the one that is referred to in the annotation
|
||||
' of the cell
|
||||
Sub InsertCurrentValue(CurValue as Double, iRow as Integer, Newdate as Date)
|
||||
Dim oCell as Object
|
||||
Dim OldDate as Date
|
||||
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1, iRow)
|
||||
OldDate = CDate(oCell.Annotation.Text.String)
|
||||
If NewDate >= OldDate Then
|
||||
oCell.SetValue(CurValue)
|
||||
oCell.Annotation.Text.SetString(CStr(NewDate))
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SplitCellValue(oSheet, FirstNumber, SecondNumber, iCol, iRow, NoteText)
|
||||
Dim oCell as Object
|
||||
Dim OldValue
|
||||
oCell = oSheet.GetCellByPosition(iCol, iRow)
|
||||
OldValue = oCell.Value
|
||||
oCell.Value = OldValue * FirstNumber / SecondNumber
|
||||
If NoteText <> "" Then
|
||||
oCell.Annotation.SetString(NoteText)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetStockRowIndex(ByVal Stockname) as Integer
|
||||
Dim i, StocksCount as Integer
|
||||
Dim iStartRow as Integer
|
||||
Dim oCell as Object
|
||||
StocksCount = GetStocksCount(iStartRow)
|
||||
For i = 1 To StocksCount
|
||||
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
|
||||
If oCell.String = Stockname Then
|
||||
GetStockRowIndex = iStartRow + i
|
||||
Exit Function
|
||||
End If
|
||||
Next
|
||||
GetStockRowIndex = -1
|
||||
End Function
|
||||
|
||||
|
||||
Function GetStockID(StockName as String, Optional iFirstRow as Integer) as String
|
||||
Dim CellStockName as String
|
||||
Dim i as Integer
|
||||
Dim iCount as Integer
|
||||
Dim iLastRow as Integer
|
||||
If IsMissing(iFirstRow) Then
|
||||
iFirstRow = GetRowIndex(oFirstSheet, "HiddenRow1")
|
||||
End If
|
||||
iCount = GetStocksCount(iFirstRow)
|
||||
iLastRow = iFirstRow + iCount
|
||||
For i = iFirstRow To iLastRow
|
||||
CellStockName = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, i).String
|
||||
If CellStockname = StockName Then
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If i > iLastRow Then
|
||||
GetStockID() = ""
|
||||
Else
|
||||
If Not IsMissing(iFirstRow) Then
|
||||
iFirstRow = i
|
||||
End If
|
||||
GetStockID() = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckDocLocale(LocLanguage as String, LocCountry as String)
|
||||
Dim bIsDocLanguage as Boolean
|
||||
Dim bIsDocCountry as Boolean
|
||||
bIsDocLanguage = Instr(1, LocLanguage, sDocLanguage, SBBINARY) <> 0
|
||||
bIsDocCountry = Instr(1, LocCountry, sDocCountry, SBBINARY) <> 0 OR SDocCountry = ""
|
||||
CheckDocLocale = (bIsDocLanguage And bIsDocCountry)
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,415 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="AutoPilotRun" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public SourceDir as String
|
||||
Public TargetDir as String
|
||||
Public TargetStemDir as String
|
||||
Public SourceFile as String
|
||||
Public TargetFile as String
|
||||
Public Source as String
|
||||
Public SubstFile as String
|
||||
Public SubstDir as String
|
||||
Public NoArgs()
|
||||
Public TypeList(6) as String
|
||||
Public GoOn as Boolean
|
||||
Public DoUnprotect as Integer
|
||||
Public Password as String
|
||||
Public DocIndex as Integer
|
||||
Public oPathSettings as Object
|
||||
Public oUcb as Object
|
||||
Public TotDocCount as Integer
|
||||
Public sTotDocCount as String
|
||||
Public OpenProperties(1) as New com.sun.star.beans.PropertyValue
|
||||
|
||||
|
||||
Sub StartAutoPilot()
|
||||
Dim i As Integer
|
||||
Dim oFactoryKey as Object
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
BasicLibraries.LoadLibrary("ImportWizard")
|
||||
If InitResources("Euro Converter") Then
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
oLocale = GetStarOfficeLocale()
|
||||
InitializeConverter(oLocale, 2)
|
||||
ToggleGoOnButton()
|
||||
oFactoryKey = GetRegistryKeyContent("org.openoffice.Setup/Office/Factories")
|
||||
DialogModel.chkTextDocuments.Enabled = oFactoryKey.hasbyName("com.sun.star.text.TextDocument")
|
||||
DialogModel.cmdGoOn.DefaultButton = True
|
||||
DialogModel.lstCurrencies.TabIndex = 12
|
||||
DialogConvert.GetControl("optWholeDir").SetFocus()
|
||||
DialogConvert.Execute()
|
||||
DialogConvert.Dispose()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertDocuments()
|
||||
Dim FilesList()
|
||||
Dim bDisposable as Boolean
|
||||
|
||||
If Source <> "" And TargetDir <> "" Then
|
||||
If DialogModel.optSingleFile.State = 1 Then
|
||||
SourceFile = Source
|
||||
TotDocCount = 1
|
||||
Else
|
||||
SourceDir = Source
|
||||
TargetStemDir = TargetDir
|
||||
TypeList(0) = "calc8"
|
||||
TypeList(1) = "calc_StarOffice_XML_Calc"
|
||||
If DialogModel.chkTextDocuments.State = 1 Then
|
||||
ReDim Preserve TypeList(5) as String
|
||||
|
||||
TypeList(2) = "writer8"
|
||||
TypeList(3) = "writerglobal8"
|
||||
TypeList(4) = "writer_StarOffice_XML_Writer"
|
||||
TypeList(5) = "writer_globaldocument_StarOffice_XML_Writer_GlobalDocument"
|
||||
End If
|
||||
FilesList() = ReadDirectories(SourceDir, bRecursive, True, False, TypeList())
|
||||
TotDocCount = Ubound(FilesList(),1) + 1
|
||||
End If
|
||||
InitializeProgressPage(DialogModel)
|
||||
' ChangeToNextProgressStep()
|
||||
sTotDocCount = CStr(TotDocCount)
|
||||
OpenProperties(0).Name = "Hidden"
|
||||
OpenProperties(0).Value = True
|
||||
OpenProperties(1).Name = "AsTemplate"
|
||||
OpenProperties(1).Value = False
|
||||
For DocIndex = 0 To TotDocCount - 1
|
||||
If InitializeDocument(FilesList(), bDisposable) Then
|
||||
If StoreDocument() Then
|
||||
ConvertDocument()
|
||||
oDocument.Store
|
||||
End If
|
||||
If bDisposable Then
|
||||
oDocument.Dispose()
|
||||
End If
|
||||
End If
|
||||
Next DocIndex
|
||||
DialogModel.cmdBack.Enabled = True
|
||||
DialogModel.cmdGoOn.Enabled = True
|
||||
DialogModel.cmdGoOn.Label = sReady
|
||||
DialogModel.cmdCancel.Label = sEnd
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function InitializeDocument(FilesList(), bDisposable as Boolean) as Boolean
|
||||
' The Autopilot is started from step No. 2
|
||||
Dim sViewPath as String
|
||||
Dim bIsReadOnly as Boolean
|
||||
Dim sExtension as String
|
||||
On Local Error Goto NEXTFILE
|
||||
If Not bCancelTask Then
|
||||
If DialogModel.optWholeDir.State = 1 Then
|
||||
SourceFile = FilesList(DocIndex,0)
|
||||
TargetFile = ReplaceString(SourceFile,TargetStemDir,SourceDir)
|
||||
TargetDir = DirectorynameoutofPath(TargetFile, "/")
|
||||
Else
|
||||
SourceFile = Source
|
||||
TargetFile = TargetDir & "/" & FileNameoutofPath(SourceFile, "/")
|
||||
End If
|
||||
If CreateFolder(TargetDir) Then
|
||||
sExtension = GetFileNameExtension(SourceFile, "/")
|
||||
oDocument = OpenDocument(SourceFile, OpenProperties(), bDisposable)
|
||||
If (oDocument.IsReadOnly) AND (UCase(SourceFile) = UCase(TargetFile)) Then
|
||||
bIsReadOnly = True
|
||||
Msgbox(sMsgDOCISREADONLY, 16, GetProductName())
|
||||
Else
|
||||
bIsReadOnly = False
|
||||
RetrieveDocumentObjects()
|
||||
sViewPath = CutPathView(SourceFile, 60)
|
||||
DialogModel.lblCurDocument.Label = Str(DocIndex+1) & "/" & sTotDocCount & " (" & sViewPath & ")"
|
||||
End If
|
||||
InitializeDocument() = Not bIsReadOnly
|
||||
Else
|
||||
InitializeDocument() = False
|
||||
End If
|
||||
Else
|
||||
InitializeDocument() = False
|
||||
End If
|
||||
NEXTFILE:
|
||||
If Err <> 0 Then
|
||||
InitializeDocument() = False
|
||||
Resume LETSGO
|
||||
LETSGO:
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub ChangeToNextProgressStep()
|
||||
DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.NORMAL
|
||||
DialogConvert.GetControl("lblCurProgress").Visible = True
|
||||
End Sub
|
||||
|
||||
|
||||
Function StoreDocument() as Boolean
|
||||
Dim sCurFileExists as String
|
||||
Dim iOverWrite as Integer
|
||||
If (TargetFile <> "") And (Not bCancelTask) Then
|
||||
On Local Error Goto NOSAVING
|
||||
If oUcb.Exists(TargetFile) Then
|
||||
sCurFileExists = ReplaceString(sMsgFileExists, ConvertFromUrl(TargetFile), "<1>")
|
||||
sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>")
|
||||
iOverWrite = Msgbox (sCurFileExists, 32 + 3, sMsgDLGTITLE)
|
||||
Select Case iOverWrite
|
||||
Case 1 ' OK
|
||||
Case 2 ' Abort
|
||||
bCancelTask = True
|
||||
StoreDocument() = False
|
||||
Exit Function
|
||||
Case 7 ' No
|
||||
StoreDocument() = False
|
||||
Exit Function
|
||||
End Select
|
||||
End If
|
||||
If TargetFile <> SourceFile Then
|
||||
oDocument.StoreAsUrl(TargetFile,NoArgs)
|
||||
Else
|
||||
oDocument.Store
|
||||
End If
|
||||
StoreDocument() = True
|
||||
NOSAVING:
|
||||
If Err <> 0 Then
|
||||
StoreDocument() = False
|
||||
Resume CLERROR
|
||||
End If
|
||||
CLERROR:
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub SwapExtent()
|
||||
DialogModel.chkRecursive.Enabled = DialogModel.optWholeDir.State = 1
|
||||
If DialogModel.optWholeDir.State = 1 Then
|
||||
DialogModel.lblSource.Label = sSOURCEDIR
|
||||
If Not IsNull(SubstFile) Then
|
||||
SubstFile = DialogModel.txtSource.Text
|
||||
DialogModel.txtSource.Text = SubstDir
|
||||
End If
|
||||
Else
|
||||
DialogModel.LblSource.Label = sSOURCEFILE
|
||||
If Not IsNull(SubstDir) Then
|
||||
SubstDir = DialogModel.txtSource.Text
|
||||
DialogModel.txtSource.Text = SubstFile
|
||||
End If
|
||||
End If
|
||||
ToggleGoOnButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Function InitializeThirdStep() as Boolean
|
||||
Dim TextBoxText as String
|
||||
Source = AssignFileName(DialogModel.txtSource.Text, DialogModel.lblSource.Label, True)
|
||||
If CheckTextBoxPath(DialogModel.txtTarget, True, True, sMsgDLGTITLE, True) Then
|
||||
TargetDir = AssignFileName(DialogModel.txtTarget.Text, DialogModel.lblTarget.Label, False)
|
||||
Else
|
||||
TargetDir = ""
|
||||
End If
|
||||
If Source <> "" And TargetDir <> "" Then
|
||||
bRecursive = DialogModel.chkRecursive.State = 1
|
||||
bDoUnprotect = DialogModel.chkProtect.State = 1
|
||||
DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
DialogModel.lblRetrieval.Label = sPrgsRETRIEVAL
|
||||
DialogModel.lblCurProgress.Label = sPrgsCONVERTING
|
||||
If DialogModel.optWholeDir.State = 1 Then
|
||||
TextBoxText = sSOURCEDIR & " " & ConvertFromUrl(Source) & chr(13)
|
||||
If DialogModel.chkRecursive.State = 1 Then
|
||||
TextBoxText = TextBoxText & DeleteStr(sInclusiveSubDir,"~") & chr(13)
|
||||
End If
|
||||
Else
|
||||
TextBoxText = sSOURCEFILE & " " & ConvertFromUrl(Source) & chr(13)
|
||||
End If
|
||||
TextBoxText = TextBoxText & sTARGETDIR & " " & ConvertFromUrl(TargetDir) & chr(13)
|
||||
If DialogModel.chkProtect.State = 1 Then
|
||||
TextBoxText = TextboxText & sPrgsUNPROTECT
|
||||
End If
|
||||
DialogModel.txtConfig.Text = TextBoxText
|
||||
ToggleProgressStep()
|
||||
DialogModel.cmdGoOn.Enabled = False
|
||||
InitializeThirdStep() = True
|
||||
Else
|
||||
InitializeThirdStep() = False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub ToggleProgressStep(Optional aEvent as Object)
|
||||
Dim bMakeVisible as Boolean
|
||||
Dim LocStep as Integer
|
||||
' If the Sub is call by the 'cmdBack' Button then set the 'bMakeVisible' variable accordingly
|
||||
bMakeVisible = IsMissing(aEvent)
|
||||
If bMakeVisible Then
|
||||
DialogModel.Step = 3
|
||||
Else
|
||||
DialogModel.Step = 2
|
||||
End If
|
||||
DialogConvert.GetControl("lblCurrencies").Visible = Not bMakeVisible
|
||||
DialogConvert.GetControl("lstCurrencies").Visible = Not bMakeVisible
|
||||
DialogConvert.GetControl("cmdBack").Visible = bMakeVisible
|
||||
DialogConvert.GetControl("cmdGoOn").Visible = bMakeVisible
|
||||
DialogModel.imgPreview.ImageUrl = BitmapDir & "euro_" & DialogModel.Step & ".png"
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EnableStep2DialogControls(OnValue as Boolean)
|
||||
With DialogModel
|
||||
.hlnExtent.Enabled = OnValue
|
||||
.optWholeDir.Enabled = OnValue
|
||||
.optSingleFile.Enabled = OnValue
|
||||
.chkProtect.Enabled = OnValue
|
||||
.cmdCallSourceDialog.Enabled = OnValue
|
||||
.cmdCallTargetDialog.Enabled = OnValue
|
||||
.lblSource.Enabled = OnValue
|
||||
.lblTarget.Enabled = OnValue
|
||||
.txtSource.Enabled = OnValue
|
||||
.txtTarget.Enabled = OnValue
|
||||
.imgPreview.Enabled = OnValue
|
||||
.lstCurrencies.Enabled = OnValue
|
||||
.lblCurrencies.Enabled = OnValue
|
||||
If OnValue Then
|
||||
ToggleGoOnButton()
|
||||
.chkRecursive.Enabled = .optWholeDir.State = 1
|
||||
Else
|
||||
.cmdGoOn.Enabled = False
|
||||
.chkRecursive.Enabled = False
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeProgressPage()
|
||||
DialogConvert.GetControl("lblRetrieval").Visible = False
|
||||
DialogConvert.GetControl("lblCurProgress").Visible = False
|
||||
DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.NORMAL
|
||||
DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
DialogConvert.GetControl("lblRetrieval").Visible = True
|
||||
DialogConvert.GetControl("lblCurProgress").Visible = True
|
||||
End Sub
|
||||
|
||||
|
||||
Function AssignFileName(sPath as String, ByVal HeaderString, bCheckFileType as Boolean) as String
|
||||
Dim bIsValid as Boolean
|
||||
Dim sLocMimeType as String
|
||||
Dim sNoDirMessage as String
|
||||
HeaderString = DeleteStr(HeaderString, ":")
|
||||
sPath = ConvertToUrl(Trim(sPath))
|
||||
bIsValid = oUcb.Exists(sPath)
|
||||
If bIsValid Then
|
||||
If DialogModel.optSingleFile.State = 1 Then
|
||||
If bCheckFileType Then
|
||||
sLocMimeType = GetRealFileContent(sPath)
|
||||
If DialogModel.chkTextDocuments.State = 1 Then
|
||||
If (Instr(1, sLocMimeType, "text") = 0) And (Instr(1, sLocMimeType, "calc") = 0) Then
|
||||
Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE)
|
||||
bIsValid = False
|
||||
End If
|
||||
Else
|
||||
If (Instr(1, sLocMimeType, "spreadsheet") = 0) And (Instr(1, sLocMimeType, "calc")) = 0 Then
|
||||
Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE)
|
||||
bIsValid = False
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If Not oUcb.IsFolder(sPath) Then
|
||||
sNoDirMessage = ReplaceString(sMsgNODIRECTORY,sPath,"<1>")
|
||||
Msgbox(sNoDirMessage,48, sMsgDLGTITLE)
|
||||
bIsValid = False
|
||||
Else
|
||||
sPath = RTrimStr(sPath,"/")
|
||||
sPath = sPath & "/"
|
||||
End If
|
||||
End if
|
||||
Else
|
||||
Msgbox(HeaderString & " '" & ConvertFromUrl(sPath) & "' " & sMsgNOTTHERE,48, sMsgDLGTITLE)
|
||||
End If
|
||||
If bIsValid Then
|
||||
AssignFileName() = sPath
|
||||
Else
|
||||
AssignFilename() = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub ToggleGoOnButton()
|
||||
Dim bDoEnable as Boolean
|
||||
Dim sLocMimeType as String
|
||||
Dim sPath as String
|
||||
bDoEnable = Ubound(DialogModel.lstCurrencies.SelectedItems()) > -1
|
||||
If bDoEnable Then
|
||||
' Check if Source is set correctly
|
||||
sPath = ConvertToUrl(Trim(DialogModel.txtSource.Text))
|
||||
bDoEnable = oUcb.Exists(sPath)
|
||||
End If
|
||||
DialogModel.cmdGoOn.Enabled = bDoEnable
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CallFolderPicker()
|
||||
GetFolderName(DialogModel.txtTarget)
|
||||
ToggleGoOnButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CallFilePicker()
|
||||
If DialogModel.optSingleFile.State = 1 Then
|
||||
Dim oMasterKey as Object
|
||||
Dim oTypes() as Object
|
||||
Dim oUIKey() as Object
|
||||
|
||||
oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types")
|
||||
oTypes() = oMasterKey.Types
|
||||
oUIKey = GetRegistryKeyContent("org.openoffice.Office.UI/FilterClassification/LocalFilters")
|
||||
If DialogModel.chkTextDocuments.State = 1 Then
|
||||
Dim FilterNames(7,1) as String
|
||||
FilterNames(4,0) = oTypes.GetByName("writer_StarOffice_XML_Writer").UIName
|
||||
FilterNames(4,1) = "*.sxw"
|
||||
FilterNames(5,0) = oTypes.GetByName("writer_StarOffice_XML_Writer_Template").UIName
|
||||
FilterNames(5,1) = "*.stw"
|
||||
FilterNames(6,0) = oTypes.GetByName("writer8").UIName
|
||||
FilterNames(6,1) = "*.odt"
|
||||
FilterNames(7,0) = oTypes.GetByName("writer8_template").UIName
|
||||
FilterNames(7,1) = "*.ott"
|
||||
Else
|
||||
ReDim FilterNames(3,1) as String
|
||||
End If
|
||||
FilterNames(0,0) = oTypes.GetByName("calc8").UIName
|
||||
Filternames(0,1) = "*.ods"
|
||||
FilterNames(1,0) = oTypes.GetByName("calc8_template").UIName
|
||||
Filternames(1,1) = "*.ots"
|
||||
FilterNames(2,0) = oTypes.GetByName("calc_StarOffice_XML_Calc").UIName
|
||||
Filternames(2,1) = "*.sxc"
|
||||
FilterNames(3,0) = oTypes.GetByName("calc_StarOffice_XML_Calc_Template").UIName
|
||||
Filternames(3,1) = "*.stc"
|
||||
GetFileName(DialogModel.txtSource, Filternames())
|
||||
Else
|
||||
GetFolderName(DialogModel.txtSource)
|
||||
End If
|
||||
ToggleGoOnButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub PreviousStep()
|
||||
DialogModel.Step = 2
|
||||
DialogModel.cmdGoOn.Label = sGOON
|
||||
DialogModel.cmdCancel.Label = sCANCEL
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,289 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Common" script:language="StarBasic"> REM ***** BASIC *****
|
||||
Public DialogModel as Object
|
||||
Public DialogConvert as Object
|
||||
Public DialogPassword as Object
|
||||
Public PasswordModel as Object
|
||||
|
||||
Sub RetrieveDocumentObjects()
|
||||
CurMimeType = Tools.GetDocumentType(oDocument)
|
||||
If Instr(1, CurMimeType, "calc") <> 0 Then
|
||||
oSheets = oDocument.Sheets
|
||||
oSheet = oDocument.Sheets.GetbyIndex(0)
|
||||
oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
End If
|
||||
' Retrieve the indices for the cellformatations
|
||||
oFormats = oDocument.NumberFormats
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CancelTask()
|
||||
' If Not DocDisposed Then
|
||||
' ReprotectSheets()
|
||||
' End If
|
||||
If DialogModel.Step = 3 And (Not bCancelTask) Then
|
||||
If Msgbox(sMsgCancelConversion, 36, sMsgCancelTitle) = 6 Then
|
||||
bCancelTask = True
|
||||
DialogConvert.EndExecute
|
||||
Else
|
||||
bCancelTask = False
|
||||
End If
|
||||
Else
|
||||
DialogConvert.EndExecute()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function ConvertDocument()
|
||||
GoOn = True
|
||||
' DocDisposed = True
|
||||
InitializeProgressbar()
|
||||
If Instr(1, CurMimeType, "calc") <> 0 Then
|
||||
bDocHasProtectedSheets = CheckSheetProtection(oSheets)
|
||||
If bDocHasProtectedSheets Then
|
||||
bDocHasProtectedSheets = UnprotectSheetsWithPassword(oSheets, bDoUnProtect)
|
||||
End If
|
||||
If Not bDocHasProtectedSheets Then
|
||||
If Not bRangeListDefined Then
|
||||
TotCellCount = 0
|
||||
CreateRangeEnumeration(True)
|
||||
Else
|
||||
IncreaseStatusvalue(SBRelGet/3)
|
||||
End If
|
||||
RangeIndex = Ubound(RangeList())
|
||||
If RangeIndex > -1 Then
|
||||
ConvertThehardWay(RangeList(), True, False)
|
||||
MakeStyleEnumeration(True)
|
||||
oDocument.calculateAll()
|
||||
End If
|
||||
ReprotectSheets()
|
||||
bRangeListDefined = False
|
||||
End If
|
||||
Else
|
||||
DialogModel.ProgressBar.ProgressValue = 10 ' oStatusline.SetValue(10)
|
||||
ConvertTextFields()
|
||||
DialogModel.ProgressBar.ProgressValue = 80 ' oStatusline.SetValue(80)
|
||||
ConvertWriterTables()
|
||||
End If
|
||||
EndStatusLine()
|
||||
On Local Error Goto 0
|
||||
End Function
|
||||
|
||||
|
||||
Sub SwitchNumberFormat(oObject as Object, oFormats as object)
|
||||
Dim nFormatLanguage as Integer
|
||||
Dim nFormatDecimals as Integer
|
||||
Dim nFormatLeading as Integer
|
||||
Dim bFormatLeading as Integer
|
||||
Dim bFormatNegRed as Integer
|
||||
Dim bFormatThousands as Integer
|
||||
Dim i as Integer
|
||||
Dim aNewStr as String
|
||||
Dim iNumberFormat as Long
|
||||
Dim AddToList as Boolean
|
||||
Dim sOldCurrSymbol as String
|
||||
On Local Error Resume Next
|
||||
iNumberFormat = oObject.NumberFormat
|
||||
On Local Error GoTo NOKEY
|
||||
aFormat() = oFormats.getByKey(iNumberFormat)
|
||||
On Local Error GoTo 0
|
||||
sOldCurrSymbol = aFormat.CurrencySymbol
|
||||
If sOldCurrSymbol = CurrValue(CurrIndex,5) Then
|
||||
aSimpleStr = "0 [$EUR]"
|
||||
Else
|
||||
aSimpleStr = "0 [$" & sEuroSign & aFormat.CurrencyExtension & "]"
|
||||
End If
|
||||
|
||||
nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale)
|
||||
' set new Currency format with according settings
|
||||
nFormatDecimals = 2
|
||||
nFormatLeading = aFormat.LeadingZeros
|
||||
bFormatNegRed = aFormat.NegativeRed
|
||||
bFormatThousands = aFormat.ThousandsSeparator
|
||||
aNewStr = oFormats.generateFormat( nSimpleKey, aFormat.Locale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
|
||||
oObject.NumberFormat = Numberformat(oFormats, aNewStr, aFormat.Locale)
|
||||
NOKEY:
|
||||
If Err <> 0 Then
|
||||
Resume CLERROR
|
||||
End If
|
||||
CLERROR:
|
||||
End Sub
|
||||
|
||||
|
||||
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Object)
|
||||
Dim nRetkey
|
||||
Dim l as String
|
||||
Dim c as String
|
||||
nRetKey = oFormats.queryKey( aFormatStr, oLocale, True )
|
||||
If nRetKey = -1 Then
|
||||
l = oLocale.Language
|
||||
c = oLocale.Country
|
||||
nRetKey = oFormats.addNew( aFormatStr, oLocale )
|
||||
If nRetKey = -1 Then nRetKey = 0
|
||||
End If
|
||||
Numberformat = nRetKey
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckFormatType( FormatObject as object)
|
||||
Dim i as Integer
|
||||
Dim LocCurrIndex as Integer
|
||||
Dim nFormatFormatString as String
|
||||
Dim FormatLangID as Integer
|
||||
Dim sFormatCurrExt as String
|
||||
Dim oFormatofObject() as Object
|
||||
|
||||
' Retrieve the Format of the Object
|
||||
On Local Error GoTo NOKEY
|
||||
oFormatofObject = oFormats.getByKey(FormatObject.NumberFormat)
|
||||
On Local Error GoTo 0
|
||||
If NOT INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Then
|
||||
CheckFormatType = False
|
||||
Exit Function
|
||||
End If
|
||||
If FieldInArray(CurrSymbolList(),2,oFormatofObject.CurrencySymbol) Then
|
||||
' If the Currencysymbol of the object is the one needed, then check the Currency extension
|
||||
sFormatCurrExt = oFormatofObject.CurrencyExtension
|
||||
|
||||
If FieldInList(CurExtension(),2,sFormatCurrExt) Then
|
||||
' The Currency - extension also fits
|
||||
CheckFormatType = True
|
||||
Else
|
||||
' The Currency - symbol is Euro-conforming (like 'DEM'), so there is no Currency-Extension
|
||||
CheckFormatType = oFormatofObject.CurrencySymbol = CurrsymbolList(2)
|
||||
End If
|
||||
Else
|
||||
' The Currency Symbol of the object is not the desired one
|
||||
If oFormatofObject.CurrencySymbol = "" Then
|
||||
' Format is "automatic"
|
||||
CheckFormatType = CheckLocale(oFormatofObject.Locale)
|
||||
Else
|
||||
CheckFormatType = False
|
||||
End If
|
||||
End If
|
||||
|
||||
NOKEY:
|
||||
If Err <> 0 Then
|
||||
CheckFormatType = False
|
||||
Resume CLERROR
|
||||
End If
|
||||
CLERROR:
|
||||
End Function
|
||||
|
||||
|
||||
Sub StartConversion()
|
||||
GoOn = True
|
||||
Select Case DialogModel.Step
|
||||
Case 1
|
||||
If DialogModel.chkComplete.State = 1 Then
|
||||
ConvertWholeDocument()
|
||||
Else
|
||||
ConvertRangesorStylesofDocument()
|
||||
End If
|
||||
Case 2
|
||||
bCancelTask = False
|
||||
If InitializeThirdStep() Then
|
||||
ConvertDocuments()
|
||||
bCancelTask = True
|
||||
End If
|
||||
Case 3
|
||||
DialogConvert.EndExecute()
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Sub IncreaseStatusValue(AddStatusValue as Integer)
|
||||
StatusValue = Int(StatusValue + AddStatusValue)
|
||||
If DialogModel.Step = 3 Then
|
||||
DialogModel.ProgressBar.ProgressValue = StatusValue
|
||||
Else
|
||||
oStatusline.SetValue(StatusValue)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectCurrency()
|
||||
Dim AddtoList as Boolean
|
||||
Dim NullList()
|
||||
Dim OldCurrIndex as Integer
|
||||
bRangeListDefined = False
|
||||
OldCurrIndex = CurrIndex
|
||||
CurrIndex = DialogModel.lstCurrencies.SelectedItems(0)
|
||||
If OldCurrIndex <> CurrIndex Then
|
||||
InitializeCurrencyValues(CurrIndex)
|
||||
CurExtension(0) = LangIDValue(CurrIndex,0,2)
|
||||
CurExtension(1) = LangIDValue(CurrIndex,1,2)
|
||||
CurExtension(2) = LangIDValue(CurrIndex,2,2)
|
||||
If DialogModel.Step = 1 Then
|
||||
EnableStep1DialogControls(False,False, False)
|
||||
If DialogModel.optCellTemplates.State = 1 Then
|
||||
EnableStep1DialogControls(False, False, False)
|
||||
CreateStyleEnumeration()
|
||||
ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then
|
||||
CreateRangeEnumeration(False)
|
||||
If Ubound(RangeList()) = -1 Then
|
||||
DialogModel.lstSelection.StringItemList() = NullList()
|
||||
End If
|
||||
ElseIf DialogModel.optSelRange.State= 1 Then
|
||||
'Preselected Range
|
||||
End If
|
||||
EnableStep1DialogControls(True, True, True)
|
||||
ElseIf DialogModel.Step = 2 Then
|
||||
EnableStep2DialogControls(True)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillUpCurrencyListbox()
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(CurrValue(),1)
|
||||
Dim LocList(MaxIndex) as String
|
||||
For i = 0 To MaxIndex
|
||||
LocList(i) = CurrValue(i,0)
|
||||
Next i
|
||||
DialogModel.lstCurrencies.StringItemList() = LocList()
|
||||
If CurrIndex > -1 Then
|
||||
SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeProgressbar()
|
||||
CurCellCount = 0
|
||||
If Not IsNull(oStatusLine) Then
|
||||
oStatusline.Start(sStsPROGRESS, 100)
|
||||
Else
|
||||
DialogModel.ProgressBar.ProgressValue = 0
|
||||
End If
|
||||
StatusValue = 0
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EndStatusLine()
|
||||
If Not IsNull(oStatusLine) Then
|
||||
oStatusline.End
|
||||
Else
|
||||
DialogModel.ProgressBar.ProgressValue = 100
|
||||
End If
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,334 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ConvertRun" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public oPreSelRange as Object
|
||||
|
||||
Sub Main()
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
If InitResources("Euro Converter") Then
|
||||
bDoUnProtect = False
|
||||
bPreSelected = True
|
||||
oDocument = ThisComponent
|
||||
RetrieveDocumentObjects() ' Statusline, SheetsCollection etc.
|
||||
InitializeConverter(oDocument.CharLocale, 1)
|
||||
GetPreSelectedRange()
|
||||
If GoOn Then
|
||||
DialogModel.lstCurrencies.TabIndex = 2
|
||||
DialogConvert.GetControl("chkComplete").SetFocus()
|
||||
DialogConvert.Execute
|
||||
End If
|
||||
DialogConvert.Dispose
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectListItem()
|
||||
Dim Listbox as Object
|
||||
Dim oListSheet as Object
|
||||
Dim CurStyleName as String
|
||||
Dim oCursheet as Object
|
||||
Dim oTempRanges as Object
|
||||
Dim sCurSheetName as String
|
||||
Dim RangeName as String
|
||||
Dim oSheetRanges as Object
|
||||
Dim ListIndex as Integer
|
||||
Dim a as Integer
|
||||
Dim i as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Listbox = DialogModel.lstSelection
|
||||
If Ubound(Listbox.SelectedItems()) > -1 Then
|
||||
EnableStep1DialogControls(False, False, False)
|
||||
oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
|
||||
' Is the sheet the basis, then the sheetobject has to be created
|
||||
If DialogModel.optDocRanges.State = 1 Then
|
||||
' Document is the basis for the conversion
|
||||
ListIndex = Listbox.SelectedItems(0)
|
||||
oCurSheet = RetrieveSheetoutofRangeName(Listbox.StringItemList(ListIndex))
|
||||
oDocument.CurrentController.SetActiveSheet(oCurSheet)
|
||||
Else
|
||||
oCurSheet = oDocument.CurrentController.ActiveSheet
|
||||
End If
|
||||
sCurSheetName = oCurSheet.Name
|
||||
If DialogModel.optCellTemplates.State = 1 Then
|
||||
Dim CurIndex as Integer
|
||||
For i = 0 To Ubound(Listbox.SelectedItems())
|
||||
CurIndex = Listbox.SelectedItems(i)
|
||||
CurStylename = Listbox.StringItemList(CurIndex)
|
||||
oSheetRanges = oCursheet.CellFormatRanges.createEnumeration
|
||||
While oSheetRanges.hasMoreElements
|
||||
oRange = oSheetRanges.NextElement
|
||||
If oRange.getPropertyState("NumberFormat") = 1 Then
|
||||
If oRange.CellStyle = CurStyleName Then
|
||||
oSelRanges.InsertbyName("",oRange)
|
||||
End If
|
||||
End If
|
||||
Wend
|
||||
Next i
|
||||
Else
|
||||
' Hard Formatation is selected
|
||||
a = -1
|
||||
For n = 0 To Ubound(Listbox.SelectedItems())
|
||||
m = Listbox.SelectedItems(n)
|
||||
RangeName = Listbox.StringItemList(m)
|
||||
oListSheet = RetrieveSheetoutofRangeName(RangeName)
|
||||
a = a + 1
|
||||
MaxIndex = Ubound(SelRangeList())
|
||||
If a > MaxIndex Then
|
||||
Redim Preserve SelRangeList(MaxIndex + SBRANGEUBOUND)
|
||||
End If
|
||||
SelRangeList(a) = RangeName
|
||||
If oListSheet.Name = sCurSheetName Then
|
||||
oRange = RetrieveRangeoutofRangeName(RangeName)
|
||||
oSelRanges.InsertbyName("",oRange)
|
||||
End If
|
||||
Next n
|
||||
End If
|
||||
If a > -1 Then
|
||||
ReDim Preserve SelRangeList(a)
|
||||
Else
|
||||
ReDim SelRangeList()
|
||||
End If
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
EnableStep1DialogControls(True, True, True)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
' Procedure that is called by an event
|
||||
Sub RetrieveEnableValue()
|
||||
Dim EnableValue as Boolean
|
||||
EnableValue = Not DialogModel.lstSelection.Enabled
|
||||
EnableStep1DialogControls(True, EnableValue, True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EnableStep1DialogControls(bCurrEnabled as Boolean, bFrameEnabled as Boolean, bButtonsEnabled as Boolean)
|
||||
Dim bCurrIsSelected as Boolean
|
||||
Dim bObjectIsSelected as Boolean
|
||||
Dim bConvertWholeDoc as Boolean
|
||||
Dim bDoEnableFrame as Boolean
|
||||
bConvertWholeDoc = DialogModel.chkComplete.State = 1
|
||||
bDoEnableFrame = bFrameEnabled And (NOT bConvertWholeDoc)
|
||||
|
||||
' Controls around the Selection Listbox
|
||||
With DialogModel
|
||||
.lblCurrencies.Enabled = bCurrEnabled
|
||||
.lstCurrencies.Enabled = bCurrEnabled
|
||||
.lstSelection.Enabled = bDoEnableFrame
|
||||
.lblSelection.Enabled = bDoEnableFrame
|
||||
.hlnSelection.Enabled = bDoEnableFrame
|
||||
.optCellTemplates.Enabled = bDoEnableFrame
|
||||
.optSheetRanges.Enabled = bDoEnableFrame
|
||||
.optDocRanges.Enabled = bDoEnableFrame
|
||||
.optSelRange.Enabled = bDoEnableFrame
|
||||
End With
|
||||
' The CheckBox has the Value '1' when the Controls in the Frame are disabled
|
||||
If bButtonsEnabled Then
|
||||
bCurrIsSelected = Ubound(DialogModel.lstCurrencies.SelectedItems()) <> -1
|
||||
' Enable GoOnButton only when Currency is selected
|
||||
DialogModel.cmdGoOn.Enabled = bCurrIsSelected
|
||||
DialogModel.chkComplete.Enabled = bCurrIsSelected
|
||||
If bDoEnableFrame AND DialogModel.cmdGoOn.Enabled Then
|
||||
' If FrameControls are enabled, check if Listbox is Empty
|
||||
bObjectIsSelected = Ubound(DialogModel.lstSelection.SelectedItems()) <> -1
|
||||
DialogModel.cmdGoOn.Enabled = bObjectIsSelected
|
||||
End If
|
||||
Else
|
||||
DialogModel.cmdGoOn.Enabled = False
|
||||
DialogModel.chkComplete.Enabled = False
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertRangesOrStylesOfDocument()
|
||||
Dim i as Integer
|
||||
Dim ItemName as String
|
||||
Dim SelList() as String
|
||||
Dim oSheetRanges as Object
|
||||
|
||||
bDocHasProtectedSheets = CheckSheetProtection(oSheets)
|
||||
If bDocHasProtectedSheets Then
|
||||
bDocHasProtectedSheets = UnprotectSheetsWithPassWord(oSheets, bDoUnProtect)
|
||||
DialogModel.cmdGoOn.Enabled = False
|
||||
End If
|
||||
If Not bDocHasProtectedSheets Then
|
||||
EnableStep1DialogControls(False, False, False)
|
||||
InitializeProgressBar()
|
||||
If DialogModel.optSelRange.State = 1 Then
|
||||
SelectListItem()
|
||||
End If
|
||||
SelList() = DialogConvert.GetControl("lstSelection").SelectedItems()
|
||||
If DialogModel.optCellTemplates.State = 1 Then
|
||||
' Option 'Soft' Formatation is selected
|
||||
AssignRangestoStyle(DialogModel.lstSelection.StringItemList(), SelList())
|
||||
ConverttheSoftWay(SelList(), True)
|
||||
ElseIf DialogModel.optSelRange.State = 1 Then
|
||||
oSheetRanges = oPreSelRange.CellFormatRanges.createEnumeration
|
||||
While oSheetRanges.hasMoreElements
|
||||
oRange = oSheetRanges.NextElement
|
||||
If CheckFormatType(oRange) Then
|
||||
ConvertCellCurrencies(oRange)
|
||||
SwitchNumberFormat(oRange, oFormats, sEuroSign)
|
||||
End If
|
||||
Wend
|
||||
Else
|
||||
ConverttheHardWay(SelList(), False, True)
|
||||
End If
|
||||
oStatusline.End
|
||||
EnableStep1DialogControls(True, False, True)
|
||||
DialogModel.cmdGoOn.Enabled = True
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertWholeDocument()
|
||||
Dim s as Integer
|
||||
DialogModel.cmdGoOn.Enabled = False
|
||||
DialogModel.chkComplete.Enabled = False
|
||||
GoOn = ConvertDocument()
|
||||
EmptyListbox(DialogModel.lstSelection())
|
||||
EnableStep1DialogControls(True, True, True)
|
||||
End Sub
|
||||
|
||||
|
||||
' Everything previously selected will be deselected
|
||||
Sub EmptySelection()
|
||||
Dim RangeName as String
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim EmptySelRangeList() as String
|
||||
|
||||
If Not IsNull(oSelRanges) Then
|
||||
If oSelRanges.HasElements Then
|
||||
EmptySelRangeList() = ArrayOutofString(oSelRanges.RangeAddressesasString, ";", MaxIndex)
|
||||
For i = 0 To MaxIndex
|
||||
oSelRanges.RemovebyName(EmptySelRangeList(i))
|
||||
Next i
|
||||
End If
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
Else
|
||||
oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function AddSelectedRangeToSelRangesEnum() as Object
|
||||
Dim oLocRange as Object
|
||||
osheet = oDocument.CurrentController.GetActiveSheet
|
||||
oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
' Check if a Currency-Range has been selected
|
||||
oLocRange = oDocument.CurrentController.Selection
|
||||
bPreSelected = oLocRange.SupportsService("com.sun.star.sheet.SheetCellRange")
|
||||
If bPreSelected Then
|
||||
oSelRanges.InsertbyName("",oLocRange)
|
||||
AddSelectedRangeToSelRangesEnum() = oLocRange
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetPreSelectedRange()
|
||||
Dim i as Integer
|
||||
Dim OldCurrSymbolList(2) as String
|
||||
Dim OldCurrIndex as Integer
|
||||
Dim OldCurExtension(2) as String
|
||||
oPreSelRange = AddSelectedRangeToSelRangesEnum()
|
||||
|
||||
DialogModel.chkComplete.State = Abs(Not(bPreSelected))
|
||||
If bPreSelected Then
|
||||
DialogModel.optSelRange.State = 1
|
||||
AddRangeToListbox(oPreSelRange)
|
||||
Else
|
||||
DialogModel.optCellTemplates.State = 1
|
||||
CreateStyleEnumeration()
|
||||
End If
|
||||
EnableStep1DialogControls(True, bPreSelected, True)
|
||||
DialogModel.optSelRange.Enabled = bPreSelected
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddRangeToListbox(oLocRange as Object)
|
||||
EmptyListBox(DialogModel.lstSelection)
|
||||
PreName = RetrieveRangeNamefromAddress(oLocRange)
|
||||
AddSingleItemToListbox(DialogModel.lstSelection, Prename)', 0)
|
||||
SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
|
||||
TotCellCount = CountRangeCells(oLocRange)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckRangeSelection(Optional oEvent)
|
||||
EmptySelection()
|
||||
AddRangeToListbox(oPreSelRange)
|
||||
oPreSelRange = AddSelectedRangeToSelRangesEnum()
|
||||
End Sub
|
||||
|
||||
|
||||
' Checks if a Field (LocField) is already defined in an Array
|
||||
' Returns 'True' or 'False'
|
||||
Function FieldInList(LocList(), MaxIndex as integer, ByVal LocField ) As Boolean
|
||||
Dim i as integer
|
||||
LocField = UCase(LocField)
|
||||
For i = Lbound(LocList()) to MaxIndex
|
||||
If UCase(LocList(i)) = LocField then
|
||||
FieldInList = True
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
FieldInList = False
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckLocale(oLocale) as Boolean
|
||||
Dim i as Integer
|
||||
Dim LocCountry as String
|
||||
Dim LocLanguage as String
|
||||
LocCountry = oLocale.Country
|
||||
LocLanguage = oLocale.Language
|
||||
For i = 0 To 1
|
||||
If LocLanguage = LangIDValue(CurrIndex,i,0) AND LocCountry = LangIDValue(CurrIndex,i,1) Then
|
||||
CheckLocale = True
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
CheckLocale = False
|
||||
End Function
|
||||
|
||||
|
||||
Sub SetOptionValuestoNull()
|
||||
With DialogModel
|
||||
.optCellTemplates.State = 0
|
||||
.optSheetRanges.State = 0
|
||||
.optDocRanges.State = 0
|
||||
.optSelRange.State = 0
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub SetStatusLineText(sStsREPROTECT as String)
|
||||
If Not IsNull(oStatusLine) Then
|
||||
oStatusline.SetText(sStsREPROTECT)
|
||||
End If
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,94 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DialogConvert" dlg:left="96" dlg:top="28" dlg:width="270" dlg:height="210" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_DIALOG" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblCurrencies" dlg:tab-index="1" dlg:left="170" dlg:top="39" dlg:width="92" dlg:height="8" dlg:value="lblCurrencies"/>
|
||||
<dlg:checkbox dlg:id="chkComplete" dlg:tab-index="0" dlg:left="12" dlg:top="43" dlg:width="129" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CHECKBOX1" dlg:value="chkComplete" dlg:checked="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Euro.ConvertRun.RetrieveEnableValue?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:menulist dlg:id="lstCurrencies" dlg:tab-index="2" dlg:left="170" dlg:top="51" dlg:width="93" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_COMBOBOX1" dlg:spin="true" dlg:linecount="12">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Euro.Common.SelectCurrency?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optCellTemplates" dlg:tab-index="3" dlg:left="12" dlg:top="96" dlg:width="129" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OPTIONBUTTON1" dlg:value="optCellTemplates">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Soft.CreateStyleEnumeration?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optSheetRanges" dlg:tab-index="4" dlg:left="12" dlg:top="110" dlg:width="130" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OPTIONBUTTON2" dlg:value="optSheetRanges">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Hard.CreateRangeList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optDocRanges" dlg:tab-index="5" dlg:left="12" dlg:top="124" dlg:width="130" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OPTIONBUTTON3" dlg:value="optDocRanges">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Hard.CreateRangeList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optSelRange" dlg:tab-index="6" dlg:left="12" dlg:top="138" dlg:width="130" dlg:height="10" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OPTIONBUTTON4" dlg:value="optSelRange">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.ConvertRun.CheckRangeSelection?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:text dlg:id="lblSelection" dlg:tab-index="7" dlg:left="170" dlg:top="84" dlg:width="73" dlg:height="8" dlg:page="1" dlg:value="lblSelection"/>
|
||||
<dlg:menulist dlg:id="lstSelection" dlg:tab-index="8" dlg:left="170" dlg:top="96" dlg:width="90" dlg:height="52" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_LISTBOX1" dlg:multiselection="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Euro.ConvertRun.SelectListItem?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optSingleFile" dlg:tab-index="9" dlg:left="12" dlg:top="51" dlg:width="146" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OBFILE" dlg:value="optSingleFile">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.SwapExtent?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optWholeDir" dlg:tab-index="10" dlg:left="12" dlg:top="65" dlg:width="146" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_OBDIR" dlg:value="optWholeDir" dlg:checked="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.SwapExtent?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:textfield dlg:id="txtConfig" dlg:tab-index="11" dlg:left="6" dlg:top="50" dlg:width="258" dlg:height="55" dlg:page="3" dlg:vscroll="true" dlg:multiline="true" dlg:readonly="true"/>
|
||||
<dlg:textfield dlg:id="txtSource" dlg:tab-index="12" dlg:left="80" dlg:top="82" dlg:width="165" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_TBSOURCE">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.ToggleGoOnButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:textfield>
|
||||
<dlg:button dlg:id="cmdCallSourceDialog" dlg:tab-index="13" dlg:left="249" dlg:top="81" dlg:width="15" dlg:height="14" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CBSOURCEOPEN" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.CallFilePicker?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:checkbox dlg:id="chkRecursive" dlg:tab-index="14" dlg:left="12" dlg:top="98" dlg:width="252" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CHECKRECURSIVE" dlg:value="chkRecursive" dlg:checked="false"/>
|
||||
<dlg:checkbox dlg:id="chkTextDocuments" dlg:tab-index="15" dlg:left="12" dlg:top="112" dlg:width="251" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CHKTEXTDOCUMENTS" dlg:value="chkTextDocuments" dlg:checked="false"/>
|
||||
<dlg:checkbox dlg:id="chkProtect" dlg:tab-index="16" dlg:left="12" dlg:top="126" dlg:width="251" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CHKPROTECT" dlg:value="chkProtect" dlg:checked="false"/>
|
||||
<dlg:textfield dlg:id="txtTarget" dlg:tab-index="17" dlg:left="80" dlg:top="143" dlg:width="165" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_TBTARGET"/>
|
||||
<dlg:button dlg:id="cmdCallTargetDialog" dlg:tab-index="18" dlg:left="249" dlg:top="142" dlg:width="15" dlg:height="14" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CBTARGETOPEN" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.CallFolderPicker?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:progressmeter dlg:id="ProgressBar" dlg:tab-index="19" dlg:left="85" dlg:top="152" dlg:width="179" dlg:height="10" dlg:page="3"/>
|
||||
<dlg:text dlg:id="lblHint" dlg:tab-index="20" dlg:left="6" dlg:top="166" dlg:width="258" dlg:height="20" dlg:value="lblHint" dlg:multiline="true"/>
|
||||
<dlg:text dlg:id="lblTarget" dlg:tab-index="21" dlg:left="6" dlg:top="145" dlg:width="73" dlg:height="8" dlg:page="2" dlg:value="lblTarget"/>
|
||||
<dlg:text dlg:id="lblSource" dlg:tab-index="22" dlg:left="6" dlg:top="84" dlg:width="73" dlg:height="8" dlg:page="2" dlg:value="lblSource"/>
|
||||
<dlg:text dlg:id="lblCurProgress" dlg:tab-index="23" dlg:left="16" dlg:top="130" dlg:width="208" dlg:height="8" dlg:page="3"/>
|
||||
<dlg:text dlg:id="lblRetrieval" dlg:tab-index="24" dlg:left="9" dlg:top="119" dlg:width="216" dlg:height="8" dlg:page="3" dlg:value="lblRetrieval"/>
|
||||
<dlg:text dlg:id="lblConfig" dlg:tab-index="25" dlg:left="6" dlg:top="39" dlg:width="94" dlg:height="8" dlg:page="3" dlg:value="lblConfig"/>
|
||||
<dlg:text dlg:id="lblCurDocument" dlg:tab-index="26" dlg:left="16" dlg:top="141" dlg:width="208" dlg:height="8" dlg:page="3"/>
|
||||
<dlg:img dlg:id="imgPreview" dlg:tab-index="27" dlg:left="6" dlg:top="6" dlg:width="258" dlg:height="26"/>
|
||||
<dlg:fixedline dlg:id="hlnSelection" dlg:tab-index="28" dlg:left="7" dlg:top="72" dlg:width="258" dlg:height="8" dlg:page="1" dlg:value="hlnSelection"/>
|
||||
<dlg:fixedline dlg:id="hlnExtent" dlg:tab-index="29" dlg:left="6" dlg:top="39" dlg:width="156" dlg:height="8" dlg:page="2" dlg:value="hlnExtent"/>
|
||||
<dlg:fixedline dlg:id="hlnProgress" dlg:tab-index="30" dlg:left="6" dlg:top="108" dlg:width="258" dlg:height="8" dlg:page="3" dlg:value="hlnProgress"/>
|
||||
<dlg:fixedline dlg:id="FixedLine1" dlg:tab-index="31" dlg:left="6" dlg:top="152" dlg:width="258" dlg:height="9" dlg:page="1"/>
|
||||
<dlg:text dlg:id="lblProgress" dlg:tab-index="32" dlg:left="6" dlg:top="153" dlg:width="79" dlg:height="8" dlg:page="3" dlg:value="lblProgress"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="33" dlg:left="6" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CBCANCEL" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Common.CancelTask?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdHelp" dlg:tab-index="34" dlg:left="63" dlg:top="190" dlg:width="53" dlg:height="14" dlg:value="cmdHelp" dlg:button-type="help"/>
|
||||
<dlg:button dlg:id="cmdBack" dlg:tab-index="35" dlg:left="155" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CBBACK" dlg:value="cmdBack">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.AutoPilotRun.PreviousStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="36" dlg:left="211" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGCONVERT_CBGOON" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Common.StartConversion?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,32 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DlgPassword" dlg:left="77" dlg:top="93" dlg:width="310" dlg:height="65" dlg:closeable="true" dlg:moveable="true" dlg:title="DlgPassword">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="0" dlg:left="251" dlg:top="6" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGPASSWORD_CMDGOON" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Protect.ReadPassword?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="1" dlg:left="251" dlg:top="24" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGPASSWORD_CMDCANCEL" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Euro.Protect.RejectPassword?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdHelp" dlg:tab-index="2" dlg:left="251" dlg:top="45" dlg:width="53" dlg:height="14" dlg:tag="34692" dlg:value="cmdHelp" dlg:button-type="help"/>
|
||||
<dlg:textfield dlg:id="txtPassword" dlg:tab-index="3" dlg:left="11" dlg:top="18" dlg:width="232" dlg:height="12" dlg:help-url="HID:WIZARDS_HID_DLGPASSWORD_TXTPASSWORD" dlg:echochar="*"/>
|
||||
<dlg:fixedline dlg:id="hlnPassword" dlg:tab-index="4" dlg:left="6" dlg:top="6" dlg:width="238" dlg:height="8" dlg:value="hlnPassword"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,246 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Hard" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
|
||||
Sub CreateRangeList()
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = -1
|
||||
EnableStep1DialogControls(False, False, False)
|
||||
EmptySelection()
|
||||
DialogModel.lblSelection.Label = sCURRRANGES
|
||||
EmptyListbox(DialogModel.lstSelection)
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State <> 1) Then
|
||||
' Conversion on a sheet?
|
||||
SetStatusLineText(sStsRELRANGES)
|
||||
osheet = oDocument.CurrentController.GetActiveSheet
|
||||
oRanges = osheet.CellFormatRanges.createEnumeration()
|
||||
MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False)
|
||||
If MaxIndex > -1 Then
|
||||
ReDim Preserve RangeList(MaxIndex)
|
||||
End If
|
||||
Else
|
||||
CreateRangeEnumeration(False)
|
||||
bRangeListDefined = True
|
||||
End If
|
||||
EnableStep1DialogControls(True, True, True)
|
||||
SetStatusLineText("")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CreateRangeEnumeration(bAutopilot as Boolean)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as integer
|
||||
Dim sStatustext as String
|
||||
MaxIndex = -1
|
||||
If Not bRangeListDefined Then
|
||||
' Cellranges are not yet defined
|
||||
oSheets = oDocument.Sheets
|
||||
For i = 0 To oSheets.Count-1
|
||||
oSheet = oSheets.GetbyIndex(i)
|
||||
If bAutopilot Then
|
||||
IncreaseStatusValue(SBRELGET/osheets.Count)
|
||||
Else
|
||||
sStatustext = ReplaceString(sStsRELSHEETRANGES,Str(i+1),"%1Number%1")
|
||||
sStatustext = ReplaceString(sStatusText,oSheets.Count,"%2TotPageCount%2")
|
||||
SetStatusLineText(sStatusText)
|
||||
End If
|
||||
oRanges = osheet.CellFormatRanges.createEnumeration
|
||||
MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot)
|
||||
Next i
|
||||
Else
|
||||
If Not bAutoPilot Then
|
||||
SetStatusLineText(sStsRELRANGES)
|
||||
' cellranges already defined
|
||||
For i = 0 To Ubound(RangeList())
|
||||
If RangeList(i) <> "" Then
|
||||
AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i))
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
If MaxIndex > -1 Then
|
||||
ReDim Preserve RangeList(MaxIndex)
|
||||
Else
|
||||
ReDim RangeList()
|
||||
End If
|
||||
Rangeindex = MaxIndex
|
||||
End Sub
|
||||
|
||||
|
||||
Function AddSheetRanges(oRanges as Object, r as Integer, oSheet as Object, bAutopilot)
|
||||
Dim RangeName as String
|
||||
Dim AddtoList as Boolean
|
||||
Dim iCurStep as Integer
|
||||
Dim MaxIndex as Integer
|
||||
iCurStep = DialogModel.Step
|
||||
While oRanges.hasMoreElements
|
||||
oRange = oRanges.NextElement
|
||||
AddToList = CheckFormatType(oRange)
|
||||
If AddToList Then
|
||||
RangeName = RetrieveRangeNamefromAddress(oRange)
|
||||
TotCellCount = TotCellCount + CountRangeCells(oRange)
|
||||
If Not bAutoPilot Then
|
||||
AddSingleItemToListbox(DialogModel.lstSelection, RangeName)
|
||||
End If
|
||||
' The Ranges are only passed to an Array when the whole Document is the basis
|
||||
' Redimension the RangeList Array if necessary
|
||||
MaxIndex = Ubound(RangeList())
|
||||
r = r + 1
|
||||
If r > MaxIndex Then
|
||||
MaxIndex = MaxIndex + SBRANGEUBOUND
|
||||
ReDim Preserve RangeList(MaxIndex)
|
||||
End If
|
||||
RangeList(r) = RangeName
|
||||
End If
|
||||
Wend
|
||||
AddSheetRanges = r
|
||||
End Function
|
||||
|
||||
|
||||
' adds a section to the collection
|
||||
Sub SelectRange()
|
||||
Dim i as Integer
|
||||
Dim RangeName as String
|
||||
Dim SelItem as String
|
||||
Dim CurRange as String
|
||||
Dim SheetRangeName as String
|
||||
Dim DescriptionList() as String
|
||||
Dim MaxRangeIndex as Integer
|
||||
Dim StatusValue as Integer
|
||||
StatusValue = 0
|
||||
MaxRangeIndex = Ubound(SelRangeList())
|
||||
CurSheetName = oSheet.Name
|
||||
For i = 0 To MaxRangeIndex
|
||||
SelItem = SelRangeList(i)
|
||||
' Is the Range already included in the collection?
|
||||
oRange = RetrieveRangeoutOfRangename(SelItem)
|
||||
TotCellCount = TotCellCount + CountRangeCells(oRange)
|
||||
DescriptionList() = ArrayOutofString(SelItem,".",1)
|
||||
SheetRangeName = DeleteStr(DescriptionList(0),"'")
|
||||
If SheetRangeName = CurSheetName Then
|
||||
oSelRanges.InsertbyName("",oRange)
|
||||
End If
|
||||
IncreaseStatusValue(SBRELGET/MaxRangeIndex)
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertThehardWay(ListboxList(), SwitchFormat as Boolean, bRemove as Boolean)
|
||||
Dim i as Integer
|
||||
Dim AddCells as Long
|
||||
Dim OldStatusValue as Single
|
||||
Dim RangeName as String
|
||||
Dim LastIndex as Integer
|
||||
Dim oSelListbox as Object
|
||||
|
||||
oSelListbox = DialogConvert.GetControl("lstSelection")
|
||||
Lastindex = Ubound(ListboxList())
|
||||
If TotCellCount > 0 Then
|
||||
OldStatusValue = StatusValue
|
||||
' hard format
|
||||
For i = 0 To LastIndex
|
||||
RangeName = ListboxList(i)
|
||||
oRange = RetrieveRangeoutofRangeName(RangeName)
|
||||
ConvertCellCurrencies(oRange)
|
||||
If bRemove Then
|
||||
If oSelRanges.HasbyName(RangeName) Then
|
||||
oSelRanges.RemovebyName(RangeName)
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
End If
|
||||
End If
|
||||
If SwitchFormat Then
|
||||
If oRange.getPropertyState("NumberFormat") <> 1 Then
|
||||
' Range is hard formatted
|
||||
SwitchNumberFormat(oRange, oFormats, sEuroSign)
|
||||
End If
|
||||
Else
|
||||
SwitchNumberFormat(oRange, oFormats, sEuroSign)
|
||||
End If
|
||||
AddCells = CountRangeCells(oRange)
|
||||
CurCellCount = AddCells
|
||||
IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue))
|
||||
If bRemove Then
|
||||
RemoveListBoxItemByName(oSelListbox.Model,Rangename)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertCellCurrencies(oRange as Object)
|
||||
Dim oValues as Object
|
||||
Dim oCells as Object
|
||||
Dim oCell as Object
|
||||
oValues = oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE)
|
||||
If (oValues.Count > 0) Then
|
||||
oCells = oValues.Cells.createEnumeration
|
||||
While oCells.hasMoreElements
|
||||
oCell = oCells.nextElement
|
||||
ModifyObjectValuewithCurrFactor(oCell)
|
||||
Wend
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ModifyObjectValuewithCurrFactor(oDocObject as Object)
|
||||
Dim oDocObjectValue as double
|
||||
oDocObjectValue = oDocObject.Value
|
||||
oDocObject.Value = Round(oDocObjectValue/CurrFactor, 2)
|
||||
End Sub
|
||||
|
||||
|
||||
Function CheckIfRangeisCurrency(FormatObject as Object)
|
||||
Dim oFormatofObject() as Object
|
||||
' Retrieve the Format of the Object
|
||||
On Local Error GoTo NOKEY
|
||||
oFormatofObject() = oFormats.getByKey(FormatObject.NumberFormat)
|
||||
On Local Error GoTo 0
|
||||
CheckIfRangeIsCurrency = INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
|
||||
Exit Function
|
||||
NOKEY:
|
||||
CheckIfRangeisCurrency = False
|
||||
Resume CLERROR
|
||||
CLERROR:
|
||||
End Function
|
||||
|
||||
|
||||
Function CountColumnsForRow(IndexArray() as String, Row as Integer)
|
||||
Dim i as Integer
|
||||
Dim NoNulls as Boolean
|
||||
For i = 1 To Ubound(IndexArray,2)
|
||||
If IndexArray(Row,i)= "" Then
|
||||
NoNulls = False
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
CountColumnsForRow = i
|
||||
End Function
|
||||
|
||||
|
||||
Function CountRangeCells(oRange as Object) As Long
|
||||
Dim oRangeAddress as Object
|
||||
Dim LocCellCount as Long
|
||||
oRangeAddress = oRange.RangeAddress
|
||||
LocCellCount = (oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1) * (oRangeAddress.EndRow - oRangeAddress.StartRow + 1)
|
||||
CountRangeCells = LocCellCount
|
||||
End Function</script:module>
|
||||
@@ -0,0 +1,683 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Init" script:language="StarBasic">Option Explicit
|
||||
REM ***** BASIC *****
|
||||
|
||||
Public Const SBRANGEUBOUND = 20
|
||||
Public StyleRangeAssignmentList(SBRANGEUBOUND)as String
|
||||
Public SelRangeList(SBRANGEUBOUND) as String
|
||||
Public RangeList(SBRANGEUBOUND) as String
|
||||
Public UnprotectList() as String
|
||||
Public FilterNames(2,1) as String
|
||||
Public bDoUnProtect as Boolean
|
||||
Public bCancelTask as Boolean
|
||||
|
||||
Public sREADY as String
|
||||
Public sPROTECT as String
|
||||
Public sCONTINUE as String
|
||||
|
||||
Public sSELTEMPL as String
|
||||
Public sSELCELL as String
|
||||
Public sCURRRANGES as String
|
||||
Public sTEMPLATES as String
|
||||
|
||||
Public sSOURCEFILE as String
|
||||
Public sSOURCEDIR as String
|
||||
Public sTARGETDIR as String
|
||||
|
||||
Public sStsPROGRESS as String
|
||||
Public sStsCELLPROGRSS as String
|
||||
Public sStsRELRANGES as String
|
||||
Public sStsRELSHEETRANGES as String
|
||||
Public sStsREPROTECT as String
|
||||
|
||||
Public sMsgSELDIR as String
|
||||
Public sMsgSELFILE as String
|
||||
Public sMsgTARGETDIR as String
|
||||
Public sMsgNOTTHERE as String
|
||||
Public sMsgDLGTITLE as String
|
||||
Public sMsgUNPROTECT as String
|
||||
Public sMsgPWPROTECT as String
|
||||
Public sMsgWRONGPW as String
|
||||
Public sMsgSHEETPROTECTED as String
|
||||
Public sMsgWARNING as String
|
||||
Public sMsgSHEETSNOPROTECT as String
|
||||
Public sMsgSHEETNOPROTECT as String
|
||||
Public sMsgCHOOSECURRENCY as String
|
||||
Public sMsgPASSWORD as String
|
||||
Public sMsgOK as String
|
||||
Public sMsgCANCEL as String
|
||||
Public sMsgFileInvalid as String
|
||||
Public sMsgNODIRECTORY as String
|
||||
Public sMsgDOCISREADONLY as String
|
||||
Public sMsgFileExists as String
|
||||
Public sMsgCancelConversion as String
|
||||
Public sMsgCancelTitle as String
|
||||
Public sCurrPORTUGUESE as String
|
||||
Public sCurrDUTCH as String
|
||||
Public sCurrFRENCH as String
|
||||
Public sCurrSPANISH as String
|
||||
Public sCurrITALIAN as String
|
||||
Public sCurrGERMAN as String
|
||||
Public sCurrBELGIAN as String
|
||||
Public sCurrIRISH as String
|
||||
Public sCurrLUXEMBOURG as String
|
||||
Public sCurrAUSTRIAN as String
|
||||
Public sCurrFINNISH as String
|
||||
Public sCurrGREEK as String
|
||||
Public sCurrSLOVENIAN as String
|
||||
Public sCurrCYPRIOT as String
|
||||
Public sCurrMALTESE as String
|
||||
Public sCurrSLOVAK as String
|
||||
Public sCurrESTONIAN as String
|
||||
Public sCurrLATVIAN as String
|
||||
Public sCurrLITHUANIAN as String
|
||||
Public sCurrCROATIAN as String
|
||||
|
||||
Public sPrgsRETRIEVAL as String
|
||||
Public sPrgsCONVERTING as String
|
||||
Public sPrgsUNPROTECT as String
|
||||
Public sInclusiveSubDir as String
|
||||
|
||||
Public Const SBCOUNTRYCOUNT = 19
|
||||
Public CurMimeType as String
|
||||
Public CurCellCount as Long
|
||||
Public oSheets as Object
|
||||
Public oStyles as Object
|
||||
Public oStyle as Object
|
||||
Public oFormats as Object
|
||||
Public aSimpleStr as String
|
||||
Public nSimpleKey as Long
|
||||
Public aFormat() as Variant
|
||||
Public oRanges as Object
|
||||
Public oRange as Object
|
||||
Public nLanguage as integer
|
||||
Public nFormatLanguage as integer
|
||||
Public aCellFormat as Variant
|
||||
Public oDocument as Object
|
||||
Public StartCol, StartRow, EndCol, EndRow as String
|
||||
Public oSheet as Object
|
||||
Public IntStartCol, IntStartRow, IntEndCol, IntEndRow as integer
|
||||
Public oSelRanges as Object
|
||||
Public nFormatType as Integer
|
||||
Public sFormatCurrency as String
|
||||
Public sFormatLanguage as String
|
||||
Public CurSheetName as String
|
||||
Public oStatusLine as Object
|
||||
Public Const SBRELGET = 50
|
||||
Public StatusValue as Single
|
||||
Public TotCellCount as Long
|
||||
Public StyleIndex as Integer
|
||||
Public RangeIndex as Integer
|
||||
Public CurrIndex as Integer
|
||||
Public ActLangNumber(1) as Integer
|
||||
Public CurExtension(2) as String
|
||||
Public Currfactor as Double
|
||||
Public CurrSymbolList(2) as String
|
||||
Public CurrLanguage as String
|
||||
Public CurrValue(18,5)
|
||||
Public LangIDValue(18,2,2) as String
|
||||
Public PreName as String
|
||||
Public Separator as String
|
||||
Public BitmapDir as String
|
||||
Public TypeIndex as Integer, CSIndex as Integer, LangIndex as Integer, FSIndex as Integer
|
||||
Public oLocale as New com.sun.star.lang.Locale
|
||||
Public sEuroSign as String
|
||||
Public oPointer as Object
|
||||
Public sDocType as String
|
||||
Public bPreSelected as Boolean
|
||||
Public bRecursive as Boolean
|
||||
Public bCancelProtection as Boolean
|
||||
Public CurrRoundMode as Boolean
|
||||
Public bRangeListDefined as Boolean
|
||||
Public bDocHasProtectedSheets as Boolean
|
||||
Public sGOON as String
|
||||
Public sHELP as String
|
||||
Public sCANCEL as String
|
||||
Dim sEnd as String
|
||||
|
||||
Sub InitializeResources()
|
||||
Dim LocWorkPath as String
|
||||
With DialogModel
|
||||
' Strings that are also needed by the Password Dialog
|
||||
sGoOn = GetResText("STEP_ZERO_3")
|
||||
sHelp = GetResText("STEP_ZERO_1")
|
||||
sCANCEL = GetResText("MESSAGES_18")
|
||||
sEnd = GetResText("STEP_ZERO_0")
|
||||
sPROTECT = GetResText("STEP_ZERO_5")
|
||||
sCONTINUE = GetResText("STEP_ZERO_7")
|
||||
sSELTEMPL = GetResText("STEP_CONVERTER_6")
|
||||
sSELCELL = GetResText("STEP_CONVERTER_7")
|
||||
sCURRRANGES = GetResText("STEP_CONVERTER_8")
|
||||
sTEMPLATES = GetResText("STEP_CONVERTER_9")
|
||||
sStsPROGRESS = GetResText("STATUSLINE_0")
|
||||
sStsCELLPROGRSS = GetResText("STATUSLINE_1")
|
||||
sStsRELSHEETRANGES = GetResText("STATUSLINE_2")
|
||||
sStsRELRANGES = GetResText("STATUSLINE_3")
|
||||
sStsREPROTECT = GetResText("STATUSLINE_4")
|
||||
sREADY = GetResText("MESSAGES_0")
|
||||
sMsgSELDIR = GetResText("MESSAGES_1")
|
||||
sMsgSELFILE = GetResText("MESSAGES_2")
|
||||
sMsgTARGETDIR = GetResText("MESSAGES_3")
|
||||
sMsgNOTTHERE = GetResText("MESSAGES_4")
|
||||
sMsgDLGTITLE = GetResText("MESSAGES_5")
|
||||
sMsgUNPROTECT = GetResText("MESSAGES_6")
|
||||
sMsgPWPROTECT = GetResText("MESSAGES_7")
|
||||
sMsgWRONGPW = GetResText("MESSAGES_8")
|
||||
sMsgSHEETPROTECTED = GetResText("MESSAGES_9")
|
||||
sMsgWARNING = GetResText("MESSAGES_10")
|
||||
sMsgSHEETSNOPROTECT = GetResText("MESSAGES_11")
|
||||
sMsgSHEETNOPROTECT = GetResText("MESSAGES_12")
|
||||
sMsgCHOOSECURRENCY = GetResText("MESSAGES_15")
|
||||
sMsgPASSWORD = GetResText("MESSAGES_16")
|
||||
sMsgOK = GetResText("MESSAGES_17")
|
||||
sMsgCANCEL = GetResText("MESSAGES_18")
|
||||
sMsgFILEINVALID = GetResText("MESSAGES_19")
|
||||
sMsgFILEINVALID = ReplaceString(sMsgFILEINVALID,"%PRODUCTNAME", GetProductname())
|
||||
SMsgNODIRECTORY = GetResText("MESSAGES_20")
|
||||
sMsgDOCISREADONLY = GetResText("MESSAGES_21")
|
||||
sMsgFileExists = GetResText("MESSAGES_22")
|
||||
sMsgCancelConversion = GetResText("MESSAGES_23")
|
||||
sMsgCancelTitle = GetResText("MESSAGES_24")
|
||||
sCurrPORTUGUESE = GetResText("CURRENCIES_0")
|
||||
sCurrDUTCH = GetResText("CURRENCIES_1")
|
||||
sCurrFRENCH = GetResText("CURRENCIES_2")
|
||||
sCurrSPANISH = GetResText("CURRENCIES_3")
|
||||
sCurrITALIAN = GetResText("CURRENCIES_4")
|
||||
sCurrGERMAN = GetResText("CURRENCIES_5")
|
||||
sCurrBELGIAN = GetResText("CURRENCIES_6")
|
||||
sCurrIRISH = GetResText("CURRENCIES_7")
|
||||
sCurrLUXEMBOURG = GetResText("CURRENCIES_8")
|
||||
sCurrAUSTRIAN = GetResText("CURRENCIES_9")
|
||||
sCurrFINNISH = GetResText("CURRENCIES_10")
|
||||
sCurrGREEK = GetResText("CURRENCIES_11")
|
||||
sCurrSLOVENIAN = GetResText("CURRENCIES_12")
|
||||
sCurrCYPRIOT = GetResText("CURRENCIES_13")
|
||||
sCurrMALTESE = GetResText("CURRENCIES_14")
|
||||
sCurrSLOVAK = GetResText("CURRENCIES_15")
|
||||
sCurrESTONIAN = GetResText("CURRENCIES_16")
|
||||
sCurrLATVIAN = GetResText("CURRENCIES_17")
|
||||
sCurrLITHUANIAN = GetResText("CURRENCIES_18")
|
||||
sCurrCROATIAN = GetResText("CURRENCIES_19")
|
||||
.cmdCancel.Label = sCANCEL
|
||||
.cmdHelp.Label = sHELP
|
||||
.cmdBack.Label = GetResText("STEP_ZERO_2")
|
||||
.cmdGoOn.Label = sGOON
|
||||
.lblHint.Label = GetResText("STEP_ZERO_4")
|
||||
.lblCurrencies.Label = GetResText("STEP_ZERO_6")
|
||||
.cmdBack.Enabled = False
|
||||
If .Step = 1 Then
|
||||
.chkComplete.Label = GetResText("STEP_CONVERTER_0")
|
||||
.hlnSelection.Label = GetResText("STEP_CONVERTER_1")
|
||||
.optCellTemplates.Label = GetResText("STEP_CONVERTER_2")
|
||||
.optSheetRanges.Label = GetResText("STEP_CONVERTER_3")
|
||||
.optDocRanges.Label = GetResText("STEP_CONVERTER_4")
|
||||
.optSelRange.Label = GetResText("STEP_CONVERTER_5")
|
||||
sCURRRANGES = GetResText("STEP_CONVERTER_8")
|
||||
.lblSelection.Label = sCURRRANGES
|
||||
Else
|
||||
.lblProgress.Label = sStsPROGRESS
|
||||
.hlnExtent.Label = GetResText("STEP_AUTOPILOT_0")
|
||||
.optSingleFile.Label = GetResText("STEP_AUTOPILOT_1")
|
||||
.optWholeDir.Label = GetResText("STEP_AUTOPILOT_2")
|
||||
.chkProtect.Label = GetResText("STEP_AUTOPILOT_7")
|
||||
.chkTextDocuments.Label = GetResText("STEP_AUTOPILOT_10")
|
||||
|
||||
sSOURCEFILE = GetResText("STEP_AUTOPILOT_3")
|
||||
sSOURCEDIR = GetResText("STEP_AUTOPILOT_4")
|
||||
.lblSource.Label = sSOURCEDIR
|
||||
sInclusiveSubDir = GetResText("STEP_AUTOPILOT_5")
|
||||
.chkRecursive.Label = sInclusiveSubDir
|
||||
sTARGETDIR = GetResText("STEP_AUTOPILOT_6")
|
||||
.lblTarget.Label = STARGETDIR
|
||||
|
||||
LocWorkPath = GetPathSettings("Work")
|
||||
If Not oUcb.Exists(LocWorkPath) Then
|
||||
ShowNoOfficePathError()
|
||||
Stop
|
||||
End If
|
||||
|
||||
.txtSource.Text = ConvertfromUrl(LocWorkPath)
|
||||
|
||||
SubstDir = .txtSource.Text
|
||||
.txtTarget.Text = .txtSource.Text
|
||||
.hlnProgress.Label = GetResText("STEP_LASTPAGE_0")
|
||||
.lblConfig.Label = GetResText("STEP_LASTPAGE_3")
|
||||
sPrgsRETRIEVAL = GetResText("STEP_LASTPAGE_1")
|
||||
sPrgsCONVERTING = GetResText("STEP_LASTPAGE_2")
|
||||
sPrgsUNPROTECT = GetResText("STEP_LASTPAGE_4")
|
||||
End If
|
||||
End With
|
||||
End Sub
|
||||
|
||||
Sub InitializeLanguages()
|
||||
sEuroSign = chr(8364)
|
||||
|
||||
' CURRENCIES_PORTUGUESE
|
||||
LangIDValue(0,0,0) = "pt"
|
||||
LangIDValue(0,0,1) = ""
|
||||
LangIDValue(0,0,2) = "-816"
|
||||
|
||||
' CURRENCIES_DUTCH
|
||||
LangIDValue(1,0,0) = "nl"
|
||||
LangIDValue(1,0,1) = ""
|
||||
LangIDValue(1,0,2) = "-413"
|
||||
|
||||
' CURRENCIES_FRENCH
|
||||
LangIDValue(2,0,0) = "fr"
|
||||
LangIDValue(2,0,1) = ""
|
||||
LangIDValue(2,0,2) = "-40C"
|
||||
|
||||
' CURRENCIES_SPANISH
|
||||
LangIDValue(3,0,0) = "es"
|
||||
LangIDValue(3,0,1) = ""
|
||||
LangIDValue(3,0,2) = "-40A"
|
||||
|
||||
'Spanish modern
|
||||
LangIDValue(3,1,0) = "es"
|
||||
LangIDValue(3,1,1) = ""
|
||||
LangIDValue(3,1,2) = "-C0A"
|
||||
|
||||
'Spanish katalanic
|
||||
LangIDValue(3,2,0) = "es"
|
||||
LangIDValue(3,2,1) = ""
|
||||
LangIDValue(3,2,2) = "-403"
|
||||
|
||||
' CURRENCIES_ITALIAN
|
||||
LangIDValue(4,0,0) = "it"
|
||||
LangIDValue(4,0,1) = ""
|
||||
LangIDValue(4,0,2) = "-410"
|
||||
|
||||
' CURRENCIES_GERMAN
|
||||
LangIDValue(5,0,0) = "de"
|
||||
LangIDValue(5,0,1) = "DE"
|
||||
LangIDValue(5,0,2) = "-407"
|
||||
|
||||
' CURRENCIES_BELGIAN
|
||||
LangIDValue(6,0,0) = "fr"
|
||||
LangIDValue(6,0,1) = "BE"
|
||||
LangIDValue(6,0,2) = "-80C"
|
||||
|
||||
LangIDValue(6,1,0) = "nl"
|
||||
LangIDValue(6,1,1) = "BE"
|
||||
LangIDValue(6,1,2) = "-813"
|
||||
|
||||
' CURRENCIES_IRISH
|
||||
LangIDValue(7,0,0) = "en"
|
||||
LangIDValue(7,0,1) = "IE"
|
||||
LangIDValue(7,0,2) = "-1809"
|
||||
|
||||
LangIDValue(7,1,0) = "ga"
|
||||
LangIDValue(7,1,1) = "IE"
|
||||
LangIDValue(7,1,2) = "-83C"
|
||||
|
||||
' CURRENCIES_LUXEMBOURG
|
||||
LangIDValue(8,0,0) = "fr"
|
||||
LangIDValue(8,0,1) = "LU"
|
||||
LangIDValue(8,0,2) = "-140C"
|
||||
|
||||
LangIDValue(8,1,0) = "de"
|
||||
LangIDValue(8,1,1) = "LU"
|
||||
LangIDValue(8,1,2) = "-1007"
|
||||
|
||||
' CURRENCIES_AUSTRIAN
|
||||
LangIDValue(9,0,0) = "de"
|
||||
LangIDValue(9,0,1) = "AT"
|
||||
LangIDValue(9,0,2) = "-C07"
|
||||
|
||||
' CURRENCIES_FINNISH
|
||||
LangIDValue(10,0,0) = "fi"
|
||||
LangIDValue(10,0,1) = "FI"
|
||||
LangIDValue(10,0,2) = "-40B"
|
||||
|
||||
LangIDValue(10,1,0) = "sv"
|
||||
LangIDValue(10,1,1) = "FI"
|
||||
LangIDValue(10,1,2) = "-81D"
|
||||
|
||||
' CURRENCIES_GREEK
|
||||
LangIDValue(11,0,0) = "el"
|
||||
LangIDValue(11,0,1) = "GR"
|
||||
LangIDValue(11,0,2) = "-408"
|
||||
|
||||
' CURRENCIES_SLOVENIAN
|
||||
LangIDValue(12,0,0) = "sl"
|
||||
LangIDValue(12,0,1) = "SI"
|
||||
LangIDValue(12,0,2) = "-424"
|
||||
|
||||
' CURRENCIES_CYPRIOT
|
||||
LangIDValue(13,0,0) = "el"
|
||||
LangIDValue(13,0,1) = "CY"
|
||||
LangIDValue(13,0,2) = "-408"
|
||||
|
||||
' CURRENCIES_MALTESE
|
||||
LangIDValue(14,0,0) = "mt"
|
||||
LangIDValue(14,0,1) = "MT"
|
||||
LangIDValue(14,0,2) = "-43A"
|
||||
|
||||
' CURRENCIES_SLOVAK
|
||||
LangIDValue(15,0,0) = "sk"
|
||||
LangIDValue(15,0,1) = "SK"
|
||||
LangIDValue(15,0,2) = "-41B"
|
||||
|
||||
' CURRENCIES_ESTONIAN
|
||||
LangIDValue(16,0,0) = "et"
|
||||
LangIDValue(16,0,1) = "ET"
|
||||
LangIDValue(16,0,2) = "-425"
|
||||
|
||||
' CURRENCIES_LATVIAN
|
||||
LangIDValue(17,0,0) = "lv"
|
||||
LangIDValue(17,0,1) = "LV"
|
||||
LangIDValue(17,0,2) = "-426"
|
||||
' and Latgalian
|
||||
LangIDValue(17,1,0) = "ltg"
|
||||
LangIDValue(17,1,1) = "LV"
|
||||
LangIDValue(17,1,2) = "-64B"
|
||||
|
||||
' CURRENCIES_LITHUANIAN
|
||||
LangIDValue(18,0,0) = "lt"
|
||||
LangIDValue(18,0,1) = "LT"
|
||||
LangIDValue(18,0,2) = "-427"
|
||||
|
||||
' CURRENCIES_CROATIAN
|
||||
LangIDValue(19,0,0) = "hr"
|
||||
LangIDValue(19,0,1) = "HR"
|
||||
LangIDValue(19,0,2) = "-41A"
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub InitializeCurrencies()
|
||||
Dim i as Integer
|
||||
GoOn = True
|
||||
|
||||
CurrValue(0,0) = sCurrPORTUGUESE
|
||||
' real conversion rate
|
||||
CurrValue(0,1) = 200.482
|
||||
' rounded conversion rate
|
||||
CurrValue(0,2) = 200
|
||||
CurrValue(0,3) = "Esc."
|
||||
CurrValue(0,4) = "Esc."
|
||||
CurrValue(0,5) = "PTE"
|
||||
|
||||
CurrValue(1,0) = sCurrDUTCH
|
||||
' real conversion rate
|
||||
CurrValue(1,1) = 2.20371
|
||||
' rounded conversion rate
|
||||
CurrValue(1,2) = 2
|
||||
CurrValue(1,3) = "F"
|
||||
CurrValue(1,4) = "fl"
|
||||
CurrValue(1,5) = "NLG"
|
||||
|
||||
CurrValue(2,0) = sCurrFRENCH
|
||||
' real conversion rate
|
||||
CurrValue(2,1) = 6.55957
|
||||
' rounded conversion rate
|
||||
CurrValue(2,2) = 7
|
||||
CurrValue(2,3) = "F"
|
||||
CurrValue(2,4) = "F"
|
||||
CurrValue(2,5) = "FRF"
|
||||
|
||||
CurrValue(3,0) = sCurrSPANISH
|
||||
' real conversion rate
|
||||
CurrValue(3,1) = 166.386
|
||||
' rounded conversion rate
|
||||
CurrValue(3,2) = 170
|
||||
CurrValue(3,3) = "Pts"
|
||||
CurrValue(3,4) = "Pts"
|
||||
CurrValue(3,5) = "ESP"
|
||||
|
||||
CurrValue(4,0) = sCurrITALIAN
|
||||
' real conversion rate
|
||||
CurrValue(4,1) = 1936.27
|
||||
' rounded conversion rate
|
||||
CurrValue(4,2) = 2000
|
||||
CurrValue(4,3) = "L."
|
||||
CurrValue(4,4) = "L."
|
||||
CurrValue(4,5) = "ITL"
|
||||
|
||||
CurrValue(5,0) = sCurrGERMAN
|
||||
' real conversion rate
|
||||
CurrValue(5,1) = 1.95583
|
||||
' rounded conversion rate
|
||||
CurrValue(5,2) = 2
|
||||
CurrValue(5,3) = "DM"
|
||||
CurrValue(5,4) = "DM"
|
||||
CurrValue(5,5) = "DEM"
|
||||
|
||||
CurrValue(6,0) = sCurrBELGIAN
|
||||
' real conversion rate
|
||||
CurrValue(6,1) = 40.3399
|
||||
' rounded conversion rate
|
||||
CurrValue(6,2) = 40
|
||||
CurrValue(6,3) = "FB"
|
||||
CurrValue(6,4) = "BF"
|
||||
CurrValue(6,5) = "BEF"
|
||||
|
||||
CurrValue(7,0) = sCurrIRISH
|
||||
' real conversion rate
|
||||
CurrValue(7,1) = 0.787564
|
||||
' rounded conversion rate
|
||||
CurrValue(7,2) = 0.8
|
||||
CurrValue(7,3) = "IR£"
|
||||
CurrValue(7,4) = "£"
|
||||
CurrValue(7,5) = "IEP"
|
||||
|
||||
CurrValue(8,0) = sCurrLUXEMBOURG
|
||||
' real conversion rate
|
||||
CurrValue(8,1) = 40.3399
|
||||
' rounded conversion rate
|
||||
CurrValue(8,2) = 40
|
||||
CurrValue(8,3) = "F"
|
||||
CurrValue(8,4) = "F"
|
||||
CurrValue(8,5) = "LUF"
|
||||
|
||||
CurrValue(9,0) = sCurrAUSTRIAN
|
||||
' real conversion rate
|
||||
CurrValue(9,1) = 13.7603
|
||||
' rounded conversion rate
|
||||
CurrValue(9,2) = 15
|
||||
CurrValue(9,3) = "öS"
|
||||
CurrValue(9,4) = "S"
|
||||
CurrValue(9,5) = "ATS"
|
||||
|
||||
CurrValue(10,0) = sCurrFINNISH
|
||||
' real conversion rate
|
||||
CurrValue(10,1) = 5.94573
|
||||
' rounded conversion rate
|
||||
CurrValue(10,2) = 6
|
||||
CurrValue(10,3) = "mk"
|
||||
CurrValue(10,4) = "mk"
|
||||
CurrValue(10,5) = "FIM"
|
||||
|
||||
CurrValue(11,0) = sCurrGREEK
|
||||
' real conversion rate
|
||||
CurrValue(11,1) = 340.750
|
||||
' rounded conversion rate
|
||||
CurrValue(11,2) = 400
|
||||
CurrValue(11,3) = chr(916) & chr(961) & chr(967)
|
||||
CurrValue(11,4) = chr(916) & chr(961) & chr(967)
|
||||
CurrValue(11,5) = "GRD"
|
||||
|
||||
CurrValue(12,0) = sCurrSLOVENIAN
|
||||
' real conversion rate
|
||||
CurrValue(12,1) = 239.64
|
||||
' rounded conversion rate
|
||||
CurrValue(12,2) = 240
|
||||
CurrValue(12,3) = "SIT"
|
||||
CurrValue(12,4) = "SIT"
|
||||
CurrValue(12,5) = "SIT"
|
||||
|
||||
CurrValue(13,0) = sCurrCYPRIOT
|
||||
' real conversion rate
|
||||
CurrValue(13,1) = 0.585274
|
||||
' rounded conversion rate
|
||||
CurrValue(13,2) = 0.6
|
||||
CurrValue(13,3) = "£C"
|
||||
CurrValue(13,4) = "£"
|
||||
CurrValue(13,5) = "CYP"
|
||||
|
||||
CurrValue(14,0) = sCurrMALTESE
|
||||
' real conversion rate
|
||||
CurrValue(14,1) = 0.429300
|
||||
' rounded conversion rate
|
||||
CurrValue(14,2) = 0.4
|
||||
CurrValue(14,3) = chr(8356)
|
||||
CurrValue(14,4) = "Lm"
|
||||
CurrValue(14,5) = "MTL"
|
||||
|
||||
CurrValue(15,0) = sCurrSLOVAK
|
||||
' real conversion rate
|
||||
CurrValue(15,1) = 30.1260
|
||||
' rounded conversion rate
|
||||
CurrValue(15,2) = 30
|
||||
CurrValue(15,3) = "Sk"
|
||||
CurrValue(15,4) = "Sk"
|
||||
CurrValue(15,5) = "SKK"
|
||||
|
||||
CurrValue(16,0) = sCurrESTONIAN
|
||||
' real conversion rate
|
||||
CurrValue(16,1) = 15.6466
|
||||
' rounded conversion rate
|
||||
CurrValue(16,2) = 16
|
||||
CurrValue(16,3) = "kr"
|
||||
CurrValue(16,4) = "kr"
|
||||
CurrValue(16,5) = "EEK"
|
||||
|
||||
CurrValue(17,0) = sCurrLATVIAN
|
||||
' real conversion rate
|
||||
CurrValue(17,1) = 0.702804
|
||||
' rounded conversion rate
|
||||
CurrValue(17,2) = 0.7
|
||||
CurrValue(17,3) = "Ls"
|
||||
CurrValue(17,4) = "Ls"
|
||||
CurrValue(17,5) = "LVL"
|
||||
|
||||
CurrValue(18,0) = sCurrLITHUANIAN
|
||||
' real conversion rate
|
||||
CurrValue(18,1) = 3.45280
|
||||
' rounded conversion rate
|
||||
CurrValue(18,2) = 3.5
|
||||
CurrValue(18,3) = "Lt"
|
||||
CurrValue(18,4) = "Lt"
|
||||
CurrValue(18,5) = "LTL"
|
||||
|
||||
CurrValue(19,0) = sCurrCROATIAN
|
||||
' real conversion rate
|
||||
CurrValue(19,1) = 7.53450
|
||||
' rounded conversion rate
|
||||
CurrValue(19,2) = 7.5
|
||||
CurrValue(19,3) = "kn"
|
||||
CurrValue(19,4) = "kn"
|
||||
CurrValue(19,5) = "HRK"
|
||||
|
||||
i = -1
|
||||
CurrSymbolList(0) = ""
|
||||
CurrSymbolList(1) = ""
|
||||
InitializeCurrencyValues(CurrIndex)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeControls()
|
||||
If CurrIndex = -1 Then
|
||||
If DialogModel.Step = 1 Then
|
||||
EnableStep1DialogControls(True, False, False)
|
||||
ElseIf DialogModel.Step = 2 Then
|
||||
EnableStep2DialogControls(True)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeConverter(oLocale, iDialogPage as Integer)
|
||||
Dim Isthere as Boolean
|
||||
bCancelProtection = False
|
||||
bRangeListDefined = False
|
||||
PWIndex = -1
|
||||
If iDialogPage = 1 Then
|
||||
ToggleWindow(False)
|
||||
sDocType = Tools.GetDocumentType(ThisComponent)
|
||||
If sDocType = "sCalc" Then
|
||||
bDocHasProtectedSheets = CheckSheetProtection(oSheets)
|
||||
End If
|
||||
oStatusline = ThisComponent.GetCurrentController.GetFrame.CreateStatusIndicator()
|
||||
End If
|
||||
DialogConvert = LoadDialog("Euro", "DlgConvert")
|
||||
DialogModel = DialogConvert.Model
|
||||
DialogPassword = LoadDialog("Euro", "DlgPassword")
|
||||
PasswordModel = DialogPassword.Model
|
||||
DialogModel.Step = iDialogPage
|
||||
InitializeResources()
|
||||
InitializeLanguages()
|
||||
InitializeLocales(oLocale)
|
||||
InitializeCurrencies()
|
||||
InitializeControls()
|
||||
BitmapDir = GetOfficeSubPath("Template", "../wizard/bitmap")
|
||||
If BitmapDir = "" Then
|
||||
Stop
|
||||
End If
|
||||
FillUpCurrencyListbox()
|
||||
DialogModel.imgPreview.ImageUrl = BitmapDir & "euro_" & DialogModel.Step & ".png"
|
||||
DialogConvert.Title = sMsgDLGTITLE
|
||||
DialogModel.cmdGoOn.DefaultButton = True
|
||||
If iDialogPage = 1 Then
|
||||
ToggleWindow(True)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeCurrencyValues(CurrIndex)
|
||||
If CurrIndex <> -1 Then
|
||||
CurrLanguage = CurrValue(CurrIndex,0)
|
||||
CurrFactor = CurrValue(CurrIndex,1)
|
||||
CurrSymbolList(0) = CurrValue(CurrIndex,3)
|
||||
CurrSymbolList(1) = CurrValue(CurrIndex,4)
|
||||
CurrSymbolList(2) = CurrValue(CurrIndex,5)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function InitializeLocales(oLocale) as Boolean
|
||||
Dim i as Integer, n as Integer, m as Integer
|
||||
Dim sLanguage as String, sCountry as String
|
||||
Dim bTakeThisLocale as Boolean
|
||||
sLanguage = oLocale.Language
|
||||
sCountry = oLocale.Country
|
||||
For n = 0 To SBCOUNTRYCOUNT - 1
|
||||
For m = 0 TO 1
|
||||
If DialogModel.Step = 2 Then
|
||||
bTakeThisLocale = LangIDValue(n,m,0) = sLanguage
|
||||
Else
|
||||
bTakeThisLocale = LangIDValue(n,m,0) = sLanguage
|
||||
End If
|
||||
If bTakeThisLocale Then
|
||||
CurrIndex = n
|
||||
For i = 0 To 2
|
||||
CurExtension(i) = LangIDValue(CurrIndex,i,2)
|
||||
Next i
|
||||
InitializeLocales = True
|
||||
Exit Function
|
||||
End If
|
||||
Next m
|
||||
Next n
|
||||
CurrIndex = -1
|
||||
InitializeLocales = False
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,192 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Protect" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
Public PWIndex as Integer
|
||||
|
||||
|
||||
Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim iMsgResult as Integer
|
||||
PWIndex = -1
|
||||
If bDocHasProtectedSheets Then
|
||||
If Not bDoUnprotect Then
|
||||
' At First query if sheets shall generally be unprotected
|
||||
iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE)
|
||||
bDoUnProtect = iMsgResult = 6
|
||||
End If
|
||||
If bDoUnProtect Then
|
||||
MaxIndex = oSheets.Count-1
|
||||
For i = 0 To MaxIndex
|
||||
bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i))
|
||||
If bDocHasProtectedSheets Then
|
||||
ReprotectSheets()
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If PWIndex = -1 Then
|
||||
ReDim UnProtectList() as String
|
||||
Else
|
||||
ReDim Preserve UnProtectList(PWIndex) as String
|
||||
End If
|
||||
Else
|
||||
Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
|
||||
End If
|
||||
End If
|
||||
UnProtectSheetsWithPassword = bDocHasProtectedSheets
|
||||
End Function
|
||||
|
||||
|
||||
Function UnprotectSheet(oListSheet as Object)
|
||||
Dim ListSheetName as String
|
||||
Dim sStatustext as String
|
||||
Dim i as Integer
|
||||
Dim bOneSheetIsUnprotected as Boolean
|
||||
i = -1
|
||||
ListSheetName = oListSheet.Name
|
||||
If oListSheet.IsProtected Then
|
||||
oListSheet.Unprotect("")
|
||||
If oListSheet.IsProtected Then
|
||||
' Sheet is protected by a Password
|
||||
bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName)
|
||||
UnProtectSheet() = bOneSheetIsUnProtected
|
||||
Else
|
||||
' The Sheet could be unprotected without a password
|
||||
AddSheettoUnprotectionlist(ListSheetName,"")
|
||||
UnprotectSheet() = True
|
||||
End If
|
||||
Else
|
||||
UnprotectSheet() = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean
|
||||
Dim PWIsCorrect as Boolean
|
||||
Dim QueryText as String
|
||||
oDocument.CurrentController.SetActiveSheet(oListSheet)
|
||||
QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1")
|
||||
'"Please insert the password to unprotect the sheet '" & ListSheetName'"
|
||||
Do
|
||||
ExecutePasswordDialog(QueryText)
|
||||
If bCancelProtection Then
|
||||
bCancelProtection = False
|
||||
Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE)
|
||||
UnprotectSheetWithDialog() = False
|
||||
exit Function
|
||||
End If
|
||||
oListSheet.Unprotect(Password)
|
||||
If oListSheet.IsProtected Then
|
||||
PWIsCorrect = False
|
||||
Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE)
|
||||
Else
|
||||
' Sheet could be unprotected
|
||||
AddSheettoUnprotectionlist(ListSheetName,Password)
|
||||
PWIsCorrect = True
|
||||
End If
|
||||
Loop Until PWIsCorrect
|
||||
UnprotectSheetWithDialog() = True
|
||||
End Function
|
||||
|
||||
|
||||
Sub ExecutePasswordDialog(QueryText as String)
|
||||
With PasswordModel
|
||||
.Title = QueryText
|
||||
.hlnPassword.Label = sMsgPASSWORD
|
||||
.cmdCancel.Label = sMsgCANCEL
|
||||
.cmdHelp.Label = sHELP
|
||||
.cmdGoOn.Label = sMsgOK
|
||||
.cmdGoOn.DefaultButton = True
|
||||
End With
|
||||
DialogPassword.Execute
|
||||
End Sub
|
||||
|
||||
Sub ReadPassword()
|
||||
Password = PasswordModel.txtPassword.Text
|
||||
DialogPassword.EndExecute
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RejectPassword()
|
||||
bCancelProtection = True
|
||||
DialogPassword.EndExecute
|
||||
End Sub
|
||||
|
||||
|
||||
' Reprotects the previously protected sheets
|
||||
' The password information is stored in the List 'UnProtectList()'
|
||||
Sub ReprotectSheets()
|
||||
Dim i as Integer
|
||||
Dim oProtectSheet as Object
|
||||
Dim ProtectList() as String
|
||||
Dim SheetName as String
|
||||
Dim SheetPassword as String
|
||||
If PWIndex > -1 Then
|
||||
SetStatusLineText(sStsREPROTECT)
|
||||
For i = 0 To PWIndex
|
||||
ProtectList() = ArrayOutOfString(UnProtectList(i),";")
|
||||
SheetName = ProtectList(0)
|
||||
If Ubound(ProtectList()) > 0 Then
|
||||
SheetPassWord = ProtectList(1)
|
||||
Else
|
||||
SheetPassword = ""
|
||||
End If
|
||||
oProtectSheet = oSheets.GetbyName(SheetName)
|
||||
If Not oProtectSheet.IsProtected Then
|
||||
oProtectSheet.Protect(SheetPassWord)
|
||||
End If
|
||||
Next i
|
||||
SetStatusLineText("")
|
||||
End If
|
||||
PWIndex = -1
|
||||
ReDim UnProtectList()
|
||||
End Sub
|
||||
|
||||
|
||||
' Add a Sheet to the list of sheets that finally have to be
|
||||
' unprotected
|
||||
Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String)
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(UnProtectList())
|
||||
PWIndex = PWIndex + 1
|
||||
If PWIndex > MaxIndex Then
|
||||
ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND)
|
||||
End If
|
||||
UnprotectList(PWIndex) = ListSheetName & ";" & Password
|
||||
End Sub
|
||||
|
||||
|
||||
Function CheckSheetProtection(oSheets as Object) as Boolean
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
Dim bProtectedSheets as Boolean
|
||||
bProtectedSheets = False
|
||||
MaxIndex = oSheets.Count-1
|
||||
For i = 0 To MaxIndex
|
||||
bProtectedSheets = oSheets(i).IsProtected
|
||||
If bProtectedSheets Then
|
||||
CheckSheetProtection() = True
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
CheckSheetProtection() = False
|
||||
End Function</script:module>
|
||||
@@ -0,0 +1,256 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Soft" script:language="StarBasic">Option Explicit
|
||||
REM ***** BASIC *****
|
||||
|
||||
|
||||
Sub CreateStyleEnumeration()
|
||||
EmptySelection()
|
||||
EmptyListbox(DialogModel.lstSelection)
|
||||
CurSheetName = oDocument.CurrentController.GetActiveSheet.Name
|
||||
MakeStyleEnumeration(False)
|
||||
DialogModel.lblSelection.Label = sTEMPLATES
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MakeStyleEnumeration(bAddToListbox as Boolean)
|
||||
Dim m as integer
|
||||
Dim aStyleFormat as Object
|
||||
Dim Stylename as String
|
||||
StyleIndex = -1
|
||||
oStyles = oDocument.StyleFamilies.GetbyIndex(0)
|
||||
For m = 0 To oStyles.count-1
|
||||
oStyle = oStyles.GetbyIndex(m)
|
||||
StyleName = oStyle.Name
|
||||
If CheckFormatType(oStyle) Then
|
||||
If Not bAddToListBox Then
|
||||
AddSingleItemToListbox(DialogModel.lstSelection, Stylename)
|
||||
Else
|
||||
SwitchNumberFormat(ostyle, oFormats, sEuroSign)
|
||||
End If
|
||||
StyleIndex = StyleIndex + 1
|
||||
If StyleIndex > Ubound(StyleRangeAssignMentList()) Then
|
||||
Redim Preserve StyleRangeAssignmentList(StyleIndex)
|
||||
End If
|
||||
StyleRangeAssignmentList(StyleIndex) = "<STYLENAME>" & Stylename & "</STYLENAME>" & _
|
||||
"<DEFINED>FALSE</DEFINED>" & "<RANGES></RANGES>" &_
|
||||
"<CELLCOUNT>0</CELLCOUNT>" &_
|
||||
"<SELECTED>FALSE</SELECTED>"
|
||||
End If
|
||||
Next m
|
||||
If StyleIndex > -1 Then
|
||||
Redim Preserve StyleRangeAssignmentList(StyleIndex)
|
||||
Else
|
||||
ReDim StyleRangeAssignmentList()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AssignRangestoStyle(StyleList(), SelList())
|
||||
Dim i as Integer
|
||||
Dim n as integer
|
||||
Dim LastIndex as Integer
|
||||
Dim CurStyleName as String
|
||||
Dim AssignString as String
|
||||
LastIndex = Ubound(StyleList())
|
||||
StatusValue = 0
|
||||
SetStatusLineText(sStsRELRANGES)
|
||||
For i = 0 To LastIndex
|
||||
CurStyleName = StyleList(i)
|
||||
n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
|
||||
AssignString = StyleRangeAssignmentlist(n)
|
||||
If IndexInArray(CurStyleName, SelList()) <> -1 Then
|
||||
' Style is selected
|
||||
If FindPartString(AssignString, "<DEFINED>", "</DEFINED>", 1) = "FALSE" Then
|
||||
AssignString = ReplaceString(AssignString, "<SELECTED>TRUE</SELECTED>", "<SELECTED>FALSE</SELECTED>")
|
||||
AssignCellFormatRanges(n, AssignString, CurStyleName)
|
||||
End If
|
||||
Else
|
||||
' Style is not selected
|
||||
If FindPartString(AssignString, "<SELECTED>", "</SELECTED>", 1) = "FALSE" Then
|
||||
DeselectStyle(CurStyleName, n)
|
||||
End If
|
||||
End If
|
||||
IncreaseStatusvalue(SBRELGET/(LastIndex+1))
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String)
|
||||
Dim oRanges() as Object
|
||||
Dim oRange as Object
|
||||
Dim oRangeAddress
|
||||
Dim oSheet as Object
|
||||
Dim StyleCellCount as Long
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim RangeString as String
|
||||
Dim SheetName as String
|
||||
Dim RangeName as String
|
||||
Dim CellCountString as String
|
||||
StyleCellCount = 0
|
||||
RangeString = "<RANGES>"
|
||||
MaxIndex = oSheets.Count-1
|
||||
For i = 0 To MaxIndex
|
||||
oSheet = oSheets(i)
|
||||
SheetName = oSheet.Name
|
||||
oRanges = osheet.CellFormatRanges.CreateEnumeration
|
||||
While oRanges.hasMoreElements
|
||||
oRange = oRanges.NextElement
|
||||
If oRange.getPropertyState("NumberFormat") = 1 Then
|
||||
If oRange.CellStyle = CurStyleName Then
|
||||
oRangeAddress = oRange.RangeAddress
|
||||
RangeName = RetrieveRangeNamefromAddress(oRange)
|
||||
RangeString = RangeString & RangeName & ","
|
||||
StyleCellCount = StyleCellCount + CountRangeCells(oRange)
|
||||
End If
|
||||
End If
|
||||
Wend
|
||||
Next i
|
||||
If StyleCellCount > 0 Then
|
||||
TotCellCount = TotCellCount + StyleCellCount
|
||||
RangeString = RTrimStr(RangeString,",")
|
||||
RangeString = RangeString & "</RANGES>"
|
||||
CellCountString = "<CELLCOUNT>" & StyleCellCount & "</CELLCOUNT"
|
||||
AssignString = ReplaceString(AssignString, RangeString,"<RANGES></RANGES>")
|
||||
AssignString = ReplaceString(AssignString, CellCountString,"<CELLCOUNT>0</CELLCOUNT>")
|
||||
End If
|
||||
AssignString = ReplaceString(AssignString, "<DEFINED>TRUE</DEFINED>", "<DEFINED>FALSE</DEFINED>")
|
||||
StyleRangeAssignmentList(n) = AssignString
|
||||
End Sub
|
||||
|
||||
|
||||
' deletes a styletemplate from the Collection that selects the ranges
|
||||
Sub DeselectStyle(DeSelStyleName as String, n as Integer)
|
||||
Dim i as Integer
|
||||
Dim RangeName as String
|
||||
Dim SelectString as String
|
||||
Dim AssignString as String
|
||||
Dim StyleRangeList() as String
|
||||
Dim MaxIndex as Integer
|
||||
SelectString ="<SELECTED>FALSE</SELECTED>"
|
||||
AssignString = StyleRangeAssignmentList(n)
|
||||
RangeString = FindPartString(AssignString,"<RANGES>","</RANGES>",1)
|
||||
StyleRangeList() = ArrayoutofString(RangeString,",")
|
||||
MaxIndex = Ubound(StyleRangeList())
|
||||
For i = 0 To MaxIndex
|
||||
RangeName = StyleRangeList(i)
|
||||
If oSelRanges.HasbyName(RangeName) Then
|
||||
oSelRanges.RemovebyName(RangeName)
|
||||
End If
|
||||
Next i
|
||||
AssignString = ReplaceString(AssignString, "<SELECTED>FALSE</SELECTED>", "<SELECTED>TRUE</SELECTED>")
|
||||
StyleRangeAssignmentList(n) = AssignString
|
||||
End Sub
|
||||
|
||||
|
||||
Function RetrieveRangeNamefromAddress(oRange as Object) as String
|
||||
Dim Rangename as String
|
||||
Dim oAddressRanges as Object
|
||||
oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
oAddressRanges.InsertbyName("",oRange)
|
||||
Rangename = oAddressRanges.RangeAddressesasString
|
||||
' Msgbox "Adresse: " & oRangeAddress.StartColumn & " ; " & oRangeAddress.EndColumn & " ; " & oRangeAddress.StartRow & " ; " & oRangeAddress.EndRow & chr(13) & RangeName
|
||||
' oAddressRanges.RemovebyName(RangeName)
|
||||
RetrieveRangeNamefromAddress = Rangename
|
||||
End Function
|
||||
|
||||
|
||||
' creates a sheet object from an according sectionname
|
||||
Function RetrieveSheetoutofRangeName(TableText as String)
|
||||
Dim DescriptionList() as String
|
||||
Dim SheetName as String
|
||||
Dim MaxIndex as integer
|
||||
' find out in which sheet the range is
|
||||
DescriptionList() = ArrayOutofString(TableText,".",MaxIndex)
|
||||
SheetName = DescriptionList(0)
|
||||
SheetName = DeleteStr(SheetName,"'")
|
||||
' set the viewcursor on this sheet
|
||||
RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName)
|
||||
End Function
|
||||
|
||||
|
||||
' creates a rangeobject from an according rangename
|
||||
Function RetrieveRangeoutofRangeName(TableText as String)
|
||||
oSheet = RetrieveSheetoutofRangeName(TableText)
|
||||
oRange = oSheet.GetCellRangebyName(TableText)
|
||||
RetrieveRangeoutofRangeName = oRange
|
||||
End Function
|
||||
|
||||
|
||||
Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean)
|
||||
Dim i as Integer
|
||||
Dim l as Integer
|
||||
Dim s as Integer
|
||||
Dim n as Integer
|
||||
Dim CurStyleName as String
|
||||
Dim RangeName as String
|
||||
Dim OldStatusValue as Integer
|
||||
Dim LastIndex as Integer
|
||||
Dim oSelListbox as Object
|
||||
Dim StyleRangeList() as String
|
||||
Dim MaxIndex as Integer
|
||||
oSelListbox = DialogConvert.GetControl("lstSelection")
|
||||
LastIndex = Ubound(StyleList())
|
||||
OldStatusValue = StatusValue
|
||||
For i = 0 To LastIndex
|
||||
CurStyleName = StyleList(i)
|
||||
oStyle = oStyles.GetbyName(CurStyleName)
|
||||
StyleRangeList() = GetAssignedRanges(CurStyleName, n)
|
||||
MaxIndex = Ubound(StyleRangeList())
|
||||
For s = 0 To MaxIndex
|
||||
RangeName = StyleRangeList(s)
|
||||
oRange = RetrieveRangeoutofRangeName(RangeName)
|
||||
If oRange.getPropertyState("NumberFormat") = 1 Then
|
||||
' Range is hard formatted
|
||||
ConvertCellCurrencies(oRange)
|
||||
CurCellCount = CountRangeCells(oRange)
|
||||
End If
|
||||
IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue))
|
||||
If bDeSelect Then
|
||||
' Note: On Problems see Bug #73157
|
||||
If oSelRanges.HasbyName(RangeName) Then
|
||||
oSelRanges.RemovebyName(RangeName)
|
||||
oDocument.CurrentController.Select(oSelRanges)
|
||||
End If
|
||||
End If
|
||||
Next s
|
||||
SwitchNumberFormat(ostyle, oFormats, sEuroSign)
|
||||
StyleRangeAssignmentList(n) = ""
|
||||
l = GetItemPos(oSelListBox.Model, CurStyleName)
|
||||
oSelListbox.RemoveItems(l,1)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetAssignedRanges(CurStyleName as String, n as Integer)
|
||||
Dim StyleRangeList() as String
|
||||
Dim RangeString as String
|
||||
Dim AssignString as String
|
||||
n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
|
||||
If n <> -1 Then
|
||||
AssignString = StyleRangeAssignmentList(n)
|
||||
RangeString = FindPartString(AssignString,"<RANGES>", "</RANGES>",1)
|
||||
If RangeString <> "" Then
|
||||
StyleRangeList() = ArrayoutofString(RangeString,",")
|
||||
End If
|
||||
End If
|
||||
GetAssignedRanges() = StyleRangeList()
|
||||
End Function</script:module>
|
||||
@@ -0,0 +1,89 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Writer" script:language="StarBasic">REM ***** BASIC *****
|
||||
|
||||
|
||||
Sub ConvertWriterTables()
|
||||
Dim CellString as String
|
||||
Dim oParagraphs as Object
|
||||
Dim oPara as Object
|
||||
Dim i as integer
|
||||
Dim sCellNames()
|
||||
Dim oCell as Object
|
||||
oParagraphs = oDocument.Text.CreateEnumeration
|
||||
While oParagraphs.HasMoreElements
|
||||
oPara = oParagraphs.NextElement
|
||||
If NOT oPara.supportsService("com.sun.star.text.Paragraph") Then
|
||||
' Note: As cells might be split or merged
|
||||
' you cannot refer to them via their indices
|
||||
sCellNames = oPara.CellNames
|
||||
For i = 0 To Ubound(sCellNames)
|
||||
If sCellNames(i) <> "" Then
|
||||
oCell = oPara.getCellByName(sCellNames(i))
|
||||
If CheckFormatType(oCell) Then
|
||||
SwitchNumberFormat(oCell, oFormats, sEuroSign)
|
||||
ModifyObjectValuewithCurrFactor(oCell)
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ModifyObjectValuewithCurrFactor(oDocObject as Object)
|
||||
oDocObjectValue = oDocObject.Value
|
||||
oDocObject.Value = oDocObjectValue/CurrFactor
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertTextFields()
|
||||
Dim oTextFields as Object
|
||||
Dim oTextField as Object
|
||||
Dim FieldValue
|
||||
Dim oDocObjectValue as double
|
||||
Dim InstanceNames(500) as String
|
||||
Dim CurInstanceName as String
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = 0
|
||||
oTextfields = oDocument.getTextfields.CreateEnumeration
|
||||
While oTextFields.hasmoreElements
|
||||
oTextField = oTextFields.NextElement
|
||||
If oTextField.PropertySetInfo.HasPropertybyName("NumberFormat") Then
|
||||
If CheckFormatType(oTextField) Then
|
||||
If oTextField.PropertySetInfo.HasPropertybyName("Value") Then
|
||||
If Not oTextField.SupportsService("com.sun.star.text.TextField.GetExpression") Then
|
||||
oTextField.Content = CStr(Round(oTextField.Value/CurrFactor,2))
|
||||
End If
|
||||
ElseIf oTextField.TextFieldMaster.PropertySetInfo.HasPropertyByName("Value") Then
|
||||
CurInstanceName = oTextField.TextFieldMaster.InstanceName
|
||||
If Not FieldInArray(InstanceNames(), MaxIndex, CurInstanceName) Then
|
||||
oTextField.TextFieldMaster.Content = CStr(Round(oTextField.TextFieldMaster.Value/CurrFactor,2))
|
||||
InstanceNames(MaxIndex) = CurInstanceName
|
||||
MaxIndex = MaxIndex + 1
|
||||
End If
|
||||
End If
|
||||
SwitchNumberFormat(oTextField, oFormats, sEuroSign)
|
||||
End If
|
||||
End If
|
||||
Wend
|
||||
oDocument.GetTextFields.refresh()
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Euro" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="DlgConvert"/>
|
||||
<library:element library:name="DlgPassword"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,12 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Euro" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="ConvertRun"/>
|
||||
<library:element library:name="AutoPilotRun"/>
|
||||
<library:element library:name="Hard"/>
|
||||
<library:element library:name="Soft"/>
|
||||
<library:element library:name="Init"/>
|
||||
<library:element library:name="Common"/>
|
||||
<library:element library:name="Writer"/>
|
||||
<library:element library:name="Protect"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,347 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DBMeta" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
|
||||
Public iCommandTypes() as Integer
|
||||
Public CurCommandType as Integer
|
||||
Public oDataSource as Object
|
||||
Public bEnableBinaryOptionGroup as Boolean
|
||||
'Public bSelectContent as Boolean
|
||||
|
||||
|
||||
Function GetDatabaseNames(baddFirstListItem as Boolean)
|
||||
Dim sDatabaseList()
|
||||
If oDBContext.HasElements Then
|
||||
Dim LocDBList() as String
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
LocDBList = oDBContext.ElementNames()
|
||||
MaxIndex = Ubound(LocDBList())
|
||||
If baddfirstListItem Then
|
||||
ReDim Preserve sDatabaseList(MaxIndex + 1)
|
||||
sDatabaseList(0) = sSelectDatasource
|
||||
a = 1
|
||||
Else
|
||||
ReDim Preserve sDatabaseList(MaxIndex)
|
||||
a = 0
|
||||
End If
|
||||
For i = 0 To MaxIndex
|
||||
sDatabaseList(a) = oDBContext.ElementNames(i)
|
||||
a = a + 1
|
||||
Next i
|
||||
End If
|
||||
GetDatabaseNames() = sDatabaseList()
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetSelectedDBMetaData(sDBName as String)
|
||||
Dim OldsDBname as String
|
||||
Dim DBIndex as Integer
|
||||
Dim LocList() as String
|
||||
' If bStartUp Then
|
||||
' bStartUp = false
|
||||
' Exit Sub
|
||||
' End Sub
|
||||
ToggleDatabasePage(False)
|
||||
With DialogModel
|
||||
If GetConnection(sDBName) Then
|
||||
If GetDBMetaData() Then
|
||||
LocList() = AddListToList(Array(sSelectDBTable), TableNames())
|
||||
.lstTables.StringItemList() = AddListToList(LocList(), QueryNames())
|
||||
' bSelectContent = True
|
||||
.lstTables.SelectedItems() = Array(0)
|
||||
iCommandTypes() = CreateCommandTypeList()
|
||||
EmptyFieldsListboxes()
|
||||
End If
|
||||
End If
|
||||
bEnableBinaryOptionGroup = False
|
||||
.lstTables.Enabled = True
|
||||
.lblTables.Enabled = True
|
||||
' Else
|
||||
' DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
|
||||
' EmptyFieldsListboxes()
|
||||
' End If
|
||||
ToggleDatabasePage(True)
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetConnection(sDBName as String)
|
||||
Dim oInteractionHandler as Object
|
||||
Dim bExitLoop as Boolean
|
||||
Dim bGetConnection as Boolean
|
||||
Dim iMsg as Integer
|
||||
Dim Nulllist()
|
||||
If Not IsNull(oDBConnection) Then
|
||||
oDBConnection.Dispose()
|
||||
End If
|
||||
oDataSource = oDBContext.GetByName(sDBName)
|
||||
' If Not oDBContext.hasbyName(sDBName) Then
|
||||
' GetConnection() = False
|
||||
' Exit Function
|
||||
' End If
|
||||
If Not oDataSource.IsPasswordRequired Then
|
||||
oDBConnection = oDBContext.GetByName(sDBName).GetConnection("","")
|
||||
GetConnection() = True
|
||||
Else
|
||||
oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler")
|
||||
oDataSource = oDBContext.GetByName(sDBName)
|
||||
On Local Error Goto NOCONNECTION
|
||||
Do
|
||||
bExitLoop = True
|
||||
oDBConnection = oDataSource.ConnectWithCompletion(oInteractionHandler)
|
||||
NOCONNECTION:
|
||||
bGetConnection = Err = 0
|
||||
If bGetConnection Then
|
||||
bGetConnection = Not IsNull(oDBConnection)
|
||||
If Not bGetConnection Then
|
||||
Exit Do
|
||||
End If
|
||||
End If
|
||||
If Not bGetConnection Then
|
||||
iMsg = Msgbox (sMsgNoConnection,32 + 2, sMsgWizardName)
|
||||
bExitLoop = iMsg = SBCANCEL
|
||||
Resume CLERROR
|
||||
CLERROR:
|
||||
End If
|
||||
Loop Until bExitLoop
|
||||
On Local Error Goto 0
|
||||
If Not bGetConnection Then
|
||||
DialogModel.lstTables.StringItemList() = Array(sSelectDBTable)
|
||||
DialogModel.lstFields.StringItemList() = NullList()
|
||||
DialogModel.lstSelFields.StringItemList() = NullList()
|
||||
End If
|
||||
GetConnection() = bGetConnection
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function GetDBMetaData()
|
||||
If oDBContext.HasElements Then
|
||||
Tablenames() = oDBConnection.Tables.ElementNames()
|
||||
Querynames() = oDBConnection.Queries.ElementNames()
|
||||
GetDBMetaData = True
|
||||
Else
|
||||
MsgBox(sMsgErrNoDatabase, 64, sMsgWizardName)
|
||||
GetDBMetaData = False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetTableMetaData()
|
||||
Dim iType as Long
|
||||
Dim m as Integer
|
||||
Dim Found as Boolean
|
||||
Dim i as Integer
|
||||
Dim sFieldName as String
|
||||
Dim n as Integer
|
||||
Dim WidthIndex as Integer
|
||||
Dim oField as Object
|
||||
MaxIndex = Ubound(DialogModel.lstSelFields.StringItemList())
|
||||
Dim ColumnMap(MaxIndex)as Integer
|
||||
FieldNames() = DialogModel.lstSelFields.StringItemList()
|
||||
' Build a structure which maps the position of a selected field (within the selection) to the column position within
|
||||
' the table. So we ensure that the controls are placed in the same order the according fields are selected.
|
||||
For i = 0 To Ubound(FieldNames())
|
||||
sFieldName = FieldNames(i)
|
||||
Found = False
|
||||
n = 0
|
||||
While (n< MaxIndex And (Not Found))
|
||||
If (FieldNames(n) = sFieldName) Then
|
||||
Found = True
|
||||
ColumnMap(n) = i
|
||||
End If
|
||||
n = n + 1
|
||||
Wend
|
||||
Next i
|
||||
For n = 0 to MaxIndex
|
||||
sFieldname = FieldNames(n)
|
||||
oField = oColumns.GetByName(sFieldName)
|
||||
iType = oField.Type
|
||||
FieldMetaValues(n,0) = oField.Type
|
||||
FieldMetaValues(n,1) = AssignFieldLength(oField.Precision)
|
||||
FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),1, WidthIndex)
|
||||
FieldMetaValues(n,3) = WidthList(WidthIndex,3)
|
||||
FieldMetaValues(n,4) = oField.FormatKey
|
||||
FieldMetaValues(n,5) = oField.DefaultValue
|
||||
FieldMetaValues(n,6) = oField.IsCurrency
|
||||
FieldMetaValues(n,7) = oField.Scale
|
||||
' If oField.Description <> "" Then
|
||||
'' Todo: What's wrong with this line?
|
||||
' Msgbox oField.Helptext
|
||||
' End If
|
||||
FieldMetaValues(n,8) = oField.Description
|
||||
Next
|
||||
ReDim oDBShapeList(MaxIndex) as Object
|
||||
ReDim oTCShapeList(MaxIndex) as Object
|
||||
ReDim oDBModelList(MaxIndex) as Object
|
||||
ReDim oGroupShapeList(MaxIndex) as Object
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetSpecificFieldNames() as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim s as Integer
|
||||
Dim iType as Integer
|
||||
Dim oField as Object
|
||||
Dim MaxIndex as Integer
|
||||
Dim EmptyList()
|
||||
If Ubound(DialogModel.lstTables.StringItemList()) > -1 Then
|
||||
FieldNames() = oColumns.GetElementNames()
|
||||
MaxIndex = Ubound(FieldNames())
|
||||
If MaxIndex <> -1 Then
|
||||
Dim ResultFieldNames(MaxIndex)
|
||||
ReDim ImgFieldNames(MaxIndex)
|
||||
m = 0
|
||||
For n = 0 To MaxIndex
|
||||
oField = oColumns.GetByName(FieldNames(n))
|
||||
iType = oField.Type
|
||||
If GetIndexInMultiArray(WidthList(), iType, 0) <> -1 Then
|
||||
ResultFieldNames(m) = FieldNames(n)
|
||||
m = m + 1
|
||||
End If
|
||||
If GetIndexInMultiArray(ImgWidthList(), iType, 0) <> -1 Then
|
||||
ImgFieldNames(s) = FieldNames(n)
|
||||
s = s + 1
|
||||
End If
|
||||
Next n
|
||||
If s <> 0 Then
|
||||
Redim Preserve ImgFieldNames(s-1)
|
||||
bEnableBinaryOptionGroup = True
|
||||
Else
|
||||
bEnableBinaryOptionGroup = False
|
||||
End If
|
||||
If (DialogModel.optBinariesasGraphics.State = 1) And (s <> 0) Then
|
||||
ResultFieldNames() = AddListToList(ResultFieldNames(), ImgFieldNames())
|
||||
Else
|
||||
Redim Preserve ResultFieldNames(m-1)
|
||||
End If
|
||||
FieldNames() = ResultFieldNames()
|
||||
DialogModel.lstFields.StringItemList = FieldNames()
|
||||
InitializeListboxProcedures(DialogModel, DialogModel.lstFields, DialogModel.lstSelFields)
|
||||
End If
|
||||
GetSpecificFieldNames = MaxIndex
|
||||
Else
|
||||
GetSpecificFieldNames = -1
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub CreateDBForm()
|
||||
If oDrawPage.Forms.Count = 0 Then
|
||||
oDBForm = oDocument.CreateInstance("com.sun.star.form.component.Form")
|
||||
oDrawpage.Forms.InsertByIndex (0, oDBForm)
|
||||
Else
|
||||
oDBForm = oDrawPage.Forms.GetByIndex(0)
|
||||
End If
|
||||
oDBForm.Name = "Standard"
|
||||
oDBForm.DataSourceName = sDBName
|
||||
oDBForm.Command = TableName
|
||||
oDBForm.CommandType = CurCommandType
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddOrRemoveBinaryFieldsToWidthList()
|
||||
Dim LocWidthList()
|
||||
Dim MaxIndex as Integer
|
||||
Dim OldMaxIndex as Integer
|
||||
Dim s as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
If DialogModel.optBinariesasGraphics.State = 1 Then
|
||||
OldMaxIndex = Ubound(WidthList(),1)
|
||||
If OldMaxIndex = 15 Then
|
||||
MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1
|
||||
ReDim Preserve WidthList(MaxIndex,4)
|
||||
s = 0
|
||||
For n = OldMaxIndex + 1 To MaxIndex
|
||||
For m = 0 To 3
|
||||
WidthList(n,m) = ImgWidthList(s,m)
|
||||
Next m
|
||||
s = s + 1
|
||||
Next n
|
||||
MergeList(DialogModel.lstFields, ImgFieldNames())
|
||||
End If
|
||||
Else
|
||||
ReDim Preserve WidthList(15, 4)
|
||||
RemoveListItems(DialogModel.lstFields(), DialogModel.lstSelFields(), ImgFieldNames())
|
||||
End If
|
||||
DialogModel.lstSelFields.Tag = True
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function CreateCommandTypeList()
|
||||
Dim MaxTableIndex as Integer
|
||||
Dim MaxQueryIndex as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
MaxTableIndex = Ubound(TableNames())
|
||||
MaxQueryIndex = Ubound(QueryNames())
|
||||
MaxIndex = MaxTableIndex + MaxQueryIndex + 1
|
||||
If MaxIndex > -1 Then
|
||||
Dim LocCommandTypes(MaxIndex) as Integer
|
||||
For i = 0 To MaxTableIndex
|
||||
LocCommandTypes(i) = com.sun.star.sdb.CommandType.TABLE
|
||||
Next i
|
||||
a = i
|
||||
For i = 0 To MaxQueryIndex
|
||||
LocCommandTypes(a) = com.sun.star.sdb.CommandType.QUERY
|
||||
a = a + 1
|
||||
Next i
|
||||
End If
|
||||
CreateCommandTypeList() = LocCommandTypes()
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetCurrentMetaValues(Index as Integer)
|
||||
CurFieldType = FieldMetaValues(Index,0)
|
||||
CurFieldLength = FieldMetaValues(Index,1)
|
||||
CurControlType = FieldMetaValues(Index,2)
|
||||
CurControlName = FieldMetaValues(Index,3)
|
||||
CurFormatKey = FieldMetaValues(Index,4)
|
||||
CurDefaultValue = FieldMetaValues(Index,5)
|
||||
CurIsCurrency = FieldMetaValues(Index,6)
|
||||
CurScale = FieldMetaValues(Index,7)
|
||||
CurHelpText = FieldMetaValues(Index,8)
|
||||
CurFieldName = FieldNames(Index)
|
||||
End Sub
|
||||
|
||||
|
||||
Function AssignFieldLength(FieldLength as Long) as Integer
|
||||
If FieldLength >= 65535 Then
|
||||
AssignFieldLength() = -1
|
||||
Else
|
||||
AssignFieldLength() = FieldLength
|
||||
End If
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,111 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DlgFormDB" dlg:left="96" dlg:top="28" dlg:width="270" dlg:height="210" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_DIALOG" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblSelFields" dlg:tab-index="10" dlg:left="154" dlg:top="70" dlg:width="110" dlg:height="8" dlg:page="1" dlg:value="lblSelFields"/>
|
||||
<dlg:menulist dlg:id="lstTables" dlg:tab-index="3" dlg:left="6" dlg:top="51" dlg:width="110" dlg:height="12" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_MASTER_LBTABLES" dlg:spin="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.FormGetFields?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-mousedown" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.DeleteFirstTableListBoxEntry?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:img dlg:id="imgTheme" dlg:tab-index="1" dlg:left="6" dlg:top="6" dlg:width="258" dlg:height="26" dlg:scale-image="false"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="33" dlg:left="6" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:34401" dlg:value="cmdCancel" dlg:button-type="cancel"/>
|
||||
<dlg:button dlg:id="cmdHelp" dlg:tab-index="34" dlg:left="63" dlg:top="190" dlg:width="53" dlg:height="14" dlg:tag="34400" dlg:value="cmdHelp" dlg:button-type="help"/>
|
||||
<dlg:button dlg:id="cmdBack" dlg:tab-index="35" dlg:left="155" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CMDPREV" dlg:value="cmdBack">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.PreviousStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="36" dlg:left="211" dlg:top="190" dlg:width="53" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CMDNEXT" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.FormWizard.NextStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="lblTables" dlg:tab-index="2" dlg:left="6" dlg:top="40" dlg:width="72" dlg:height="8" dlg:page="1" dlg:value="lblTables"/>
|
||||
<dlg:text dlg:id="lblFields" dlg:tab-index="4" dlg:left="6" dlg:top="70" dlg:width="109" dlg:height="8" dlg:page="1" dlg:value="lblFields"/>
|
||||
<dlg:button dlg:id="cmdMoveSelected" dlg:tab-index="6" dlg:left="122" dlg:top="84" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_OPTONEXISTINGRELATION" dlg:value="->">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdMoveAll" dlg:tab-index="7" dlg:left="122" dlg:top="101" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_OPTSELECTMANUALLY" dlg:value="=>>">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveAll?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdRemoveSelected" dlg:tab-index="8" dlg:left="122" dlg:top="118" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_lstRELATIONS" dlg:value="<-">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdRemoveAll" dlg:tab-index="9" dlg:left="122" dlg:top="135" dlg:width="25" dlg:height="14" dlg:page="1" dlg:help-url="HID:34425" dlg:value="<<=">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveAll?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optIgnoreBinaries" dlg:tab-index="14" dlg:left="122" dlg:top="169" dlg:width="104" dlg:height="10" dlg:page="1" dlg:help-url="HID:34427" dlg:value="optIgnoreBinaries" dlg:checked="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.DBMeta.AddOrRemoveBinaryFieldsToWidthList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBinariesasGraphics" dlg:tab-index="13" dlg:left="12" dlg:top="169" dlg:width="104" dlg:height="10" dlg:page="1" dlg:help-url="HID:34426" dlg:value="optBinariesasGraphics">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.DBMeta.AddOrRemoveBinaryFieldsToWidthList?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:menulist dlg:id="lstFields" dlg:tab-index="5" dlg:left="6" dlg:top="81" dlg:width="110" dlg:height="70" dlg:page="1" dlg:help-url="HID:34420" dlg:multiselection="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormMoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:menulist dlg:id="lstSelFields" dlg:tab-index="11" dlg:left="154" dlg:top="81" dlg:width="110" dlg:height="70" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_CHKCREATESUBFORM" dlg:multiselection="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormRemoveSelected?language=Basic&location=application" script:language="Script"/>
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:Tools.Listbox.FormSetMoveRights?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:text dlg:id="lblStyles" dlg:tab-index="25" dlg:left="150" dlg:top="39" dlg:width="114" dlg:height="8" dlg:page="2" dlg:value="lblStyles"/>
|
||||
<dlg:button dlg:id="cmdArrange1" dlg:tab-index="16" dlg:left="12" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="1" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_LBTABLES">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange2" dlg:tab-index="17" dlg:left="39" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_FIELDSAVAILABLE">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange3" dlg:tab-index="18" dlg:left="66" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="3" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVESELECTED">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange4" dlg:tab-index="19" dlg:left="93" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="4" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEALL">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdArrange5" dlg:tab-index="20" dlg:left="120" dlg:top="50" dlg:width="23" dlg:height="25" dlg:page="2" dlg:tag="5" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDREMOVESELECTED">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeArrangemode?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:menulist dlg:id="lstStyles" dlg:tab-index="26" dlg:left="150" dlg:top="50" dlg:width="114" dlg:height="86" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTSLAVELINK2">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:FormWizard.tools.ImportStyles?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:menulist>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optBorder0" dlg:tab-index="22" dlg:left="12" dlg:top="95" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEUP" dlg:value="optBorder0">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBorder1" dlg:tab-index="23" dlg:left="12" dlg:top="109" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_SUB_CMDMOVEDOWN" dlg:value="optBorder1">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optBorder2" dlg:tab-index="24" dlg:left="12" dlg:top="123" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:34440" dlg:value="optBorder2">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeBorderLayouts?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:fixedline dlg:id="hlnBinaries" dlg:tab-index="12" dlg:left="6" dlg:top="158" dlg:width="258" dlg:height="8" dlg:page="1" dlg:value="hlnBinaries"/>
|
||||
<dlg:fixedline dlg:id="hlnBackground" dlg:tab-index="30" dlg:left="150" dlg:top="143" dlg:width="114" dlg:height="8" dlg:page="2" dlg:value="hlnBackground"/>
|
||||
<dlg:fixedline dlg:id="hlnAlign" dlg:tab-index="27" dlg:left="6" dlg:top="143" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnAlign"/>
|
||||
<dlg:fixedline dlg:id="hlnBorderLayout" dlg:tab-index="21" dlg:left="6" dlg:top="83" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnBorderLayout"/>
|
||||
<dlg:fixedline dlg:id="hlnArrangements" dlg:tab-index="15" dlg:left="6" dlg:top="39" dlg:width="137" dlg:height="8" dlg:page="2" dlg:value="hlnArrangements"/>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optAlign0" dlg:tab-index="28" dlg:left="12" dlg:top="154" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTSLAVELINK1" dlg:value="optAlign0">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeLabelAlignments?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
<dlg:radio dlg:id="optAlign2" dlg:tab-index="29" dlg:left="12" dlg:top="168" dlg:width="131" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGFORM_LINKER_LSTMASTERLINK1" dlg:value="optAlign2">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:FormWizard.Layouter.ChangeLabelAlignments?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:fixedline dlg:id="FixedLine1" dlg:tab-index="0" dlg:left="6" dlg:top="180" dlg:width="258" dlg:height="6"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,440 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FormWizard" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public DocumentName as String
|
||||
Public FormPath as String
|
||||
Public WizardPath as String
|
||||
Public WorkPath as String
|
||||
Public TempPath as String
|
||||
Public TexturePath as String
|
||||
Public sQueryName as String
|
||||
Public oDBConnection as Object
|
||||
Public bWithBackGraphic as Boolean
|
||||
Public bNeedFieldRefresh as Boolean
|
||||
Public oDBForm as Object
|
||||
Public oColumns() as Object
|
||||
Public sDatabaseList() as String
|
||||
Public TableNames() as String
|
||||
Public QueryNames() as String
|
||||
Public FieldNames() as String
|
||||
Public ImgFieldNames() as String
|
||||
Public oDBContext as Object
|
||||
Public oUcb as Object
|
||||
Public oDocInfo as Object
|
||||
Public WidthList(15,3)
|
||||
Public ImgWidthList(3,3)
|
||||
Public sDBName as String
|
||||
Public Tablename as String
|
||||
Public Const SBSIZETEXT = "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog."
|
||||
Public bDisposeDoc as Boolean
|
||||
Public bDebug as Boolean
|
||||
'Public bStartUp as Boolean
|
||||
Public bConnectionIsovergiven as Boolean
|
||||
Public FormName As String
|
||||
Public sFormUrl as String
|
||||
Public oFormDocuments
|
||||
|
||||
|
||||
' The macro can be called in 4 possible scenarios:
|
||||
' Scenario 1. No parameters at given
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
' Scenario 3: a data source and a connection are given
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
|
||||
Sub Main()
|
||||
Dim oLocDBContext as Object
|
||||
Dim oLocConnection as Object
|
||||
|
||||
' Scenario 1. No parameters at given
|
||||
MainWithDefault()
|
||||
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
' MainWithDefault("Bibliography")
|
||||
|
||||
' Scenario 3: a data source and a connection are given
|
||||
' oLocDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
' oLocConnection = oLocDBContext.GetByName("Bibliography").GetConnection("","")
|
||||
' MainWithDefault("Bibliography", oLocConnection)
|
||||
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
' oLocDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
' oLocConnection = oLocDBContext.GetByName("Bibliography").GetConnection("","")
|
||||
' MainWithDefault("Bibliography", oLocConnection, com.sun.star.sdb.CommandType.TABLE, "biblio")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MainWithDefault(Optional DatasourceName as String, Optional oConnection as Object, Optional CommandType as Integer, Optional sContent as String)
|
||||
Dim i as Integer
|
||||
Dim SelCount as Integer
|
||||
Dim RetValue as Integer
|
||||
Dim SelList(0) as Integer
|
||||
Dim LocList() as String
|
||||
SelList(0) = 0
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
bDebug = False
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
OpenFormDocument()
|
||||
CurArrangement = 0
|
||||
bControlsareCreated = False
|
||||
bEnableBinaryOptionGroup = False
|
||||
bDisposeDoc = True
|
||||
MaxIndex = -1
|
||||
If Not InitResources("Formwizard") Then
|
||||
Exit Sub
|
||||
End If
|
||||
oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
If GetFormWizardPaths() = False Then
|
||||
Exit Sub
|
||||
End If
|
||||
oDocument.GetCurrentController().Frame.ComponentWindow.Enable = False
|
||||
oProgressBar.Value = 10
|
||||
LoadLanguage()
|
||||
oProgressBar.Value = 20
|
||||
InitializeWidthList()
|
||||
oProgressBar.Value = 30
|
||||
Styles() = getListBoxArrays(oUcb, "/stl")
|
||||
CurIndex = GetCurIndex(DialogModel, Styles(), 2)
|
||||
oProgressBar.Value = 40
|
||||
ConfigurePageStyle()
|
||||
oProgressBar.Value = 50
|
||||
InitializeLabelValues()
|
||||
bNeedFieldRefresh = True
|
||||
SetDialogLanguage()
|
||||
' bStartUp = true
|
||||
With DialogModel
|
||||
.cmdBack.Enabled = False
|
||||
.cmdGoOn.Enabled = False
|
||||
.lblTables.Enabled = False
|
||||
.lstSelFields.Tag = False
|
||||
.Step = 1
|
||||
End With
|
||||
oProgressBar.Value = 60
|
||||
bConnectionIsovergiven = Not IsMissing(oConnection)
|
||||
If Not IsMissing(DataSourceName) Then
|
||||
sDBName = DataSourceName
|
||||
If Not IsMissing(oConnection) Then
|
||||
' Scenario 3: a data source and a connection are given
|
||||
Set oDBConnection = oConnection
|
||||
oDataSource = oDBContext.GetByName(DataSourceName)
|
||||
DialogModel.lstTables.Enabled = True
|
||||
DialogModel.lblTables.Enabled = True
|
||||
If GetDBMetaData() Then
|
||||
LocList() = AddListToList(TableNames(), QueryNames())
|
||||
iCommandTypes = CreateCommandTypeList()
|
||||
If Not IsMissing(sContent) Then
|
||||
' Scenario 4: all parameters (data source name, connection, object type and object) are given
|
||||
DialogModel.lstTables.StringItemList() = LocList()
|
||||
iCommandTypes() = CreateCommandTypeList()
|
||||
SelCount = CountItemsInArray(DialogModel.lstTables.StringItemList(), sContent)
|
||||
If SelCount = 1 Then
|
||||
DlgFormDB.GetControl("lstTables").SelectItem(sContent, True)
|
||||
Else
|
||||
If CommandType = com.sun.star.sdb.CommandType.QUERY Then
|
||||
SelIndex = IndexInArray(sContent, QueryNames())
|
||||
DlgFormDB.GetControl("lstTables").SelectItemPos(SelIndex, True)
|
||||
ElseIf CommandType = com.sun.star.sdb.CommandType.TABLE Then
|
||||
SelIndex = IndexInArray(sContent, TableNames())
|
||||
DlgFormDB.GetControl("lstTables").SelectItemPos(Ubound(QueryNames()+1 + SelIndex, True))
|
||||
End If
|
||||
End If
|
||||
CurCommandType = CommandType
|
||||
FillUpFieldsListbox(False)
|
||||
Else
|
||||
LocList() = AddListToList(Array(sSelectDBTable), LocList())
|
||||
DialogModel.lstTables.StringItemList() = LocList()
|
||||
' bSelectContent = True
|
||||
DialogModel.lstTables.SelectedItems() = Array(0)
|
||||
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
' Scenario 2: Only Datasourcename is given, but no connection and no Content
|
||||
GetSelectedDBMetaData(sDBName)
|
||||
End If
|
||||
Else
|
||||
' Scenario 1: No parameters are given
|
||||
ToggleListboxControls(DialogModel, False)
|
||||
End If
|
||||
oProgressBar.Value = 80
|
||||
bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, Styles(CurIndex, 8), Styles(), TexturePath)
|
||||
DlgFormDB.Title = WizardTitle(1)
|
||||
DialogModel.lstStyles.StringItemList() = ArrayfromMultiArray(Styles, 1)
|
||||
DialogModel.lstStyles.SelectedItems() = SelList()
|
||||
ControlCaptionsToStandardLayout()
|
||||
oDocument.GetCurrentController().Frame.ComponentWindow.Enable = True
|
||||
oProgressBar.Value = 90
|
||||
DialogModel.imgTheme.ImageURL = FormPath & "FormWizard_1.png"
|
||||
DialogModel.imgTheme.BackGroundColor = RGB(0,60,126)
|
||||
ToggleDatabasePage(True)
|
||||
oProgressBar.Value = 100
|
||||
DlgFormDB.GetControl("lstTables").SetFocus()
|
||||
oProgressbar.End
|
||||
RetValue = DlgFormDB.Execute()
|
||||
DlgFormDB.Dispose()
|
||||
If bDisposeDoc Then
|
||||
Dim aPropertyValues(2) as new com.sun.star.beans.PropertyValue
|
||||
oFormDocuments = oDataSource.getFormDocuments()
|
||||
DlgFormDB.Dispose()
|
||||
oDocument.dispose()
|
||||
Dim bLinkExists as Boolean
|
||||
i = 1
|
||||
Dim FormBaseName as String
|
||||
FormBaseName = FormName
|
||||
Do
|
||||
bLinkExists = oFormDocuments.HasbyHierarchicalName(FormName)
|
||||
If bLinkExists Then
|
||||
i = i + 1
|
||||
FormName = FormBaseName & "_" & i
|
||||
End If
|
||||
Loop Until Not bLinkExists
|
||||
aPropertyValues(0).Name = "Name"
|
||||
aPropertyValues(0).Value = FormName
|
||||
aPropertyValues(1).Name = "Parent"
|
||||
aPropertyValues(1).Value = oFormDocuments()
|
||||
aPropertyValues(2).Name = "URL"
|
||||
aPropertyValues(2).Value = sFormUrl
|
||||
Dim oDBDocument
|
||||
oDBDocument = oFormDocuments.createInstanceWithArguments("com.sun.star.sdb.DocumentDefinition", aPropertyValues())
|
||||
oFormDocuments.insertbyName(FormName, oDBDocument)
|
||||
ElseIf RetValue = 0 Then
|
||||
RemoveNirwanaShapes()
|
||||
End If
|
||||
If ((Not IsNull(oDBConnection)) And (Not bConnectionIsovergiven)) Then
|
||||
oDBConnection.Dispose()
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormGetFields()
|
||||
Dim i as Integer
|
||||
' If bSelectContent Then
|
||||
' bSelectContent = False
|
||||
' Exit Sub
|
||||
' End If
|
||||
DeleteFirstListBoxEntry("lstTables", sSelectDBTable)
|
||||
ToggleDatabasePage(False)
|
||||
FillUpFieldsListbox(True)
|
||||
ToggleDatabasePage(True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillUpFieldsListbox(bGetCommandType as Boolean)
|
||||
Dim SelIndex as Integer
|
||||
Dim QueryIndex as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo NOFIELDS
|
||||
End If
|
||||
SelIndex = DlgFormDB.GetControl("lstTables").getSelectedItemPos() '.SelectedItems())
|
||||
If SelIndex > -1 Then
|
||||
If bGetCommandType Then
|
||||
CurCommandType = iCommandTypes(SelIndex)
|
||||
End If
|
||||
If CurCommandType = com.sun.star.sdb.CommandType.QUERY Then
|
||||
QueryIndex = SelIndex - Ubound(Tablenames()) - 1
|
||||
Tablename = QueryNames(QueryIndex)
|
||||
oColumns = oDBConnection.Queries.GetByName(TableName).Columns
|
||||
Else
|
||||
Tablename = Tablenames(SelIndex)
|
||||
oColumns = oDBConnection.Tables.GetByName(Tablename).Columns
|
||||
End If
|
||||
If GetSpecificFieldNames() <> -1 Then
|
||||
ToggleListboxControls(DialogModel, True)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
EmptyFieldsListboxes()
|
||||
NOFIELDS:
|
||||
If Err <> 0 Then
|
||||
MsgBox sMsgErrCouldNotOpenObject, 16, sMsgWizardName
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub PreviousStep()
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
With DialogModel
|
||||
.Step = 1
|
||||
.cmdBack.Enabled = False
|
||||
.cmdGoOn.Enabled = True
|
||||
.lstSelFields.Tag = Not bControlsareCreated
|
||||
.cmdGoOn.Label = sGoOn
|
||||
.imgTheme.ImageUrl = FormPath & "FormWizard_1.png"
|
||||
End With
|
||||
FormSetMoveRights()
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub NextStep()
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
Select Case DialogModel.Step
|
||||
Case 1
|
||||
bControlsAreCreated = Not (cBool(DialogModel.lstSelFields.Tag))
|
||||
If Not bControlsAreCreated Then
|
||||
GetTableMetaData()
|
||||
CreateDBForm()
|
||||
RemoveShapes()
|
||||
InitializeLayoutSettings()
|
||||
oDBForm.Load
|
||||
End If
|
||||
DialogModel.cmdGoOn.Label = sReady
|
||||
DialogModel.cmdBack.Enabled = True
|
||||
DialogModel.Step = 2
|
||||
bDisposeDoc = False
|
||||
Case 2
|
||||
StoreForm()
|
||||
DlgFormDB.EndExecute()
|
||||
exit Sub
|
||||
End Select
|
||||
DialogModel.imgTheme.ImageUrl = FormPath & "FormWizard_" & DialogModel.Step & ".png"
|
||||
DlgFormDB.Title = WizardTitle(DialogModel.Step)
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeLayoutSettings()
|
||||
SwitchArrangementButtons(cTabled)
|
||||
SwitchAlignMode(SBALIGNLEFT)
|
||||
SwitchBorderMode(SB3DBORDER)
|
||||
ToggleBorderGroup(bControlsAreCreated)
|
||||
ToggleAlignGroup(bControlsAreCreated)
|
||||
ArrangeControls()
|
||||
If OldAlignMode <> 0 Then
|
||||
DlgFormDB.GetControl("optAlign2").Model.State = 0
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleDatabasePage(bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
.cmdBack.Enabled = False
|
||||
.cmdHelp.Enabled = bDoEnable
|
||||
.cmdGoOn.Enabled = Ubound(DialogModel.lstSelFields.StringItemList()) <> -1
|
||||
.hlnBinaries.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
.optIgnoreBinaries.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
.optBinariesasGraphics.Enabled = ((bDoEnable = True) And (bEnableBinaryOptionGroup = True))
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
' This Sub is called from the Procedure "StoreDocument" in the "Tools" Library
|
||||
Sub CommitLastDocumentChanges(sTargetPath as String)
|
||||
Dim i as Integer
|
||||
Dim sBookmarkName as String
|
||||
Dim oDBBookmarks as Object
|
||||
Dim bLinkExists as Boolean
|
||||
Dim sBaseBookmarkName as String
|
||||
sBookmarkName = GetFileNamewithoutExtension(FileNameoutofPath(sTargetPath))
|
||||
sBaseBookmarkName = sBookmarkName
|
||||
oDBBookmarks = oDataSource.GetBookmarks()
|
||||
i = 1
|
||||
Do
|
||||
bLinkExists = oDBBookmarks.HasbyName(sBookmarkName)
|
||||
If bLinkExists Then
|
||||
i = i + 1
|
||||
sBookmarkName = sBaseBookmarkName & "_" & i
|
||||
Else
|
||||
oDBBookmarks.insertByName(sBookmarkName, sTargetPath)
|
||||
End If
|
||||
Loop Until Not bLinkExists
|
||||
bDisposeDoc = False
|
||||
GroupShapesTogether()
|
||||
ToggleDesignMode(oDocument)
|
||||
oDBForm.Reload()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StoreFormInDatabase()
|
||||
Dim NoArgs() as new com.sun.star.beans.PropertyValue
|
||||
FormName = "Form_" & sDBName & "_" & TableName & ".sxw"
|
||||
sFormUrl = TempPath & "/" & FormName
|
||||
oDocument.StoreAsUrl(sFormUrl, NoArgs())
|
||||
bdisposeDoc = true
|
||||
DlgFormDB.Endexecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StoreForm()
|
||||
Dim sTargetPath as String
|
||||
Dim TypeNames(0,2) as String
|
||||
Dim oMasterKey as Object
|
||||
Dim oTypes() as Object
|
||||
oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types/")
|
||||
oTypes() = oMasterKey.Types
|
||||
TypeNames(0,0) = GetFilterName("StarOffice XML (Writer)")
|
||||
TypeNames(0,1) = "*.sxw"
|
||||
TypeNames(0,2) = ""
|
||||
StoreFormInDatabase()
|
||||
' sTargetPath = StoreDocument(oDocument, TypeNames(), "Form_" & sDBName & "_" & TableName & ".sxw", WorkPath, 1)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub EmptyFieldsListboxes()
|
||||
Dim NullList() as String
|
||||
ToggleListboxControls(DialogModel, False)
|
||||
DialogModel.lstFields.StringItemList() = NullList()
|
||||
DialogModel.lstSelFields.StringItemList() = NullList()
|
||||
bEnableBinaryOptionGroup = False
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DeleteFirstTableListBoxEntry()
|
||||
DeleteFirstListBoxEntry("lstTables", sSelectDBTable)
|
||||
End Sub
|
||||
|
||||
Sub DeleteFirstListboxEntry(ListBoxName as String, DelEntryName as String)
|
||||
Dim oListbox as Object
|
||||
Dim sFirstItem as String
|
||||
dim iSelPos as Integer
|
||||
oListBox = DlgFormDB.getControl(ListBoxName)
|
||||
sFirstItem = oListBox.getItem(0)
|
||||
If sFirstItem = DelEntryName Then
|
||||
iSelPos = oListBox.getSelectedItemPos()
|
||||
oListBox.removeItems(0, 1)
|
||||
If iSelPos > 0 Then
|
||||
oListBox.selectItemPos(iSelPos-1, True)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,297 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit
|
||||
|
||||
|
||||
Public Const SBCANCEL = 2
|
||||
Public Const SBREPEAT = 4
|
||||
Public LabelDiffHeight as Long
|
||||
Public BasicLabelDiffHeight as Long
|
||||
|
||||
Public WizardTitle(1 To 3) as String
|
||||
Public DlgFormDB as Object
|
||||
Public DialogModel as Object
|
||||
|
||||
Dim sMsgWizardName as String
|
||||
Dim sMsgErrMsg as String
|
||||
Dim sMsgErrNoDatabase as String
|
||||
Dim sMsgErrNoTableInDatabase as String
|
||||
Dim sMsgErrTitleSuggestedExist as String
|
||||
Dim sMsgErrTitleSyntaxError as String
|
||||
Dim sMsgErrTitleAsTableExist as String
|
||||
Dim sMsgProgressText as String
|
||||
Dim sMsgCreatedForm as String
|
||||
Dim sMsgErrCouldNotOpenObject as String
|
||||
Dim sMsgErrNameToLong as String
|
||||
Dim sTimeAppendix as String
|
||||
Dim sDateAppendix as String
|
||||
Public sGoOn as String
|
||||
Public sReady as String
|
||||
Public sMsgNoConnection as String
|
||||
Public XPixelFactor as Long
|
||||
Public YPixelFactor as Long
|
||||
Public sSelectDatasource as String
|
||||
Public sSelectDBTable as String
|
||||
|
||||
|
||||
|
||||
Sub LoadLanguage ()
|
||||
sMsgWizardName = GetResText("RID_FORM_0")
|
||||
sMsgErrMsg = GetResText("RID_DB_COMMON_6")
|
||||
sMsgErrNoDatabase = GetResText("RID_DB_COMMON_8")
|
||||
sMsgErrNoTableInDatabase = GetResText("RID_DB_COMMON_9")
|
||||
sMsgErrTitleSuggestedExist = GetResText("RID_DB_COMMON_10")
|
||||
sMsgErrTitleAsTableExist = GetResText("RID_DB_COMMON_10")
|
||||
sMsgErrTitleSyntaxError = GetResText("RID_DB_COMMON_11")
|
||||
sMsgNoConnection = GetResText("RID_DB_COMMON_14")
|
||||
sMsgProgressText = GetResText("RID_FORM_2")
|
||||
sMsgCreatedForm = GetResText("RID_FORM_26")
|
||||
sMsgErrNameToLong = GetResText("RID_FORM_27")
|
||||
sMsgErrCouldNotOpenObject = GetResText("RID_DB_COMMON_13")
|
||||
|
||||
' Internal Logic
|
||||
sDateAppendix = GetResText("RID_FORM_4")
|
||||
sTimeAppendix = GetResText("RID_FORM_5")
|
||||
|
||||
sReady = GetResText("RID_DB_COMMON_0")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetDialogLanguage ()
|
||||
Dim i as Integer
|
||||
Dim ButtonHelpText as String
|
||||
Dim CmdButton as Object
|
||||
Dim IDArray as Variant
|
||||
Dim FNameAddOn as String
|
||||
Dim slblSelFields as String
|
||||
Dim slblFields as String
|
||||
|
||||
DlgFormDB = LoadDialog("FormWizard", "DlgFormDB")
|
||||
DialogModel = DlgFormDB.Model
|
||||
|
||||
With DialogModel
|
||||
.cmdCancel.Label = GetResText("RID_DB_COMMON_1")
|
||||
.cmdBack.Label = GetResText("RID_DB_COMMON_2")
|
||||
.cmdHelp.Label = GetResText("RID_DB_COMMON_20")
|
||||
sGoOn = GetResText("RID_DB_COMMON_3")
|
||||
.cmdGoOn.Label = sGoOn
|
||||
.lblTables.Label = GetResText("RID_FORM_6")
|
||||
|
||||
slblFields = GetResText("RID_FORM_12")
|
||||
slblSelFields = GetResText("RID_FORM_13")
|
||||
.lblFields.Label = slblFields
|
||||
.lblSelFields.Label = slblSelFields
|
||||
|
||||
.lblStyles.Label = GetResText("RID_FORM_21")
|
||||
.hlnBorderLayout.Label = GetResText("RID_FORM_28")
|
||||
.hlnAlign.Label = GetResText("RID_FORM_32")
|
||||
.hlnArrangements.Label = GetResText("RID_FORM_35")
|
||||
|
||||
WizardTitle(1) = sMsgWizardName & " - " & GetResText("RID_FORM_45")
|
||||
WizardTitle(2) = sMsgWizardName & " - " & GetResText("RID_FORM_46")
|
||||
WizardTitle(3) = sMsgWizardName & " - " & GetResText("RID_FORM_47")
|
||||
|
||||
.hlnBinaries.Label = GetResText("RID_FORM_50")
|
||||
.optIgnoreBinaries.Label = GetResText("RID_FORM_51")
|
||||
.optBinariesasGraphics.Label = GetResText("RID_FORM_52")
|
||||
|
||||
.hlnBackground.Label = GetResText("RID_FORM_55")
|
||||
.optTiled.Label = GetResText("RID_FORM_56")
|
||||
.optArea.Label = GetResText("RID_FORM_57")
|
||||
|
||||
.optBorder0.Label = GetResText("RID_FORM_29")
|
||||
.optBorder1.Label = GetResText("RID_FORM_30")
|
||||
.optBorder2.Label = GetResText("RID_FORM_31")
|
||||
.optBorder1.State = 1
|
||||
|
||||
.optAlign0.Label = GetResText("RID_FORM_33")
|
||||
.optAlign2.Label = GetResText("RID_FORM_34")
|
||||
.optAlign0.State = 1
|
||||
|
||||
REM//FIXME: Remove this unused FNameAddOn through the file
|
||||
FNameAddOn = ""
|
||||
|
||||
IDArray = Array("RID_FORM_36", "RID_FORM_37", "RID_FORM_40", "RID_FORM_38", "RID_FORM_39")
|
||||
For i = 1 To 5
|
||||
ButtonHelpText = GetResText(IDArray(i-1))
|
||||
cmdButton = DlgFormDB.getControl("cmdArrange" & i)
|
||||
cmdButton.Model.ImageURL = FormPath & "Arrange_" & i & FNameAddOn & ".gif"
|
||||
cmdButton.Model.HelpText = ButtonHelpText
|
||||
cmdButton.getPeer().setProperty("AccessibleName", ButtonHelpText)
|
||||
Next i
|
||||
' .cmdArrange1.ImageURL = FormPath & "Arrange_1" & FNameAddOn & ".gif"
|
||||
' .cmdArrange1.HelpText = GetResText("RID_FORM_36")
|
||||
'
|
||||
' .cmdArrange2.ImageURL = FormPath & "Arrange_2" & FNameAddOn & ".gif"
|
||||
' .cmdArrange2.HelpText = GetResText("RID_FORM_37")
|
||||
'
|
||||
' .cmdArrange3.ImageURL = FormPath & "Arrange_3" & FNameAddOn & ".gif"
|
||||
' .cmdArrange3.HelpText = GetResText("RID_FORM_40")
|
||||
'
|
||||
' .cmdArrange4.ImageURL = FormPath & "Arrange_4" & FNameAddOn & ".gif"
|
||||
' .cmdArrange4.HelpText = GetResText("RID_FORM_38")
|
||||
'
|
||||
' .cmdArrange5.ImageURL = FormPath & "Arrange_5" & FNameAddOn & ".gif"
|
||||
' .cmdArrange5.HelpText = GetResText("RID_FORM_39")
|
||||
End With
|
||||
DlgFormDB.GetControl("cmdMoveSelected").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_39"))
|
||||
DlgFormDB.GetControl("cmdRemoveSelected").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_40"))
|
||||
DlgFormDB.GetControl("cmdMoveAll").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_41"))
|
||||
DlgFormDB.GetControl("cmdRemoveAll").getPeer().setProperty("AccessibleName", GetResText("RID_DB_COMMON_42"))
|
||||
DlgFormDB.getControl("lstFields").getPeer().setProperty("AccessibleName", DeleteStr(slblFields, "~"))
|
||||
DlgFormDB.getControl("lstSelFields").getPeer().setProperty("AccessibleName", DeleteStr(slblSelFields, "~"))
|
||||
|
||||
sSelectDatasource = GetResText("RID_DB_COMMON_37")
|
||||
sSelectDBTable = GetResText("RID_DB_COMMON_38")
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub InitializeWidthList()
|
||||
|
||||
If Ubound(WidthList(),1) > 16 Then
|
||||
ReDim WidthList(16,4)
|
||||
End If
|
||||
|
||||
WidthList(0,0) = com.sun.star.sdbc.DataType.BIT ' = -7;
|
||||
WidthList(0,1) = cCheckbox
|
||||
WidthList(0,2) = False
|
||||
WidthList(0,3) = "CheckBox"
|
||||
|
||||
WidthList(1,0) = com.sun.star.sdbc.DataType.TINYINT ' = -6;
|
||||
WidthList(1,1) = cNumericBox
|
||||
WidthList(1,2) = False
|
||||
WidthList(1,3) = "FormattedField"
|
||||
|
||||
WidthList(2,0) = com.sun.star.sdbc.DataType.SMALLINT ' = 5;
|
||||
WidthList(2,1) = cNumericBox
|
||||
WidthList(2,2) = False
|
||||
WidthList(2,3) = "FormattedField"
|
||||
|
||||
WidthList(3,0) = com.sun.star.sdbc.DataType.INTEGER ' = 4;
|
||||
WidthList(3,1) = cNumericBox
|
||||
WidthList(3,2) = False
|
||||
WidthList(3,3) = "FormattedField"
|
||||
|
||||
WidthList(4,0) = com.sun.star.sdbc.DataType.BIGINT ' = -5;
|
||||
WidthList(4,1) = cNumericBox
|
||||
WidthList(4,2) = False
|
||||
WidthList(4,3) = "FormattedField"
|
||||
|
||||
WidthList(5,0) = com.sun.star.sdbc.DataType.FLOAT ' = 6;
|
||||
WidthList(5,1) = cNumericBox
|
||||
WidthList(5,2) = False
|
||||
WidthList(5,3) = "FormattedField"
|
||||
|
||||
WidthList(6,0) = com.sun.star.sdbc.DataType.REAL ' = 7;
|
||||
WidthList(6,1) = cNumericBox
|
||||
WidthList(6,2) = False
|
||||
WidthList(6,3) = "FormattedField"
|
||||
|
||||
WidthList(7,0) = com.sun.star.sdbc.DataType.DOUBLE ' = 8;
|
||||
WidthList(7,1) = cNumericBox
|
||||
WidthList(7,2) = False
|
||||
WidthList(7,3) = "FormattedField"
|
||||
|
||||
WidthList(8,0) = com.sun.star.sdbc.DataType.NUMERIC ' = 2;
|
||||
WidthList(8,1) = cNumericBox
|
||||
WidthList(8,2) = False
|
||||
WidthList(8,3) = "FormattedField"
|
||||
|
||||
WidthList(9,0) = com.sun.star.sdbc.DataType.DECIMAL ' = 3; (including decimal places)
|
||||
WidthList(9,1) = cNumericBox
|
||||
WidthList(9,2) = False
|
||||
WidthList(9,3) = "FormattedField"
|
||||
|
||||
WidthList(10,0) = com.sun.star.sdbc.DataType.CHAR ' = 1;
|
||||
WidthList(10,1) = cTextBox
|
||||
WidthList(10,2) = False
|
||||
WidthList(10,3) = "TextField"
|
||||
|
||||
WidthList(11,0) = com.sun.star.sdbc.DataType.VARCHAR ' = 12;
|
||||
WidthList(11,1) = cTextBox
|
||||
WidthList(11,2) = True
|
||||
WidthList(11,3) = "TextField"
|
||||
|
||||
WidthList(12,0) = com.sun.star.sdbc.DataType.LONGVARCHAR ' = -1;
|
||||
WidthList(12,1) = cTextBox
|
||||
WidthList(12,2) = True
|
||||
WidthList(12,3) = "TextField"
|
||||
|
||||
WidthList(13,0) = com.sun.star.sdbc.DataType.DATE ' = 91;
|
||||
WidthList(13,1) = cDateBox
|
||||
WidthList(13,2) = False
|
||||
WidthList(13,3) = "DateField"
|
||||
|
||||
WidthList(14,0) = com.sun.star.sdbc.DataType.TIME ' = 92;
|
||||
WidthList(14,1) = cTimeBox
|
||||
WidthList(14,2) = False
|
||||
WidthList(14,3) = "TimeField"
|
||||
|
||||
WidthList(15,0) = com.sun.star.sdbc.DataType.TIMESTAMP ' = 93;
|
||||
WidthList(15,1) = cDateBox
|
||||
WidthList(15,2) = False
|
||||
WidthList(15,3) = "DateField"
|
||||
|
||||
WidthList(16,0) = com.sun.star.sdbc.DataType.BOOLEAN ' = 16;
|
||||
WidthList(16,1) = cCheckbox
|
||||
WidthList(16,2) = False
|
||||
WidthList(16,3) = "CheckBox"
|
||||
|
||||
ImgWidthList(0,0) = com.sun.star.sdbc.DataType.BINARY ' = -2;
|
||||
ImgWidthList(0,1) = cImageControl
|
||||
ImgWidthList(0,2) = False
|
||||
ImgWidthList(0,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(1,0) = com.sun.star.sdbc.DataType.VARBINARY ' = -3;
|
||||
ImgWidthList(1,1) = cImageControl
|
||||
ImgWidthList(1,2) = False
|
||||
ImgWidthList(1,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(2,0) = com.sun.star.sdbc.DataType.LONGVARBINARY ' = -4;
|
||||
ImgWidthList(2,1) = cImageControl
|
||||
ImgWidthList(2,2) = False
|
||||
ImgWidthList(2,3) = "ImageControl"
|
||||
|
||||
ImgWidthList(3,0) = com.sun.star.sdbc.DataType.BLOB ' = 2004;
|
||||
ImgWidthList(3,1) = cImageControl
|
||||
ImgWidthList(3,2) = False
|
||||
ImgWidthList(3,3) = "ImageControl"
|
||||
|
||||
' Note: the following Fieldtypes are ignored
|
||||
'ExcludeList(0) = com.sun.star.sdbc.DataType.SQLNULL
|
||||
'ExcludeList(1) = com.sun.star.sdbc.DataType.OTHER
|
||||
'ExcludeList(2) = com.sun.star.sdbc.DataType.OBJECT
|
||||
'ExcludeList(3) = com.sun.star.sdbc.DataType.DISTINCT
|
||||
'ExcludeList(4) = com.sun.star.sdbc.DataType.STRUCT
|
||||
'ExcludeList(5) = com.sun.star.sdbc.DataType.ARRAY
|
||||
'ExcludeList(6) = com.sun.star.sdbc.DataType.CLOB
|
||||
'ExcludeList(7) = com.sun.star.sdbc.DataType.REF
|
||||
|
||||
oModelService(cLabel) = "com.sun.star.form.component.FixedText"
|
||||
oModelService(cTextBox) = "com.sun.star.form.component.TextField"
|
||||
oModelService(cCheckBox) = "com.sun.star.form.component.CheckBox"
|
||||
oModelService(cDateBox) = "com.sun.star.form.component.DateField"
|
||||
oModelService(cTimeBox) = "com.sun.star.form.component.TimeField"
|
||||
oModelService(cNumericBox) = "com.sun.star.form.component.FormattedField"
|
||||
oModelService(cGridControl) = "com.sun.star.form.component.GridControl"
|
||||
oModelService(cImageControl) = "com.sun.star.form.component.DatabaseImageControl"
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,397 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Layouter" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public oProgressbar as Object
|
||||
Public ProgressValue as Integer
|
||||
Public oDocument as Object
|
||||
Public oController as Object
|
||||
Public oForm as Object
|
||||
Public oDrawPage as Object
|
||||
Public oPageStyle as Object
|
||||
|
||||
Public nMaxColRightX as Long
|
||||
Public nMaxTCWidth as Long
|
||||
Public nMaxRowRightX as Long
|
||||
Public nMaxRowY as Long
|
||||
Public nSecMaxRowY as Long
|
||||
Public MaxIndex as Integer
|
||||
Public CurIndex as Integer
|
||||
|
||||
Public Const cVertDistance = 200
|
||||
Public Const cHoriDistance = 300
|
||||
|
||||
Public nPageWidth as Long
|
||||
Public nPageHeight as Long
|
||||
Public nFormWidth as Long
|
||||
Public nFormHeight as Long
|
||||
Public nMaxHoriPos as Long
|
||||
Public nMaxVertPos as Long
|
||||
|
||||
Public CONST SBALIGNLEFT = 0
|
||||
Public CONST SBALIGNRIGHT = 2
|
||||
|
||||
Public Const SBNOBORDER = 0
|
||||
Public Const SB3DBORDER = 1
|
||||
Public Const SBSIMPLEBORDER = 2
|
||||
|
||||
Public CurArrangement as Integer
|
||||
Public CurBorderType as Integer
|
||||
Public CurAlignmode as Integer
|
||||
|
||||
Public OldAlignMode as Integer
|
||||
Public OldBorderType as Integer
|
||||
Public OldArrangement as Integer
|
||||
|
||||
Public Const cColumnarLeft = 1
|
||||
Public Const cColumnarTop = 2
|
||||
Public Const cTabled = 3
|
||||
Public Const cLeftJustified = 4
|
||||
Public Const cTopJustified = 5
|
||||
|
||||
Public Const cXOffset = 1000
|
||||
Public Const cYOffset = 700
|
||||
' This is the viewed space that we lose because of the symbol bars
|
||||
Public Const cSymbolMargin = 2000
|
||||
Public Const MaxFieldIndex = 200
|
||||
|
||||
Public Const cControlCollectionCount = 9
|
||||
Public Const cLabel = 1
|
||||
Public Const cTextBox = 2
|
||||
Public Const cCheckBox = 3
|
||||
Public Const cDateBox = 4
|
||||
Public Const cTimeBox = 5
|
||||
Public Const cNumericBox = 6
|
||||
Public Const cCurrencyBox = 7
|
||||
Public Const cGridControl = 8
|
||||
Public Const cImageControl = 9
|
||||
|
||||
Public Styles(100, 8) as String
|
||||
|
||||
Public CurControlType as Integer
|
||||
Public CurFieldlength as Double
|
||||
Public CurFieldType as Integer
|
||||
Public CurFieldName as String
|
||||
Public CurControlName as String
|
||||
Public CurFormatKey as Long
|
||||
Public CurDefaultValue
|
||||
Public CurIsCurrency as Boolean
|
||||
Public CurScale as Integer
|
||||
Public CurHelpText as String
|
||||
|
||||
Public FieldMetaValues(MaxFieldIndex, 8)
|
||||
' Description of this List:
|
||||
' CurFieldType = FieldMetaValues(Index,0)
|
||||
' CurFieldLength = FieldMetaValues(Index,1)
|
||||
' CurControlType = FieldMetaValues(Index,2) (ControlType, e.g., cLabel, cTextbox, etc.)
|
||||
' CurControlName = FieldMetaValues(Index,3)
|
||||
' CurFormatKey = FieldMetaValues(Index,4)
|
||||
' CurDefaultValue = FieldMetaValues(Index,5)
|
||||
' CurIsCurrency = FieldMetaValues(Index,6)
|
||||
' CurScale = FieldMetaValues(Index,7)
|
||||
' CurHelpText = FieldMetaValues(Index,8)
|
||||
|
||||
Public FieldNames(MaxFieldIndex) as string
|
||||
Public oModelService(cControlCollectionCount) as String
|
||||
Public oGridModel as Object
|
||||
|
||||
|
||||
Function InsertControl(oContainer as Object, oControlObject as object, aPoint as Object, aSize as Object)
|
||||
Dim oShape as object
|
||||
oShape = oDocument.CreateInstance ("com.sun.star.drawing.ControlShape")
|
||||
oShape.Size = aSize
|
||||
oShape.Position = aPoint
|
||||
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
|
||||
oShape.control = oControlObject
|
||||
oContainer.Add(oShape)
|
||||
InsertControl() = oShape
|
||||
End Function
|
||||
|
||||
|
||||
Function ArrangeControls()
|
||||
Dim oShape as Object
|
||||
Dim i as Integer
|
||||
oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
|
||||
oProgressbar.Start("", MaxIndex)
|
||||
If oDBForm.HasbyName("Grid1") Then
|
||||
RemoveShapes()
|
||||
End If
|
||||
ToggleLayoutPage(False)
|
||||
Select Case CurArrangement
|
||||
Case cTabled
|
||||
PositionGridControl(MaxIndex)
|
||||
Case Else
|
||||
PositionControls(MaxIndex)
|
||||
End Select
|
||||
ToggleLayoutPage(True)
|
||||
oProgressbar.End
|
||||
End Function
|
||||
|
||||
|
||||
Sub OpenFormDocument()
|
||||
Dim NoArgs() as new com.sun.star.beans.PropertyValue
|
||||
Dim oViewSettings as Object
|
||||
oDocument = CreateNewDocument("swriter")
|
||||
oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
|
||||
oProgressbar.Start("", 100)
|
||||
oDocument.ApplyFormDesignMode = False
|
||||
oController = oDocument.GetCurrentController
|
||||
oViewSettings = oDocument.CurrentController.ViewSettings
|
||||
oViewSettings.ShowTableBoundaries = False
|
||||
oViewSettings.ShowOnlineLayout = True
|
||||
oDrawPage = oDocument.DrawPage
|
||||
oPageStyle = oDocument.StyleFamilies.GetByName("PageStyles").GetByName("Standard")
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeLabelValues()
|
||||
Dim oLabelModel as Object
|
||||
Dim oTBModel as Object
|
||||
Dim oLabelShape as Object
|
||||
Dim oTBShape as Object
|
||||
Dim aTBSize As New com.sun.star.awt.Size
|
||||
Dim aLabelSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim oLocControl as Object
|
||||
Dim oLocPeer as Object
|
||||
oLabelModel = CreateUnoService("com.sun.star.form.component.FixedText")
|
||||
oTBModel = CreateUnoService("com.sun.star.form.component.TextField")
|
||||
|
||||
Set oLabelShape = InsertControl(oDrawPage, oLabelModel, aPoint, aLabelSize)
|
||||
Set oTBShape = InsertControl(oDrawPage, oTBModel, aPoint, aSize)
|
||||
|
||||
oLocPeer = oController.GetControl(oLabelModel).Peer
|
||||
XPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterX
|
||||
YPixelFactor = 100000/oLocPeer.GetInfo.PixelPerMeterY
|
||||
aLabelSize = GetPeerSize(oLabelModel, oLocControl, "The quick brown fox...")
|
||||
nTCHeight = (aLabelSize.Height+1) * YPixelFactor
|
||||
aTBSize = GetPeerSize(oTBModel, oLocControl, "The quick brown fox...")
|
||||
nDBRefHeight = (aTBSize.Height+1) * YPixelFactor
|
||||
BasicLabelDiffHeight = Clng((nDBRefHeight - nTCHeight)/2)
|
||||
oDrawPage.Remove(oLabelShape)
|
||||
oDrawPage.Remove(oTBShape)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConfigurePageStyle()
|
||||
Dim aPageSize As New com.sun.star.awt.Size
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
oPageStyle.IsLandscape = True
|
||||
aPageSize = oPageStyle.Size
|
||||
nPageWidth = aPageSize.Width
|
||||
nPageHeight = aPageSize.Height
|
||||
aSize.Width = nPageHeight
|
||||
aSize.Height = nPageWidth
|
||||
oPageStyle.Size = aSize
|
||||
nPageWidth = nPageHeight
|
||||
nPageHeight = oPageStyle.Size.Height
|
||||
nFormWidth = nPageWidth - oPageStyle.RightMargin - oPageStyle.LeftMargin - 2 * cXOffset
|
||||
nFormHeight = nPageHeight - oPageStyle.TopMargin - oPageStyle.BottomMargin - 2 * cYOffset - cSymbolMargin
|
||||
End Sub
|
||||
|
||||
|
||||
' Modify the Borders of the Controls
|
||||
Sub ChangeBorderLayouts(oEvent as Object)
|
||||
Dim oModel as Object
|
||||
Dim i as Integer
|
||||
Dim oCurModel as Object
|
||||
Dim sLocText as String
|
||||
Dim oGroupShape as Object
|
||||
Dim s as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchBorderMode(Val(Right(oModel.Name,1)))
|
||||
ToggleLayoutPage(False)
|
||||
If CurArrangement = cTabled Then
|
||||
oGridModel.Border = CurBorderType
|
||||
Else
|
||||
If OldBorderType <> CurBorderType Then
|
||||
For i = 0 To MaxIndex
|
||||
If oDBShapeList(i).SupportsService("com.sun.star.drawing.GroupShape") Then
|
||||
oGroupShape = oDBShapeList(i)
|
||||
For s = 0 To oGroupShape.Count-1
|
||||
oGroupShape(s).Control.Border = CurBorderType
|
||||
Next s
|
||||
Else
|
||||
If oDBModelList(i).PropertySetInfo.HasPropertyByName("Border") Then
|
||||
oDBModelList(i).Border = CurBorderType
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
ToggleLayoutPage(True)
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
DlgFormDB.Dispose()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChangeLabelAlignments(oEvent as Object)
|
||||
Dim i as Integer
|
||||
Dim oSize as New com.sun.star.awt.Size
|
||||
Dim oModel as Object
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchAlignMode(Val(Right(oModel.Name,1)))
|
||||
ToggleLayoutPage(False)
|
||||
If OldAlignMode <> CurAlignMode Then
|
||||
For i = 0 To MaxIndex
|
||||
oTCShapeList(i).GetControl.Align = CurAlignmode
|
||||
Next i
|
||||
End If
|
||||
If CurAlignmode = com.sun.star.awt.TextAlign.RIGHT Then
|
||||
For i = 0 To Ubound(oTCShapeList())
|
||||
oSize = oTCShapeList(i).Size
|
||||
oSize.Width = oDBShapeList(i).Position.X - oTCShapeList(i).Position.X - cHoriDistance
|
||||
oTCShapeList(i).Size = oSize
|
||||
Next i
|
||||
End If
|
||||
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
ToggleLayoutPage(True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ChangeArrangemode(oEvent as Object)
|
||||
Dim oModel as Object
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
oModel = oEvent.Source.Model
|
||||
SwitchArrangementButtons(Val(Right(oModel.Name,1)))
|
||||
oModel.State = 1
|
||||
DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0
|
||||
If CurArrangement <> OldArrangement Then
|
||||
ArrangeControls()
|
||||
Select Case CurArrangement
|
||||
Case cTabled
|
||||
ToggleBorderGroup(False)
|
||||
ToggleAlignGroup(False)
|
||||
Case Else ' cColumnarTop,cLeftJustified, cTopJustified
|
||||
ToggleAlignGroup(CurArrangement = cColumnarLeft)
|
||||
If CurArrangement = cColumnarTop Then
|
||||
If CurAlignMode = com.sun.star.awt.TextAlign.RIGHT Then
|
||||
DialogModel.optAlign0.State = 1
|
||||
CurAlignMode = com.sun.star.awt.TextAlign.LEFT
|
||||
OldAlignMode = com.sun.star.awt.TextAlign.RIGHT
|
||||
End If
|
||||
End If
|
||||
ControlCaptionstoStandardLayout()
|
||||
oDBForm.Load
|
||||
End Select
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleBorderGroup(bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
.hlnBorderLayout.Enabled = bDoEnable
|
||||
.optBorder0.Enabled = bDoEnable ' 0: No border
|
||||
.optBorder1.Enabled = bDoEnable ' 1: 3D border
|
||||
.optBorder2.Enabled = bDoEnable ' 2: simple border
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleAlignGroup(ByVal bDoEnable as Boolean)
|
||||
With DialogModel
|
||||
If bDoEnable Then
|
||||
bDoEnable = CurArrangement = cColumnarLeft
|
||||
End If
|
||||
.hlnAlign.Enabled = bDoEnable
|
||||
.optAlign0.Enabled = bDoEnable
|
||||
.optAlign2.Enabled = bDoEnable
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleLayoutPage(bDoEnable as Boolean, Optional FocusControlName as String)
|
||||
DialogModel.Enabled = bDoEnable
|
||||
If bDoEnable Then
|
||||
If Not bDebug Then
|
||||
oDocument.UnlockControllers()
|
||||
End If
|
||||
ToggleOptionButtons(DialogModel,(bWithBackGraphic = True))
|
||||
ToggleAlignGroup(bDoEnable)
|
||||
ToggleBorderGroup(bDoEnable)
|
||||
Else
|
||||
If Not bDebug Then
|
||||
oDocument.LockControllers()
|
||||
End If
|
||||
End If
|
||||
If Not IsMissing(FocusControlName) Then
|
||||
DlgFormDB.GetControl(FocusControlName).SetFocus()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DestroyControlShapes(oDrawPage as Object)
|
||||
Dim i as Integer
|
||||
Dim oShape as Object
|
||||
For i = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage.GetByIndex(i)
|
||||
If oShape.ShapeType = "com.sun.star.drawing.ControlShape" Then
|
||||
oShape.Dispose()
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchArrangementButtons(ByVal LocArrangement as Integer)
|
||||
OldArrangement = CurArrangement
|
||||
CurArrangement = LocArrangement
|
||||
If OldArrangement <> 0 Then
|
||||
DlgFormDB.GetControl("cmdArrange" & OldArrangement).Model.State = 0
|
||||
End If
|
||||
DlgFormDB.GetControl("cmdArrange" & CurArrangement).Model.State = 1
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchBorderMode(ByVal LocBorderType as Integer)
|
||||
OldBorderType = CurBorderType
|
||||
CurBorderType = LocBorderType
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchAlignMode(ByVal LocAlignMode as Integer)
|
||||
OldAlignMode = CurAlignMode
|
||||
CurAlignMode = LocAlignMode
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,550 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="develop" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
|
||||
Public oDBShapeList() as Object
|
||||
Public oTCShapeList() as Object
|
||||
Public oDBModelList() as Object
|
||||
Public oGroupShapeList() as Object
|
||||
|
||||
Public oGridShape as Object
|
||||
Public a as Integer
|
||||
Public StartA as Integer
|
||||
Public bIsFirstRun as Boolean
|
||||
Public bIsVeryFirstRun as Boolean
|
||||
Public bControlsareCreated as Boolean
|
||||
Public nDBRefHeight as Long
|
||||
Public nXTCPos&, nYTCPos&, nXDBPos&, nYDBPos&, nTCHeight&, nTCWidth&, nDBHeight&, nDBWidth&
|
||||
|
||||
Dim iReduceWidth as Integer
|
||||
|
||||
Function PositionControls(Maxindex as Integer)
|
||||
Dim oTCModel as Object
|
||||
Dim oDBModel as Object
|
||||
Dim i as Integer
|
||||
InitializePosSizes()
|
||||
bIsFirstRun = True
|
||||
bIsVeryFirstRun = True
|
||||
a = 0
|
||||
StartA = 0
|
||||
nMaxRowY = 0
|
||||
nSecMaxRowY = 0
|
||||
If CurArrangement = cLeftJustified Or cTopJustified Then
|
||||
DialogModel.optAlign0.State = 1
|
||||
End If
|
||||
For i = 0 To MaxIndex
|
||||
GetCurrentMetaValues(i)
|
||||
oTCModel = InsertTextControl(i)
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
|
||||
InsertTimeStampShape(i)
|
||||
Else
|
||||
InsertDBControl(i)
|
||||
bIsVeryFirstRun = False
|
||||
oDBModelList(i).LabelControl = oTCModel
|
||||
End If
|
||||
GetLabelDiffHeight(i+1)
|
||||
ResetPosSizes(i)
|
||||
oProgressbar.Value = i
|
||||
Next i
|
||||
ControlCaptionstoStandardLayout()
|
||||
bControlsareCreated = True
|
||||
End Function
|
||||
|
||||
|
||||
Sub ResetPosSizes(LastIndex as Integer)
|
||||
Select Case CurArrangement
|
||||
Case cColumnarLeft
|
||||
nYDBPos = nYDBPos + nDBHeight + cVertDistance
|
||||
If (nYDBPos > cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then
|
||||
RepositionColumnarLeftControls(LastIndex)
|
||||
nXTCPos = nMaxColRightX + 2 * cHoriDistance
|
||||
nXDBPos = nXTCPos + cHoriDistance + nMaxTCWidth
|
||||
nYDBPos = cYOffset
|
||||
bIsFirstRun = True
|
||||
StartA = LastIndex + 1
|
||||
a = 0
|
||||
Else
|
||||
a = a + 1
|
||||
End If
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
Case cColumnarTop
|
||||
nYTCPos = nYDBPos + nDBHeight + cVertDistance
|
||||
If nYTCPos > cYOffset + nFormHeight Then
|
||||
nXDBPos = nMaxColRightX + cHoriDistance
|
||||
nXTCPos = nXDBPos
|
||||
nYDBPos = cYOffset + nTCHeight + cVertDistance
|
||||
nYTCPos = cYOffset
|
||||
bIsFirstRun = True
|
||||
StartA = LastIndex + 1
|
||||
a = 0
|
||||
Else
|
||||
a = a + 1
|
||||
End If
|
||||
Case cLeftJustified,cTopJustified
|
||||
If nMaxColRightX > cXOffset + nFormWidth Then
|
||||
Dim nOldYTCPos as Long
|
||||
nOldYTCPos = nYTCPos
|
||||
CheckJustifiedPosition()
|
||||
Else
|
||||
nXTCPos = nMaxColRightX + CHoriDistance
|
||||
If CurArrangement = cLeftJustified Then
|
||||
nYTCPos = nYDBPos + LabelDiffHeight
|
||||
End If
|
||||
End If
|
||||
a = a + 1
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RepositionColumnarLeftControls(LastIndex as Integer)
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim i as Integer
|
||||
aSize = GetSize(nMaxTCWidth, nTCHeight)
|
||||
bIsFirstRun = True
|
||||
For i = StartA To LastIndex
|
||||
If i = StartA Then
|
||||
nXTCPos = oTCShapeList(i).Position.X
|
||||
nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance
|
||||
End If
|
||||
ResetDBShape(oDBShapeList(i), nXDBPos)
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ResetDBShape(oLocDBShape as Object, iXPos as Long)
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
nYDBPos = oLocDBShape.Position.Y
|
||||
nDBWidth = oLocDBShape.Size.Width
|
||||
nDBHeight = oLocDBShape.Size.Height
|
||||
aPoint = GetPoint(iXPos,nYDBPos)
|
||||
oLocDBShape.SetPosition(aPoint)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializePosSizes()
|
||||
nXTCPos = cXOffset
|
||||
nTCWidth = 2000
|
||||
nDBWidth = 2000
|
||||
nDBHeight = nDBRefHeight
|
||||
iReduceWidth = 0
|
||||
Select Case CurArrangement
|
||||
Case cColumnarLeft, cLeftJustified
|
||||
GetLabelDiffHeight(0)
|
||||
nYTCPos = cYOffset + LABELDIFFHEIGHT
|
||||
nXDBPos = cXOffset + 3050
|
||||
nYDBPos = cYOffset
|
||||
Case cColumnarTop, cTopJustified
|
||||
nXDBPos = cXOffset
|
||||
nYTCPos = cYOffset
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Function InsertTextControl(i as Integer) as Object
|
||||
Dim oShape as Object
|
||||
Dim oModel as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
If bControlsareCreated Then
|
||||
Set oShape = oTCShapeList(i)
|
||||
Set oModel = oShape.GetControl
|
||||
If CurArrangement = cLeftJustified Then
|
||||
nTCWidth = GetPreferredWidth(oModel, True, CurFieldname)
|
||||
Else
|
||||
nTCWidth = oShape.Size.Width
|
||||
End If
|
||||
oShape.Position = GetPoint(nXTCPos, nYTCPos)
|
||||
If CurArrangement = cColumnarTop Then
|
||||
oModel.Align = com.sun.star.awt.TextAlign.LEFT
|
||||
End If
|
||||
Else
|
||||
oModel = CreateUnoService(oModelService(cLabel))
|
||||
aPoint = GetPoint(nXTCPos, nYTCPos)
|
||||
aSize = GetSize(nTCWidth,nTCHeight)
|
||||
Set oShape = InsertControl(oDrawPage, oModel, aPoint, aSize)
|
||||
Set oTCShapeList(i)= oShape
|
||||
If bIsVeryFirstRun Then
|
||||
If CurArrangement = cColumnarTop Then
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
End If
|
||||
End If
|
||||
nTCWidth = GetPreferredWidth(oModel, True, CurFieldName)
|
||||
End If
|
||||
If CurArrangement = cColumnarLeft Then
|
||||
' Note This If Sequence must be called before retrieving the outer Points
|
||||
If bIsFirstRun Then
|
||||
nMaxTCWidth = nTCWidth
|
||||
bIsFirstRun = False
|
||||
ElseIf nTCWidth > nMaxTCWidth Then
|
||||
nMaxTCWidth = nTCWidth
|
||||
End If
|
||||
End If
|
||||
CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight, False)
|
||||
Select Case CurArrangement
|
||||
Case cLeftJustified
|
||||
nXDBPos = nMaxColRightX
|
||||
Case cColumnarTop,cTopJustified
|
||||
oModel.Align = com.sun.star.awt.TextAlign.LEFT
|
||||
nXDBPos = nXTCPos
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
If CurFieldLength = 20 And nDBWidth > 2 * nTCWidth Then
|
||||
iReduceWidth = iReduceWidth + 1
|
||||
End If
|
||||
End Select
|
||||
oShape.SetSize(GetSize(nTCWidth,nTCHeight))
|
||||
If CurHelpText <> "" Then
|
||||
oModel.HelpText = CurHelptext
|
||||
End If
|
||||
InsertTextControl = oModel
|
||||
End Function
|
||||
|
||||
|
||||
Sub InsertDBControl(i as Integer)
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
Dim oControl as Object
|
||||
Dim iColRightX as Long
|
||||
|
||||
aPoint = GetPoint(nXDBPos, nYDBPos)
|
||||
If bControlsAreCreated Then
|
||||
oDBShapeList(i).Position = aPoint
|
||||
Else
|
||||
oDBModelList(i) = CreateUnoService(oModelService(CurControlType))
|
||||
oDBShapeList(i) = InsertControl(oDrawPage, oDBModelList(i), aPoint, aSize)
|
||||
SetNumerics(oDBModelList(i), CurFieldType)
|
||||
If CurControlType = cCheckBox Then
|
||||
oDBModelList(i).Label = ""
|
||||
End If
|
||||
oDBModelList(i).DataField = CurFieldName
|
||||
End If
|
||||
nDBHeight = GetDBHeight(oDBModelList(i))
|
||||
nDBWidth = GetPreferredWidth(oDBModelList(i),True)
|
||||
aSize = GetSize(nDBWidth,nDBHeight)
|
||||
oDBShapeList(i).SetSize(aSize)
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
End Sub
|
||||
|
||||
|
||||
Function InsertTimeStampShape(i as Integer) as Object
|
||||
Dim oDateModel as Object
|
||||
Dim oTimeModel as Object
|
||||
Dim oDateShape as Object
|
||||
Dim oTimeShape as Object
|
||||
Dim oDateTimeShape as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize as New com.sun.star.awt.Size
|
||||
Dim nDateWidth as Long
|
||||
Dim nTimeWidth as Long
|
||||
Dim oGroupShape as Object
|
||||
aPoint = GetPoint(nXDBPos, nYDBPos)
|
||||
If bControlsAreCreated Then
|
||||
oDBShapeList(i).Position = aPoint
|
||||
nDBWidth = oDBShapeList(i).Size.Width
|
||||
nDBHeight = oDBShapeList(i).Size.Height
|
||||
Else
|
||||
oGroupShape = oDocument.CreateInstance("com.sun.star.drawing.GroupShape")
|
||||
oGroupShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
|
||||
oDrawPage.Add(oGroupShape)
|
||||
CurFieldType = com.sun.star.sdbc.DataType.DATE
|
||||
oDateModel = CreateUnoService("com.sun.star.form.component.DateField")
|
||||
oDateModel.DataField = CurFieldName
|
||||
oDateShape = InsertControl(oGroupShape, oDateModel, aPoint, aSize)
|
||||
SetNumerics(oDateModel, CurFieldType)
|
||||
nDBHeight = GetDBHeight(oDateModel)
|
||||
nDateWidth = GetPreferredWidth(oDateModel,True)
|
||||
aSize = GetSize(nDateWidth,nDBHeight)
|
||||
oDateShape.SetSize(aSize)
|
||||
|
||||
CurFieldType = com.sun.star.sdbc.DataType.TIME
|
||||
oTimeModel = CreateUnoService("com.sun.star.form.component.TimeField")
|
||||
oTimeModel.DataField = CurFieldName
|
||||
oTimeShape = InsertControl(oGroupShape, oTimeModel, aPoint, aSize)
|
||||
oTimeShape.Position = GetPoint(nXDBPos + 10 + nDateWidth,nYDBPos)
|
||||
nTimeWidth = GetPreferredWidth(oTimeModel)
|
||||
aSize = GetSize(nTimeWidth,nDBHeight)
|
||||
oTimeShape.SetSize(aSize)
|
||||
nDBWidth = nDateWidth + nTimeWidth + 10
|
||||
oGroupShape.Position = aPoint
|
||||
oGroupShape.Size = GetSize(nDBWidth, nDBHeight)
|
||||
Set oDBShapeList(i)= oGroupShape
|
||||
End If
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
InsertTimeStampShape() = oDBShapeList(i)
|
||||
End Function
|
||||
|
||||
|
||||
' Note: on all Controls except for the checkbox the Label has to be set
|
||||
' a bit under the DBControl because its Height is also smaller
|
||||
Sub GetLabelDiffHeight(Index as Integer)
|
||||
If (CurArrangement = cLeftJustified) Or (CurArrangement = cColumnarLeft) Then
|
||||
If Index <= Ubound(FieldMetaValues()) Then
|
||||
If FieldMetaValues(Index,2) = cCheckBox Then
|
||||
LabelDiffHeight = 0
|
||||
Else
|
||||
LabelDiffHeight = BasicLabelDiffHeight
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckJustifiedPosition()
|
||||
Dim nLeftDist as Long
|
||||
Dim nRightDist as Long
|
||||
Dim oLocDBShape as Object
|
||||
Dim oLocTextShape as Object
|
||||
Dim nBaseWidth as Long
|
||||
nBaseWidth = nFormWidth + cXOffset
|
||||
nLeftDist = nMaxColRightX - nBaseWidth
|
||||
nRightDist = nBaseWidth - nXTCPos + cHoriDistance
|
||||
If nLeftDist < 0.5 * nRightDist and iReduceWidth > 2 Then
|
||||
' Fieldwidths in the line can be made smaller
|
||||
AdjustLineWidth(StartA, a, nLeftDist, - 1)
|
||||
If CurArrangement = cLeftjustified Then
|
||||
nYDBPos = nMaxRowY + cVertDistance
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
nXTCPos = cXOffset
|
||||
Else
|
||||
nYTCPos = nMaxRowY + cVertDistance
|
||||
nYDBPos = nYTCPos + nTCHeight
|
||||
nXTCPos = cXOffset
|
||||
nXDBPos = cXOffset
|
||||
End If
|
||||
bIsFirstRun = True
|
||||
StartA = a + 1
|
||||
Else
|
||||
Set oLocDBShape = oDBShapeList(a)
|
||||
Set oLocTextShape = oTCShapeList(a)
|
||||
If CurArrangement = cLeftJustified Then
|
||||
If nYDBPos + nDBHeight = nMaxRowY Then
|
||||
' The last Control was the highest in the row
|
||||
nYDBPos = nSecMaxRowY + cVertDistance
|
||||
Else
|
||||
nYDBPos = nMaxRowY + cVertDistance
|
||||
End If
|
||||
nYTCPos = nYDBPos + LABELDIFFHEIGHT
|
||||
nXDBPos = cXOffset + nTCWidth
|
||||
oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
|
||||
oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos)
|
||||
' PosSizes for the next two Controls
|
||||
nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
|
||||
bIsFirstRun = True
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
nXDBPos = nMaxColRightX + cHoriDistance
|
||||
Else ' cTopJustified
|
||||
If nYDBPos + nDBHeight = nMaxRowY Then
|
||||
' The last Control was the highest in the row
|
||||
nYTCPos = nSecMaxRowY + cVertDistance
|
||||
Else
|
||||
nYTCPos = nMaxRowY + cVertDistance
|
||||
End If
|
||||
nYDBPos = nYTCPOS + nTCHeight
|
||||
nXDBPos = cXOffset
|
||||
nXTCPos = cXOffset
|
||||
oLocTextShape.Position = GetPoint(cXOffset, nYTCPos)
|
||||
oLocDBShape.Position = GetPoint(cXOffset, nYDBPos)
|
||||
bIsFirstRun = True
|
||||
If nDBWidth > nTCWidth Then
|
||||
CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight, True)
|
||||
Else
|
||||
CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight, True)
|
||||
End If
|
||||
nXTCPos = nMaxColRightX + cHoriDistance
|
||||
nXDBPos = nXTCPos
|
||||
End If
|
||||
AdjustLineWidth(StartA, a-1, nRightDist, 1)
|
||||
StartA = a
|
||||
End If
|
||||
iReduceWidth = 0
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function GetCorrWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) as Integer
|
||||
Dim ShapeCount as Integer
|
||||
If WidthFactor > 0 Then
|
||||
ShapeCount = EndIndex-StartIndex + 1
|
||||
Else
|
||||
ShapeCount = iReduceWidth
|
||||
End If
|
||||
GetCorrWidth() = (nDist)/ShapeCount
|
||||
End Function
|
||||
|
||||
|
||||
Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer)
|
||||
Dim i as Integer
|
||||
Dim oLocDBShape as Object
|
||||
Dim oLocTCShape as Object
|
||||
Dim CorrWidth as Integer
|
||||
Dim bAdjustPos as Boolean
|
||||
Dim iLocTCPosX as Long
|
||||
Dim iLocDBPosX as Long
|
||||
CorrWidth = GetCorrWidth(StartIndex, EndIndex, nDist, Widthfactor)
|
||||
bAdjustPos = False
|
||||
iLocTCPosX = cXOffset
|
||||
For i = StartIndex To EndIndex
|
||||
Set oLocDBShape = oDBShapeList(i)
|
||||
Set oLocTCShape = oTCShapeList(i)
|
||||
If bAdjustPos Then
|
||||
oLocTCShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y)
|
||||
If CurArrangement = cLeftJustified Then
|
||||
iLocDBPosX = oLocTCShape.Position.X + oLocTCShape.Size.Width
|
||||
oLocDBShape.Position = GetPoint(iLocDBPosX, oLocDBShape.Position.Y)
|
||||
Else
|
||||
oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight)
|
||||
End If
|
||||
Else
|
||||
bAdjustPos = True
|
||||
End If
|
||||
If CDbl(FieldMetaValues(i,1)) > 20 or WidthFactor > 0 Then
|
||||
If (CurArrangement = cTopJustified) And (oLocTCShape.Size.Width > oLocDBShape.Size.Width) Then
|
||||
oLocDBShape.Size = GetSize(oLocTCShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
|
||||
Else
|
||||
oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height)
|
||||
End If
|
||||
End If
|
||||
iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance
|
||||
If CurArrangement = cTopJustified Then
|
||||
If oLocTCShape.Size.Width > oLocDBShape.Size.Width Then
|
||||
iLocTCPosX = oLocDBShape.Position.X + oLocTCShape.Size.Width + cHoriDistance
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight, bIsDBField as Boolean)
|
||||
Dim nColRightX as Long
|
||||
Dim nRowY as Long
|
||||
Dim nOldMaxRowY as Long
|
||||
If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then
|
||||
If bIsDBField Then
|
||||
' Only at DBControls you can measure the Value of nMaxRowY
|
||||
If bIsFirstRun Then
|
||||
nMaxRowY = nYPos + nHeight
|
||||
nSecMaxRowY = nMaxRowY
|
||||
Else
|
||||
nRowY = nYPos + nHeight
|
||||
If nRowY >= nMaxRowY Then
|
||||
nOldMaxRowY = nMaxRowY
|
||||
nSecMaxRowY = nOldMaxRowY
|
||||
nMaxRowY = nRowY
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
' Find the outer right point
|
||||
If bIsFirstRun Then
|
||||
nMaxColRightX = nXPos + nWidth
|
||||
bIsFirstRun = False
|
||||
Else
|
||||
nColRightX = nXPos + nWidth
|
||||
If nColRightX > nMaxColRightX Then
|
||||
nMaxColRightX = nColRightX
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function PositionGridControl(MaxIndex as Integer)
|
||||
Dim oControl as Object
|
||||
Dim n as Integer
|
||||
Dim oColumn as Object
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
Dim aSize as New com.sun.star.awt.Size
|
||||
If bControlsareCreated Then
|
||||
ShapesToNirwana()
|
||||
End If
|
||||
oGridModel = CreateUnoService(oModelService(cGridControl))
|
||||
oGridModel.Name = "Grid1"
|
||||
aPoint = GetPoint(cXOffset, cYOffset)
|
||||
aSize = GetSize(nFormWidth, nFormHeight)
|
||||
oDBForm.InsertByName (oGridModel.Name, oGridModel)
|
||||
oGridShape = InsertControl(oDrawPage, oGridModel, aPoint, aSize)
|
||||
For n = 0 to MaxIndex
|
||||
GetCurrentMetaValues(n)
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.TIMESTAMP Then
|
||||
oColumn = SetupGridColumn(oGridModel,"DateField", False, com.sun.star.sdbc.DataType.DATE, CurFieldName & " " & sDateAppendix)
|
||||
oColumn = SetupGridColumn(oGridModel,"TimeField", False, com.sun.star.sdbc.DataType.TIME, CurFieldName & " " & sTimeAppendix)
|
||||
Else
|
||||
If CurControlType = cImageControl Then
|
||||
oColumn = SetupGridColumn(oGridModel,"TextField", True, CurFieldType, CurFieldName)
|
||||
Else
|
||||
oColumn = SetupGridColumn(oGridModel, CurControlName, False, CurFieldType, CurFieldName)
|
||||
End If
|
||||
End If
|
||||
oProgressbar.Value = n
|
||||
next n
|
||||
End Function
|
||||
|
||||
|
||||
Function SetupGridColumn(oGridModel as Object, ControlName as String, bHidden as Boolean, iLocFieldType as Integer, ColName as String) as Object
|
||||
Dim oColumn as Object
|
||||
CurControlName = ControlName
|
||||
oColumn = oGridModel.CreateColumn(CurControlName)
|
||||
oColumn.Name = CalcUniqueContentName(oGridModel, CurControlName)
|
||||
oColumn.Hidden = bHidden
|
||||
SetNumerics(oColumn, iLocFieldType)
|
||||
oColumn.DataField = CurFieldName
|
||||
oColumn.Label = ColName
|
||||
oColumn.Width = 0 ' Width of column is adjusted to Columname
|
||||
oGridModel.insertByName(oColumn.Name, oColumn)
|
||||
End Function
|
||||
|
||||
|
||||
Sub ControlCaptionstoStandardLayout()
|
||||
Dim i as Integer
|
||||
Dim iBorderType as Integer
|
||||
Dim oCurModel as Object
|
||||
Dim oStyle as Object
|
||||
Dim iStandardColor as Long
|
||||
If CurArrangement <> cTabled Then
|
||||
oStyle = oDocument.StyleFamilies.GetByName("ParagraphStyles").GetByName("Standard")
|
||||
iStandardColor = oStyle.CharColor
|
||||
For i = 0 To MaxIndex
|
||||
oCurModel = oTCShapeList(i).GetControl
|
||||
If i = 0 Then
|
||||
If oCurModel.TextColor = iStandardColor Then
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
oCurModel.TextColor = iStandardColor
|
||||
Next i
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GroupShapesTogether()
|
||||
Dim i as Integer
|
||||
If CurArrangement <> cTabled Then
|
||||
For i = 0 To MaxIndex
|
||||
oGroupShapeList(i) = CreateUnoService("com.sun.star.drawing.ShapeCollection")
|
||||
oGroupShapeList(i).Add(oTCShapeList(i))
|
||||
oGroupShapeList(i).Add(oDBShapeList(i))
|
||||
oDrawPage.Group(oGroupShapeList(i))
|
||||
Next i
|
||||
Else
|
||||
RemoveNirwanaShapes()
|
||||
End If
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,5 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="FormWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="DlgFormDB"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,10 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="FormWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="FormWizard"/>
|
||||
<library:element library:name="Layouter"/>
|
||||
<library:element library:name="Language"/>
|
||||
<library:element library:name="DBMeta"/>
|
||||
<library:element library:name="tools"/>
|
||||
<library:element library:name="develop"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,363 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC *****
|
||||
Option Explicit
|
||||
Public Const SBMAXTEXTSIZE = 50
|
||||
|
||||
|
||||
Function SetProgressValue(iValue as Integer)
|
||||
If iValue = 0 Then
|
||||
oProgressbar.End
|
||||
End If
|
||||
ProgressValue = iValue
|
||||
oProgressbar.Value = iValue
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim nWidth as Integer
|
||||
Dim oControl as Object
|
||||
If Not IsMissing(LocText) Then
|
||||
' Label
|
||||
aPeerSize = GetPeerSize(oModel, oControl, LocText)
|
||||
ElseIf CurControlType = cImageControl Then
|
||||
GetPreferredWidth() = 2000
|
||||
Exit Function
|
||||
Else
|
||||
aPeerSize = GetPeerSize(oModel, oControl)
|
||||
End If
|
||||
nWidth = aPeerSize.Width
|
||||
' We increase the preferred Width a bit so that the control does not become too small
|
||||
' when we change the border from "3D" to "Flat"
|
||||
GetPreferredWidth = (nWidth + 10) * XPixelFactor ' PixelTo100thmm(nWidth)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPreferredHeight(oModel as Object, Optional LocText)
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim nHeight as Integer
|
||||
Dim oControl as Object
|
||||
If Not IsMissing(LocText) Then
|
||||
' Label
|
||||
aPeerSize = GetPeerSize(oModel, oControl, LocText)
|
||||
ElseIf CurControlType = cImageControl Then
|
||||
GetPreferredHeight() = 2000
|
||||
Exit Function
|
||||
Else
|
||||
aPeerSize = GetPeerSize(oModel, oControl)
|
||||
End If
|
||||
nHeight = aPeerSize.Height
|
||||
' We increase the preferred Height a bit so that the control does not become too small
|
||||
' when we change the border from "3D" to "Flat"
|
||||
GetPreferredHeight = (nHeight+1) * YPixelFactor ' PixelTo100thmm(nHeight)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
|
||||
Dim oPeer as Object
|
||||
Dim aPeerSize as new com.sun.star.awt.Size
|
||||
Dim NullValue
|
||||
oControl = oController.GetControl(oModel)
|
||||
oPeer = oControl.GetPeer()
|
||||
If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
|
||||
If oControl.Model.EffectiveMax = 0 Then
|
||||
' This is relevant for decimal fields
|
||||
oControl.Model.EffectiveValue = 999.9999
|
||||
Else
|
||||
oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
|
||||
End If
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Model.EffectiveValue = NullValue
|
||||
ElseIf Not IsMissing(LocText) Then
|
||||
oControl.Text = LocText
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.BOOLEAN Then
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
|
||||
oControl.Model.Date = Date
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Model.Date = NullValue
|
||||
ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
|
||||
oControl.Time = Time
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Time = NullValue
|
||||
Else
|
||||
If oControl.MaxTextLen > SBMAXTEXTSIZE Then
|
||||
oControl.Text = Mid(SBSIZETEXT,1, SBMAXTEXTSIZE)
|
||||
Else
|
||||
oControl.Text = Mid(SBSIZETEXT,1, oControl.MaxTextLen)
|
||||
End If
|
||||
GetPeerSize() = oPeer.PreferredSize()
|
||||
oControl.Text = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function TwipToCM(ByVal nValue as long) as String
|
||||
TwipToCM = trim(str(nValue / 567)) + "cm"
|
||||
End function
|
||||
|
||||
|
||||
Function TwipTo100telMM(ByVal nValue as long) as long
|
||||
TwipTo100telMM = nValue / 0.567
|
||||
End function
|
||||
|
||||
|
||||
Function TwipToPixel(ByVal nValue as long) as long ' not an exact calculation
|
||||
TwipToPixel = nValue / 15
|
||||
End function
|
||||
|
||||
|
||||
Function PixelTo100thMMX(oControl as Object) as long
|
||||
oPeer = oControl.GetPeer()
|
||||
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
|
||||
|
||||
' PixelTo100thMM = nValue * 28 ' not an exact calculation
|
||||
End function
|
||||
|
||||
|
||||
Function PixelTo100thMMY(oControl as Object) as long
|
||||
oPeer = oControl.GetPeer()
|
||||
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
|
||||
|
||||
' PixelTo100thMM = nValue * 28 ' not an exact calculation
|
||||
End function
|
||||
|
||||
|
||||
Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
|
||||
Dim aPoint as New com.sun.star.awt.Point
|
||||
aPoint.X = xPos
|
||||
aPoint.Y = yPos
|
||||
GetPoint() = aPoint
|
||||
End Function
|
||||
|
||||
|
||||
Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
aSize.Width = iWidth
|
||||
aSize.Height = iHeight
|
||||
GetSize() = aSize
|
||||
End Function
|
||||
|
||||
|
||||
Sub ImportStyles()
|
||||
Dim OldIndex as Integer
|
||||
If Not bDebug Then
|
||||
On Local Error GoTo WIZARDERROR
|
||||
End If
|
||||
OldIndex = CurIndex
|
||||
CurIndex = GetCurIndex(DialogModel.lstStyles, Styles(),8)
|
||||
If CurIndex <> OldIndex Then
|
||||
ToggleLayoutPage(False)
|
||||
Dim sImportPath as String
|
||||
sImportPath = Styles(CurIndex, 8)
|
||||
bWithBackGraphic = LoadNewStyles(oDocument, DialogModel, CurIndex, sImportPath, Styles(), TexturePath)
|
||||
ControlCaptionsToStandardLayout()
|
||||
ToggleLayoutPage(True, "lstStyles")
|
||||
End If
|
||||
WIZARDERROR:
|
||||
If Err <> 0 Then
|
||||
Msgbox(sMsgErrMsg, 16, GetProductName())
|
||||
Resume LOCERROR
|
||||
LOCERROR:
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) as Object
|
||||
If CurControlType = cNumericBox Then
|
||||
oLocObject.TreatAsNumber = True
|
||||
Select Case iLocFieldType
|
||||
Case com.sun.star.sdbc.DataType.BIGINT
|
||||
oLocObject.EffectiveMax = 2147483647 * 2147483647
|
||||
oLocObject.EffectiveMin = -(-2147483648 * -2147483648)
|
||||
' oLocObject.DecimalAccuracy = 0
|
||||
Case com.sun.star.sdbc.DataType.INTEGER
|
||||
oLocObject.EffectiveMax = 2147483647
|
||||
oLocObject.EffectiveMin = -2147483648
|
||||
Case com.sun.star.sdbc.DataType.SMALLINT
|
||||
oLocObject.EffectiveMax = 32767
|
||||
oLocObject.EffectiveMin = -32768
|
||||
Case com.sun.star.sdbc.DataType.TINYINT
|
||||
oLocObject.EffectiveMax = 127
|
||||
oLocObject.EffectiveMin = -128
|
||||
Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
|
||||
'Todo: oLocObject.DecimalAccuracy = ...
|
||||
oLocObject.EffectiveDefault = CurDefaultValue
|
||||
' Todo: HelpText???
|
||||
End Select
|
||||
If oLocObject.PropertySetinfo.HasPropertyByName("Width")Then ' Note: an Access AutoincrementField does not provide this property Width
|
||||
oLocObject.Width = CurFieldLength + CurScale + 1
|
||||
End If
|
||||
If CurIsCurrency Then
|
||||
'Todo: How do you set currencies?
|
||||
End If
|
||||
ElseIf CurControlType = cTextBox Then 'com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
|
||||
If CurFieldLength = 0 Then 'Or oLocObject.MaxTextLen > SBMAXTEXTSIZE
|
||||
oLocObject.MaxTextLen = SBMAXTEXTSIZE
|
||||
CurFieldLength = SBMAXTEXTSIZE
|
||||
Else
|
||||
oLocObject.MaxTextLen = CurFieldLength
|
||||
End If
|
||||
oLocObject.DefaultText = CurDefaultValue
|
||||
ElseIf CurControlType = cDateBox Then
|
||||
' Todo Why does this not work?: oLocObject.DefaultDate = CurDefaultValue
|
||||
ElseIf CurControlType = cTimeBox Then ' com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
|
||||
oLocObject.DefaultTime = CurDefaultValue
|
||||
' Todo: Property TimeFormat? from where?
|
||||
ElseIf CurControlType = cCheckBox Then
|
||||
' Todo Why does this not work?: oLocObject.DefaultState = CurDefaultValue
|
||||
End If
|
||||
If oLocObject.PropertySetInfo.HasPropertybyName("FormatKey") Then
|
||||
On Local Error Resume Next
|
||||
oLocObject.FormatKey = CurFormatKey
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Destroy all Shapes in Nirwana
|
||||
Sub RemoveShapes()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
Dim oShape as Object
|
||||
For n = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage(n)
|
||||
If oShape.Position.Y > -2000 Then
|
||||
oDrawPage.Remove(oShape)
|
||||
End If
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
' Destroy all Shapes in Nirwana
|
||||
Sub RemoveNirwanaShapes()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
Dim oShape as Object
|
||||
For n = oDrawPage.Count-1 To 0 Step -1
|
||||
oShape = oDrawPage(n)
|
||||
If oShape.Position.Y < -2000 Then
|
||||
oDrawPage.Remove(oShape)
|
||||
End If
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
' Note: as Shapes cannot be removed from the DrawPage without destroying
|
||||
' the object we have to park them somewhere beyond the visible area of the page
|
||||
Sub ShapesToNirwana()
|
||||
Dim n as Integer
|
||||
Dim oControl as Object
|
||||
For n = 0 To oDrawPage.Count-1
|
||||
oDrawPage(n).Position = GetPoint(-20, -10000)
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
Function CalcUniqueContentName(ByVal oContainer as Object, sBaseName as String) as String
|
||||
|
||||
Dim nPostfix as Integer
|
||||
Dim sReturn as String
|
||||
nPostfix = 2
|
||||
sReturn = sBaseName
|
||||
while (oContainer.hasByName(sReturn))
|
||||
sReturn = sBaseName & nPostfix
|
||||
nPostfix = nPostfix + 1
|
||||
Wend
|
||||
CalcUniqueContentName = sReturn
|
||||
End Function
|
||||
|
||||
|
||||
Function CountItemsInArray(BigArray(), SearchItem)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim ResCount as Integer
|
||||
ResCount = 0
|
||||
MaxIndex = Ubound(BigArray())
|
||||
For i = 0 To MaxIndex
|
||||
If SearchItem = BigArray(i) Then
|
||||
ResCount = ResCount + 1
|
||||
End If
|
||||
Next i
|
||||
CountItemsInArray() = ResCount
|
||||
End Function
|
||||
|
||||
|
||||
Function GetDBHeight(oDBModel as Object)
|
||||
If CurControlType = cImageControl Then
|
||||
nDBHeight = 2000
|
||||
Else
|
||||
If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
|
||||
oDBModel.MultiLine = True
|
||||
nDBHeight = nDBRefHeight * 4
|
||||
Else
|
||||
nDBHeight = nDBRefHeight
|
||||
End If
|
||||
End If
|
||||
GetDBHeight() = nDBHeight
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFormWizardPaths() as Boolean
|
||||
FormPath = GetOfficeSubPath("Template","../wizard/bitmap")
|
||||
If FormPath <> "" Then
|
||||
WizardPath = GetOfficeSubPath("Template","wizard/")
|
||||
If Wizardpath <> "" Then
|
||||
TexturePath = GetOfficeSubPath("Gallery", "backgrounds/")
|
||||
If TexturePath <> "" Then
|
||||
WorkPath = GetPathSettings("Work")
|
||||
If WorkPath <> "" Then
|
||||
TempPath = GetPathSettings("Temp")
|
||||
If TempPath <> "" Then
|
||||
GetFormWizardPaths = True
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
DisposeDocument(oDocument)
|
||||
GetFormWizardPaths() = False
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFilterName(sApplicationKey as String) as String
|
||||
Dim oArgs()
|
||||
Dim oFactory
|
||||
Dim i as Integer
|
||||
Dim Maxindex as Integer
|
||||
Dim UIName as String
|
||||
oFactory = createUnoService("com.sun.star.document.FilterFactory")
|
||||
oArgs() = oFactory.getByName(sApplicationKey)
|
||||
MaxIndex = Ubound(oArgs())
|
||||
For i = 0 to MaxIndex
|
||||
If (oArgs(i).Name="UIName") Then
|
||||
UIName = oArgs(i).Value
|
||||
Exit For
|
||||
End If
|
||||
next i
|
||||
GetFilterName() = UIName
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,114 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="AutoText" script:language="StarBasic">' BASIC
|
||||
Option Explicit
|
||||
Dim oDocument as Object
|
||||
Dim sDocumentTitle as String
|
||||
|
||||
|
||||
Sub Main()
|
||||
Dim oTable as Object
|
||||
Dim oRows as Object
|
||||
Dim oDocuText as Object
|
||||
Dim oAutoTextCursor as Object
|
||||
Dim oAutoTextContainer as Object
|
||||
Dim oAutogroup as Object
|
||||
Dim oAutoText as Object
|
||||
Dim oCharStyles as Object
|
||||
Dim oContentStyle as Object
|
||||
Dim oHeaderStyle as Object
|
||||
Dim oGroupTitleStyle as Object
|
||||
Dim n, m, iAutoCount as Integer
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
sDocumentTitle = "Installed AutoTexts"
|
||||
|
||||
' Open a new empty document
|
||||
oDocument = CreateNewDocument("swriter")
|
||||
If Not IsNull(oDocument) Then
|
||||
oDocument.DocumentProperties.Title = sDocumentTitle
|
||||
oDocuText = oDocument.Text
|
||||
|
||||
' Create The Character-templates
|
||||
oCharStyles = oDocument.StyleFamilies.GetByName("CharacterStyles")
|
||||
|
||||
' The Characterstyle for the Header that describes the Title of Autotextgroups
|
||||
oGroupTitleStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("AutoTextGroupTitle", oGroupTitleStyle)
|
||||
|
||||
oGroupTitleStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oGroupTitleStyle.CharHeight = 14
|
||||
|
||||
' The Characterstyle for the Header that describes the Title of Autotextgroups
|
||||
oHeaderStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("AutoTextHeading", oHeaderStyle)
|
||||
oHeaderStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
|
||||
' "Ordinary" Table Content
|
||||
oContentStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("TableContent", oContentStyle)
|
||||
|
||||
oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer")
|
||||
|
||||
oAutoTextCursor = oDocuText.CreateTextCursor()
|
||||
|
||||
oAutoTextCursor.CharStyleName = "AutoTextGroupTitle"
|
||||
' Link the Title with the following table
|
||||
oAutoTextCursor.ParaKeepTogether = True
|
||||
|
||||
For n = 0 To oAutoTextContainer.Count - 1
|
||||
oAutoGroup = oAutoTextContainer.GetByIndex(n)
|
||||
|
||||
oAutoTextCursor.SetString(oAutoGroup.Title)
|
||||
oAutoTextCursor.CollapseToEnd()
|
||||
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oTable = oDocument.CreateInstance("com.sun.star.text.TextTable")
|
||||
' Divide the table if necessary
|
||||
oTable.Split = True
|
||||
' oTable.KeepTogether = False
|
||||
oTable.RepeatHeadLine = True
|
||||
oAutoTextCursor.Text.InsertTextContent(oAutoTextCursor,oTable,False)
|
||||
InsertStringToCell("AutoText Name",oTable.GetCellbyPosition(0,0), "AutoTextHeading")
|
||||
InsertStringToCell("AutoText Shortcut",oTable.GetCellbyPosition(1,0), "AutoTextHeading")
|
||||
' Insert one row at the bottom of the table
|
||||
oRows = oTable.Rows
|
||||
iAutoCount = oAutoGroup.Count
|
||||
For m = 0 To iAutoCount-1
|
||||
' Insert the name and the title of all Autotexts
|
||||
oAutoText = oAutoGroup.GetByIndex(m)
|
||||
InsertStringToCell(oAutoGroup.Titles(m), oTable.GetCellbyPosition(0, m + 1), "TableContent")
|
||||
InsertStringToCell(oAutoGroup.ElementNames(m), oTable.GetCellbyPosition(1, m + 1), "TableContent")
|
||||
If m < iAutoCount-1 Then
|
||||
oRows.InsertbyIndex(m + 2,1)
|
||||
End If
|
||||
Next m
|
||||
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oAutoTextCursor.CollapseToEnd()
|
||||
Next n
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertStringToCell(sCellString as String, oCell as Object, sCellStyle as String)
|
||||
Dim oCellCursor as Object
|
||||
oCellCursor = oCell.CreateTextCursor()
|
||||
oCellCursor.CharStyleName = sCellStyle
|
||||
oCell.Text.insertString(oCellCursor,sCellString,False)
|
||||
oDocument.CurrentController.Select(oCellCursor)
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,92 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ChangeAllChars" script:language="StarBasic">' This macro replaces all characters in a writer-document through "x" or "X" signs.
|
||||
' It works on the currently activated document.
|
||||
Private const UPPERREPLACECHAR = "X"
|
||||
Private const LOWERREPLACECHAR = "x"
|
||||
|
||||
Private MSGBOXTITLE
|
||||
Private NOTSAVEDTEXT
|
||||
Private WARNING
|
||||
|
||||
Sub ChangeAllChars ' Change all chars in the active document
|
||||
Dim oSheets, oPages as Object
|
||||
Dim i as Integer
|
||||
Const MBYES = 6
|
||||
Const MBABORT = 2
|
||||
Const MBNO = 7
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
MSGBOXTITLE = "Change All Characters to an '" & UPPERREPLACECHAR & "'"
|
||||
NOTSAVEDTEXT = "This document has already been modified: All characters will be changed to an " & UPPERREPLACECHAR & "'. Should the document be saved now?"
|
||||
WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
|
||||
|
||||
On Local Error GoTo NODOCUMENT
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
NODOCUMENT:
|
||||
If Err <> 0 Then
|
||||
Msgbox(WARNING & chr(13) & "First, activate a Writer document." , 16, GetProductName())
|
||||
Exit Sub
|
||||
End If
|
||||
On Local Error Goto 0
|
||||
|
||||
sDocType = GetDocumentType(oDocument)
|
||||
|
||||
If oDocument.IsModified And oDocument.Url <> "" Then
|
||||
Status = MsgBox(NOTSAVEDTEXT, 3+32, MSGBOXTITLE)
|
||||
Select Case Status
|
||||
Case MBYES
|
||||
oDocument.Store
|
||||
Case MBABORT, MBNO
|
||||
End
|
||||
End Select
|
||||
Else
|
||||
Status = MsgBox(WARNING, 3+32, MSGBOXTITLE)
|
||||
If Status = MBNO Or Status = MBABORT Then ' No, Abort
|
||||
End
|
||||
End If
|
||||
End If
|
||||
|
||||
Select Case sDocType
|
||||
Case "swriter"
|
||||
ReplaceAllStrings(oDocument)
|
||||
|
||||
Case Else
|
||||
Msgbox("This macro only works with Writer documents.", 16, GetProductName())
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ReplaceAllStrings(oContainer as Object)
|
||||
ReplaceStrings(oContainer, "[a-z]", LOWERREPLACECHAR)
|
||||
ReplaceStrings(oContainer, "[à-þ]", LOWERREPLACECHAR)
|
||||
ReplaceStrings(oContainer, "[A-Z]", UPPERREPLACECHAR)
|
||||
ReplaceStrings(oContainer, "[À-ß]", UPPERREPLACECHAR)
|
||||
ReplaceStrings(oContainer, "[0-9]", UPPERREPLACECHAR)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString as String)
|
||||
oReplaceDesc = oContainer.createReplaceDescriptor()
|
||||
oReplaceDesc.SearchCaseSensitive = True
|
||||
oReplaceDesc.SearchRegularExpression = True
|
||||
oReplaceDesc.Searchstring = sSearchString
|
||||
oReplaceDesc.ReplaceString = sReplaceString
|
||||
oReplCount = oContainer.ReplaceAll(oReplaceDesc)
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,536 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="GetTexts" script:language="StarBasic">Option Explicit
|
||||
' Description:
|
||||
' This macro extracts the strings out of the currently active document and inserts them into a log document.
|
||||
' The aim of the macro is to provide the programmer an insight into the OpenOffice API.
|
||||
' It focuses on how document objects are accessed.
|
||||
' Therefore not only texts of the document body are retrieved but also texts of general
|
||||
' document objects like, annotations, charts and general document information.
|
||||
|
||||
Public oLogDocument, oLogText, oLogCursor, oLogHeaderStyle, oLogBodyTextStyle as Object
|
||||
Public oDocument as Object
|
||||
Public LogArray(1000) as String
|
||||
Public LogIndex as Integer
|
||||
Public oLocHeaderStyle as Object
|
||||
|
||||
Sub Main
|
||||
Dim sDocType as String
|
||||
Dim oHyperCursor as Object
|
||||
Dim oCharStyles as Object
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
On Local Error GoTo NODOCUMENT
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
sDocType = GetDocumentType(oDocument)
|
||||
NODOCUMENT:
|
||||
If Err <> 0 Then
|
||||
Msgbox("This macro extracts all data from the active Writer, Calc or Draw/Impress document." & chr(13) &_
|
||||
"To start this macro you have to activate a document first." , 16, GetProductName)
|
||||
Exit Sub
|
||||
End If
|
||||
On Local Error Goto 0
|
||||
|
||||
' Open a new document where all the texts are inserted
|
||||
oLogDocument = CreateNewDocument("swriter")
|
||||
If Not IsNull(oLogDocument) Then
|
||||
oLogText = oLogDocument.Text
|
||||
|
||||
' create and define the character styles of the log document
|
||||
oCharStyles = oLogDocument.StyleFamilies.GetByName("CharacterStyles")
|
||||
oLogHeaderStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("Log Header", oLogHeaderStyle)
|
||||
|
||||
oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oLogBodyTextStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
|
||||
oCharStyles.InsertbyName("Log Body", oLogBodyTextStyle)
|
||||
|
||||
' Insert the title of the activated document as a hyperlink
|
||||
oHyperCursor = oLogText.createTextCursor()
|
||||
oHyperCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
oHyperCursor.gotoStart(False)
|
||||
oHyperCursor.HyperLinkURL = oDocument.URL
|
||||
oHyperCursor.HyperLinkTarget = oDocument.URL
|
||||
If oDocument.DocumentProperties.Title <> "" Then
|
||||
oHyperCursor.HyperlinkName = oDocument.DocumentProperties.Title
|
||||
End If
|
||||
oLogText.insertString(oHyperCursor, oDocument.DocumentProperties.Title, False)
|
||||
oLogText.insertControlCharacter(oHyperCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
|
||||
oLogCursor = oLogText.createTextCursor()
|
||||
oLogCursor.GotoEnd(False)
|
||||
' "Switch off" the Hyperlink - Properties
|
||||
oLogCursor.SetPropertyToDefault("HyperLinkURL")
|
||||
oLogCursor.SetPropertyToDefault("HyperLinkTarget")
|
||||
oLogCursor.SetPropertyToDefault("HyperLinkName")
|
||||
LogIndex = 0
|
||||
|
||||
' Get the Properties of the document
|
||||
GetDocumentProps()
|
||||
|
||||
Select Case sDocType
|
||||
Case "swriter"
|
||||
GetWriterStrings()
|
||||
Case "scalc"
|
||||
GetCalcStrings()
|
||||
Case "sdraw", "simpress"
|
||||
GetDrawStrings()
|
||||
Case Else
|
||||
Msgbox("This macro only works with a Writer, Calc or Draw/Impress document.", 16, GetProductName())
|
||||
End Select
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
' ***********************************************Calc documents**************************************************
|
||||
|
||||
Sub GetCalcStrings()
|
||||
Dim i, n as integer
|
||||
Dim oSheet as Object
|
||||
Dim SheetName as String
|
||||
Dim oSheets as Object
|
||||
' Create a sequence of all sheets within the document
|
||||
oSheets = oDocument.Sheets
|
||||
|
||||
For i = 0 to osheets.Count - 1
|
||||
oSheet = osheets.GetbyIndex(i)
|
||||
SheetName = oSheet.Name
|
||||
MakeLogHeadLine("Sheet No. " & i & " (" & SheetName & ")" )
|
||||
|
||||
' Check the "body" of the sheet
|
||||
GetCellTexts(oSheet)
|
||||
|
||||
If oSheet.IsScenario then
|
||||
MakeLogHeadLine("Scenario Comments from " & SheetName & "'")
|
||||
WriteStringtoLogFile(osheet.ScenarioComment)
|
||||
End if
|
||||
|
||||
GetAnnotations(oSheet, "Annotations from '" & SheetName & "'")
|
||||
|
||||
GetChartStrings(oSheet, "Charts from '" & SheetName & "'")
|
||||
|
||||
GetControlStrings(oSheet.DrawPage, "Controls from '" & SheetName & "'")
|
||||
Next
|
||||
|
||||
' Pictures
|
||||
GetCalcGraphicNames()
|
||||
|
||||
GetNamedRanges()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetCellTexts(oSheet as Object)
|
||||
Dim BigRange, BigEnum, oCell as Object
|
||||
BigRange = oDocument.CreateInstance("com.sun.star.sheet.SheetCellRanges")
|
||||
BigRange.InsertbyName("",oSheet)
|
||||
BigEnum = BigRange.GetCells.CreateEnumeration
|
||||
While BigEnum.hasmoreElements
|
||||
oCell = BigEnum.NextElement
|
||||
If oCell.String <> "" And Val(oCell.String) = 0then
|
||||
WriteStringtoLogFile(oCell.String)
|
||||
End If
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetAnnotations(oSheet as Object, HeaderLine as String)
|
||||
Dim oNotes as Object
|
||||
Dim n as Integer
|
||||
oNotes = oSheet.getAnnotations
|
||||
If oNotes.hasElements() then
|
||||
MakeLogHeadLine(HeaderLine)
|
||||
For n = 0 to oNotes.Count-1
|
||||
WriteStringtoLogFile(oNotes.GetbyIndex(n).String)
|
||||
Next
|
||||
End if
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetNamedRanges()
|
||||
Dim i as integer
|
||||
MakeLogHeadLine("Named Ranges")
|
||||
For i = 0 To oDocument.NamedRanges.Count - 1
|
||||
WriteStringtoLogFile(oDocument.NamedRanges.GetbyIndex(i).Name)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetCalcGraphicNames()
|
||||
Dim n,m as integer
|
||||
MakeLogHeadLine("Graphics")
|
||||
For n = 0 To oDocument.Drawpages.count-1
|
||||
For m = 0 To oDocument.Drawpages.GetbyIndex(n).Count - 1
|
||||
WriteStringtoLogFile(oDocument.DrawPages.GetbyIndex(n).GetbyIndex(m).Text.String)
|
||||
Next m
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
' ***********************************************Writer documents**************************************************
|
||||
|
||||
Sub GetParagraphTexts(oParaObject as Object, HeadLine as String)
|
||||
Dim ParaEnum as Object
|
||||
Dim oPara as Object
|
||||
Dim oTextPortEnum as Object
|
||||
Dim oTextPortion as Object
|
||||
Dim i as integer
|
||||
Dim oCellNames()
|
||||
Dim oCell as Object
|
||||
|
||||
MakeLogHeadLine(HeadLine)
|
||||
ParaEnum = oParaObject.Text.CreateEnumeration
|
||||
|
||||
While ParaEnum.HasMoreElements
|
||||
oPara = ParaEnum.NextElement
|
||||
|
||||
' Note: The enumeration ParaEnum lists all tables and paragraphs.
|
||||
' Therefore we have to find out what kind of object "oPara" actually is
|
||||
If oPara.supportsService("com.sun.star.text.Paragraph") Then
|
||||
' "oPara" is a Paragraph
|
||||
oTextPortEnum = oPara.createEnumeration
|
||||
While oTextPortEnum.hasmoreElements
|
||||
oTextPortion = oTextPortEnum.nextElement()
|
||||
WriteStringToLogFile(oTextPortion.String)
|
||||
Wend
|
||||
Else
|
||||
' "oPara" is a table
|
||||
oCellNames = oPara.CellNames
|
||||
For i = 0 To Ubound(oCellNames())
|
||||
If oCellNames(i) <> "" Then
|
||||
oCell = oPara.getCellByName(oCellNames(i))
|
||||
WriteStringToLogFile(oCell.String)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetChartStrings(oSheet as Object, HeaderLine as String)
|
||||
Dim i as Integer
|
||||
Dim aChartObject as Object
|
||||
Dim aChartDiagram as Object
|
||||
|
||||
MakeLogHeadLine(HeaderLine)
|
||||
|
||||
For i = 0 to oSheet.Charts.Count-1
|
||||
aChartObject = oSheet.Charts.GetByIndex(i).EmbeddedObject
|
||||
If aChartObject.HasSubTitle then
|
||||
WriteStringToLogFile(aChartObject.SubTitle.String)
|
||||
End If
|
||||
|
||||
If aChartObject.HasMainTitle then
|
||||
WriteStringToLogFile(aChartObject.Title.String)
|
||||
End If
|
||||
|
||||
aChartDiagram = aChartObject.Diagram
|
||||
|
||||
If aChartDiagram.hasXAxisTitle Then
|
||||
WriteStringToLogFile(aChartDiagram.XAxisTitle)
|
||||
End If
|
||||
|
||||
If aChartDiagram.hasYAxisTitle Then
|
||||
WriteStringToLogFile(aChartDiagram.YAxisTitle)
|
||||
End If
|
||||
|
||||
If aChartDiagram.hasZAxisTitle Then
|
||||
WriteStringToLogFile(aChartDiagram.ZAxisTitle)
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetFrameTexts()
|
||||
Dim i as integer
|
||||
Dim oTextFrame as object
|
||||
Dim oFrameEnum as Object
|
||||
Dim oFramePort as Object
|
||||
Dim oFrameTextEnum as Object
|
||||
Dim oFrameTextPort as Object
|
||||
|
||||
MakeLogHeadLine("Text Frames")
|
||||
For i = 0 to oDocument.TextFrames.Count-1
|
||||
oTextFrame = oDocument.TextFrames.GetbyIndex(i)
|
||||
WriteStringToLogFile(oTextFrame.Name)
|
||||
|
||||
' Is the frame bound to the page?
|
||||
If oTextFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE Then
|
||||
GetParagraphTexts(oTextFrame, "Text Frame Contents")
|
||||
End If
|
||||
|
||||
oFrameEnum = oTextFrame.CreateEnumeration
|
||||
While oFrameEnum.HasMoreElements
|
||||
oFramePort = oFrameEnum.NextElement
|
||||
If oFramePort.supportsService("com.sun.star.text.Paragraph") then
|
||||
oFrameTextEnum = oFramePort.createEnumeration
|
||||
While oFrameTextEnum.HasMoreElements
|
||||
oFrameTextPort = oFrameTextEnum.NextElement
|
||||
If oFrameTextPort.SupportsService("com.sun.star.text.TextFrame") Then
|
||||
WriteStringtoLogFile(oFrameTextPort.String)
|
||||
End If
|
||||
Wend
|
||||
Else
|
||||
WriteStringtoLogFile(oFramePort.Name)
|
||||
End if
|
||||
Wend
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetTextFieldStrings()
|
||||
Dim aTextField as Object
|
||||
Dim i as integer
|
||||
Dim CurElement as Object
|
||||
MakeLogHeadLine("Text Fields")
|
||||
aTextfield = oDocument.getTextfields.CreateEnumeration
|
||||
While aTextField.hasmoreElements
|
||||
CurElement = aTextField.NextElement
|
||||
If CurElement.PropertySetInfo.hasPropertybyName("Content") Then
|
||||
WriteStringtoLogFile(CurElement.Content)
|
||||
ElseIf CurElement.PropertySetInfo.hasPropertybyName("PlaceHolder") Then
|
||||
WriteStringtoLogFile(CurElement.PlaceHolder)
|
||||
WriteStringtoLogFile(CurElement.Hint)
|
||||
ElseIf Curelement.TextFieldMaster.PropertySetInfo.HasPropertybyName("Content") then
|
||||
WriteStringtoLogFile(CurElement.TextFieldMaster.Content)
|
||||
End If
|
||||
Wend
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetLinkedFileNames()
|
||||
Dim oDocSections as Object
|
||||
Dim LinkedFileName as String
|
||||
Dim i as Integer
|
||||
If Right(oDocument.URL,3) = "sgl" Then
|
||||
MakeLogHeadLine("Sub-documents")
|
||||
oDocSections = oDocument.TextSections
|
||||
For i = 0 to oDocSections.Count - 1
|
||||
LinkedFileName = oDocSections.GetbyIndex(i).FileLink.FileURL
|
||||
If LinkedFileName <> "" Then
|
||||
WriteStringToLogFile(LinkedFileName)
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetSectionNames()
|
||||
Dim i as integer
|
||||
Dim oDocSections as Object
|
||||
MakeLogHeadLine("Sections")
|
||||
oDocSections = oDocument.TextSections
|
||||
For i = 0 to oDocSections.Count-1
|
||||
WriteStringtoLogFile(oDocSections.GetbyIndex(i).Name)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetWriterStrings()
|
||||
GetParagraphTexts(oDocument, "Document Body")
|
||||
GetGraphicNames()
|
||||
GetStyles()
|
||||
GetControlStrings(oDocument.DrawPage, "Controls")
|
||||
GetTextFieldStrings()
|
||||
GetSectionNames()
|
||||
GetFrameTexts()
|
||||
GetHyperLinks
|
||||
GetLinkedFileNames()
|
||||
End Sub
|
||||
|
||||
|
||||
' ***********************************************Draw/Impress documents**************************************************
|
||||
|
||||
Sub GetDrawPageTitles(LocObject as Object)
|
||||
Dim n as integer
|
||||
Dim oPage as Object
|
||||
|
||||
For n = 0 to LocObject.Count - 1
|
||||
oPage = LocObject.GetbyIndex(n)
|
||||
WriteStringtoLogFile(oPage.Name)
|
||||
' Is the page a DrawPage and not a MasterPage?
|
||||
If oPage.supportsService("com.sun.star.drawing.DrawPage")then
|
||||
' Get the name of the NotesPage (only relevant for Impress documents)
|
||||
If oDocument.supportsService("com.sun.star.presentation.PresentationDocument") then
|
||||
WriteStringtoLogFile(oPage.NotesPage.Name)
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetPageStrings(oPages as Object)
|
||||
Dim m, n, s as Integer
|
||||
Dim oPage, oPageElement, oShape as Object
|
||||
For n = 0 to oPages.Count-1
|
||||
oPage = oPages.GetbyIndex(n)
|
||||
If oPage.HasElements then
|
||||
For m = 0 to oPage.Count-1
|
||||
oPageElement = oPage.GetByIndex(m)
|
||||
If HasUnoInterfaces(oPageElement,"com.sun.star.container.XIndexAccess") Then
|
||||
' The Object "oPageElement" a group of Shapes, that can be accessed by their index
|
||||
For s = 0 To oPageElement.Count - 1
|
||||
WriteStringToLogFile(oPageElement.GetByIndex(s).String)
|
||||
Next s
|
||||
ElseIf HasUnoInterfaces(oPageElement, "com.sun.star.text.XText") Then
|
||||
WriteStringtoLogFile(oPageElement.String)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetDrawStrings()
|
||||
Dim oDPages, oMPages as Object
|
||||
|
||||
oDPages = oDocument.DrawPages
|
||||
oMPages = oDocument.Masterpages
|
||||
|
||||
MakeLogHeadLine("Titles")
|
||||
GetDrawPageTitles(oDPages)
|
||||
GetDrawPageTitles(oMPages)
|
||||
|
||||
MakeLogHeadLine("Document Body")
|
||||
GetPageStrings(oDPages)
|
||||
GetPageStrings(oMPages)
|
||||
End Sub
|
||||
|
||||
|
||||
' ***********************************************Misc**************************************************
|
||||
|
||||
Sub GetDocumentProps()
|
||||
Dim oDocuProps as Object
|
||||
MakeLogHeadLine("Document Properties")
|
||||
oDocuProps = oDocument.DocumentProperties
|
||||
WriteStringToLogFile(oDocuProps.Title)
|
||||
WriteStringToLogFile(oDocuProps.Description)
|
||||
WriteStringToLogFile(oDocuProps.Subject)
|
||||
WriteStringToLogFile(oDocuProps.Author)
|
||||
' WriteStringToLogFile(oDocuProps.UserDefinedProperties.ReplyTo)
|
||||
' WriteStringToLogFile(oDocuProps.UserDefinedProperties.Recipient)
|
||||
' WriteStringToLogFile(oDocuProps.UserDefinedProperties.References)
|
||||
' WriteStringToLogFile(oDocuProps.Keywords)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetHyperlinks()
|
||||
Dim i as integer
|
||||
Dim oCrsr as Object
|
||||
Dim oAllHyperLinks as Object
|
||||
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
|
||||
Dim oSearchDesc as Object
|
||||
|
||||
MakeLogHeadLine("Hyperlinks")
|
||||
' create a Search-Descriptor
|
||||
oSearchDesc = oDocument.CreateSearchDescriptor
|
||||
oSearchDesc.Valuesearch = False
|
||||
|
||||
' define the Search-attributes
|
||||
srchattributes(0).Name = "HyperLinkURL"
|
||||
srchattributes(0).Value = ""
|
||||
oSearchDesc.SetSearchAttributes(SrchAttributes())
|
||||
|
||||
oAllHyperLinks = oDocument.findAll(oSearchDesc())
|
||||
|
||||
For i = 0 to oAllHyperLinks.Count - 1
|
||||
oFound = oAllHyperLinks(i)
|
||||
oCrsr = oFound.Text.createTextCursorByRange(oFound)
|
||||
WriteStringToLogFile(oCrs.HyperLinkURL) 'Url
|
||||
WriteStringToLogFile(oCrs.HyperLinkTarget) 'Name
|
||||
WriteStringToLogFile(oCrs.HyperLinkName) 'Frame
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetGraphicNames()
|
||||
Dim i as integer
|
||||
Dim oDocGraphics as Object
|
||||
MakeLogHeadLine("Graphics")
|
||||
oDocGraphics = oDocument.GraphicObjects
|
||||
For i = 0 to oDocGraphics.count - 1
|
||||
WriteStringtoLogFile(oDocGraphics.GetbyIndex(i).Name)
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetStyles()
|
||||
Dim m,n as integer
|
||||
MakeLogHeadLine("User-defined Templates")
|
||||
|
||||
' Check all StyleFamilies(i.e. PageStyles, ParagraphStyles, CharacterStyles, cellStyles)
|
||||
For n = 0 to oDocument.StyleFamilies.Count - 1
|
||||
For m = 0 to oDocument.StyleFamilies.getbyIndex(n).Count-1
|
||||
If oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).IsUserDefined then
|
||||
WriteStringtoLogFile(oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).Name)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetControlStrings(oDPage as Object, HeaderLine as String)
|
||||
Dim aForm as Object
|
||||
Dim m,n as integer
|
||||
MakeLogHeadLine(HeaderLine)
|
||||
'SearchFor all possible Controls
|
||||
For n = 0 to oDPage.Forms.Count - 1
|
||||
aForm = oDPage.Forms(n)
|
||||
For m = 0 to aForm.Count-1
|
||||
GetControlContent(aForm.GetbyIndex(m))
|
||||
Next
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetControlContent(LocControl as Object)
|
||||
Dim i as integer
|
||||
|
||||
If LocControl.PropertySetInfo.HasPropertybyName("Label") then
|
||||
WriteStringtoLogFile(LocControl.Label)
|
||||
|
||||
ElseIf LocControl.SupportsService("com.sun.star.form.component.ListBox") then
|
||||
For i = 0 to Ubound(LocControl.StringItemList())
|
||||
WriteStringtoLogFile(LocControl.StringItemList(i))
|
||||
Next
|
||||
End If
|
||||
If LocControl.PropertySetInfo.HasPropertybyName("HelpText") then
|
||||
WriteStringtoLogFile(LocControl.Helptext)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
' ***********************************************Log document**************************************************
|
||||
|
||||
Sub WriteStringtoLogFile( sString as String)
|
||||
If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then
|
||||
LogArray(LogIndex) = sString
|
||||
LogIndex = LogIndex + 1
|
||||
oLogText.insertString(oLogCursor,sString,False)
|
||||
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MakeLogHeadLine(HeadText as String)
|
||||
oLogCursor.CharStyleName = "Log Header"
|
||||
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oLogText.insertString(oLogCursor,HeadText,False)
|
||||
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
oLogCursor.CharStyleName = "Log Body"
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,322 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit
|
||||
Public Const SBPAGEX = 800
|
||||
Public Const SBPAGEY = 800
|
||||
Public Const SBRELDIST = 1.3
|
||||
|
||||
' Names of the second Dimension of the Array iLevelPos
|
||||
Public Const SBBASEX = 0
|
||||
Public Const SBBASEY = 1
|
||||
|
||||
Public Const SBOLDSTARTX = 2
|
||||
Public Const SBOLDSTARTY = 3
|
||||
|
||||
Public Const SBOLDENDX = 4
|
||||
Public Const SBOLDENDY = 5
|
||||
|
||||
Public Const SBNEWSTARTX = 6
|
||||
Public Const SBNEWSTARTY = 7
|
||||
|
||||
Public Const SBNEWENDX = 8
|
||||
Public Const SBNEWENDY = 9
|
||||
|
||||
Public ConnectLevel As Integer
|
||||
Public iLevelPos(1,9) As Long
|
||||
Public Source as String
|
||||
Public iCurLevel as Integer
|
||||
Public nConnectLevel as Integer
|
||||
Public nOldWidth, nOldHeight As Long
|
||||
Public nOldX, nOldY, nOldLevel As Integer
|
||||
Public oOldLeavingLine As Object
|
||||
Public oOldArrivingLine As Object
|
||||
Public DlgReadDir as Object
|
||||
Dim oProgressBar as Object
|
||||
Dim oDocument As Object
|
||||
Dim oPage As Object
|
||||
|
||||
|
||||
Sub Main()
|
||||
Dim oStandardTemplate as Object
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
oDocument = CreateNewDocument("sdraw")
|
||||
If Not IsNull(oDocument) Then
|
||||
oPage = oDocument.DrawPages(0)
|
||||
oStandardTemplate = oDocument.StyleFamilies.GetByName("graphics").GetByName("standard")
|
||||
oStandardTemplate.CharHeight = 10
|
||||
oStandardTemplate.TextLeftDistance = 100
|
||||
oStandardTemplate.TextRightDistance = 100
|
||||
oStandardTemplate.TextUpperDistance = 50
|
||||
oStandardTemplate.TextLowerDistance = 50
|
||||
DlgReadDir = LoadDialog("Gimmicks","ReadFolderDlg")
|
||||
oProgressBar = DlgReadDir.Model.ProgressBar1
|
||||
DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings("Work"))
|
||||
DlgReadDir.Model.cmdGoOn.DefaultButton = True
|
||||
DlgReadDir.GetControl("TextField1").SetFocus()
|
||||
DlgReadDir.Execute
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub TreeInfo()
|
||||
Dim oCurTextShape As Object
|
||||
Dim i as Integer
|
||||
Dim bStartUpRun As Boolean
|
||||
Dim CurFilename as String
|
||||
Dim BaseLevel as Integer
|
||||
Dim oController as Object
|
||||
Dim MaxFileIndex as Integer
|
||||
Dim FileNames() as String
|
||||
ToggleDialogControls(False)
|
||||
oProgressBar.ProgressValueMin = 0
|
||||
oProgressBar.ProgressValueMax = 100
|
||||
bStartUpRun = True
|
||||
nOldHeight = 200
|
||||
nOldY = SBPAGEY
|
||||
nOldX = SBPAGEX
|
||||
nOldWidth = SBPAGEX
|
||||
oController = oDocument.GetCurrentController
|
||||
Source = ConvertToURL(DlgReadDir.Model.TextField1.Text)
|
||||
BaseLevel = CountCharsInString(Source, "/", 1)
|
||||
oProgressBar.ProgressValue = 5
|
||||
DlgReadDir.Model.Label3.Enabled = True
|
||||
FileNames() = ReadSourceDirectory(Source)
|
||||
DlgReadDir.Model.Label4.Enabled = True
|
||||
DlgReadDir.Model.Label3.Enabled = False
|
||||
oProgressBar.ProgressValue = 12
|
||||
FileNames() = BubbleSortList(FileNames())
|
||||
DlgReadDir.Model.Label5.Enabled = True
|
||||
DlgReadDir.Model.Label4.Enabled = False
|
||||
oProgressBar.ProgressValue = 20
|
||||
MaxFileIndex = Ubound(FileNames(),1)
|
||||
For i = 0 To MaxFileIndex
|
||||
oProgressBar.ProgressValue = 20 + (i/MaxFileIndex * 80)
|
||||
CurFilename = FileNames(i,1)
|
||||
SetNewLevels(FileNames(i,0), BaseLevel)
|
||||
oCurTextShape = CreateTextShape(oPage, CurFilename)
|
||||
CheckPageWidth(oCurTextShape.Size.Width)
|
||||
iLevelPos(iCurLevel,SBBASEY) = oCurTextShape.Position.Y
|
||||
If i = 0 Then
|
||||
AdjustPageHeight(oCurTextShape.Size.Height, MaxFileIndex + 1)
|
||||
End If
|
||||
' The Current TextShape has To be connected with a TextShape one Level higher
|
||||
' except for a TextShape In Level 0:
|
||||
If Not bStartUpRun Then
|
||||
' A leaving Line Is only drawn when level is not 0
|
||||
If iCurLevel<> 0 Then
|
||||
' Determine the Coordinates of the arriving Line
|
||||
iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
|
||||
iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
|
||||
|
||||
iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX)
|
||||
iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
|
||||
|
||||
oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage)
|
||||
|
||||
' Determine the End-Coordinates of the last leaving Line
|
||||
iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
|
||||
iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
|
||||
Else
|
||||
' On Level 0 the last Leaving Line's Endpoint is the upper edge of the TextShape
|
||||
iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y
|
||||
iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
|
||||
End If
|
||||
' Draw the Connectors To the previous TextShapes
|
||||
oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
|
||||
Else
|
||||
' StartingPoint of the leaving Edge
|
||||
bStartUpRun = FALSE
|
||||
End If
|
||||
|
||||
' Determine the beginning Coordinates of the leaving Line
|
||||
iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width
|
||||
iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height
|
||||
|
||||
' Save the values For the Next run
|
||||
nOldHeight = oCurTextShape.Size.Height
|
||||
nOldX = oCurTextShape.Position.X
|
||||
nOldWidth = oCurTextShape.Size.Width
|
||||
nOldLevel = iCurLevel
|
||||
Next i
|
||||
ToggleDialogControls(True)
|
||||
DlgReadDir.Model.cmdGoOn.Enabled = False
|
||||
End Sub
|
||||
|
||||
|
||||
Function CreateTextShape(oPage as Object, Filename as String)
|
||||
Dim oTextShape As Object
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
|
||||
aPoint.X = CalculateXPoint()
|
||||
aPoint.Y = nOldY + SBRELDIST * nOldHeight
|
||||
nOldY = aPoint.Y
|
||||
|
||||
oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape")
|
||||
oTextShape.LineStyle = 1
|
||||
oTextShape.Position = aPoint
|
||||
|
||||
oPage.add(oTextShape)
|
||||
oTextShape.TextAutoGrowWidth = TRUE
|
||||
oTextShape.TextAutoGrowHeight = TRUE
|
||||
oTextShape.String = FileName
|
||||
|
||||
' Configure Size And Position of the TextShape according to its Scripting
|
||||
aPoint.X = iLevelPos(iCurLevel,SBBASEX)
|
||||
oTextShape.Position = aPoint
|
||||
CreateTextShape() = oTextShape
|
||||
End Function
|
||||
|
||||
|
||||
Function CalculateXPoint()
|
||||
' The current level Is lower than the Old one
|
||||
If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then
|
||||
' ClearArray(iLevelPos(),iCurLevel+1)
|
||||
Elseif iCurLevel= 0 Then
|
||||
iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
|
||||
' The current level Is higher than the old one
|
||||
Elseif iCurLevel> nOldLevel Then
|
||||
iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
|
||||
End If
|
||||
CalculateXPoint = iLevelPos(iCurLevel,SBBASEX)
|
||||
End Function
|
||||
|
||||
|
||||
Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object)
|
||||
Dim oConnect As Object
|
||||
Dim aPoint As New com.sun.star.awt.Point
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
aPoint.X = iLevelPos(nLevel,nStartX)
|
||||
aPoint.Y = iLevelPos(nLevel,nStartY)
|
||||
aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX)
|
||||
aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY)
|
||||
oConnect = oDocument.createInstance("com.sun.star.drawing.LineShape")
|
||||
oConnect.Position = aPoint
|
||||
oConnect.Size = aSize
|
||||
oPage.Add(oConnect)
|
||||
DrawLine() = oConnect
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetSourceDirectory()
|
||||
GetFolderName(DlgReadDir.Model.TextField1)
|
||||
End Sub
|
||||
|
||||
|
||||
Function ReadSourceDirectory(ByVal Source As String)
|
||||
Dim i as Integer
|
||||
Dim m as Integer
|
||||
Dim n as Integer
|
||||
Dim s as integer
|
||||
Dim FileName as string
|
||||
Dim FileNameList(100,1) as String
|
||||
Dim DirList(0) as String
|
||||
Dim oUCBobject as Object
|
||||
Dim DirContent() as String
|
||||
Dim SystemPath as String
|
||||
Dim PathSeparator as String
|
||||
Dim MaxFileIndex as Integer
|
||||
PathSeparator = GetPathSeparator()
|
||||
oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
m = 0
|
||||
s = 0
|
||||
DirList(0) = Source
|
||||
FileNameList(n,0) = Source
|
||||
SystemPath = ConvertFromUrl(Source)
|
||||
FileNameList(n,1) = FileNameoutofPath(SystemPath, PathSeparator)
|
||||
n = 1
|
||||
Do
|
||||
Source = DirList(m)
|
||||
m = m + 1
|
||||
DirContent() = oUcbObject.GetFolderContents(Source,True)
|
||||
If Ubound(DirContent()) <> -1 Then
|
||||
MaxFileIndex = Ubound(DirContent())
|
||||
For i = 0 to MaxFileIndex
|
||||
FileName = DirContent(i)
|
||||
FileNameList(n,0) = FileName
|
||||
SystemPath = ConvertFromUrl(FileName)
|
||||
FileNameList(n,1) = FileNameOutofPath(SystemPath, PathSeparator)
|
||||
n = n + 1
|
||||
If n > Ubound(FileNameList(),1) Then
|
||||
ReDim Preserve FileNameList(n + 10,1) as String
|
||||
End If
|
||||
If oUcbObject.IsFolder(FileName) Then
|
||||
s = s + 1
|
||||
ReDim Preserve DirList(s) as String
|
||||
DirList(s) = FileName
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
Loop Until m > Ubound(DirList())
|
||||
ReDim Preserve FileNameList(n-1,1) as String
|
||||
ReadSourceDirectory() = FileNameList()
|
||||
End Function
|
||||
|
||||
|
||||
Sub CloseDialog
|
||||
DlgReadDir.EndExecute
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AdjustPageHeight(lShapeHeight, FileCount)
|
||||
Dim lNecHeight as Long
|
||||
Dim lBorders as Long
|
||||
oDocument.LockControllers
|
||||
lBorders = oPage.BorderTop + oPage.BorderBottom
|
||||
lNecHeight = SBPAGEY + (FileCount * SBRELDIST * lShapeHeight)
|
||||
If lNecHeight > (oPage.Height - lBorders) Then
|
||||
oPage.Height = lNecHeight + lBorders + 500
|
||||
End If
|
||||
oDocument.UnlockControllers
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetNewLevels(FileName as String, BaseLevel as Integer)
|
||||
iCurLevel= CountCharsInString(FileName, "/", 1) - BaseLevel
|
||||
If iCurLevel <> 0 Then
|
||||
nConnectLevel = iCurLevel- 1
|
||||
Else
|
||||
nConnectLevel = iCurLevel
|
||||
End If
|
||||
If iCurLevel > Ubound(iLevelPos(),1) Then
|
||||
ReDim Preserve iLevelPos(iCurLevel,9) as Long
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckPageWidth(TextWidth as Long)
|
||||
Dim PageWidth as Long
|
||||
Dim BaseX as Long
|
||||
PageWidth = oPage.Width
|
||||
BaseX = iLevelPos(iCurLevel,SBBASEX)
|
||||
If BaseX + TextWidth > PageWidth - 1000 Then
|
||||
oPage.Width = 1000 + BaseX + TextWidth
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleDialogControls(bDoEnable as Boolean)
|
||||
With DlgReadDir.Model
|
||||
.cmdGoOn.Enabled = bDoEnable
|
||||
.cmdGetDir.Enabled = bDoEnable
|
||||
.Label1.Enabled = bDoEnable
|
||||
.Label2.Enabled = bDoEnable
|
||||
.TextField1.Enabled = bDoEnable
|
||||
End With
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,39 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="ReadFolderDlg" dlg:left="161" dlg:top="81" dlg:width="180" dlg:height="136" dlg:closeable="true" dlg:moveable="true" dlg:title="Read and Design Recursively">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:button dlg:id="cmdGetDir" dlg:tab-index="0" dlg:left="161" dlg:top="49" dlg:width="14" dlg:height="14" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.GetSourceDirectory?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:textfield dlg:id="TextField1" dlg:tab-index="1" dlg:left="6" dlg:top="50" dlg:width="147" dlg:height="12"/>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="2" dlg:left="49" dlg:top="115" dlg:width="35" dlg:height="14" dlg:value="~Cancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.CloseDialog?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="3" dlg:left="95" dlg:top="115" dlg:width="35" dlg:height="14" dlg:value="~GoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.TreeInfo?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="Label1" dlg:tab-index="4" dlg:left="6" dlg:top="38" dlg:width="122" dlg:height="8" dlg:value="Top level path"/>
|
||||
<dlg:text dlg:id="Label2" dlg:tab-index="5" dlg:left="6" dlg:top="4" dlg:width="168" dlg:height="26" dlg:value="This macro will create a drawing document and design a complete tree view of all subdirectories from a given path." dlg:multiline="true"/>
|
||||
<dlg:progressmeter dlg:id="ProgressBar1" dlg:tab-index="6" dlg:left="6" dlg:top="101" dlg:width="170" dlg:height="10"/>
|
||||
<dlg:text dlg:id="Label3" dlg:tab-index="7" dlg:disabled="true" dlg:left="6" dlg:top="69" dlg:width="170" dlg:height="8" dlg:value="Getting the files and subdirectories..."/>
|
||||
<dlg:text dlg:id="Label4" dlg:tab-index="8" dlg:disabled="true" dlg:left="6" dlg:top="80" dlg:width="170" dlg:height="8" dlg:value="Sorting the files and subdirectories..."/>
|
||||
<dlg:text dlg:id="Label5" dlg:tab-index="9" dlg:disabled="true" dlg:left="6" dlg:top="91" dlg:width="170" dlg:height="8" dlg:value="Drawing the filestructure..."/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,66 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="UserfieldDlg" dlg:left="161" dlg:top="57" dlg:width="281" dlg:height="214" dlg:closeable="true" dlg:moveable="true" dlg:title="Modify User Data">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="Label1" dlg:tab-index="0" dlg:left="6" dlg:top="48" dlg:width="57" dlg:height="8" dlg:value="Label1"/>
|
||||
<dlg:text dlg:id="Label2" dlg:tab-index="1" dlg:left="6" dlg:top="64" dlg:width="57" dlg:height="8" dlg:value="Label2"/>
|
||||
<dlg:text dlg:id="Label3" dlg:tab-index="2" dlg:left="6" dlg:top="80" dlg:width="57" dlg:height="8" dlg:value="Label3"/>
|
||||
<dlg:text dlg:id="Label4" dlg:tab-index="3" dlg:left="6" dlg:top="96" dlg:width="57" dlg:height="8" dlg:value="Label4"/>
|
||||
<dlg:text dlg:id="Label5" dlg:tab-index="4" dlg:left="6" dlg:top="112" dlg:width="57" dlg:height="8" dlg:value="Label5"/>
|
||||
<dlg:text dlg:id="Label6" dlg:tab-index="5" dlg:left="6" dlg:top="128" dlg:width="57" dlg:height="8" dlg:value="Label6"/>
|
||||
<dlg:text dlg:id="Label7" dlg:tab-index="6" dlg:left="6" dlg:top="144" dlg:width="57" dlg:height="8" dlg:value="Label7"/>
|
||||
<dlg:text dlg:id="Label8" dlg:tab-index="7" dlg:left="6" dlg:top="160" dlg:width="57" dlg:height="8" dlg:value="Label8"/>
|
||||
<dlg:text dlg:id="Label9" dlg:tab-index="8" dlg:left="6" dlg:top="176" dlg:width="57" dlg:height="8" dlg:value="Label9"/>
|
||||
<dlg:textfield dlg:id="TextField1" dlg:tab-index="9" dlg:left="65" dlg:top="46" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField2" dlg:tab-index="10" dlg:left="65" dlg:top="62" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField3" dlg:tab-index="11" dlg:left="65" dlg:top="78" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField4" dlg:tab-index="12" dlg:left="65" dlg:top="94" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField5" dlg:tab-index="13" dlg:left="65" dlg:top="110" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField6" dlg:tab-index="14" dlg:left="65" dlg:top="126" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField7" dlg:tab-index="15" dlg:left="65" dlg:top="142" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField8" dlg:tab-index="16" dlg:left="65" dlg:top="158" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:textfield dlg:id="TextField9" dlg:tab-index="17" dlg:left="65" dlg:top="174" dlg:width="193" dlg:height="12"/>
|
||||
<dlg:scrollbar dlg:id="ScrollBar1" dlg:tab-index="18" dlg:left="263" dlg:top="46" dlg:width="12" dlg:height="140" dlg:align="vertical">
|
||||
<script:event script:event-name="on-adjustmentvaluechange" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.ScrollControls?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:scrollbar>
|
||||
<dlg:button dlg:id="cmdQuit" dlg:tab-index="19" dlg:left="6" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Exit Macro" dlg:value="Exit">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StopMacro?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdSave" dlg:tab-index="20" dlg:left="45" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Save All Data of All Users to File" dlg:value="~Save">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.SaveSettings?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdSelect" dlg:tab-index="21" dlg:left="84" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Replace the User Data in <PRODUCTNAME> With the User Data Above" dlg:value="Se~lect">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.SelectCurrentFields?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdNextUser" dlg:tab-index="22" dlg:left="162" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="1" dlg:help-text="Show Data of Next User" dlg:value="Next >>">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StepToRecord?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdPrevUser" dlg:tab-index="23" dlg:left="123" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="-1" dlg:help-text="Show Data of Previous User" dlg:value="<<Previous">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StepToRecord?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="CommandButton1" dlg:tab-index="24" dlg:left="201" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Add Data for New User" dlg:value="~New">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.AddRecord?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="Label10" dlg:tab-index="25" dlg:left="6" dlg:top="6" dlg:width="269" dlg:height="34" dlg:value="This macro lets you easily administrate several user profiles.
The user data of several users may be stored in a single file in the directory <ConfigDir>. From there, you can select a particular user whose data is then the current user data in <PRODUCTNAME>." dlg:multiline="true"/>
|
||||
<dlg:button dlg:id="cmdDelete" dlg:tab-index="26" dlg:left="240" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Delete Data of Current User" dlg:value="Delete">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.DeleteCurrentSettings?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,236 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Userfields" script:language="StarBasic">Option Explicit
|
||||
'Todo: Controlling Scrollbar via Keyboard
|
||||
|
||||
Public Const SBMAXFIELDINDEX = 14
|
||||
|
||||
Public DlgUserFields as Object
|
||||
Public oDocument as Object
|
||||
Public UserFieldDataType(SBMAXFIELDINDEX,1) as String
|
||||
Public ScrollBarValue as Integer
|
||||
Public UserFieldFamily(0, SBMAXfIELDINDEX) as String
|
||||
Public Const SBTBCOUNT = 9
|
||||
Public oUserDataAccess as Object
|
||||
Public CurFieldIndex as Integer
|
||||
Public FilePath as String
|
||||
|
||||
Sub StartChangesUserfields
|
||||
Dim SystemPath as String
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
UserFieldDatatype(0,0) = "COMPANY"
|
||||
UserFieldDatatype(0,1) = "o"
|
||||
UserFieldDatatype(1,0) = "FIRSTNAME"
|
||||
UserFieldDatatype(1,1) = "givenname"
|
||||
UserFieldDatatype(2,0) = "LASTNAME"
|
||||
UserFieldDatatype(2,1) = "sn"
|
||||
UserFieldDatatype(3,0) = "INITIALS"
|
||||
UserFieldDatatype(3,1) = "initials"
|
||||
UserFieldDatatype(4,0) = "STREET"
|
||||
UserFieldDatatype(4,1) = "street"
|
||||
UserFieldDatatype(5,0) = "COUNTRY"
|
||||
UserFieldDatatype(5,1) = "c"
|
||||
UserFieldDatatype(6,0) = "ZIP"
|
||||
UserFieldDatatype(6,1) = "postalcode"
|
||||
UserFieldDatatype(7,0) = "CITY"
|
||||
UserFieldDatatype(7,1) = "l"
|
||||
UserFieldDatatype(8,0) = "TITLE"
|
||||
UserFieldDatatype(8,1) = "title"
|
||||
UserFieldDatatype(9,0) = "POSITION"
|
||||
UserFieldDatatype(9,1) = "position"
|
||||
UserFieldDatatype(10,0) = "PHONE_HOME"
|
||||
UserFieldDatatype(10,1) = "homephone"
|
||||
UserFieldDatatype(11,0) = "PHONE_WORK"
|
||||
UserFieldDatatype(11,1) = "telephonenumber"
|
||||
UserFieldDatatype(12,0) = "FAX"
|
||||
UserFieldDatatype(12,1) = "facsimiletelephonenumber"
|
||||
UserFieldDatatype(13,0) = "E-MAIL"
|
||||
UserFieldDatatype(13,1) = "mail"
|
||||
UserFieldDatatype(14,0) = "STATE"
|
||||
UserFieldDatatype(14,1) = "st"
|
||||
FilePath = GetPathSettings("Config", False) & "/" & "UserData.dat"
|
||||
DlgUserFields = LoadDialog("Gimmicks","UserfieldDlg")
|
||||
SystemPath = ConvertFromUrl(FilePath)
|
||||
DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, "'" & SystemPath & "'", "<ConfigDir>")
|
||||
DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, GetProductName(), "<PRODUCTNAME>")
|
||||
DlgUserFields.Model.cmdSelect.HelpText = ReplaceString(DlgUserFields.Model.cmdSelect.HelpText, GetProductName(), "<PRODUCTNAME>")
|
||||
ScrollBarValue = 0
|
||||
oUserDataAccess = GetRegistryKeyContent("org.openoffice.UserProfile/Data", True)
|
||||
InitializeUserFamily()
|
||||
FillDialog()
|
||||
DlgUserFields.Execute
|
||||
DlgUserFields.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillDialog()
|
||||
Dim a as Integer
|
||||
With DlgUserFields
|
||||
For a = 1 To SBTBCount
|
||||
.GetControl("Label" & a).Model.Label = UserFieldDataType(a-1,0)
|
||||
.GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, a-1)
|
||||
Next a
|
||||
.Model.ScrollBar1.ScrollValueMax = (SBMAXFIELDINDEX+1) - SBTBCOUNT
|
||||
.Model.ScrollBar1.BlockIncrement = SBTBCOUNT
|
||||
.Model.ScrollBar1.LineIncrement = 1
|
||||
.Model.ScrollBar1.ScrollValue = ScrollBarValue
|
||||
End With
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ScrollControls()
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
ScrollBarValue = DlgUserFields.Model.ScrollBar1.ScrollValue
|
||||
If (ScrollBarValue + SBTBCOUNT) >= SBMAXFIELDINDEX + 1 Then
|
||||
ScrollBarValue = (SBMAXFIELDINDEX + 1) - SBTBCOUNT
|
||||
End If
|
||||
FillupTextFields()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ScrollTextFieldInfo(ByVal iScrollValue as Integer)
|
||||
Dim a as Integer
|
||||
Dim CurIndex as Integer
|
||||
For a = 1 To SBTBCOUNT
|
||||
CurIndex = (a-1) + iScrollValue
|
||||
UserFieldFamily(CurFieldIndex,CurIndex) = DlgUserFields.GetControl("TextField" & a).Model.Text
|
||||
Next a
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StopMacro()
|
||||
DlgUserFields.EndExecute
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SaveSettings()
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
ScrollTextFieldInfo(DlgUserFields.Model.ScrollBar1.ScrollValue)
|
||||
MaxIndex = Ubound(UserFieldFamily(), 1)
|
||||
Dim FileStrings(MaxIndex) as String
|
||||
For n = 0 To MaxIndex
|
||||
FileStrings(n) = ""
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
FileStrings(n) = FileStrings(n) & UserFieldFamily(n,m) & ";"
|
||||
Next m
|
||||
Next n
|
||||
SaveDataToFile(FilePath, FileStrings(), True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleButtons(ByVal Index as Integer)
|
||||
Dim i as Integer
|
||||
CurFieldIndex = Index
|
||||
DlgUserFields.Model.cmdNextUser.Enabled = CurFieldIndex <> Ubound(UserFieldFamily(), 1)
|
||||
DlgUserFields.Model.cmdPrevUser.Enabled = CurFieldIndex <> 0
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializeUserFamily()
|
||||
Dim FirstIndex as Integer
|
||||
Dim UserFieldstrings() as String
|
||||
Dim LocStrings() as String
|
||||
Dim bFileExists as Boolean
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
bFileExists = LoadDataFromFile(GetPathSettings("Config", False) & "/" & "UserData.dat", UserFieldStrings())
|
||||
If bFileExists Then
|
||||
FirstIndex = Ubound(UserFieldStrings())
|
||||
ReDim Preserve UserFieldFamily(FirstIndex, SBMAXFIELDINDEX) as String
|
||||
For n = 0 To FirstIndex
|
||||
LocStrings() = ArrayOutofString(UserFieldStrings(n), ";")
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(n,m) = LocStrings(m)
|
||||
Next m
|
||||
Next n
|
||||
Else
|
||||
ReDim Preserve UserFieldFamily(0,SBMAXFIELDINDEX) as String
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(0,m) = oUserDataAccess.GetByName(UserFieldDataType(m,1))
|
||||
Next m
|
||||
End If
|
||||
ToggleButtons(0)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddRecord()
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
For i = 1 To SBTBCount
|
||||
DlgUserFields.GetControl("TextField" & i).Model.Text = ""
|
||||
Next i
|
||||
MaxIndex = Ubound(UserFieldFamily(),1)
|
||||
ReDim Preserve UserFieldFamily(MaxIndex + 1, SBMAXFIELDINDEX) as String
|
||||
ToggleButtons(MaxIndex + 1, 1)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillupTextFields()
|
||||
Dim a as Integer
|
||||
Dim CurIndex as Integer
|
||||
For a = 1 To SBTBCOUNT
|
||||
CurIndex = (a-1) + ScrollBarValue
|
||||
DlgUserFields.GetControl("Label" & a).Model.Label = UserFieldDataType(CurIndex,0)
|
||||
DlgUserFields.GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, CurIndex)
|
||||
Next a
|
||||
End Sub
|
||||
|
||||
|
||||
Sub StepToRecord(aEvent as Object)
|
||||
Dim iStep as Integer
|
||||
iStep = CInt(aEvent.Source.Model.Tag)
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
ToggleButtons(CurFieldIndex + iStep)
|
||||
FillUpTextFields()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectCurrentFields()
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
ScrollTextFieldInfo(ScrollBarValue)
|
||||
MaxIndex = Ubound(UserFieldFamily(),2)
|
||||
For i = 0 To MaxIndex
|
||||
oUserDataAccess.ReplaceByName(UserFieldDataType(i,1), UserFieldFamily(CurFieldIndex, i))
|
||||
Next i
|
||||
oUserDataAccess.commitChanges()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DeleteCurrentSettings()
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(UserFieldFamily(),1)
|
||||
If CurFieldIndex < MaxIndex Then
|
||||
For n = CurFieldIndex To MaxIndex - 1
|
||||
For m = 0 To SBMAXFIELDINDEX
|
||||
UserFieldFamily(n,m) = UserFieldFamily(n + 1,m)
|
||||
Next m
|
||||
Next n
|
||||
Else
|
||||
CurFieldIndex = MaxIndex - 1
|
||||
End If
|
||||
ReDim Preserve UserFieldFamily(MaxIndex-1, SBMAXfIELDINDEX) as String
|
||||
FillupTextFields()
|
||||
ToggleButtons(CurFieldIndex)
|
||||
End Sub</script:module>
|
||||
@@ -0,0 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Gimmicks" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="UserfieldDlg"/>
|
||||
<library:element library:name="ReadFolderDlg"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,9 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Gimmicks" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="GetTexts"/>
|
||||
<library:element library:name="Userfields"/>
|
||||
<library:element library:name="ChangeAllChars"/>
|
||||
<library:element library:name="AutoText"/>
|
||||
<library:element library:name="ReadDir"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,216 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="API" script:language="StarBasic">Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
|
||||
(ByVal hKey As Long, _
|
||||
ByVal lpSubKey As String, _
|
||||
ByVal ulOptions As Long, _
|
||||
ByVal samDesired As Long, _
|
||||
phkResult As Long) As Long
|
||||
|
||||
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
|
||||
(ByVal hKey As Long, _
|
||||
ByVal lpValueName As String, _
|
||||
ByVal lpReserved As Long, _
|
||||
lpType As Long, _
|
||||
lpData As String, _
|
||||
lpcbData As Long) As Long
|
||||
|
||||
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
|
||||
(ByVal hKey As Long, _
|
||||
ByVal lpValueName As String, _
|
||||
ByVal lpReserved As Long, _
|
||||
lpType As Long, _
|
||||
lpData As Long, _
|
||||
lpcbData As Long) As Long
|
||||
|
||||
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
|
||||
(ByVal hKey As Long, _
|
||||
ByVal lpValueName As String, _
|
||||
ByVal lpReserved As Long, _
|
||||
lpType As Long, _
|
||||
ByVal lpData As Long, _
|
||||
lpcbData As Long) As Long
|
||||
|
||||
Declare Function RegCloseKeyA Lib "advapi32.dll" Alias "RegCloseKey" _
|
||||
(ByVal hKey As Long) As Long
|
||||
|
||||
|
||||
Public Const HKEY_CLASSES_ROOT = &H80000000
|
||||
Public Const HKEY_CURRENT_USER = &H80000001
|
||||
Public Const HKEY_LOCAL_MACHINE = &H80000002
|
||||
Public Const HKEY_USERS = &H80000003
|
||||
Public Const KEY_ALL_ACCESS = &H3F
|
||||
Public Const REG_OPTION_NON_VOLATILE = 0
|
||||
Public Const REG_SZ As Long = 1
|
||||
Public Const REG_DWORD As Long = 4
|
||||
Public Const ERROR_NONE = 0
|
||||
Public Const ERROR_BADDB = 1
|
||||
Public Const ERROR_BADKEY = 2
|
||||
Public Const ERROR_CANTOPEN = 3
|
||||
Public Const ERROR_CANTREAD = 4
|
||||
Public Const ERROR_CANTWRITE = 5
|
||||
Public Const ERROR_OUTOFMEMORY = 6
|
||||
Public Const ERROR_INVALID_PARAMETER = 7
|
||||
Public Const ERROR_ACCESS_DENIED = 8
|
||||
Public Const ERROR_INVALID_PARAMETERS = 87
|
||||
Public Const ERROR_NO_MORE_ITEMS = 259
|
||||
'Public Const KEY_READ = &H20019
|
||||
|
||||
|
||||
Function OpenRegKey(lBaseKey As Long, sKeyName As String) As Variant
|
||||
Dim LocKeyValue
|
||||
Dim hKey as Long
|
||||
Dim lRetValue as Long
|
||||
lRetValue = RegOpenKeyEx(lBaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
|
||||
' lRetValue = QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Outlook Express\5.0\Default Settings", "Revocation Checking")
|
||||
If hKey <> 0 Then
|
||||
RegCloseKeyA (hKey)
|
||||
End If
|
||||
OpenRegKey() = lRetValue
|
||||
End Function
|
||||
|
||||
|
||||
Function GetDefaultPath(CurOffice as Integer) As String
|
||||
Dim sPath as String
|
||||
Dim Index as Integer
|
||||
Select Case Wizardmode
|
||||
Case SBMICROSOFTMODE
|
||||
Index = Applications(CurOffice,SBAPPLKEY)
|
||||
If GetGUIType = 1 Then ' Windows
|
||||
sPath = QueryValue(HKEY_LOCAL_MACHINE, sKeyName(Index), sValueName(Index))
|
||||
Else
|
||||
sPath = ""
|
||||
End If
|
||||
If sPath = "" Then
|
||||
sPath = SOWorkPath
|
||||
End If
|
||||
GetDefaultPath = sPath
|
||||
End Select
|
||||
End Function
|
||||
|
||||
|
||||
Function GetTemplateDefaultPath(Index as Integer) As String
|
||||
Dim sLocTemplatePath as String
|
||||
Dim sLocProgrampath as String
|
||||
Dim Progstring as String
|
||||
Dim PathList()as String
|
||||
Dim Maxindex as Integer
|
||||
Dim OldsLocTemplatePath
|
||||
Dim sTemplateKeyName as String
|
||||
Dim sTemplateValueName as String
|
||||
On Local Error Goto NOVAlIDSYSTEMPATH
|
||||
Select Case WizardMode
|
||||
Case SBMICROSOFTMODE
|
||||
If GetGUIType = 1 Then ' Windows
|
||||
' Template directory of Office 97
|
||||
sTemplateKeyName = "Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates"
|
||||
sTemplateValueName = ""
|
||||
sLocTemplatePath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
|
||||
|
||||
If sLocTemplatePath = "" Then
|
||||
' Retrieve the template directory of Office 2000
|
||||
' Unfortunately there is no existing note about the template directory in
|
||||
' the whole registry.
|
||||
|
||||
' Programdirectory of Office 2000
|
||||
sTemplateKeyName = "Software\Microsoft\Office\9.0\Common\InstallRoot"
|
||||
sTemplateValueName = "Path"
|
||||
sLocProgrampath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName)
|
||||
If sLocProgrampath <> "" Then
|
||||
If Right(sLocProgrampath, 1) <> "\" Then
|
||||
sLocProgrampath = sLocProgrampath & "\"
|
||||
End If
|
||||
PathList() = ArrayoutofString(sLocProgrampath,"\",Maxindex)
|
||||
Progstring = "\" & PathList(Maxindex-1) & "\"
|
||||
OldsLocTemplatePath = DeleteStr(sLocProgramPath,Progstring)
|
||||
|
||||
sLocTemplatePath = OldsLocTemplatePath & "\" & "Templates"
|
||||
|
||||
' Does this subdirectory "templates" exist at all
|
||||
If oUcb.Exists(sLocTemplatePath) Then
|
||||
' If Not the main directory of the office is the base
|
||||
sLocTemplatePath = OldsLocTemplatePath
|
||||
End If
|
||||
Else
|
||||
sLocTemplatePath = SOWorkPath
|
||||
End If
|
||||
End If
|
||||
GetTemplateDefaultPath = ConvertToUrl(sLocTemplatePath)
|
||||
Else
|
||||
GetTemplateDefaultPath = SOWorkPath
|
||||
End If
|
||||
End Select
|
||||
NOVALIDSYSTEMPATH:
|
||||
If Err <> 0 Then
|
||||
GetTemplateDefaultPath() = SOWorkPath
|
||||
Resume ONITGOES
|
||||
ONITGOES:
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function QueryValueEx(ByVal lhKey, ByVal szValueName As String, vValue As String) As Long
|
||||
Dim cch As Long
|
||||
Dim lrc As Long
|
||||
Dim lType As Long
|
||||
Dim lValue As Long
|
||||
Dim sValue As String
|
||||
Dim Empty
|
||||
|
||||
On Error GoTo QueryValueExError
|
||||
|
||||
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
|
||||
If lrc <> ERROR_NONE Then Error 5
|
||||
Select Case lType
|
||||
Case REG_SZ:
|
||||
sValue = String(cch, 0)
|
||||
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
|
||||
If lrc = ERROR_NONE Then
|
||||
vValue = Left$(sValue, cch)
|
||||
Else
|
||||
vValue = Empty
|
||||
End If
|
||||
Case REG_DWORD:
|
||||
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
|
||||
If lrc = ERROR_NONE Then
|
||||
vValue = lValue
|
||||
End If
|
||||
Case Else
|
||||
lrc = -1
|
||||
End Select
|
||||
QueryValueExExit:
|
||||
QueryValueEx = lrc
|
||||
Exit Function
|
||||
QueryValueExError:
|
||||
Resume QueryValueExExit
|
||||
End Function
|
||||
|
||||
|
||||
Function QueryValue(BaseKey As Long, sKeyName As String, sValueName As String) As Variant
|
||||
Dim lRetVal As Long ' Returnvalue API-Call
|
||||
Dim hKey As Long ' One key handle
|
||||
Dim vValue As String ' Key value
|
||||
|
||||
lRetVal = RegOpenKeyEx(BaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
|
||||
lRetVal = QueryValueEx(hKey, sValueName, vValue)
|
||||
RegCloseKeyA (hKey)
|
||||
QueryValue = vValue
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,484 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DialogModul" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public Const bDebugWizard = True
|
||||
|
||||
Public Const SBFIRSTAPPLCHECKED = 0
|
||||
Public Const SBSECONDAPPLCHECKED = 1
|
||||
Public Const SBTHIRDAPPLCHECKED = 2
|
||||
Public Const SBFOURTHAPPLCHECKED = 3
|
||||
Public WizardMode as String
|
||||
Public Const SBMICROSOFTMODE = "MS"
|
||||
' The absolute maximal Number of possible Applications
|
||||
Public Const SBMAXAPPLCOUNT = 4
|
||||
Public Const Twip = 425
|
||||
Public MaxApplCount as Integer
|
||||
Public CurOffice As Integer
|
||||
Public SOBitmapPath As String
|
||||
Public SOWorkPath As String
|
||||
Public SOTemplatePath as String
|
||||
Public bCancelTask As Boolean
|
||||
Public bDoKeepApplValues as Boolean
|
||||
Public oUcb as Object
|
||||
Public PathSeparator as String
|
||||
|
||||
Public ApplCount as Integer
|
||||
Public sKeyName(SBMAXAPPLCOUNT-1) as String
|
||||
Public sValueName(SBMAXAPPLCOUNT-1) as String
|
||||
Public sCRLF as String
|
||||
Public MSFilterName(5,4) as String
|
||||
|
||||
Public Applications(SBMAXAPPLCOUNT-1,9)
|
||||
|
||||
Public Const SBAPPLCONVERT = 0
|
||||
Public Const SBDOCCONVERT = 1
|
||||
Public Const SBDOCRECURSIVE = 2
|
||||
Public Const SBDOCSOURCE = 3
|
||||
Public Const SBDOCTARGET = 4
|
||||
Public Const SBTEMPLCONVERT = 5
|
||||
Public Const SBTEMPLRECURSIVE = 6
|
||||
Public Const SBTEMPLSOURCE = 7
|
||||
Public Const SBTEMPLTARGET = 8
|
||||
Public Const SBAPPLKEY = 9
|
||||
Public XMLTemplateList()
|
||||
|
||||
' Application-relating Data are stored in this Array
|
||||
' according to the following structure:
|
||||
' Applications(X,0) = True/False (Application is to be converted)
|
||||
' Applications(X,1) = True/False (Documents are to be converted)
|
||||
' Applications(X,2) = True/False (Including Subdirectories)
|
||||
' Applications(X,3) = "File:///..." (SourceUrl of the documents)
|
||||
' Applications(X,4) = "File///:..." (TargetUrl of the documents)
|
||||
' Applications(X,5) = True/False (Templates are to be converted)
|
||||
' Applications(X,6) = True/False (Including Subdirectories)
|
||||
' Applications(X,7) = "File:///..." (SourceUrl of the templates)
|
||||
' Applications(X,8) = "File:///..." (TargetUrl of the templates)
|
||||
' Applications(X,9) = 0 (Key to the original Index of the Applications)
|
||||
|
||||
|
||||
Sub FillStep_Welcome()
|
||||
Dim i as Integer
|
||||
' bDoKeepApplValues = False
|
||||
ImportDialogArea.Title = sTitle
|
||||
With ImportDialog
|
||||
.cmdHelp.Label = sHelpButton
|
||||
.cmdCancel.Label = sCancelButton
|
||||
.cmdBack.Label = sBackButton
|
||||
.cmdGoOn.Label = sNextButton
|
||||
.WelcomeTextLabel.Label = sWelcomeTextLabel1
|
||||
.WelcomeTextLabel3.Label = sWelcomeTextLabel3
|
||||
|
||||
.optMSDocuments.Label = sContainerName(0)
|
||||
.chkMSApplication1.Label = sMsDocumentCheckbox(0)
|
||||
.chkMSApplication2.Label = sMsDocumentCheckbox(1)
|
||||
.chkMSApplication3.Label = sMsDocumentCheckbox(2)
|
||||
|
||||
.cmdBack.Enabled = False
|
||||
.Step = 1
|
||||
|
||||
If Not oFactoryKey.hasbyName("com.sun.star.text.TextDocument") Then
|
||||
.chkLogfile.State = 0
|
||||
.chkLogfile.Enabled = False
|
||||
End If
|
||||
End With
|
||||
CheckModuleInstallation()
|
||||
ToggleNextButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillStep_InputPaths(OfficeIndex as Integer, bStartup as Boolean)
|
||||
Dim Index as Integer
|
||||
Dim oNullObject as Object
|
||||
If bStartup And Not bDoKeepApplValues Then
|
||||
If ImportDialog.optMSDocuments.State = 1 Then
|
||||
SetupMSConfiguration()
|
||||
Else
|
||||
'Not supposed to happen - is there an assert in BASIC...
|
||||
End If
|
||||
FillUpApplicationList()
|
||||
End If
|
||||
CurOffice = OfficeIndex
|
||||
Index = Applications(CurOffice,SBAPPLKEY)
|
||||
InitializePathsforCurrentApplication(Index)
|
||||
With ImportDialog
|
||||
.chkTemplatePath.Label = sTemplateCheckbox(Index)
|
||||
.chkDocumentPath.State = Abs(Applications(CurOffice,SBDOCCONVERT))
|
||||
.chkDocumentSearchSubDir.State = Abs(Applications(CurOffice,SBDOCRECURSIVE))
|
||||
.txtDocumentImportPath.Text = ConvertFromUrl(Applications(CurOffice,SBDOCSOURCE))
|
||||
.txtDocumentExportPath.Text = ConvertFromUrl(Applications(CurOffice,SBDOCTARGET))
|
||||
.hlnDocuments.Label = sProgressMoreDocs
|
||||
If WizardMode = SBMICROSOFTMODE Then
|
||||
ImportDialogArea.Title = sTitle & " - " & sMSDocumentCheckBox(Index)
|
||||
End If
|
||||
.chkTemplatePath.Enabled = True
|
||||
.chkDocumentPath.Enabled = True
|
||||
.chkTemplatePath.Label = sTemplateCheckbox(Index)
|
||||
.chkDocumentPath.Label = sDocumentCheckbox(Index)
|
||||
.hlnTemplates.Label = sProgressMoreTemplates
|
||||
.chkTemplatePath.State = Abs(Applications(CurOffice,SBTEMPLCONVERT))
|
||||
ToggleInputPaths(oNullObject,"Template")
|
||||
ToggleInputPaths(oNullObject,"Document")
|
||||
.chkTemplateSearchSubDir.State = Abs(Applications(CurOffice,SBTEMPLRECURSIVE))
|
||||
.txtTemplateImportPath.Text = ConvertFromUrl(Applications(CurOffice,SBTEMPLSOURCE))
|
||||
.txtTemplateExportPath.Text = ConvertFromUrl(Applications(CurOffice,SBTEMPLTARGET))
|
||||
.cmdGoOn.Label = sNextButton
|
||||
.cmdBack.Enabled = True
|
||||
ImportDialog.Step = 2
|
||||
End With
|
||||
ImportDialogArea.GetControl("chkTemplatePath").SetFocus()
|
||||
ToggleNextButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillUpApplicationList()
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
Dim BoolValue as Boolean
|
||||
If Not bDoKeepApplValues Then
|
||||
a = 0
|
||||
For i = 1 To ApplCount
|
||||
If ImportDialog.optMSDocuments.State = 1 Then
|
||||
BoolValue = ImportDialogArea.GetControl("chkMSApplication" & i).Model.State = 1
|
||||
End If
|
||||
Applications(a,SBAPPLCONVERT) = BoolValue
|
||||
Applications(a,SBDOCCONVERT) = BoolValue
|
||||
Applications(a,SBDOCRECURSIVE) = BoolValue
|
||||
Applications(a,SBDOCSOURCE) = "" ' GetDefaultPath(i)
|
||||
Applications(a,SBDOCTARGET) = "" ' SOWorkPath
|
||||
Applications(a,SBTEMPLCONVERT) = BoolValue
|
||||
Applications(a,SBTEMPLRECURSIVE) = BoolValue
|
||||
Applications(a,SBTEMPLSOURCE) = "" ' GetTemplateDefaultPath(i)
|
||||
Applications(a,SBTEMPLTARGET) = "" ' GetTargetTemplatePath(i)
|
||||
Applications(a,SBAPPLKEY) = i-1
|
||||
If BoolValue Then
|
||||
a = a + 1
|
||||
End If
|
||||
Next i
|
||||
ApplCount = a
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InitializePathsforCurrentApplication(i as Integer)
|
||||
AssignPathToCurrentApplication(SBDOCSOURCE, GetDefaultPath(i))
|
||||
AssignPathToCurrentApplication(SBDOCTARGET, SOWorkPath)
|
||||
AssignPathToCurrentApplication(SBTEMPLSOURCE, GetTemplateDefaultPath(i))
|
||||
AssignPathToCurrentApplication(SBTEMPLTARGET, GetTargetTemplatePath(i))
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AssignPathToCurrentApplication(Index as Integer, NewPath as String)
|
||||
If Applications(CurOffice,Index) = "" Then
|
||||
If CurOffice > 0 Then
|
||||
Applications(CurOffice,Index) = Applications(CurOffice-1,Index)
|
||||
Else
|
||||
Applications(CurOffice,Index) = NewPath
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SaveStep_InputPath()
|
||||
Applications(CurOffice,SBDOCCONVERT) = ImportDialog.chkDocumentPath.State = 1
|
||||
Applications(CurOffice,SBDOCRECURSIVE) = ImportDialog.chkDocumentSearchSubDir.State = 1
|
||||
Applications(CurOffice,SBDOCSOURCE) = ConvertToURL(ImportDialog.txtDocumentImportPath.Text)
|
||||
Applications(CurOffice,SBDOCTARGET) = ConvertToUrl(ImportDialog.txtDocumentExportPath.Text)
|
||||
Applications(CurOffice,SBTEMPLCONVERT) = ImportDialog.chkTemplatePath.State = 1
|
||||
Applications(CurOffice,SBTEMPLRECURSIVE) = ImportDialog.chkTemplateSearchSubDir.State = 1
|
||||
Applications(CurOffice,SBTEMPLSOURCE) = ConvertToURL(ImportDialog.txtTemplateImportPath.Text)
|
||||
Applications(CurOffice,SBTEMPLTARGET) = ConvertToURL(ImportDialog.txtTemplateExportPath.Text)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleInputPaths(aEvent as Object, Optional sDocType)
|
||||
Dim bDoEnable as Boolean
|
||||
Dim sLocDocType as String
|
||||
Dim oCheckBox as Object
|
||||
If Not IsNull(aEvent) Then
|
||||
sLocDocType = aEvent.Source.Model.Tag
|
||||
Else
|
||||
sLocDocType = sDocType
|
||||
End If
|
||||
With ImportDialogArea
|
||||
oCheckBox = .GetControl("chk" & sLocDocType & "Path").Model
|
||||
bDoEnable = oCheckBox.State = 1 And oCheckBox.Enabled
|
||||
.GetControl("lbl" & sLocDocType & "Import").Model.Enabled = bDoEnable
|
||||
.GetControl("lbl" & sLocDocType & "Export").Model.Enabled = bDoEnable
|
||||
.GetControl("txt" & sLocDocType & "ImportPath").Model.Enabled = bDoEnable
|
||||
.GetControl("txt" & sLocDocType & "ExportPath").Model.Enabled = bDoEnable
|
||||
.GetControl("chk" & sLocDocType & "SearchSubDir").Model.Enabled = bDoEnable
|
||||
.GetControl("cmd" & sLocDocType & "Import").Model.Enabled = bDoEnable
|
||||
.GetControl("cmd" & sLocDocType & "Export").Model.Enabled = bDoEnable
|
||||
End With
|
||||
ToggleNextButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Function MakeSummaryString()
|
||||
Dim sTmpText As String
|
||||
Dim i as Integer
|
||||
Dim Index as Integer
|
||||
Dim sAddText as String
|
||||
For i = 0 To ApplCount -1
|
||||
Index = Applications(i,SBAPPLKEY)
|
||||
If Applications(i,SBTEMPLCONVERT) Then
|
||||
' Templates are to be converted
|
||||
sAddText = ""
|
||||
If WizardMode = SBMICROSOFTMODE Then
|
||||
sAddText = sSumMSTemplates(Index) & sCRLF
|
||||
End If
|
||||
sTmpText = sTmpText & sAddText & ConvertFromUrl(Applications(i,SBTEMPLSOURCE)) & sCRLF
|
||||
If Applications(i,SBTEMPLRECURSIVE) Then
|
||||
' Including Subdirectories
|
||||
sTmpText = sTmpText & sSumInclusiveSubDir & sCRLF
|
||||
End If
|
||||
sTmpText = sTmpText & sSumSaveDocuments & sCRLF
|
||||
sTmpText = sTmpText & ConvertFromUrl(Applications(i,SBTEMPLTARGET)) & sCRLF
|
||||
sTmpText = sTmpText & sCRLF
|
||||
End If
|
||||
|
||||
If Applications(i,SBDOCCONVERT) Then
|
||||
' Documents are to be converted
|
||||
If WizardMode = SBMICROSOFTMODE Then
|
||||
sAddText = sSumMSDocuments(Index) & sCRLF
|
||||
End If
|
||||
sTmpText = sTmpText & sAddText & ConvertFromUrl(Applications(i,SBDOCSOURCE)) & sCRLF
|
||||
|
||||
If Applications(i,SBDOCRECURSIVE) Then
|
||||
' Including Subdirectories
|
||||
sTmpText = sTmpText & sSumInclusiveSubDir & sCRLF
|
||||
End If
|
||||
|
||||
sTmpText = sTmpText & sSumSaveDocuments & sCRLF
|
||||
sTmpText = sTmpText & ConvertFromUrl(Applications(i,SBDOCTARGET)) & sCRLF
|
||||
sTmpText = sTmpText & sCRLF
|
||||
End If
|
||||
Next i
|
||||
MakeSummaryString = sTmpText
|
||||
End Function
|
||||
|
||||
|
||||
Sub FillStep_Summary()
|
||||
ImportDialogArea.Title = sTitle
|
||||
With ImportDialog
|
||||
.SummaryTextbox.Text = MakeSummaryString()
|
||||
.cmdGoOn.Enabled = .SummaryTextbox.Text <> ""
|
||||
.cmdGoOn.Label = sBeginButton
|
||||
.SummaryHeaderLabel.Label = sSummaryHeader
|
||||
.Step = 3
|
||||
End With
|
||||
ImportDialogArea.GetControl("SummaryHeaderLabel").SetFocus()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillStep_Progress()
|
||||
With ImportDialog
|
||||
.cmdBack.Enabled = False
|
||||
.cmdGoOn.Enabled = False
|
||||
.hlnProgress.Label = sProgressPage_1
|
||||
.LabelRetrieval.FontWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
.LabelRetrieval.Label = sProgressPage_2
|
||||
.LabelCurProgress.Label = sProgressPage_3
|
||||
.LabelCurDocumentRetrieval.Label = ""
|
||||
.LabelCurTemplateRetrieval.Label = ""
|
||||
.LabelCurDocument.Label = ""
|
||||
.Step = 4
|
||||
End With
|
||||
ImportDialogArea.GetControl("LabelRetrieval").SetFocus()
|
||||
If ImportDialog.chkLogfile.State = 1 Then
|
||||
ImportDialog.cmdShowLogFile.DefaultButton = True
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetupMSConfiguration()
|
||||
Wizardmode = SBMICROSOFTMODE
|
||||
MaxApplCount = 3
|
||||
ApplCount = 3
|
||||
' chkTemplatePath-Captions
|
||||
sTemplateCheckBox(0) = GetResText("MSTemplateCheckbox_1_")
|
||||
sTemplateCheckBox(1) = GetResText("MSTemplateCheckbox_2_")
|
||||
sTemplateCheckBox(2) = GetResText("MSTemplateCheckbox_3_")
|
||||
' DocumentCheckbox- Captions
|
||||
sDocumentCheckBox(0) = GetResText("MSDocumentCheckbox_1_")
|
||||
sDocumentCheckBox(1) = GetResText("MSDocumentCheckbox_2_")
|
||||
sDocumentCheckBox(2) = GetResText("MSDocumentCheckbox_3_")
|
||||
|
||||
sKeyName(0) = "Software\Microsoft\Office\8.0\Word\Options"
|
||||
sKeyName(1) = "Software\Microsoft\Office\8.0\Excel\Microsoft Excel"
|
||||
sKeyName(2) = "Software\Microsoft\Office\8.0\PowerPoint\Recent Folder List\Default"
|
||||
|
||||
sValueName(0) = "DOC-PATH"
|
||||
sValueName(1) = "DefaultPath"
|
||||
sValueName(2) = ""
|
||||
|
||||
' See definition of Filtername-Array about meaning of fields
|
||||
MSFilterName(0,0) = "doc|docx|docm"
|
||||
MSFilterName(0,1) = "writer8|writer8|writer8"
|
||||
MSFilterName(0,2) = "odt|odt|odt"
|
||||
MSFilterName(0,3) = sMSDocumentCheckBox(0)
|
||||
MSFilterName(0,4) = "Word"
|
||||
|
||||
|
||||
MSFilterName(1,0) = "xls|xlsx|xlsm"
|
||||
MSFilterName(1,1) = "calc8|calc8|calc8"
|
||||
MSFilterName(1,2) = "ods|ods|ods"
|
||||
MSFilterName(1,3) = sMSDocumentCheckBox(1)
|
||||
MSFilterName(1,4) = "Excel"
|
||||
|
||||
MSFilterName(2,0) = "ppt|pps|pptx|pub|pptm|ppsx|ppsm"
|
||||
MSFilterName(2,1) = "impress8|impress8|impress8|impress8|impress8|impress8|impress8"
|
||||
MSFilterName(2,2) = "odp|odp|odp|odp|odp|odp|odp"
|
||||
MSFilterName(2,3) = sMSDocumentCheckBox(2)
|
||||
MSFilterName(2,4) = "PowerPoint/Publisher"
|
||||
|
||||
MSFilterName(3,0) = "dot|dotx|dotm"
|
||||
MSFilterName(3,1) = "writer8_template|writer8_template|writer8_template"
|
||||
MSFilterName(3,2) = "ott|ott|ott"
|
||||
MSFilterName(3,3) = sMSTemplateCheckBox(0)
|
||||
MSFilterName(3,4) = "Word"
|
||||
|
||||
MSFilterName(4,0) = "xlt|xltx|xltm"
|
||||
MSFilterName(4,1) = "calc8_template|calc8_template|calc8_template"
|
||||
MSFilterName(4,2) = "ots|ots|ots"
|
||||
MSFilterName(4,3) = sMSTemplateCheckBox(1)
|
||||
MSFilterName(4,4) = "Excel"
|
||||
|
||||
MSFilterName(5,0) = "pot|potx|potm"
|
||||
MSFilterName(5,1) = "impress8_template|impress8_template|impress8_template"
|
||||
MSFilterName(5,2) = "otp|otp|otp"
|
||||
MSFilterName(5,3) = sMSTemplateCheckBox(2)
|
||||
MSFilterName(5,4) = "PowerPoint"
|
||||
End Sub
|
||||
|
||||
|
||||
Function CheckControlPath(oCheckbox as Object, oTextBox as Object, ByVal bDoEnable as Boolean)
|
||||
Dim sPath as String
|
||||
If Not bDoEnable Then
|
||||
CheckControlPath = False
|
||||
ElseIf oCheckbox.State = 0 Then
|
||||
CheckControlPath = True
|
||||
Else
|
||||
sPath = ConvertToUrl(Trim(oTextBox.Text))
|
||||
CheckControlPath = oUcb.Exists(sPath)
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckInputPaths() as Boolean
|
||||
Dim bChangePage as Boolean
|
||||
bChangePage = CheckTextBoxPath(ImportDialog.txtTemplateImportPath, True, False, sTitle, False)
|
||||
bChangePage = CheckTextBoxPath(ImportDialog.txtTemplateExportPath, bChangePage, True, sTitle, False)
|
||||
bChangePage = CheckTextBoxPath(ImportDialog.txtDocumentImportPath, bChangePage, False, sTitle, False)
|
||||
bChangePage = CheckTextBoxPath(ImportDialog.txtDocumentExportPath, bChangePage, True, sTitle, False)
|
||||
CheckInputPaths = bChangePage
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckTextBoxPath(oTextBox as Object, ByVal bCheck as Boolean, bCreateNew as Boolean, sTitle as String, bgetResources as Boolean) as Boolean
|
||||
Dim iCreate as Integer
|
||||
Dim sQueryMessage as String
|
||||
Dim sUrlPath as String
|
||||
Dim sMessageNoDir as String
|
||||
Dim sShowPath as String
|
||||
Dim oLocUcb as Object
|
||||
oLocUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
If bGetResources Then
|
||||
If InitResources("ImportWizard") then
|
||||
sNoDirCreation = GetResText("NoDirCreation")
|
||||
sMsgDirNotThere = GetResText("MsgDirNotThere")
|
||||
sQueryForNewCreation = GetResText("QueryfornewCreation")
|
||||
Else
|
||||
CheckTextBoxPath() = False
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
If oTextBox.Enabled Then
|
||||
If bCheck Then
|
||||
sShowPath = oTextBox.Text
|
||||
sUrlPath = ConvertToUrl(sShowPath)
|
||||
If Not oLocUcb.Exists(sUrlPath) Then
|
||||
If Not bCreateNew Then
|
||||
' Sourcedirectories must be existing, Targetdirectories may be created new
|
||||
sQueryMessage = ReplaceString(sMsgDirNotThere, sShowPath,"%1")
|
||||
Msgbox(sQueryMessage,16,sTitle)
|
||||
CheckTextBoxPath() = False
|
||||
Exit Function
|
||||
Else
|
||||
sQueryMessage = ReplaceString(sMsgDirNotThere, sShowPath,"%1")
|
||||
sQueryMessage = sQueryMessage & Chr(13) & sQueryForNewCreation
|
||||
iCreate = Msgbox (sQueryMessage, 36, sTitle)
|
||||
If iCreate = 6 Then
|
||||
On Local Error Goto NOVALIDPATH
|
||||
CreateFolder(sUrlPath)
|
||||
If Not oLocUcb.Exists(sUrlPath) Then
|
||||
Goto NOVALIDPATH
|
||||
End If
|
||||
Else
|
||||
CheckTextBoxPath() = False
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
CheckTextBoxPath() = True
|
||||
Else
|
||||
CheckTextBoxPath() = False
|
||||
End If
|
||||
Else
|
||||
CheckTextBoxPath() = True
|
||||
End If
|
||||
Exit Function
|
||||
NOVALIDPATH:
|
||||
sMessageNoDir = ReplaceString(sNoDirCreation, sShowPath, "%1")
|
||||
Msgbox(sMessageNoDir, 16, sTitle)
|
||||
CheckTextBoxPath() = False
|
||||
End Function
|
||||
|
||||
|
||||
Sub InitializeProgressPage(oDialog as Object)
|
||||
oDialog.LabelRetrieval.FontWeight = com.sun.star.awt.FontWeight.NORMAL
|
||||
oDialog.LabelCurProgress.FontWeight = com.sun.star.awt.FontWeight.BOLD
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetProgressDisplay(AbsFound as Integer)
|
||||
ImportDialog.LabelRetrieval.Label = sProgressPage_2 & " " & ReplaceString(sProgressPage_5, Str(AbsFound) & " ", "%1")
|
||||
ImportDialog.LabelCurDocumentRetrieval.Label = sProgressFound & " " & CStr(AbsDocuFound) & " " & sProgressMoreDocs
|
||||
ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound & " " & CStr(AbsTemplateFound) & " " & sProgressMoreTemplates
|
||||
End Sub
|
||||
|
||||
Sub TakoverFolderName(aEvent as Object)
|
||||
Dim RefControlName as String
|
||||
Dim oRefControl
|
||||
RefControlName = aEvent.Source.Model.Tag
|
||||
oRefControl = ImportDialogArea.GetControl(RefControlName)
|
||||
GetFolderName(oRefControl.Model)
|
||||
ToggleNextButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FinalizeDialogButtons()
|
||||
ImportDialog.cmdShowLogFile.Enabled = ((Isnull(oLogDocument) = False) And (ImportDialog.chkLogfile.State = 1))
|
||||
ImportDialog.cmdCancel.Enabled = False
|
||||
ImportDialog.cmdGoOn.Label = sCloseButton
|
||||
ImportDialog.cmdGoOn.Enabled = True
|
||||
End Sub
|
||||
</script:module>
|
||||
@@ -0,0 +1,783 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FilesModul" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public AbsTemplateFound as Integer
|
||||
Public AbsDocuFound as Integer
|
||||
Public oLogDocument as Object
|
||||
Public oLogTable as Object
|
||||
Public bLogExists as Boolean
|
||||
Public sComment as String
|
||||
Public MaxCollectIndex as Integer
|
||||
Public bInsertRow as Boolean
|
||||
Public sLogUrl as String
|
||||
Public sCurPassWord as String
|
||||
Public FileCount as Integer
|
||||
Public XMLTemplateCount as Integer
|
||||
Public PathCollection(7,3) as String
|
||||
Public bIsFirstLogTable as Boolean
|
||||
|
||||
|
||||
Function ReadCollectionPaths(FilesList() as String, sFilterName() as String)
|
||||
Dim FilterIndex as Integer
|
||||
Dim bRecursive as Boolean
|
||||
Dim SearchDir as String
|
||||
Dim i as Integer
|
||||
Dim n as Integer
|
||||
Dim a as Integer
|
||||
Dim s as Integer
|
||||
Dim t as Integer
|
||||
Dim sFileContent() as String
|
||||
Dim NewList(0,1) as String
|
||||
Dim Index as Integer
|
||||
Dim CurFileName as String
|
||||
Dim CurExtension as String
|
||||
Dim CurFileContent as String
|
||||
Dim XMLTemplateContentList() as String
|
||||
Dim bIsTemplatePath as Boolean
|
||||
Dim MaxIndex as Integer
|
||||
Dim NewContentList() as String
|
||||
Dim XMLTemplateContentString as String
|
||||
Dim ApplIndex as Integer
|
||||
Dim bAssignFileName as Boolean
|
||||
Dim bInterruptSearch as Boolean
|
||||
bInterruptSearch = False
|
||||
For i = 0 To MaxCollectIndex
|
||||
SearchDir = PathCollection(i,0)
|
||||
bRecursive = PathCollection(i,1)
|
||||
sFileContent() = ArrayoutofString(PathCollection(i,2), "|")
|
||||
NewList() = ReadDirectories(SearchDir, bRecursive, False, False, sFileContent(), "")
|
||||
If InterruptProcess Then
|
||||
ReadCollectionPaths() = False
|
||||
Exit Function
|
||||
End If
|
||||
If Ubound(NewList()) > -1 Then
|
||||
bIsTemplatePath = FieldInList("vor", sFileContent)
|
||||
If bIsTemplatePath Then
|
||||
XMLTemplateContentString = PathCollection(i,3)
|
||||
XMLTemplateContentList() = ArrayoutofString(XMLTemplateContentString, "|")
|
||||
If Ubound(XMLTemplateContentList()) > -1 Then
|
||||
MaxIndex = Ubound(NewList())
|
||||
ReDim Preserve NewList(MaxIndex, 1) as String
|
||||
ReDim Preserve NewContentList(MaxIndex) as String
|
||||
a = -1
|
||||
For n = 0 To MaxIndex
|
||||
bAssignFileName = True
|
||||
If InterruptProcess() Then
|
||||
ReadCollectionPaths() = False
|
||||
Exit Function
|
||||
End If
|
||||
CurFileContent = ""
|
||||
CurFileName = NewList(n,0)
|
||||
If (FieldInList(NewList(n,1), XMLTemplateList())) Then
|
||||
CurFileContent = GetRealFileContent(CurFileName)
|
||||
t = SearchArrayforPartString(CurFileContent, XMLTemplateContentList())
|
||||
bAssignFileName = (t > -1)
|
||||
If bAssignFileName Then
|
||||
CurFileContent = XMLTemplateContentList(t)
|
||||
End If
|
||||
NewList(n,1) = CurFileContent
|
||||
End If
|
||||
CurExtension = NewList(n,1)
|
||||
If bAssignFileName Then
|
||||
If a < n Then
|
||||
a = a + 1
|
||||
NewList(a,0) = CurFileName
|
||||
NewList(a,1) = CurExtension
|
||||
If CurFileContent = "" Then
|
||||
CurFileContent = CurExtension
|
||||
End If
|
||||
ApplIndex = GetApplicationIndex(CurFileContent, sFiltername())
|
||||
NewContentList(a) = ApplIndex
|
||||
End If
|
||||
End If
|
||||
Next n
|
||||
If a < MaxIndex And a > -1 Then
|
||||
ReDim Preserve NewList(a, 1) as String
|
||||
End If
|
||||
If a > -1 Then
|
||||
AddListtoFilesList(FilesList(), NewList(), NewContentList())
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
MaxIndex = Ubound(NewList())
|
||||
ReDim Preserve NewContentList(MaxIndex) as String
|
||||
For s = 0 To MaxIndex
|
||||
CurExtension = NewList(s,1)
|
||||
NewContentList(s) = GetApplicationIndex(CurExtension, sFiltername())
|
||||
Next s
|
||||
AddListtoFilesList(FilesList(), NewList(), NewContentList())
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
ReadCollectionPaths() = Ubound(FilesList()) > -1
|
||||
End Function
|
||||
|
||||
|
||||
Function GetApplicationIndex(CurFileContent as String, sFilterName() as String) as Integer
|
||||
Dim Index as Integer
|
||||
Dim i as Integer
|
||||
Index = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
|
||||
If Index >= MaxApplCount Then
|
||||
Index = Index - MaxApplCount
|
||||
End If
|
||||
For i = 0 To MaxApplCount - 1
|
||||
If Applications(i, SBAPPLKEY) = Index Then
|
||||
GetApplicationIndex() = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
GetApplicationIndex() = - 1
|
||||
End Function
|
||||
|
||||
|
||||
Function InterruptProcess() as Boolean
|
||||
If bCancelTask Or RetValue = 0 Then
|
||||
bConversionIsRunning = False
|
||||
InterruptProcess() = True
|
||||
Exit Function
|
||||
End if
|
||||
InterruptProcess() = False
|
||||
End Function
|
||||
|
||||
|
||||
Sub AddCollectionPath(ApplIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
|
||||
MaxCollectIndex = MaxCollectIndex + 1
|
||||
PathCollection(MaxCollectIndex, 0) = Applications(ApplIndex, DocIndex)
|
||||
PathCollection(MaxCollectIndex, 1) = Applications(ApplIndex, RecursiveIndex)
|
||||
AddFilterNameToPathItem(ApplIndex, MaxCollectIndex, sFiltername(), DistIndex)
|
||||
End Sub
|
||||
|
||||
|
||||
Function SetExtension(LocExtension) as String
|
||||
if (Instr(LocExtension, "vnd.sun.xml.impress")) > 0 then
|
||||
SetExtension() = "vor|sti|std"
|
||||
elseif (Instr(LocExtension, "vnd.sun.xml.writer")) > 0 then
|
||||
SetExtension() = "vor|stw"
|
||||
elseif (Instr(LocExtension, "vnd.sun.xml.calc")) > 0 then
|
||||
SetExtension() = "vor|stc"
|
||||
elseif (Instr(LocExtension, "vnd.sun.xml.draw")) > 0 then
|
||||
SetExtension() = "vor|std|sti"
|
||||
endif
|
||||
End Function
|
||||
|
||||
Sub AddFilterNameToPathItem(ApplIndex as Integer, CollectIndex as Integer, sFiltername() as String, DistIndex as Integer)
|
||||
Dim iKey as Integer
|
||||
Dim CurListString as String
|
||||
Dim LocExtension as String
|
||||
Dim LocContentString as String
|
||||
Dim LocXMLTemplateContent as String
|
||||
iKey = Applications(ApplIndex, SBAPPLKEY)
|
||||
CurListString = PathCollection(CollectIndex, 2)
|
||||
LocExtension = sFilterName(iKey +DistIndex, 0)
|
||||
If Instr(LocExtension, "vnd.sun.xml.") = 1 Then
|
||||
LocExtension = SetExtension(LocExtension)
|
||||
LocContentString = sFilterName(iKey +DistIndex, 0)
|
||||
LocContentString = ReplaceString(LocContentString, "|", ";")
|
||||
LocXMLTemplateContent = PathCollection(CollectIndex, 3)
|
||||
If LocXMLTemplateContent = "" Then
|
||||
LocXMLTemplateContent = LocContentString
|
||||
Else
|
||||
LocXMLTemplateContent = LocXMLTemplateContent & "|" & LocContentString
|
||||
End If
|
||||
PathCollection(CollectIndex, 3) = LocXMLTemplateContent
|
||||
End If
|
||||
If CurListString = "" Then
|
||||
PathCollection(CollectIndex, 2) = LocExtension
|
||||
Else
|
||||
If Instr(CurListString, LocExtension) = 0 Then
|
||||
PathCollection(CollectIndex, 2) = CurListString & "|" & LocExtension
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckIfToAddPathToCollection(ApplIndex as Integer, bDoConvertIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
|
||||
Dim CollectIndex as Integer
|
||||
Dim bCheckDocuType as Boolean
|
||||
bCheckDocuType = Applications(ApplIndex, bDoConvertIndex)
|
||||
If bCheckDocuType Then
|
||||
CollectIndex = GetIndexInMultiArray(PathCollection(), Applications(ApplIndex,DocIndex), 0)
|
||||
If (CollectIndex >-1) Then
|
||||
If Applications(ApplIndex, RecursiveIndex) <> PathCollection(CollectIndex, 1) Then
|
||||
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
|
||||
Else
|
||||
AddFilterNameToPathItem(ApplIndex, CollectIndex, sFilterName(), DistIndex)
|
||||
End If
|
||||
Else
|
||||
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CollectPaths(sFiltername() as String)
|
||||
Dim i as Integer
|
||||
Dim XMLTemplateContentString as String
|
||||
MaxCollectIndex = -1
|
||||
For i = 0 To ApplCount-1
|
||||
CheckIfToAddPathToCollection(i, SBDOCCONVERT, SBDOCSOURCE, SBDOCRECURSIVE, sFilterName(), 0)
|
||||
Next i
|
||||
XMLTemplateCount = 0
|
||||
XMLTemplateContentString = ""
|
||||
For i = 0 To ApplCount-1
|
||||
CheckIfToAddPathToCollection(i, SBTEMPLCONVERT, SBTEMPLSOURCE, SBTEMPLRECURSIVE, sFilterName(), MaxApplCount)
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ConvertAllDocuments(sFilterName() as String)
|
||||
Dim FileProperties(1) as new com.sun.star.beans.PropertyValue
|
||||
Dim PWFileProperties(2) as New com.sun.star.beans.PropertyValue
|
||||
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
|
||||
Dim OpenProperties(4) as new com.sun.star.beans.PropertyValue
|
||||
Dim oInteractionHandler as Object
|
||||
Dim InteractionTypes(0) as Long
|
||||
Dim FilesList(0,2) as String
|
||||
Dim sViewPath as String
|
||||
Dim i as Integer
|
||||
Dim FilterIndex as Integer
|
||||
Dim sSourceUrl as String
|
||||
Dim CurFilename as String
|
||||
Dim oDocument as Object
|
||||
Dim sExtension as String
|
||||
Dim OldExtension as String
|
||||
Dim CurFound as Integer
|
||||
Dim TotFound as Integer
|
||||
Dim TargetStemDir as String
|
||||
Dim SourceStemDir as String
|
||||
Dim TargetDir as String
|
||||
Dim sTargetUrl as String
|
||||
Dim CurFilterName as String
|
||||
Dim ApplIndex as Integer
|
||||
Dim Index as Integer
|
||||
Dim bIsDocument as Boolean
|
||||
Dim bDoSave as Boolean
|
||||
Dim sCurFileExists as String
|
||||
Dim MaxFileIndex as Integer
|
||||
Dim bContainsBasicMacro as Boolean
|
||||
Dim bIsPassWordProtected as Boolean
|
||||
Dim iOverwrite as Integer
|
||||
Dim sMimeTypeorExtension as String
|
||||
Dim sPrevMimeTypeorExtension as String
|
||||
bConversionisrunning = True
|
||||
InteractionTypes(0) = com.sun.star.task.PasswordRequestMode.PASSWORD_REENTER
|
||||
oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler")
|
||||
oInteractionHandler.initialize(InteractionTypes())
|
||||
iGeneralOverwrite = SBOVERWRITEUNDEFINED
|
||||
bConversionIsRunning = True
|
||||
bLogExists = false
|
||||
AbsTemplateFound = 0
|
||||
AbsDocuFound = 0
|
||||
CollectPaths(sFiltername())
|
||||
If Not ReadCollectionPaths(FilesList(), sFilterName()) Then
|
||||
TotFound = 0
|
||||
SetProgressDisplay(0)
|
||||
bConversionisrunning = false
|
||||
FinalizeDialogButtons()
|
||||
Exit Sub
|
||||
End If
|
||||
TotFound = Ubound(FilesList()) + 1
|
||||
If FilesList(0,0) = "" Then ' Querying the number of fields in a multidimensional Array is unsecure
|
||||
TotFound = 0 ' because it will return the value 0 (and not -1) even when the Array is empty
|
||||
SetProgressDisplay(0)
|
||||
End If
|
||||
BubbleSortList(FilesList(), true)
|
||||
If TotFound > 0 Then
|
||||
CreateLogDocument(OpenProperties())
|
||||
InitializeProgressPage(ImportDialog)
|
||||
OpenProperties(0).Name = "Hidden"
|
||||
OpenProperties(0).Value = True
|
||||
OpenProperties(1).Name = "AsTemplate"
|
||||
OpenProperties(1).Value = False
|
||||
OpenProperties(2).Name = "MacroExecutionMode"
|
||||
OpenProperties(2).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE
|
||||
OpenProperties(3).Name = "UpdateDocMode"
|
||||
OpenProperties(3).Value = com.sun.star.document.UpdateDocMode.NO_UPDATE
|
||||
OpenProperties(4).Name = "InteractionHandler"
|
||||
OpenProperties(4).Value = oInteractionHandler
|
||||
MaxFileIndex = Ubound(FilesList(),1)
|
||||
FileCount = 0
|
||||
For i = 0 To MaxFileIndex
|
||||
sComment = ""
|
||||
If InterruptProcess() Then
|
||||
Exit For
|
||||
End If
|
||||
bDoSave = True
|
||||
sSourceUrl = FilesList(i,0)
|
||||
sPrevMimeTypeorExtension = sMimeTypeorExtension
|
||||
sMimeTypeorExtension = FilesList(i,1)
|
||||
CurFiltername = GetFilterName(sMimeTypeorExtension, sFilterName(), sExtension, FilterIndex)
|
||||
ApplIndex = FilesList(i,2)
|
||||
If sMimeTypeorExtension <> sPrevMimeTypeorExtension Then
|
||||
CreateLogTable(ApplIndex, sMimeTypeOrExtension, sFiltername())
|
||||
End If
|
||||
If ApplIndex > Ubound(Applications) or (ApplIndex < 0) Then
|
||||
Msgbox "Applicationindex out of bounds:" & sSourcUrl
|
||||
End If
|
||||
sViewPath = ConvertFromUrl(sSourceUrl) ' CutPathView(sSourceUrl, 70)
|
||||
ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & " (" & sViewPath & ")"
|
||||
Select Case lcase(sExtension)
|
||||
Case "odt", "ods", "odp", "odg", "odm", "odf"
|
||||
SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), "/")
|
||||
TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), "/")
|
||||
Case Else ' Templates and Helper-Applications remain
|
||||
SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), "/")
|
||||
TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), "/")
|
||||
End Select
|
||||
sTargetUrl = ReplaceString(sSourceUrl, TargetStemDir, SourceStemDir)
|
||||
CurFilename = GetFileNameWithoutExtension(sTargetUrl, "/")
|
||||
OldExtension = GetFileNameExtension(sTargetUrl)
|
||||
sTargetUrl = RTrimStr(sTargetUrl, OldExtension)
|
||||
sTargetUrl = sTargetUrl & sExtension
|
||||
TargetDir = RTrimStr(sTargetUrl, CurFilename & "." & sExtension)
|
||||
If (oUcb.Exists(sTargetUrl)) Then
|
||||
If (iGeneralOverwrite <> SBOVERWRITEALWAYS) Then
|
||||
If (iGeneralOverwrite = SBOVERWRITEUNDEFINED) Then
|
||||
ShowOverwriteAllDialog(sTargetUrl, sTitle)
|
||||
bDoSave = (iGeneralOverwrite = SBOVERWRITEQUERY) Or (iGeneralOverwrite = SBOVERWRITEALWAYS)
|
||||
Elseif iGeneralOverwrite = SBOVERWRITENEVER Then
|
||||
bDoSave = False
|
||||
ElseIf ((iGeneralOverWrite = SBOVERWRITEQUERY) OR (iGeneralOverwrite = SBOVERWRITECANCEL)) Then
|
||||
' Todo: According to AS there might come a new feature that storeasUrl could possibly rise a UI dialog.
|
||||
' In this case my own UI becomes obsolete
|
||||
sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(sTargetUrl), "<1>")
|
||||
sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>")
|
||||
iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle)
|
||||
Select Case iOverWrite
|
||||
Case 1 ' OK
|
||||
' In the FileProperty-Bean this is already default
|
||||
bDoSave = True
|
||||
Case 2 ' Abort
|
||||
CancelTask(False)
|
||||
bDoSave = False
|
||||
Case 7 ' No
|
||||
bDoSave = False
|
||||
End Select
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
If bDoSave Then
|
||||
If Not oUcb.Exists(TargetDir) Then
|
||||
bDoSave = CreateFolder(TargetDir)
|
||||
End If
|
||||
If bDoSave Then
|
||||
oDocument = StarDesktop.LoadComponentFromURL(sSourceUrl, "_default", 0, OpenProperties())
|
||||
If Not IsNull(oDocument) Then
|
||||
InsertSourceUrlToLogDocument(sSourceUrl, "")
|
||||
bIsPassWordProtected = CheckPassWordProtection(oDocument)
|
||||
CheckIfMacroExists(oDocument.BasicLibraries, sComment)
|
||||
On Local Error Goto NOSAVING
|
||||
If bIsPassWordProtected Then
|
||||
PWFileProperties(0).Name = "FilterName"
|
||||
PWFileProperties(0).Value = CurFilterName
|
||||
PWFileProperties(1).Name = "Overwrite"
|
||||
PWFileProperties(1).Value = True
|
||||
PWFileProperties(2).Name = "Password"
|
||||
PWFileProperties(2).Value = sCurPassWord
|
||||
oDocument.StoreAsUrl(sTargetUrl, PWFileProperties())
|
||||
Else
|
||||
FileProperties(0).Name = "FilterName"
|
||||
FileProperties(0).Value = CurFilterName
|
||||
FileProperties(1).Name = "Overwrite"
|
||||
FileProperties(1).Value = True
|
||||
oDocument.StoreAsUrl(sTargetUrl,FileProperties())
|
||||
End If
|
||||
' Todo: Make sure that an errorbox pops up when saving fails
|
||||
NOSAVING:
|
||||
If Err <> 0 Then
|
||||
sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(sTargetUrl), "<1>")
|
||||
sComment = ConcatComment(sComment, sCurCouldnotsaveDocument)
|
||||
Resume LETSGO
|
||||
LETSGO:
|
||||
Else
|
||||
FileCount = FileCount + 1
|
||||
End If
|
||||
oDocument.Dispose()
|
||||
InsertTargetUrlToLogDocument(sTargetUrl, sComment)
|
||||
Else
|
||||
sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sSourceUrl), "<1>")
|
||||
sComment = ConcatComment(sComment, sCurCouldnotopenDocument)
|
||||
InsertSourceUrlToLogDocument(sSourceUrl, sComment)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
AddLogStatistics()
|
||||
FinalizeDialogButtons()
|
||||
bConversionIsRunning = False
|
||||
Exit Sub
|
||||
RTError:
|
||||
Msgbox sRTErrorDesc, 16, sRTErrorHeader
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub AddListtoFilesList(FirstList(), SecList(), NewContentList() as String)
|
||||
Dim sLocExtension as String
|
||||
Dim FirstStart as Integer
|
||||
Dim FirstEnd as Integer
|
||||
Dim i as Integer
|
||||
Dim s as Integer
|
||||
If FirstList(0,0) = "" Then
|
||||
FirstStart = Ubound(FirstList(),1)
|
||||
Else
|
||||
FirstStart = Ubound(FirstList(),1) + 1
|
||||
End If
|
||||
FirstEnd = FirstStart + Ubound(SecList(),1)
|
||||
ReDim Preserve FirstList(FirstEnd,2)
|
||||
s = 0
|
||||
For i = FirstStart To FirstEnd
|
||||
FirstList(i,0) = SecList(s,0)
|
||||
FirstList(i,1) = SecList(s,1)
|
||||
sLocExtension = lcase(FirstList(i,1))
|
||||
Select Case sLocExtension
|
||||
Case "sdw", "sdc", "sda", "sdd", "smf", "sgl", "doc", "docx", "docm", "xls", "xlsx", "xlsm", "ppt", "pps", "pptx", "pptm", "ppsx", "ppsm", "pub", "sxi", "sxw", "sxd", "sxg", "sxm", "sxc"
|
||||
AbsDocuFound = AbsDocuFound + 1
|
||||
Case else
|
||||
AbsTemplateFound = AbsTemplateFound + 1
|
||||
End Select
|
||||
FirstList(i,2) = CStr(NewContentList(s))
|
||||
s = s + 1
|
||||
Next i
|
||||
SetProgressDisplay(Ubound(FirstList()) + 1)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function GetTargetTemplatePath(Index as Integer)
|
||||
Select Case WizardMode
|
||||
Case SBMICROSOFTMODE
|
||||
GetTargetTemplatePath() = SOTemplatePath & "/" & sTemplateGroupName
|
||||
End Select
|
||||
End Function
|
||||
|
||||
|
||||
' Retrieves the second value for a next to 'SearchString' in
|
||||
' a two-dimensional string-Array
|
||||
Function GetFilterName(sMimetypeorExtension as String, sFilterName(), sExtension as string, FilterIndex as Integer) as String
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim sLocFilterlist() as String
|
||||
For i = 0 To Ubound(sFiltername(),1)
|
||||
If Instr(1,sFilterName(i,0),sMimeTypeOrExtension) <> 0 Then
|
||||
sLocFilterList() = ArrayoutofString(sFiltername(i,0),"|", MaxIndex)
|
||||
If MaxIndex = 0 Then
|
||||
sExtension = sFiltername(i,2)
|
||||
GetFilterName = sFilterName(i,1)
|
||||
Else
|
||||
Dim b as Integer
|
||||
Dim sLocExtensionList() as String
|
||||
b = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
|
||||
sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex)
|
||||
GetFilterName = sLocFilterList(b)
|
||||
sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex)
|
||||
sExtension = sLocExtensionList(b)
|
||||
End If
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
FilterIndex = i
|
||||
End Function
|
||||
|
||||
|
||||
Function SearchArrayforPartString(SearchString as String, LocList()) as Integer
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
Dim StringList() as String
|
||||
For i = Lbound(LocList(),1) to Ubound(LocList(),1)
|
||||
StringList() = ArrayoutofString(LocList(i), "|")
|
||||
For a = 0 To Ubound(StringList())
|
||||
If (Instr(1, SearchString, StringList(a)) <> 0) Then
|
||||
SearchArrayForPartString() = i
|
||||
Exit Function
|
||||
End If
|
||||
Next a
|
||||
Next i
|
||||
SearchArrayForPartString() = -1
|
||||
End Function
|
||||
|
||||
|
||||
Sub CreateLogTable(ApplIndex as Integer, CurFileContent as String, sFilterName() as String)
|
||||
Dim oLogCursor as Object
|
||||
Dim oLogRows as Object
|
||||
Dim FilterIndex as Integer
|
||||
Dim sDocumentType as String
|
||||
Dim oTextCursor
|
||||
Dim oCell
|
||||
If Not bLogExists Then
|
||||
Exit Sub
|
||||
End If
|
||||
FilterIndex = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
|
||||
sDocumentType = sFiltername(FilterIndex,3)
|
||||
oLogCursor = oLogDocument.Text.createTextCursor()
|
||||
oLogCursor.GotoEnd(False)
|
||||
If Not bIsFirstLogTable Then
|
||||
oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
|
||||
Else
|
||||
bisFirstLogTable = False
|
||||
End If
|
||||
oLogCursor.HyperLinkURL = ""
|
||||
oLogCursor.HyperLinkName = ""
|
||||
oLogCursor.HyperLinkTarget = ""
|
||||
oLogCursor.ParaStyleName = "Heading 1"
|
||||
oLogCursor.setString(sDocumentType)
|
||||
oLogCursor.CollapsetoEnd()
|
||||
oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
|
||||
oLogTable = oLogDocument.CreateInstance("com.sun.star.text.TextTable")
|
||||
oLogTable.RepeatHeadline = true
|
||||
oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
|
||||
oTextCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor()
|
||||
oTextCursor.SetString(sSourceDocuments)
|
||||
oTextCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor()
|
||||
oTextCursor.SetString(sTargetDocuments)
|
||||
bInsertRow = False
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
|
||||
Dim aSize As New com.sun.star.awt.Size
|
||||
aSize.Width = iWidth
|
||||
aSize.Height = iHeight
|
||||
GetSize() = aSize
|
||||
End Function
|
||||
|
||||
|
||||
Sub InsertCommandButtonatViewCursor(oLocDocument, oLocCursor, TargetUrl as String, Optional aSize)
|
||||
Dim oDocument
|
||||
Dim oController
|
||||
Dim oCommandButton
|
||||
Dim oShape
|
||||
Dim oDrawPage
|
||||
Dim oCommandControl
|
||||
Dim oEvent
|
||||
Dim oCell
|
||||
oCommandButton = oLocDocument.createInstance("com.sun.star.form.component.CommandButton")
|
||||
oShape = oLocDocument.CreateInstance ("com.sun.star.drawing.ControlShape")
|
||||
If IsMissing(aSize) Then
|
||||
oShape.Size = GetSize(4000, 600)
|
||||
End If
|
||||
oCommandButton.Label = FileNameoutofPath(Targeturl)
|
||||
oCommandButton.TargetFrame = "_default"
|
||||
oCommandButton.ButtonType = com.sun.star.form.FormButtonType.URL
|
||||
oCommandbutton.DispatchUrlInternal = True
|
||||
oCommandButton.TargetURL = ConverttoUrl(TargetUrl)
|
||||
oShape.Control = oCommandbutton
|
||||
oLocCursor.Text.InsertTextContent(oLocCursor, oShape, True)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub CreateLogDocument(HiddenProperties())
|
||||
Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue
|
||||
Dim NoArgs()
|
||||
Dim i as Integer
|
||||
Dim bLogIsThere as Boolean
|
||||
If ImportDialog.chkLogfile.State = 1 Then
|
||||
i = 2
|
||||
OpenProperties(0).Name = "Hidden"
|
||||
OpenProperties(0).Value = True
|
||||
oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_default", 4, OpenProperties())
|
||||
SOWorkPath = RTrimStr(SOWorkPath,"/")
|
||||
sLogUrl = SOWorkPath & "/Logfile.odt"
|
||||
Do
|
||||
bLogIsThere = oUcb.Exists(sLogUrl)
|
||||
If bLogIsThere Then
|
||||
If i = 2 Then
|
||||
sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.odt", "/Logfile.odt")
|
||||
Else
|
||||
sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".odt", "/Logfile_" & cStr(i-1) & ".odt")
|
||||
End If
|
||||
i = i + 1
|
||||
End If
|
||||
Loop Until Not bLogIsThere
|
||||
bLogExists = True
|
||||
oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertTargetUrlToLogDocument(sTargetUrl as String, sComment as String)
|
||||
Dim oCell
|
||||
Dim oTextCursor
|
||||
Dim CurFilterTracingpath as String
|
||||
If (bLogExists) And (sTargetUrl <> "") Then
|
||||
If sTargetUrl <> "" Then
|
||||
oCell = oLogTable.GetCellbyPosition(1,oLogTable.Rows.Count-1)
|
||||
InsertCommentToLogCell(sComment, oCell)
|
||||
InsertHyperLinkToLogCell(sTargetUrl, oCell)
|
||||
oLogDocument.Store()
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertSourceUrlToLogDocument(SourceUrl as String, sComment) '
|
||||
Dim oCell as Object
|
||||
If bLogExists Then
|
||||
If bInsertRow Then
|
||||
oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
|
||||
Else
|
||||
bInsertRow = True
|
||||
End If
|
||||
oCell = oLogTable.GetCellbyPosition(0,oLogTable.Rows.Count-1)
|
||||
InsertCommentToLogCell(sComment, oCell)
|
||||
InsertHyperLinkToLogCell(SourceUrl, oCell)
|
||||
oLogDocument.Store()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertHyperLinkToLogCell(sUrl as String, oCell as Object)
|
||||
Dim oLogCursor as Object
|
||||
Dim LocFileName as String
|
||||
oLogCursor = oCell.createTextCursor()
|
||||
oLogCursor.CollapseToStart()
|
||||
oLogCursor.HyperLinkURL = sUrl
|
||||
oLogCursor.HyperLinkName = sUrl
|
||||
oLogCursor.HyperLinkTarget = sUrl
|
||||
LocFileName = FileNameOutOfPath(sUrl)
|
||||
oCell.InsertString(oLogCursor, LocFileName,False)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub InsertCommentToLogCell(sComment as string, oCell as Object)
|
||||
Dim oCommentCursor as Object
|
||||
If sComment <> "" Then
|
||||
oCommentCursor = oCell.createTextCursor()
|
||||
oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
|
||||
oCell.insertString(oCommentCursor, sComment, false)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub AddLogStatistics()
|
||||
Dim oCell as Object
|
||||
Dim oLogCursor as Object
|
||||
Dim MaxRowIndex as Integer
|
||||
If bLogExists Then
|
||||
MaxRowIndex = oLogTable.Rows.Count
|
||||
sLogSummary = ReplaceString(sLogSummary, FileCount, "<COUNT>")
|
||||
' oLogTable.Rows.InsertByIndex(MaxRowIndex, 1)
|
||||
' oCell = oLogTable.GetCellbyPosition(0, MaxRowIndex)
|
||||
' oLogCursor = oCell.createTextCursor()
|
||||
' oCell.InsertString(oLogCursor, sLogSummary,False)
|
||||
' MergeRange(oLogTable, oCell, 1)
|
||||
|
||||
oLogCursor = oLogDocument.Text.CreateTextCursor
|
||||
oLogCursor.gotoEnd(False)
|
||||
oLogCursor.HyperLinkURL = ""
|
||||
oLogCursor.HyperLinkName = ""
|
||||
oLogCursor.HyperLinkTarget = ""
|
||||
oLogCursor.SetString(sLogSummary)
|
||||
oLogDocument.Store()
|
||||
oLogDocument.Dispose()
|
||||
bLogExists = False
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Function CheckIfMacroExists(oBasicLibraries as Object, sComment as String) as Boolean
|
||||
Dim ModuleNames() as String
|
||||
Dim ModuleName as String
|
||||
Dim MaxLibIndex as Integer
|
||||
Dim MaxModuleIndex as Integer
|
||||
Dim bMacroExists as Boolean
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim LibName as String
|
||||
Dim sBasicCode as String
|
||||
Dim oLibrary as Object
|
||||
bMacroExists = False
|
||||
bMacroExists = oBasicLibraries.hasElements
|
||||
If bMacroExists Then
|
||||
MaxLibIndex = Ubound(oBasicLibraries.ElementNames())
|
||||
For n = 0 To MaxLibIndex
|
||||
LibName = oBasicLibraries.ElementNames(n)
|
||||
If oBasicLibraries.isLibraryLoaded(LibName) Then
|
||||
oLibrary = oBasicLibraries.getbyName(LibName)
|
||||
If oLibrary.hasElements() Then
|
||||
MaxModuleIndex = Ubound(oLibrary.ElementNames())
|
||||
For m = 0 To MaxModuleIndex
|
||||
ModuleName = oLibrary.ElementNames(m)
|
||||
sBasicCode = oLibrary.getbyName(ModuleName)
|
||||
If sBasicCode <> "" Then
|
||||
ConcatComment(sComment, sReeditMacro)
|
||||
CheckIfMacroExists() = True
|
||||
Exit Function
|
||||
End If
|
||||
Next m
|
||||
End If
|
||||
End If
|
||||
Next n
|
||||
End If
|
||||
CheckIfMacroExists() = False
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function CheckPassWordProtection(oDocument as Object)
|
||||
Dim bIsPassWordProtected as Boolean
|
||||
Dim i as Integer
|
||||
Dim oArgs()
|
||||
Dim MaxIndex as Integer
|
||||
Dim sblabla as String
|
||||
bIsPassWordProtected = false
|
||||
oArgs() = oDocument.getArgs()
|
||||
MaxIndex = Ubound(oArgs())
|
||||
For i = 0 To MaxIndex
|
||||
sblabla = oArgs(i).Name
|
||||
If oArgs(i).Name = "Password" Then
|
||||
bIsPassWordProtected = True
|
||||
sCurPassWord = oArgs(i).Value
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
CheckPassWordProtection() = bIsPassWordProtected
|
||||
End Function
|
||||
|
||||
|
||||
Sub OpenLogDocument()
|
||||
|
||||
bShowLogFile = True
|
||||
ImportDialogArea.endexecute()
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MergeRange(oTable as Object, oCell as Object, MergeCount as Integer)
|
||||
Dim oTableCursor as Object
|
||||
oTableCursor = oTable.createCursorByCellName(oCell.CellName)
|
||||
oTableCursor.goRight(MergeCount, True)
|
||||
oTableCursor.mergeRange()
|
||||
End Sub
|
||||
|
||||
|
||||
Function ConcatComment(sComment as String, AdditionalComment as String)
|
||||
If sComment = "" Then
|
||||
sComment = AdditionalComment
|
||||
Else
|
||||
sComment = sComment & chr(13) + AdditionalComment
|
||||
End If
|
||||
ConcatComment = sComment
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,97 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="ImportDialog" dlg:left="96" dlg:top="28" dlg:width="270" dlg:height="210" dlg:page="4" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_DIALOG" dlg:closeable="true" dlg:moveable="true" dlg:title="ImportDialog">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblTemplateExport" dlg:tab-index="0" dlg:left="12" dlg:top="94" dlg:width="60" dlg:height="8" dlg:page="2" dlg:value="lblTemplateExport"/>
|
||||
<dlg:textfield dlg:id="txtTemplateImportPath" dlg:tab-index="1" dlg:left="73" dlg:top="76" dlg:width="170" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_LBTEMPLATEPATH">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleNextButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:textfield>
|
||||
<dlg:textfield dlg:id="txtTemplateExportPath" dlg:tab-index="2" dlg:left="73" dlg:top="92" dlg:width="170" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_EDTEMPLATEPATH"/>
|
||||
<dlg:checkbox dlg:id="chkDocumentPath" dlg:tab-index="3" dlg:left="12" dlg:top="121" dlg:width="240" dlg:height="10" dlg:page="2" dlg:tag="Document" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CBDOCUMENT" dlg:value="chkDocumentPath" dlg:checked="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.ToggleInputPaths?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:checkbox dlg:id="chkDocumentSearchSubDir" dlg:tab-index="4" dlg:left="12" dlg:top="134" dlg:width="240" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CBDOCUMENTRECURSE" dlg:value="chkDocumentSearchSubDir" dlg:checked="false"/>
|
||||
<dlg:text dlg:id="lblDocumentImport" dlg:tab-index="5" dlg:left="10" dlg:top="151" dlg:width="60" dlg:height="8" dlg:page="2" dlg:value="lblDocumentImport"/>
|
||||
<dlg:text dlg:id="lblDocumentExport" dlg:tab-index="6" dlg:left="10" dlg:top="167" dlg:width="60" dlg:height="8" dlg:page="2" dlg:value="lblDocumentExport"/>
|
||||
<dlg:textfield dlg:id="txtDocumentImportPath" dlg:tab-index="7" dlg:left="73" dlg:top="149" dlg:width="170" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_LBDOCUMENTPATH">
|
||||
<script:event script:event-name="on-textchange" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleNextButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:textfield>
|
||||
<dlg:textfield dlg:id="txtDocumentExportPath" dlg:tab-index="8" dlg:left="73" dlg:top="165" dlg:width="170" dlg:height="12" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_EDDOCUMENTPATH"/>
|
||||
<dlg:text dlg:id="SummaryHeaderLabel" dlg:tab-index="9" dlg:left="6" dlg:top="37" dlg:width="258" dlg:height="8" dlg:page="3" dlg:value="SummaryHeaderLabel"/>
|
||||
<dlg:textfield dlg:id="SummaryTextbox" dlg:tab-index="10" dlg:left="5" dlg:top="48" dlg:width="259" dlg:height="125" dlg:page="3" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_3_TBSUMMARY" dlg:vscroll="true" dlg:multiline="true" dlg:readonly="true"/>
|
||||
<dlg:text dlg:id="LabelRetrieval" dlg:tab-index="11" dlg:left="10" dlg:top="67" dlg:width="255" dlg:height="8" dlg:page="4" dlg:value="LabelRetrieval"/>
|
||||
<dlg:text dlg:id="LabelCurTemplateRetrieval" dlg:tab-index="12" dlg:left="15" dlg:top="79" dlg:width="249" dlg:height="8" dlg:page="4" dlg:value="LabelCurTemplateRetrieval"/>
|
||||
<dlg:text dlg:id="LabelCurDocumentRetrieval" dlg:tab-index="13" dlg:left="15" dlg:top="91" dlg:width="249" dlg:height="8" dlg:page="4" dlg:value="LabelCurDocumentRetrieval"/>
|
||||
<dlg:text dlg:id="LabelCurProgress" dlg:tab-index="14" dlg:left="10" dlg:top="106" dlg:width="255" dlg:height="8" dlg:page="4" dlg:value="LabelCurProgress"/>
|
||||
<dlg:text dlg:id="LabelCurDocument" dlg:tab-index="15" dlg:left="15" dlg:top="118" dlg:width="249" dlg:height="20" dlg:page="4" dlg:value="LabelCurDocument" dlg:multiline="true"/>
|
||||
<dlg:img dlg:id="ImportPreview" dlg:tab-index="16" dlg:left="6" dlg:top="6" dlg:width="258" dlg:height="26" dlg:scale-image="false"/>
|
||||
<dlg:button dlg:id="cmdBack" dlg:tab-index="17" dlg:left="155" dlg:top="190" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_0_CMDPREV" dlg:value="cmdBack">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.Main.PrevStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="18" dlg:left="6" dlg:top="190" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_0_CMDCANCEL" dlg:value="cmdCancel">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.Main.CancelTask?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdHelp" dlg:tab-index="19" dlg:left="65" dlg:top="190" dlg:width="50" dlg:height="14" dlg:value="cmdHelp" dlg:button-type="help"/>
|
||||
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="20" dlg:left="214" dlg:top="190" dlg:width="50" dlg:height="14" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_0_CMDNEXT" dlg:value="cmdGoOn">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.Main.NextStep?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:text dlg:id="WelcomeTextLabel" dlg:tab-index="21" dlg:left="6" dlg:top="38" dlg:width="258" dlg:height="20" dlg:page="1" dlg:value="WelcomeTextLabel" dlg:multiline="true"/>
|
||||
<dlg:text dlg:id="WelcomeTextLabel3" dlg:tab-index="22" dlg:left="6" dlg:top="58" dlg:width="258" dlg:height="12" dlg:page="1" dlg:value="WelcomeTextLabel3"/>
|
||||
<dlg:button dlg:id="cmdTemplateImport" dlg:tab-index="23" dlg:left="248" dlg:top="75" dlg:width="14" dlg:height="14" dlg:page="2" dlg:tag="txtTemplateImportPath" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CMDTEMPLATEPATHSELECT" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.TakoverFolderName?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdTemplateExport" dlg:tab-index="24" dlg:left="248" dlg:top="91" dlg:width="14" dlg:height="14" dlg:page="2" dlg:tag="txtTemplateExportPath" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CMDTEMPLATEPATHSELECT2" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.TakoverFolderName?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdDocumentImport" dlg:tab-index="25" dlg:left="248" dlg:top="148" dlg:width="14" dlg:height="14" dlg:page="2" dlg:tag="txtDocumentImportPath" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CMDDOCUMENTPATHSELECT" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.TakoverFolderName?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdDocumentExport" dlg:tab-index="26" dlg:left="248" dlg:top="164" dlg:width="14" dlg:height="14" dlg:page="2" dlg:tag="txtDocumentExportPath" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CMDDOCUMENTPATHSELECT2" dlg:value="...">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.TakoverFolderName?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:radiogroup>
|
||||
<dlg:radio dlg:id="optMSDocuments" dlg:tab-index="27" dlg:left="6" dlg:top="72" dlg:width="258" dlg:height="9" dlg:page="1" dlg:tag="MS" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_0_OPTMSDOCUMENTS" dlg:value="optMSDocuments" dlg:checked="true">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleCheckboxes?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:radio>
|
||||
</dlg:radiogroup>
|
||||
<dlg:checkbox dlg:id="chkMSApplication1" dlg:tab-index="29" dlg:disabled="true" dlg:left="12" dlg:top="85" dlg:width="141" dlg:height="9" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CHKWORD" dlg:value="chkMSApplication1" dlg:checked="false">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleNextButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:checkbox dlg:id="chkMSApplication2" dlg:tab-index="30" dlg:disabled="true" dlg:left="155" dlg:top="85" dlg:width="109" dlg:height="9" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CHKEXCEL" dlg:value="chkMSApplication2" dlg:checked="false">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleNextButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:checkbox dlg:id="chkMSApplication3" dlg:tab-index="31" dlg:disabled="true" dlg:left="12" dlg:top="98" dlg:width="141" dlg:height="9" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CHKPOWERPOINT" dlg:value="chkMSApplication3" dlg:checked="false">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:ImportWizard.Main.ToggleNextButton?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:checkbox dlg:id="chkTemplatePath" dlg:tab-index="36" dlg:left="12" dlg:top="48" dlg:width="240" dlg:height="10" dlg:page="2" dlg:tag="Template" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CBTEMPLATE" dlg:value="chkTemplatePath" dlg:checked="true">
|
||||
<script:event script:event-name="on-itemstatechange" script:macro-name="vnd.sun.star.script:ImportWizard.DialogModul.ToggleInputPaths?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:checkbox>
|
||||
<dlg:checkbox dlg:id="chkTemplateSearchSubDir" dlg:tab-index="37" dlg:left="12" dlg:top="61" dlg:width="240" dlg:height="10" dlg:page="2" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_2_CBTEMPLATERECURSE" dlg:value="chkTemplateSearchSubDir" dlg:checked="false"/>
|
||||
<dlg:text dlg:id="lblTemplateImport" dlg:tab-index="38" dlg:left="12" dlg:top="78" dlg:width="60" dlg:height="8" dlg:page="2" dlg:value="lblTemplateImport"/>
|
||||
<dlg:checkbox dlg:id="chkLogfile" dlg:tab-index="39" dlg:left="6" dlg:top="171" dlg:width="136" dlg:height="9" dlg:page="1" dlg:help-url="HID:WIZARDS_HID_DLGIMPORT_0_CHKLOGFILE" dlg:value="chkLogfile" dlg:checked="true"/>
|
||||
<dlg:fixedline dlg:id="hlnTemplates" dlg:tab-index="40" dlg:left="6" dlg:top="37" dlg:width="258" dlg:height="8" dlg:page="2" dlg:value="hlnTemplates"/>
|
||||
<dlg:fixedline dlg:id="hlnDocuments" dlg:tab-index="41" dlg:left="6" dlg:top="110" dlg:width="258" dlg:height="8" dlg:page="2" dlg:value="hlnDocuments"/>
|
||||
<dlg:fixedline dlg:id="FixedLine1" dlg:tab-index="42" dlg:left="6" dlg:top="181" dlg:width="258" dlg:height="6"/>
|
||||
<dlg:fixedline dlg:id="hlnProgress" dlg:tab-index="43" dlg:left="6" dlg:top="55" dlg:width="258" dlg:height="8" dlg:page="4" dlg:value="hlnProgress"/>
|
||||
<dlg:button dlg:id="cmdShowLogFile" dlg:tab-index="44" dlg:disabled="true" dlg:left="75" dlg:top="142" dlg:width="120" dlg:height="14" dlg:page="4" dlg:value="cmdShowLogFile">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:ImportWizard.FilesModul.OpenLogDocument?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
@@ -0,0 +1,150 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public sMSTemplateCheckbox(2) As String
|
||||
Public sMSDocumentCheckbox(2) As String
|
||||
Public sTemplateCheckbox(SBMAXAPPLCOUNT-1) As String
|
||||
Public sDocumentCheckbox(SBMAXAPPLCOUNT-1) As String
|
||||
Public sTemplateGroupName As String
|
||||
Public sSearchInSubDir as String
|
||||
Public sPathErrorTemplates(SBMAXAPPLCOUNT-1) As String
|
||||
Public sPathErrorDocument(SBMAXAPPLCOUNT-1) As String
|
||||
Public sPathErrorStarDoc(SBMAXAPPLCOUNT-1) As String
|
||||
Public sStarDocLabel(SBMAXAPPLCOUNT-1) As String
|
||||
Public sImportLabel As String, sExportLabel As String
|
||||
Public SOApplicationName(5) As String
|
||||
Public sHelpButton As String, sCancelButton As String, sBackButton As String, sNextButton As String
|
||||
Public sSumInclusiveSubDir As String, sSumSaveDocuments As String
|
||||
Public sSummaryHeader As String
|
||||
Public sWelcometextLabel1 As String, sWelcometextLabel3 As String
|
||||
Public sBeginButton As String, sMsgDirNotThere As String
|
||||
Public sQueryForNewCreation As String, sPathError3 As String
|
||||
Public sNoDirCreation As String
|
||||
Public sProgressMoreDocs As String, sProgressMoreTemplates as String
|
||||
Public sFileExists As String, sMorePathsError3 As String
|
||||
Public sConvertError1 As String, sConvertError2 As String, sPathDialogMessage As String
|
||||
Public sRTErrorDesc As String, sRTErrorHeader As String
|
||||
Public sProgressPage_1 As String, sProgressPage_2 As String, sProgressPage_3 as String
|
||||
Public sProgressFound as String, sProgresspage_5 as String
|
||||
Public sContainerName(1) as String
|
||||
Public sReady as String, sTitle as String
|
||||
Public sCloseButton as String
|
||||
Public sSourceDocuments as String
|
||||
Public sTargetDocuments as String
|
||||
Public sSumMSDocuments(3) as String
|
||||
Public sSumMSTemplates(3) as String
|
||||
Public ModuleList(3) as String
|
||||
Public sLogSummary as String
|
||||
Public sReeditMacro as String
|
||||
Public sOverwriteallFiles as String
|
||||
Public sCouldnotopenDocument as String
|
||||
Public sCurcouldnotopenDocument as String
|
||||
Public sCouldnotsaveDocument as String
|
||||
Public sCurcouldnotsaveDocument as String
|
||||
|
||||
|
||||
Sub LoadLanguage()
|
||||
If InitResources("ImportWizard") then
|
||||
sHelpButton = GetResText("HelpButton")
|
||||
sCancelButton = GetResText("CancelButton")
|
||||
sBackButton = GetResText("BackButton")
|
||||
sNextButton = GetResText("NextButton")
|
||||
sBeginButton = GetResText("BeginButton")
|
||||
sCloseButton = GetResText("CloseButton")
|
||||
|
||||
sWelcometextLabel1 = ReplaceString(GetResText("WelcometextLabel1"), GetProductName(),"%PRODUCTNAME")
|
||||
sWelcometextLabel3 = GetResText("WelcometextLabel3")
|
||||
|
||||
' Microsoft Documents
|
||||
sMSTemplateCheckBox(0) = GetResText("MSTemplateCheckbox_1_")
|
||||
sMSTemplateCheckBox(1) = GetResText("MSTemplateCheckbox_2_")
|
||||
sMSTemplateCheckBox(2) = GetResText("MSTemplateCheckbox_3_")
|
||||
|
||||
' DocumentCheckbox- Captions
|
||||
sMSDocumentCheckBox(0) = GetResText("MSDocumentCheckbox_1_")
|
||||
sMSDocumentCheckBox(1) = GetResText("MSDocumentCheckbox_2_")
|
||||
sMSDocumentCheckBox(2) = GetResText("MSDocumentCheckbox_3_")
|
||||
|
||||
'StarOffice Applicationnames
|
||||
|
||||
sContainerName(0) = GetResText("MSContainerName")
|
||||
|
||||
sSummaryHeader = GetResText("SummaryHeader")
|
||||
|
||||
sTemplateGroupName = GetResText("GroupnameDefault")
|
||||
|
||||
sProgressMoreDocs = GetResText("ProgressMoreDocs")
|
||||
sProgressMoreTemplates = GetResText("ProgressMoreTemplates")
|
||||
sNoDirCreation = GetResText("NoDirCreation")
|
||||
sMsgDirNotThere = GetResText("MsgDirNotThere")
|
||||
sQueryForNewCreation = GetResText("QueryfornewCreation")
|
||||
sFileExists = GetResText("FileExists")
|
||||
sMorePathsError3 = GetResText("MorePathsError3")
|
||||
sConvertError1 = GetResText("ConvertError1")
|
||||
sConvertError2 = GetResText("ConvertError2")
|
||||
sRTErrorDesc = GetResText("RTErrorDesc")
|
||||
sRTErrorHeader = GetResText("RTErrorHeader")
|
||||
sOverwriteallFiles = GetResText("OverwriteallFiles")
|
||||
sReeditMacro = GetResText("ReeditMacro")
|
||||
sCouldnotsaveDocument = GetResText("CouldNotsaveDocument")
|
||||
sCouldnotopenDocument = GetResText("CouldNotopenDocument")
|
||||
sPathDialogMessage = GetResText("PathDialogMessage")
|
||||
sTitle = GetResText("DialogTitle")
|
||||
|
||||
sProgressPage_1 = GetResText("ProgressPage1")
|
||||
sProgressPage_2 = GetResText("ProgressPage2")
|
||||
sProgressPage_3 = GetResText("ProgressPage3")
|
||||
sProgressFound = GetResText("ProgressFound")
|
||||
sProgressPage_5 = GetResText("ProgressPage5")
|
||||
sReady = GetResText("Ready")
|
||||
sSourceDocuments = GetResText("SourceDocuments")
|
||||
sTargetDocuments = GetResText("TargetDocuments")
|
||||
sLogSummary = GetResText("LogfileSummary")
|
||||
sSumInclusiveSubDir = GetResText("SumInclusiveSubDir")
|
||||
sSumSaveDocuments = GetResText("SumSaveDokumente")
|
||||
sSumMSDocuments(0) = GetResText("SumMSTextDocuments")
|
||||
sSumMSDocuments(1) = GetResText("SumMSTableDocuments")
|
||||
sSumMSDocuments(2) = GetResText("SumMSDrawDocuments")
|
||||
sSumMSTemplates(0) = GetResText("SumMSTextTemplates")
|
||||
sSumMSTemplates(1) = GetResText("SumMSTableTemplates")
|
||||
sSumMSTemplates(2) = GetResText("SumMSDrawTemplates")
|
||||
With ImportDialog
|
||||
sImportLabel = GetResText("TextImportLabel")
|
||||
sExportLabel = GetResText("TextExportLabel")
|
||||
sSearchInSubDir = GetResText("SearchInSubDir")
|
||||
.chkTemplateSearchSubDir.Label = sSearchInSubDir
|
||||
.lblDocumentImport.Label = sImportLabel
|
||||
.lblDocumentExport.Label = sExportLabel
|
||||
.chkDocumentSearchSubDir.Label = sSearchInSubDir
|
||||
.lblTemplateImport.Label = sImportLabel
|
||||
.lblTemplateExport.Label = sExportLabel
|
||||
.chkLogfile.Label = GetResText("CreateLogfile")
|
||||
.chkLogfile.Helptext = GetResText("LogfileHelpText")
|
||||
.cmdShowLogFile.Label = GetResText("ShowLogfile")
|
||||
End With
|
||||
ModuleList(0) = "com.sun.star.text.TextDocument"
|
||||
ModuleList(1) = "com.sun.star.sheet.SpreadsheetDocument"
|
||||
ModuleList(2) = "com.sun.star.drawing.DrawingDocument/com.sun.star.presentation.PresentationDocument"
|
||||
ModuleList(3) = "com.sun.star.formula.FormulaProperties/com.sun.star.text.GlobalDocument"
|
||||
End If
|
||||
End Sub
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,291 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--
|
||||
* This file is part of the LibreOffice project.
|
||||
*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public
|
||||
* License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*
|
||||
* This file incorporates work covered by the following license notice:
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one or more
|
||||
* contributor license agreements. See the NOTICE file distributed
|
||||
* with this work for additional information regarding copyright
|
||||
* ownership. The ASF licenses this file to you under the Apache
|
||||
* License, Version 2.0 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
|
||||
-->
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Main" script:language="StarBasic">Option Explicit
|
||||
REM ***** BASIC *****
|
||||
|
||||
Public HeaderPreviews(4) as Object
|
||||
Public ImportDialog as Object
|
||||
Public ImportDialogArea as Object
|
||||
Public oFactoryKey as Object
|
||||
Public bShowLogFile as Boolean
|
||||
|
||||
' If the ProgressPage is already on Top The Dialog will be immediately closed when this flag is
|
||||
' set to False
|
||||
Public bConversionIsRunning as Boolean
|
||||
Public RetValue as Integer
|
||||
|
||||
Sub Main()
|
||||
Dim NoArgs() as New com.sun.star.beans.PropertyValue
|
||||
bShowLogFile=FALSE
|
||||
If Not bDebugWizard Then
|
||||
On Local Error Goto RTError
|
||||
End If
|
||||
BasicLibraries.LoadLibrary("Tools")
|
||||
RetValue = 10
|
||||
bIsFirstLogTable = True
|
||||
bConversionIsRunning = False
|
||||
sCRLF = CHR(13) & CHR(10)
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
oFactoryKey = GetRegistryKeyContent("org.openoffice.Setup/Office/Factories")
|
||||
If GetImportWizardPaths() = False Then
|
||||
Exit Sub
|
||||
End If
|
||||
bCancelTask = False
|
||||
bDoKeepApplValues = False
|
||||
CurOffice = 0
|
||||
ImportDialogArea = LoadDialog("ImportWizard","ImportDialog")
|
||||
ImportDialog = ImportDialogArea.Model
|
||||
LoadLanguage()
|
||||
WizardMode = SBMICROSOFTMODE
|
||||
MaxApplCount = 3
|
||||
FillStep_Welcome()
|
||||
RepaintHeaderPreview()
|
||||
ImportDialog.ImportPreview.BackGroundColor = RGB(0,60,126)
|
||||
ImportDialog.cmdGoOn.DefaultButton = True
|
||||
ImportDialogArea.GetControl("optMSDocuments").SetFocus()
|
||||
ToggleCheckboxesWithBoolean(True)
|
||||
|
||||
RetValue = ImportDialogArea.Execute()
|
||||
If bShowLogFile=TRUE Then
|
||||
OpenDocument(sLogUrl, NoArgs())
|
||||
End if
|
||||
If RetValue = 0 Then
|
||||
CancelTask()
|
||||
End If
|
||||
ImportDialogArea.Dispose()
|
||||
End
|
||||
Exit Sub
|
||||
RTError:
|
||||
Msgbox sRTErrorDesc, 16, sRTErrorHeader
|
||||
End Sub
|
||||
|
||||
|
||||
Sub NextStep()
|
||||
Dim iCurStep as Integer
|
||||
If Not bDebugWizard Then
|
||||
On Error Goto RTError
|
||||
End If
|
||||
bConversionIsRunning = False
|
||||
iCurStep = ImportDialog.Step
|
||||
Select Case iCurStep
|
||||
Case 1
|
||||
FillStep_InputPaths(0, True)
|
||||
Case 2
|
||||
If CheckInputPaths Then
|
||||
SaveStep_InputPath
|
||||
If CurOffice < ApplCount - 1 Then
|
||||
CurOffice = CurOffice + 1
|
||||
TakeOverPathSettings()
|
||||
FillStep_InputPaths(CurOffice, False)
|
||||
Else
|
||||
FillStep_Summary()
|
||||
End If
|
||||
End If
|
||||
Case 3
|
||||
FillStep_Progress()
|
||||
Select Case WizardMode
|
||||
Case SBMICROSOFTMODE
|
||||
Call ConvertAllDocuments(MSFilterName())
|
||||
End Select
|
||||
Case 4
|
||||
CancelTask(True)
|
||||
End Select
|
||||
|
||||
If ((ImportDialog.chkLogfile.State <> 1) OR (iCurStep <> 3)) Then
|
||||
ImportDialog.cmdGoOn.DefaultButton = True
|
||||
End If
|
||||
|
||||
RepaintHeaderPreview()
|
||||
Exit Sub
|
||||
RTError:
|
||||
Msgbox sRTErrorDesc, 16, sRTErrorHeader
|
||||
End Sub
|
||||
|
||||
|
||||
Sub PrevStep()
|
||||
Dim iCurStep as Integer
|
||||
If Not bDebugWizard Then
|
||||
On Error Goto RTError
|
||||
End If
|
||||
bConversionIsRunning = False
|
||||
iCurStep = ImportDialog.Step
|
||||
Select Case iCurStep
|
||||
Case 4
|
||||
ImportDialog.cmdCancel.Label = sCancelButton
|
||||
FillStep_Summary()
|
||||
Case 3
|
||||
FillStep_InputPaths(Applcount-1, False)
|
||||
Case 2
|
||||
SaveStep_InputPath
|
||||
If CurOffice > 0 Then
|
||||
CurOffice = CurOffice - 1
|
||||
FillStep_InputPaths(CurOffice, False)
|
||||
Else
|
||||
FillStep_Welcome()
|
||||
ToggleCheckboxesWithBoolean(True)
|
||||
bDoKeepApplValues = True
|
||||
End If
|
||||
End Select
|
||||
ImportDialog.cmdGoOn.DefaultButton = True
|
||||
RepaintHeaderPreview()
|
||||
Exit Sub
|
||||
RTError:
|
||||
Msgbox sRTErrorDesc, 16, sRTErrorHeader
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CancelTask()
|
||||
If bConversionIsRunning Then
|
||||
If Msgbox(sConvertError1, 36, sConvertError2) = 6 Then
|
||||
bCancelTask = True
|
||||
bInterruptSearch = True
|
||||
Else
|
||||
bCancelTask = False
|
||||
ImportDialog.cmdCancel.Enabled = True
|
||||
End If
|
||||
Else
|
||||
ImportDialogArea.EndExecute()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub TemplateDirSearchDialog()
|
||||
CallDirSearchDialog(ImportDialog.TemplateImportPath)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RepaintHeaderPreview()
|
||||
Dim Bitmap As Object
|
||||
Dim CurStep as Integer
|
||||
Dim sBitmapPath as String
|
||||
Dim LocPrefix as String
|
||||
CurStep = ImportDialog.Step
|
||||
LocPrefix = WizardMode
|
||||
LocPrefix = ReplaceString(LocPrefix,"XML", "SO")
|
||||
If CurStep = 2 Then
|
||||
sBitmapPath = SOBitmapPath & LocPrefix & "-Import_" & CurStep & "-" & Applications(CurOffice,SBAPPLKEY) + 1 & ".png"
|
||||
Else
|
||||
sBitmapPath = SOBitmapPath & "Import_" & CurStep & ".png"
|
||||
End If
|
||||
ImportDialog.ImportPreview.ImageURL = sBitmapPath
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CheckModuleInstallation()
|
||||
Dim i as Integer
|
||||
For i = 1 To MaxApplCount
|
||||
ImportDialogArea.GetControl("chk" & WizardMode & "Application" & i).Model.Enabled = Abs(CheckInstalledModule(i-1))
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Function CheckInstalledModule(Index as Integer) as Boolean
|
||||
Dim ModuleName as String
|
||||
Dim NameList() as String
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
ModuleName = ModuleList(Index)
|
||||
If Instr(1,ModuleName,"/") <> 0 Then
|
||||
CheckInstalledModule() = False
|
||||
NameList() = ArrayoutOfString(ModuleName,"/", MaxIndex)
|
||||
For i = 0 To MaxIndex
|
||||
If oFactoryKey.HasByName(NameList(i)) Then
|
||||
CheckInstalledModule() = True
|
||||
End If
|
||||
Next i
|
||||
Else
|
||||
CheckInstalledModule() = oFactoryKey.HasByName(ModuleName)
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub ToggleCheckboxes(oEvent as Object)
|
||||
Dim bMSEnable as Boolean
|
||||
WizardMode = oEvent.Source.Model.Tag
|
||||
bMSEnable = WizardMode = "MS"
|
||||
ToggleCheckboxesWithBoolean(bMSEnable)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleCheckboxesWithBoolean(bMSEnable as Boolean)
|
||||
If bMSEnable = True Then
|
||||
WizardMode = SBMICROSOFTMODE
|
||||
MaxApplCount = 3
|
||||
Else
|
||||
'Not supposed to happen - is there an assert in BASIC...
|
||||
End If
|
||||
With ImportDialogArea
|
||||
.GetControl("chkMSApplication1").Model.Enabled = bMSEnable
|
||||
.GetControl("chkMSApplication2").Model.Enabled = bMSEnable
|
||||
.GetControl("chkMSApplication3").Model.Enabled = bMSEnable
|
||||
End With
|
||||
CheckModuleInstallation()
|
||||
bDoKeepApplValues = False
|
||||
ToggleNextButton()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleNextButton()
|
||||
Dim iCurStep as Integer
|
||||
Dim bDoEnable as Boolean
|
||||
Dim i as Integer
|
||||
iCurStep = ImportDialog.Step
|
||||
Select Case iCurStep
|
||||
Case 1
|
||||
With ImportDialog
|
||||
If .optMSDocuments.State = 1 Then
|
||||
bDoEnable = .chkMSApplication1.State = 1 Or .chkMSApplication2.State = 1 Or .chkMSApplication3.State = 1
|
||||
End If
|
||||
End With
|
||||
bDoKeepApplValues = False
|
||||
Case 2
|
||||
bDoEnable = CheckControlPath(ImportDialog.chkTemplatePath, ImportDialog.txtTemplateImportPath, True)
|
||||
bDoEnable = CheckControlPath(ImportDialog.chkDocumentPath, ImportDialog.txtDocumentImportPath, bDoEnable)
|
||||
End Select
|
||||
ImportDialog.cmdGoOn.Enabled = bDoEnable
|
||||
End Sub
|
||||
|
||||
|
||||
Sub TakeOverPathSettings()
|
||||
'Takes over the Pathsettings from the first selected application to the next applications
|
||||
If Applications(CurOffice,SBDOCSOURCE) = "" Then
|
||||
Applications(CurOffice,SBDOCSOURCE) = Applications(0,SBDOCSOURCE)
|
||||
Applications(CurOffice,SBDOCTARGET) = Applications(0,SBDOCTARGET)
|
||||
Applications(CurOffice,SBTEMPLSOURCE) = Applications(0,SBTEMPLSOURCE)
|
||||
Applications(CurOffice,SBTEMPLTARGET) = Applications(0,SBTEMPLTARGET)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetImportWizardPaths() as Boolean
|
||||
SOBitmapPath = GetOfficeSubPath("Template", "../wizard/bitmap")
|
||||
If SOBitmapPath <> "" Then
|
||||
SOWorkPath = GetPathSettings("Work", False)
|
||||
If SOWorkPath <> "" Then
|
||||
SOTemplatePath = GetPathSettings("Template_writable",False,0)
|
||||
If SOTemplatePath <> "" Then
|
||||
GetImportWizardPaths() = True
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
GetImportWizardPaths() = False
|
||||
End Function
|
||||
</script:module>
|
||||
@@ -0,0 +1,5 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="ImportWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="ImportDialog"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,9 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="ImportWizard" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="Main"/>
|
||||
<library:element library:name="DialogModul"/>
|
||||
<library:element library:name="Language"/>
|
||||
<library:element library:name="FilesModul"/>
|
||||
<library:element library:name="API"/>
|
||||
</library:library>
|
||||
@@ -0,0 +1,996 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Database" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
||||
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
||||
REM === The SFDatabases library is one of the associated libraries. ===
|
||||
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_Database
|
||||
''' ===========
|
||||
''' Management of databases embedded in or related to Base documents
|
||||
''' Each instance of the current class represents a single database, with essentially its tables, queries and data
|
||||
'''
|
||||
''' The exchanges with the database are done in SQL only.
|
||||
''' To make them more readable, use optionally square brackets to surround table/query/field names
|
||||
''' instead of the (RDBMS-dependent) normal surrounding character (usually, double-quote, single-quote or other).
|
||||
''' SQL statements may be run in direct or indirect mode. In direct mode the statement is transferred literally
|
||||
''' without syntax checking nor review to the database system.
|
||||
'''
|
||||
''' The provided interfaces include simple tables, queries and fields lists, and access to database metadata.
|
||||
'''
|
||||
''' Service invocation and usage:
|
||||
''' 1) To access any database at anytime
|
||||
''' Dim myDatabase As Object
|
||||
''' Set myDatabase = CreateScriptService("SFDatabases.Database", FileName, , [ReadOnly], [User, [Password]])
|
||||
''' ' Args:
|
||||
''' ' FileName: the name of the Base file compliant with the SF_FileSystem.FileNaming notation
|
||||
''' ' RegistrationName: the name of a registered database (mutually exclusive with FileName)
|
||||
''' ' ReadOnly: Default = True
|
||||
''' ' User, Password: additional connection arguments to the database server
|
||||
''' ' ... Run queries, SQL statements, ...
|
||||
''' myDatabase.CloseDatabase()
|
||||
'''
|
||||
''' 2) To access the database related to the current Base document
|
||||
''' Dim myDoc As Object, myDatabase As Object, ui As Object
|
||||
''' Set ui = CreateScriptService("UI")
|
||||
''' Set myDoc = ui.OpenBaseDocument("myDb.odb")
|
||||
''' Set myDatabase = myDoc.GetDatabase() ' user and password are supplied here, if needed
|
||||
''' ' ... Run queries, SQL statements, ...
|
||||
''' myDoc.CloseDocument()
|
||||
'''
|
||||
''' Detailed user documentation:
|
||||
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_database.html?DbPAR=BASIC
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
Private Const DBREADONLYERROR = "DBREADONLYERROR"
|
||||
Private Const SQLSYNTAXERROR = "SQLSYNTAXERROR"
|
||||
|
||||
REM ============================================================= PRIVATE MEMBERS
|
||||
|
||||
Private [Me] As Object
|
||||
Private [_Parent] As Object
|
||||
Private ObjectType As String ' Must be DATABASE
|
||||
Private ServiceName As String
|
||||
Private _DataSource As Object ' com.sun.star.comp.dba.ODatabaseSource
|
||||
Private _Connection As Object ' com.sun.star.sdbc.XConnection
|
||||
Private _URL As String ' Text on status bar
|
||||
Private _Location As String ' File name
|
||||
Private _ReadOnly As Boolean
|
||||
Private _MetaData As Object ' com.sun.star.sdbc.XDatabaseMetaData
|
||||
|
||||
REM ============================================================ MODULE CONSTANTS
|
||||
|
||||
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
Set [Me] = Nothing
|
||||
Set [_Parent] = Nothing
|
||||
ObjectType = "DATABASE"
|
||||
ServiceName = "SFDatabases.Database"
|
||||
Set _DataSource = Nothing
|
||||
Set _Connection = Nothing
|
||||
_URL = ""
|
||||
_Location = ""
|
||||
_ReadOnly = True
|
||||
Set _MetaData = Nothing
|
||||
End Sub ' SFDatabases.SF_Database Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
Call Class_Initialize()
|
||||
End Sub ' SFDatabases.SF_Database Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Dispose() As Variant
|
||||
Call Class_Terminate()
|
||||
Set Dispose = Nothing
|
||||
End Function ' SFDatabases.SF_Database Explicit Destructor
|
||||
|
||||
REM ================================================================== PROPERTIES
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get Queries() As Variant
|
||||
''' Return the list of available queries in the database
|
||||
Queries = _PropertyGet("Queries")
|
||||
End Property ' SFDatabases.SF_Database.Queries (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get Tables() As Variant
|
||||
''' Return the list of available Tables in the database
|
||||
Tables = _PropertyGet("Tables")
|
||||
End Property ' SFDatabases.SF_Database.Tables (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get XConnection() As Variant
|
||||
''' Return a com.sun.star.sdbc.XConnection UNO object
|
||||
XConnection = _PropertyGet("XConnection")
|
||||
End Property ' SFDatabases.SF_Database.XConnection (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get XMetaData() As Variant
|
||||
''' Return a com.sun.star.sdbc.XDatabaseMetaData UNO object
|
||||
XMetaData = _PropertyGet("XMetaData")
|
||||
End Property ' SFDatabases.SF_Database.XMetaData (get)
|
||||
|
||||
REM ===================================================================== METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub CloseDatabase()
|
||||
''' Close the current database connection
|
||||
|
||||
Const cstThisSub = "SFDatabases.Database.CloseDatabase"
|
||||
Const cstSubArgs = ""
|
||||
|
||||
On Local Error GoTo 0 ' Disable useless error checking
|
||||
|
||||
Check:
|
||||
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
|
||||
Try:
|
||||
With _Connection
|
||||
If Not IsNull(_Connection) Then
|
||||
If ScriptForge.SF_Session.HasUnoMethod(_Connection, "flush") Then .flush()
|
||||
.close()
|
||||
.dispose()
|
||||
End If
|
||||
Dispose()
|
||||
End With
|
||||
|
||||
Finally:
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Sub
|
||||
End Sub
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DAvg(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function AVG() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
|
||||
DAvg = _DFunction("Avg", Expression, TableName, Criteria)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DAvg
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DCount(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function COUNT() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
|
||||
DCount = _DFunction("Count", Expression, TableName, Criteria)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DCount
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DLookup(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
, Optional ByVal OrderClause As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function Lookup() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' To order the results, a pvOrderClause may be precised. The 1st record will be retained.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
''' pvOrderClause: an optional order clause incl. "DESC" if relevant
|
||||
|
||||
DLookup = _DFunction("Lookup", Expression, TableName, Criteria, OrderClause)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DLookup
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DMax(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function MAX() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
|
||||
DMax = _DFunction("Max", Expression, TableName, Criteria)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DMax
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DMin(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function MIN() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
|
||||
DMin = _DFunction("Min", Expression, TableName, Criteria)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DMin
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function DSum(Optional ByVal Expression As Variant _
|
||||
, Optional ByVal TableName As Variant _
|
||||
, Optional ByVal Criteria As Variant _
|
||||
) As Variant
|
||||
''' Compute the aggregate function Sum() on a field or expression belonging to a table
|
||||
''' filtered by a WHERE-clause.
|
||||
''' Args:
|
||||
''' Expression: an SQL expression
|
||||
''' TableName: the name of a table
|
||||
''' Criteria: an optional WHERE clause without the word WHERE
|
||||
|
||||
DSum = _DFunction("Sum", Expression, TableName, Criteria)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.DSum
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
||||
''' Return the actual value of the given property
|
||||
''' Args:
|
||||
''' PropertyName: the name of the property as a string
|
||||
''' Returns:
|
||||
''' The actual value of the property
|
||||
''' Exceptions:
|
||||
''' ARGUMENTERROR The property does not exist
|
||||
''' Examples:
|
||||
''' myDatabase.GetProperty("Queries")
|
||||
|
||||
Const cstThisSub = "SFDatabases.Database.GetProperty"
|
||||
Const cstSubArgs = ""
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
GetProperty = Null
|
||||
|
||||
Check:
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
||||
End If
|
||||
|
||||
Try:
|
||||
GetProperty = _PropertyGet(PropertyName)
|
||||
|
||||
Finally:
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database.GetProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function GetRows(Optional ByVal SQLCommand As Variant _
|
||||
, Optional ByVal DirectSQL As Variant _
|
||||
, Optional ByVal Header As Variant _
|
||||
, Optional ByVal MaxRows As Variant _
|
||||
) As Variant
|
||||
''' Return the content of a table, a query or a SELECT SQL statement as an array
|
||||
''' Args:
|
||||
''' SQLCommand: a table name, a query name or a SELECT SQL statement
|
||||
''' DirectSQL: when True, no syntax conversion is done by LO. Default = False
|
||||
''' Ignored when SQLCommand is a table or a query name
|
||||
''' Header: When True, a header row is inserted on the top of the array with the column names. Default = False
|
||||
''' MaxRows: The maximum number of returned rows. If absent, all records are returned
|
||||
''' Returns:
|
||||
''' a 2D array(row, column), even if only 1 column and/or 1 record
|
||||
''' an empty array if no records returned
|
||||
''' Example:
|
||||
''' Dim a As Variant
|
||||
''' a = myDatabase.GetRows("SELECT [First Name], [Last Name] FROM [Employees] ORDER BY [Last Name]", Header := True)
|
||||
|
||||
Dim vResult As Variant ' Return value
|
||||
Dim oResult As Object ' com.sun.star.sdbc.XResultSet
|
||||
Dim oQuery As Object ' com.sun.star.ucb.XContent
|
||||
Dim sSql As String ' SQL statement
|
||||
Dim bDirect ' Alias of DirectSQL
|
||||
Dim lCols As Long ' Number of columns
|
||||
Dim lRows As Long ' Number of rows
|
||||
Dim oColumns As Object
|
||||
Dim i As Long
|
||||
Const cstThisSub = "SFDatabases.Database.GetRows"
|
||||
Const cstSubArgs = "SQLCommand, [DirectSQL=False], [Header=False], [MaxRows=0]"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
vResult = Array()
|
||||
|
||||
Check:
|
||||
If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
|
||||
If IsMissing(Header) Or IsEmpty(Header) Then Header = False
|
||||
If IsMissing(MaxRows) Or IsEmpty(MaxRows) Then MaxRows = 0
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(Header, "Header", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(MaxRows, "MaxRows", ScriptForge.V_NUMERIC) Then GoTo Finally
|
||||
End If
|
||||
|
||||
Try:
|
||||
' Table, query of SQL ? Prepare resultset
|
||||
If ScriptForge.SF_Array.Contains(Tables, SQLCommand, CaseSensitive := True, SortOrder := "ASC") Then
|
||||
sSql = "SELECT * FROM [" & SQLCommand & "]"
|
||||
bDirect = True
|
||||
ElseIf ScriptForge.SF_Array.Contains(Queries, SQLCommand, CaseSensitive := True, SortOrder := "ASC") Then
|
||||
Set oQuery = _Connection.Queries.getByName(SQLCommand)
|
||||
sSql = oQuery.Command
|
||||
bDirect = Not oQuery.EscapeProcessing
|
||||
ElseIf ScriptForge.SF_String.StartsWith(SQLCommand, "SELECT", CaseSensitive := False) Then
|
||||
sSql = SQLCommand
|
||||
bDirect = DirectSQL
|
||||
Else
|
||||
GoTo Finally
|
||||
End If
|
||||
|
||||
' Execute command
|
||||
Set oResult = _ExecuteSql(sSql, bDirect)
|
||||
If IsNull(oResult) Then GoTo Finally
|
||||
|
||||
With oResult
|
||||
'Initialize output array with header row
|
||||
Set oColumns = oResult.getColumns()
|
||||
lCols = oColumns.Count - 1
|
||||
If Header Then
|
||||
lRows = 0
|
||||
ReDim vResult(0 To lRows, 0 To lCols)
|
||||
For i = 0 To lCols
|
||||
vResult(lRows, i) = oColumns.getByIndex(i).Name
|
||||
Next i
|
||||
If MaxRows > 0 Then MaxRows = MaxRows + 1
|
||||
Else
|
||||
lRows = -1
|
||||
End If
|
||||
|
||||
' Load data
|
||||
.first()
|
||||
Do While Not .isAfterLast() And (MaxRows = 0 Or lRows < MaxRows - 1)
|
||||
lRows = lRows + 1
|
||||
If lRows = 0 Then
|
||||
ReDim vResult(0 To lRows, 0 To lCols)
|
||||
Else
|
||||
ReDim Preserve vResult(0 To lRows, 0 To lCols)
|
||||
End If
|
||||
For i = 0 To lCols
|
||||
vResult(lRows, i) = _GetColumnValue(oResult, i + 1)
|
||||
Next i
|
||||
.next()
|
||||
Loop
|
||||
End With
|
||||
|
||||
Finally:
|
||||
GetRows = vResult
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database.GetRows
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Methods() As Variant
|
||||
''' Return the list of public methods of the Database service as an array
|
||||
|
||||
Methods = Array( _
|
||||
"CloseDatabase" _
|
||||
, "DAvg" _
|
||||
, "DCount" _
|
||||
, "DLookup" _
|
||||
, "DMax" _
|
||||
, "DMin" _
|
||||
, "DSum" _
|
||||
, "GetRows" _
|
||||
, "OpenQuery" _
|
||||
, "OpenSql" _
|
||||
, "OpenTable" _
|
||||
, "RunSql" _
|
||||
)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.Methods
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function OpenQuery(Optional ByVal QueryName As Variant) As Object
|
||||
''' Open the query given by its name
|
||||
''' The datasheet will live independently from any other (typically Base) component
|
||||
''' Args:
|
||||
''' QueryName: a valid query name as a case-sensitive string
|
||||
''' Returns:
|
||||
''' A Datasheet class instance if the query could be opened, otherwise Nothing
|
||||
''' Exceptions:
|
||||
''' Query name is invalid
|
||||
''' Example:
|
||||
''' oDb.OpenQuery("myQuery")
|
||||
|
||||
Dim oOpen As Object ' Return value
|
||||
Const cstThisSub = "SFDatabases.Database.OpenQuery"
|
||||
Const cstSubArgs = "QueryName"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
Set oOpen = Nothing
|
||||
|
||||
Check:
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(QueryName, "QueryName", V_STRING, Queries) Then GoTo Finally
|
||||
End If
|
||||
|
||||
Try:
|
||||
Set oOpen = _OpenDatasheet(QueryName, com.sun.star.sdb.CommandType.QUERY _
|
||||
, _Connection.Queries.getByName(QueryName).EscapeProcessing)
|
||||
|
||||
Finally:
|
||||
Set OpenQuery = oOpen
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDocuments.SF_Base.OpenQuery
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function OpenSql(Optional ByRef Sql As Variant _
|
||||
, Optional ByVal DirectSql As Variant _
|
||||
) As Object
|
||||
''' Open the datasheet based on a SQL SELECT statement.
|
||||
''' The datasheet will live independently from any other (typically Base) component
|
||||
''' Args:
|
||||
''' Sql: a valid Sql statement as a case-sensitive string.
|
||||
''' Identifiers may be surrounded by square brackets
|
||||
''' DirectSql: when True, the statement is processed by the targeted RDBMS
|
||||
''' Returns:
|
||||
''' A Datasheet class instance if it could be opened, otherwise Nothing
|
||||
''' Example:
|
||||
''' oDb.OpenSql("SELECT * FROM [Customers] ORDER BY [CITY]")
|
||||
|
||||
Dim oOpen As Object ' Return value
|
||||
Const cstThisSub = "SFDatabases.Database.OpenSql"
|
||||
Const cstSubArgs = "Sql, [DirectSql=False]"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
Set oOpen = Nothing
|
||||
|
||||
Check:
|
||||
If IsMissing(DirectSql) Or IsEmpty(DirectSql) Then DirectSql = False
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(Sql, "Sql", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(DirectSql, "DirectSql", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
||||
End If
|
||||
|
||||
Try:
|
||||
Set oOpen = _OpenDatasheet(_ReplaceSquareBrackets(Sql), com.sun.star.sdb.CommandType.COMMAND, Not DirectSql)
|
||||
|
||||
Finally:
|
||||
Set OpenSql = oOpen
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDocuments.SF_Base.OpenSql
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function OpenTable(Optional ByVal TableName As Variant) As Object
|
||||
''' Open the table given by its name
|
||||
''' The datasheet will live independently from any other (typically Base) component
|
||||
''' Args:
|
||||
''' TableName: a valid table name as a case-sensitive string
|
||||
''' Returns:
|
||||
''' A Datasheet class instance if the table could be opened, otherwise Nothing
|
||||
''' Exceptions:
|
||||
''' Table name is invalid
|
||||
''' Example:
|
||||
''' oDb.OpenTable("myTable")
|
||||
|
||||
Dim oOpen As Object ' Return value
|
||||
Const cstThisSub = "SFDatabases.Database.OpenTable"
|
||||
Const cstSubArgs = "TableName"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
Set oOpen = Nothing
|
||||
|
||||
Check:
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(TableName, "TableName", V_STRING, Tables) Then GoTo Finally
|
||||
End If
|
||||
|
||||
Try:
|
||||
Set oOpen = _OpenDatasheet(TableName, com.sun.star.sdb.CommandType.TABLE, True)
|
||||
|
||||
Finally:
|
||||
Set OpenTable = oOpen
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDocuments.SF_Base.OpenTable
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Properties() As Variant
|
||||
''' Return the list or properties of the Database class as an array
|
||||
|
||||
Properties = Array( _
|
||||
"Queries" _
|
||||
, "Tables" _
|
||||
, "XConnection" _
|
||||
, "XMetaData" _
|
||||
)
|
||||
|
||||
End Function ' SFDatabases.SF_Database.Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function RunSql(Optional ByVal SQLCommand As Variant _
|
||||
, Optional ByVal DirectSQL As Variant _
|
||||
) As Boolean
|
||||
''' Execute an action query (table creation, record insertion, ...) or SQL statement on the current database
|
||||
''' Args:
|
||||
''' SQLCommand: a query name or an SQL statement
|
||||
''' DirectSQL: when True, no syntax conversion is done by LO. Default = False
|
||||
''' Ignored when SQLCommand is a query name
|
||||
''' Exceptions:
|
||||
''' DBREADONLYERROR The method is not applicable on a read-only database
|
||||
''' Example:
|
||||
''' myDatabase.RunSql("INSERT INTO [EMPLOYEES] VALUES(25, 'SMITH', 'John')", DirectSQL := True)
|
||||
|
||||
Dim bResult As Boolean ' Return value
|
||||
Dim oStatement As Object ' com.sun.star.sdbc.XStatement
|
||||
Dim oQuery As Object ' com.sun.star.ucb.XContent
|
||||
Dim sSql As String ' SQL statement
|
||||
Dim bDirect ' Alias of DirectSQL
|
||||
Const cstQuery = 2, cstSql = 3
|
||||
Const cstThisSub = "SFDatabases.Database.RunSql"
|
||||
Const cstSubArgs = "SQLCommand, [DirectSQL=False]"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
bResult = False
|
||||
|
||||
Check:
|
||||
If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
||||
End If
|
||||
If _ReadOnly Then GoTo Catch_ReadOnly
|
||||
|
||||
Try:
|
||||
' Query of SQL ?
|
||||
If ScriptForge.SF_Array.Contains(Queries, SQLCommand, CaseSensitive := True, SortOrder := "ASC") Then
|
||||
Set oQuery = _Connection.Queries.getByName(SQLCommand)
|
||||
sSql = oQuery.Command
|
||||
bDirect = Not oQuery.EscapeProcessing
|
||||
ElseIf Not ScriptForge.SF_String.StartsWith(SQLCommand, "SELECT", CaseSensitive := False) Then
|
||||
sSql = SQLCommand
|
||||
bDirect = DirectSQL
|
||||
Else
|
||||
GoTo Finally
|
||||
End If
|
||||
|
||||
' Execute command
|
||||
bResult = _ExecuteSql(sSql, bDirect)
|
||||
|
||||
Finally:
|
||||
RunSql = bResult
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
Catch_ReadOnly:
|
||||
ScriptForge.SF_Exception.RaiseFatal(DBREADONLYERROR)
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database.RunSql
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
||||
, Optional ByRef Value As Variant _
|
||||
) As Boolean
|
||||
''' Set a new value to the given property
|
||||
''' Args:
|
||||
''' PropertyName: the name of the property as a string
|
||||
''' Value: its new value
|
||||
''' Exceptions
|
||||
''' ARGUMENTERROR The property does not exist
|
||||
|
||||
Const cstThisSub = "SFDatabases.Database.SetProperty"
|
||||
Const cstSubArgs = "PropertyName, Value"
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
SetProperty = False
|
||||
|
||||
Check:
|
||||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
||||
End If
|
||||
|
||||
Try:
|
||||
Select Case UCase(PropertyName)
|
||||
Case Else
|
||||
End Select
|
||||
|
||||
Finally:
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database.SetProperty
|
||||
|
||||
REM =========================================================== PRIVATE FUNCTIONS
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _DFunction(ByVal psFunction As String _
|
||||
, Optional ByVal pvExpression As Variant _
|
||||
, Optional ByVal pvTableName As Variant _
|
||||
, Optional ByVal pvCriteria As Variant _
|
||||
, Optional ByVal pvOrderClause As Variant _
|
||||
) As Variant
|
||||
''' Build and execute a SQL statement computing the aggregate function psFunction
|
||||
''' on a field or expression pvExpression belonging to a table pvTableName
|
||||
''' filtered by a WHERE-clause pvCriteria.
|
||||
''' To order the results, a pvOrderClause may be precised.
|
||||
''' Only the 1st record will be retained anyway.
|
||||
''' Args:
|
||||
''' psFunction an optional aggregate function: SUM, COUNT, AVG, LOOKUP
|
||||
''' pvExpression: an SQL expression
|
||||
''' pvTableName: the name of a table, NOT surrounded with quoting char
|
||||
''' pvCriteria: an optional WHERE clause without the word WHERE
|
||||
''' pvOrderClause: an optional order clause incl. "DESC" if relevant
|
||||
''' (meaningful only for LOOKUP)
|
||||
|
||||
Dim vResult As Variant ' Return value
|
||||
Dim oResult As Object ' com.sun.star.sdbc.XResultSet
|
||||
Dim sSql As String ' SQL statement.
|
||||
Dim sExpr As String ' For inclusion of aggregate function
|
||||
Dim sTarget as String ' Alias of pvExpression
|
||||
Dim sWhere As String ' Alias of pvCriteria
|
||||
Dim sOrderBy As String ' Alias of pvOrderClause
|
||||
Dim sLimit As String ' TOP 1 clause
|
||||
Dim sProductName As String ' RDBMS as a string
|
||||
Const cstAliasField = "[" & "TMP_ALIAS_ANY_FIELD" & "]" ' Alias field in SQL expression
|
||||
Dim cstThisSub As String : cstThisSub = "SFDatabases.SF_Database.D" & psFunction
|
||||
Const cstSubArgs = "Expression, TableName, [Criteria=""""], [OrderClause=""""]"
|
||||
Const cstLookup = "Lookup"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
vResult = Null
|
||||
|
||||
Check:
|
||||
If IsMissing(pvCriteria) Or IsEmpty(pvCriteria) Then pvCriteria = ""
|
||||
If IsMissing(pvOrderClause) Or IsEmpty(pvOrderClause) Then pvOrderClause = ""
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(pvExpression, "Expression", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(pvTableName, "TableName", V_STRING, Tables) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(pvCriteria, "Criteria", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(pvOrderClause, "OrderClause", V_STRING) Then GoTo Finally
|
||||
End If
|
||||
|
||||
Try:
|
||||
If pvCriteria <> "" Then sWhere = " WHERE " & pvCriteria Else sWhere = ""
|
||||
If pvOrderClause <> "" Then sOrderBy = " ORDER BY " & pvOrderClause Else sOrderBy = ""
|
||||
sLimit = ""
|
||||
|
||||
pvTableName = "[" & pvTableName & "]"
|
||||
|
||||
sProductName = UCase(_MetaData.getDatabaseProductName())
|
||||
|
||||
Select Case sProductName
|
||||
Case "MYSQL", "SQLITE"
|
||||
If psFunction = cstLookup Then
|
||||
sTarget = pvExpression
|
||||
sLimit = " LIMIT 1"
|
||||
Else
|
||||
sTarget = UCase(psFunction) & "(" & pvExpression & ")"
|
||||
End If
|
||||
sSql = "SELECT " & sTarget & " AS " & cstAliasField & " FROM " & psTableName & sWhere & sOrderBy & sLimit
|
||||
Case "FIREBIRD (ENGINE12)"
|
||||
If psFunction = cstLookup Then sTarget = "FIRST 1 " & pvExpression Else sTarget = UCase(psFunction) & "(" & pvExpression & ")"
|
||||
sSql = "SELECT " & sTarget & " AS " & cstAliasField & " FROM " & pvTableName & sWhere & sOrderBy
|
||||
Case Else ' Standard syntax - Includes HSQLDB
|
||||
If psFunction = cstLookup Then sTarget = "TOP 1 " & pvExpression Else sTarget = UCase(psFunction) & "(" & pvExpression & ")"
|
||||
sSql = "SELECT " & sTarget & " AS " & cstAliasField & " FROM " & pvTableName & sWhere & sOrderBy
|
||||
End Select
|
||||
|
||||
' Execute the SQL statement and retain the first column of the first record
|
||||
Set oResult = _ExecuteSql(sSql, True)
|
||||
If Not IsNull(oResult) And Not IsEmpty(oResult) Then
|
||||
If Not oResult.first() Then Goto Finally
|
||||
If oResult.isAfterLast() Then GoTo Finally
|
||||
vResult = _GetColumnValue(oResult, 1, True) ' Force return of binary field
|
||||
End If
|
||||
Set oResult = Nothing
|
||||
|
||||
Finally:
|
||||
_DFunction = vResult
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database._DFunction
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _ExecuteSql(ByVal psSql As String _
|
||||
, ByVal pbDirect As Boolean _
|
||||
) As Variant
|
||||
''' Return a read-only Resultset based on a SELECT SQL statement or execute the given action SQL (INSERT, CREATE TABLE, ...)
|
||||
''' The method raises a fatal error when the SQL statement cannot be interpreted
|
||||
''' Args:
|
||||
''' psSql : the SQL statement. Square brackets are replaced by the correct field surrounding character
|
||||
''' pbDirect: when True, no syntax conversion is done by LO. Default = False
|
||||
''' Exceptions
|
||||
''' SQLSYNTAXERROR The given SQL statement is incorrect
|
||||
|
||||
Dim vResult As Variant ' Return value - com.sun.star.sdbc.XResultSet or Boolean
|
||||
Dim oStatement As Object ' com.sun.star.sdbc.XStatement
|
||||
Dim sSql As String ' Alias of psSql
|
||||
Dim bSelect As Boolean ' True when SELECT statement
|
||||
Dim bErrorHandler As Boolean ' Can be set off to ease debugging of complex SQL statements
|
||||
|
||||
Set vResult = Nothing
|
||||
bErrorHandler = ScriptForge.SF_Utils._ErrorHandling()
|
||||
If bErrorHandler Then On Local Error GoTo Catch
|
||||
|
||||
Try:
|
||||
sSql = _ReplaceSquareBrackets(psSql)
|
||||
bSelect = ScriptForge.SF_String.StartsWith(sSql, "SELECT", CaseSensitive := False)
|
||||
|
||||
Set oStatement = _Connection.createStatement()
|
||||
With oStatement
|
||||
If bSelect Then
|
||||
.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
|
||||
.ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY
|
||||
End If
|
||||
.EscapeProcessing = Not pbDirect
|
||||
|
||||
' Setup the result set
|
||||
If bErrorHandler Then On Local Error GoTo Catch_Sql
|
||||
If bSelect Then Set vResult = .executeQuery(sSql) Else vResult = .execute(sSql)
|
||||
End With
|
||||
|
||||
Finally:
|
||||
_ExecuteSql = vResult
|
||||
Set oStatement = Nothing
|
||||
Exit Function
|
||||
Catch_Sql:
|
||||
ScriptForge.SF_Exception.RaiseFatal(SQLSYNTAXERROR, sSql)
|
||||
GoTo Finally
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database._ExecuteSql
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _GetColumnValue(ByRef poResultSet As Object _
|
||||
, ByVal plColIndex As Long _
|
||||
, Optional ByVal pbReturnBinary As Boolean _
|
||||
) As Variant
|
||||
''' Get the data stored in the current record of a result set in a given column
|
||||
''' The type of the column is found in the resultset's metadata
|
||||
''' Args:
|
||||
''' poResultSet: com.sun.star.sdbc.XResultSet or com.sun.star.awt.XTabControllerModel
|
||||
''' plColIndex: the index of the column to extract the value from. Starts at 1
|
||||
''' pbReturnBinary: when True, the method returns the content of a binary field,
|
||||
''' as long as its length does not exceed a maximum length.
|
||||
''' Default = False: binary fields are not returned, only their length
|
||||
''' Returns:
|
||||
''' The Variant value found in the column
|
||||
''' Dates and times are returned as Basic dates
|
||||
''' Null values are returned as Null
|
||||
''' Errors or strange data types are returned as Null as well
|
||||
|
||||
Dim vValue As Variant ' Return value
|
||||
Dim lType As Long ' SQL column type: com.sun.star.sdbc.DataType
|
||||
Dim vDateTime As Variant ' com.sun.star.util.DateTime
|
||||
Dim oStream As Object ' Long character or binary streams
|
||||
Dim bNullable As Boolean ' The field is defined as accepting Null values
|
||||
Dim lSize As Long ' Binary field length
|
||||
|
||||
Const cstMaxBinlength = 2 * 65535
|
||||
|
||||
On Local Error Goto 0 ' Disable error handler
|
||||
vValue = Empty ' Default value if error
|
||||
If IsMissing(pbReturnBinary) Then pbReturnBinary = False
|
||||
|
||||
With com.sun.star.sdbc.DataType
|
||||
lType = poResultSet.MetaData.getColumnType(plColIndex)
|
||||
bNullable = ( poResultSet.MetaData.IsNullable(plColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
|
||||
|
||||
Select Case lType
|
||||
Case .ARRAY : vValue = poResultSet.getArray(plColIndex)
|
||||
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
|
||||
Set oStream = poResultSet.getBinaryStream(plColIndex)
|
||||
If bNullable Then
|
||||
If Not poResultSet.wasNull() Then
|
||||
If Not ScriptForge.SF_Session.HasUNOMethod(oStream, "getLength") Then ' When no recordset
|
||||
lSize = cstMaxBinLength
|
||||
Else
|
||||
lSize = CLng(oStream.getLength())
|
||||
End If
|
||||
If lSize <= cstMaxBinLength And pbReturnBinary Then
|
||||
vValue = Array()
|
||||
oStream.readBytes(vValue, lSize)
|
||||
Else ' Return length of field, not content
|
||||
vValue = lSize
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
If Not IsNull(oStream) Then oStream.closeInput()
|
||||
Case .BIT, .BOOLEAN : vValue = poResultSet.getBoolean(plColIndex)
|
||||
Case .DATE
|
||||
vDateTime = poResultSet.getDate(plColIndex)
|
||||
If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
|
||||
Case .DISTINCT, .OBJECT, .OTHER, .STRUCT
|
||||
vValue = Null
|
||||
Case .DOUBLE, .REAL : vValue = poResultSet.getDouble(plColIndex)
|
||||
Case .FLOAT : vValue = poResultSet.getFloat(plColIndex)
|
||||
Case .INTEGER, .SMALLINT : vValue = poResultSet.getInt(plColIndex)
|
||||
Case .BIGINT : vValue = CLng(poResultSet.getLong(plColIndex))
|
||||
Case .DECIMAL, .NUMERIC : vValue = poResultSet.getDouble(plColIndex)
|
||||
Case .SQLNULL : vValue = poResultSet.getNull(plColIndex)
|
||||
Case .OBJECT, .OTHER, .STRUCT : vValue = Null
|
||||
Case .REF : vValue = poResultSet.getRef(plColIndex)
|
||||
Case .TINYINT : vValue = poResultSet.getShort(plColIndex)
|
||||
Case .CHAR, .VARCHAR : vValue = poResultSet.getString(plColIndex)
|
||||
Case .LONGVARCHAR, .CLOB
|
||||
If bNullable Then
|
||||
If Not poResultSet.wasNull() Then vValue = poResultSet.getString(plColIndex)
|
||||
Else
|
||||
vValue = ""
|
||||
End If
|
||||
Case .TIME
|
||||
vDateTime = poResultSet.getTime(plColIndex)
|
||||
If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds)
|
||||
Case .TIMESTAMP
|
||||
vDateTime = poResultSet.getTimeStamp(plColIndex)
|
||||
If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
|
||||
+ TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds)
|
||||
Case Else
|
||||
vValue = poResultSet.getString(plColIndex) 'GIVE STRING A TRY
|
||||
If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess)
|
||||
End Select
|
||||
If bNullable Then
|
||||
If poResultSet.wasNull() Then vValue = Null
|
||||
End If
|
||||
End With
|
||||
|
||||
_GetColumnValue = vValue
|
||||
|
||||
End Function ' SFDatabases.SF_Database.GetColumnValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _OpenDatasheet(Optional ByVal psCommand As Variant _
|
||||
, piDatasheetType As Integer _
|
||||
, pbEscapeProcessing As Boolean _
|
||||
) As Object
|
||||
''' Open the datasheet given by its name and its type
|
||||
''' The datasheet will live independently from any other component
|
||||
''' Args:
|
||||
''' psCommand: a valid table or query name or an SQL statement as a case-sensitive string
|
||||
''' piDatasheetType: one of the com.sun.star.sdb.CommandType constants
|
||||
''' pbEscapeProcessing: == Not DirectSql
|
||||
''' Returns:
|
||||
''' A Datasheet class instance if the datasheet could be opened, otherwise Nothing
|
||||
|
||||
Dim oOpen As Object ' Return value
|
||||
Dim oNewDatasheet As Object ' com.sun.star.lang.XComponent
|
||||
Dim oURL As Object ' com.sun.star.util.URL
|
||||
Dim oDispatch As Object ' com.sun.star.frame.XDispatch
|
||||
Dim vArgs As Variant ' Array of property values
|
||||
|
||||
On Local Error GoTo Catch
|
||||
Set oOpen = Nothing
|
||||
|
||||
Try:
|
||||
' Setup the dispatcher
|
||||
Set oURL = New com.sun.star.util.URL
|
||||
oURL.Complete = ".component:DB/DataSourceBrowser"
|
||||
Set oDispatch = StarDesktop.queryDispatch(oURL, "_blank", com.sun.star.frame.FrameSearchFlag.CREATE)
|
||||
|
||||
' Setup the arguments of the component to create
|
||||
With ScriptForge.SF_Utils
|
||||
vArgs = Array( _
|
||||
._MakePropertyValue("ActiveConnection", _Connection) _
|
||||
, ._MakePropertyValue("CommandType", piDatasheetType) _
|
||||
, ._MakePropertyValue("Command", psCommand) _
|
||||
, ._MakePropertyValue("ShowMenu", True) _
|
||||
, ._MakePropertyValue("ShowTreeView", False) _
|
||||
, ._MakePropertyValue("ShowTreeViewButton", False) _
|
||||
, ._MakePropertyValue("Filter", "") _
|
||||
, ._MakePropertyValue("ApplyFilter", False) _
|
||||
, ._MakePropertyValue("EscapeProcessing", pbEscapeProcessing) _
|
||||
)
|
||||
End With
|
||||
|
||||
' Open the targeted datasheet
|
||||
Set oNewDatasheet = oDispatch.dispatchWithReturnValue(oURL, vArgs)
|
||||
If Not IsNull(oNewDatasheet) Then Set oOpen = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Datasheet", oNewDatasheet, [Me])
|
||||
|
||||
Finally:
|
||||
Set _OpenDatasheet = oOpen
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDocuments.SF_Base._OpenDatasheet
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
||||
''' Return the value of the named property
|
||||
''' Args:
|
||||
''' psProperty: the name of the property
|
||||
|
||||
Dim cstThisSub As String
|
||||
Const cstSubArgs = ""
|
||||
|
||||
cstThisSub = "SFDatabases.Database.get" & psProperty
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
|
||||
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
|
||||
Select Case psProperty
|
||||
Case "Queries"
|
||||
If Not IsNull(_Connection) Then _PropertyGet = _Connection.Queries.getElementNames() Else _PropertyGet = Array()
|
||||
Case "Tables"
|
||||
If Not IsNull(_Connection) Then _PropertyGet = _Connection.Tables.getElementNames() Else _PropertyGet = Array()
|
||||
Case "XConnection"
|
||||
Set _PropertyGet = _Connection
|
||||
Case "XMetaData"
|
||||
Set _PropertyGet = _MetaData
|
||||
Case Else
|
||||
_PropertyGet = Null
|
||||
End Select
|
||||
|
||||
Finally:
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Database._PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _ReplaceSquareBrackets(ByVal psSql As String) As String
|
||||
''' Returns the input SQL command after replacement of square brackets by the table/field names quoting character
|
||||
|
||||
Dim sSql As String ' Return value
|
||||
Dim sQuote As String ' RDBMS specific table/field surrounding character
|
||||
Dim sConstQuote As String ' Delimiter for string constants in SQL - usually the single quote
|
||||
Const cstDouble = """" : Const cstSingle = "'"
|
||||
|
||||
Try:
|
||||
sQuote = _MetaData.IdentifierQuoteString
|
||||
sConstQuote = Iif(sQuote = cstSingle, cstDouble, cstSingle)
|
||||
|
||||
' Replace the square brackets
|
||||
sSql = Join(ScriptForge.SF_String.SplitNotQuoted(psSql, "[", , sConstQuote), sQuote)
|
||||
sSql = Join(ScriptForge.SF_String.SplitNotQuoted(sSql, "]", , sConstQuote), sQuote)
|
||||
|
||||
Finally:
|
||||
_ReplaceSquareBrackets = sSql
|
||||
Exit Function
|
||||
End Function ' SFDatabases.SF_Database._ReplaceSquareBrackets
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _Repr() As String
|
||||
''' Convert the Database instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
||||
''' Args:
|
||||
''' Return:
|
||||
''' "[DATABASE]: Location (Statusbar)"
|
||||
|
||||
_Repr = "[DATABASE]: " & _Location & " (" & _URL & ")"
|
||||
|
||||
End Function ' SFDatabases.SF_Database._Repr
|
||||
|
||||
REM ============================================ END OF SFDATABASES.SF_DATABASE
|
||||
</script:module>
|
||||
@@ -0,0 +1,894 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Datasheet" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
||||
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
||||
REM === The SFDatabases library is one of the associated libraries. ===
|
||||
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_Datasheet
|
||||
''' ============
|
||||
''' A datasheet is the visual representation of tabular data produced by a database.
|
||||
''' In the user interface of LibreOffice it is the result of the opening of
|
||||
''' a table or a query. In this case the concerned Base document must be open.
|
||||
'''
|
||||
''' In the context of ScriptForge, a datasheet may be opened automatically by script code :
|
||||
''' - either by reproducing the behaviour of the user interface
|
||||
''' - or at any moment. In this case the Base document may or may not be opened.
|
||||
''' Additionally, any SELECT SQL statement may trigger the datasheet display.
|
||||
'''
|
||||
''' The proposed API allows for either datasheets (opened manually of by code) in particular
|
||||
''' to know which cell is selected and its content.
|
||||
'''
|
||||
''' Service invocation:
|
||||
''' 1) From an open Base document
|
||||
''' Set ui = CreateScriptService("UI")
|
||||
''' Set oBase = ui.getDocument("/home/user/Documents/myDb.odb")
|
||||
''' Set oSheet1 = oBase.OpenTable("Customers") ' or OpenQuery(...)
|
||||
''' Set oSheet2 = oBase.Datasheets("Products") ' when the datasheet has been opened manually
|
||||
''' 2) Independently from a Base document
|
||||
''' Set oDatabase = CreateScriptService("Database", "/home/user/Documents/myDb.odb")
|
||||
''' Set oSheet = oDatabase.OpenTable("Customers")
|
||||
'''
|
||||
''' Detailed user documentation:
|
||||
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_datasheet.html?DbPAR=BASIC
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
Private Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR"
|
||||
|
||||
REM ============================================================= PRIVATE MEMBERS
|
||||
|
||||
Private [Me] As Object
|
||||
Private [_Parent] As Object ' Base instance when opened from a Base document by code
|
||||
' or Database instance when opened without Base document
|
||||
Private ObjectType As String ' Must be DATASHEET
|
||||
Private ServiceName As String
|
||||
|
||||
Private _Component As Object ' com.sun.star.lang.XComponent - org.openoffice.comp.dbu.ODatasourceBrowser
|
||||
Private _Frame As Object ' com.sun.star.frame.XFrame
|
||||
Private _ParentBase As Object ' The parent SF_Base instance (may be void)
|
||||
Private _ParentDatabase As Object ' The parent SF_Database instance (must not be void)
|
||||
Private _SheetType As String ' TABLE, QUERY or SQL
|
||||
Private _ParentType As String ' BASE or DATABASE
|
||||
Private _BaseFileName As String ' URL format of parent Base file
|
||||
Private _Command As String ' Table name, query name or SQL statement
|
||||
Private _DirectSql As Boolean ' When True, SQL processed by RDBMS
|
||||
Private _TabControllerModel As Object ' com.sun.star.awt.XTabControllerModel - com.sun.star.comp.forms.ODatabaseForm
|
||||
Private _ControlModel As Object ' com.sun.star.awt.XControlModel - com.sun.star.form.OGridControlModel
|
||||
Private _ControlView As Object ' com.sun.star.awt.XControl - org.openoffice.comp.dbu.ODatasourceBrowser
|
||||
Private _ColumnHeaders As Variant ' List of column headers as an array of strings
|
||||
|
||||
REM ============================================================ MODULE CONSTANTS
|
||||
|
||||
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
Set [Me] = Nothing
|
||||
Set [_Parent] = Nothing
|
||||
ObjectType = "DATASHEET"
|
||||
ServiceName = "SFDatabases.Datasheet"
|
||||
Set _Component = Nothing
|
||||
Set _Frame = Nothing
|
||||
Set _ParentBase = Nothing
|
||||
Set _ParentDatabase = Nothing
|
||||
_SheetType = ""
|
||||
_ParentType = ""
|
||||
_BaseFileName = ""
|
||||
_Command = ""
|
||||
_DirectSql = False
|
||||
Set _TabControllerModel = Nothing
|
||||
Set _ControlModel = Nothing
|
||||
Set _ControlView = Nothing
|
||||
_ColumnHeaders = Array()
|
||||
End Sub ' SFDatabases.SF_Datasheet Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
Call Class_Initialize()
|
||||
End Sub ' SFDatabases.SF_Datasheet Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Dispose() As Variant
|
||||
Call Class_Terminate()
|
||||
Set Dispose = Nothing
|
||||
End Function ' SFDatabases.SF_Datasheet Explicit Destructor
|
||||
|
||||
REM ================================================================== PROPERTIES
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get ColumnHeaders() As Variant
|
||||
''' Returns the list of column headers of the datasheet as an array of strings
|
||||
ColumnHeaders = _PropertyGet("ColumnHeaders")
|
||||
End Property ' SFDatabases.SF_Datasheet.ColumnHeaders
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get CurrentColumn() As String
|
||||
''' Returns the currently selected column by its name
|
||||
CurrentColumn = _PropertyGet("CurrentColumn")
|
||||
End Property ' SFDatabases.SF_Datasheet.CurrentColumn
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get CurrentRow() As Long
|
||||
''' Returns the currently selected row by its number >= 1
|
||||
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 Filter() As Variant
|
||||
''' The Filter is a SQL WHERE clause without the WHERE keyword
|
||||
Filter = _PropertyGet("Filter")
|
||||
End Property ' SFDatabases.SF_Datasheet.Filter (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Let Filter(Optional ByVal pvFilter As Variant)
|
||||
''' Set the updatable property Filter
|
||||
''' Table and field names may be surrounded by square brackets
|
||||
''' When the argument is the zero-length string, the actual filter is removed
|
||||
_PropertySet("Filter", pvFilter)
|
||||
End Property ' SFDatabases.SF_Datasheet.Filter (let)
|
||||
|
||||
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.
|
||||
''' Afterwards the cursor is reset to the current row.
|
||||
LastRow = _PropertyGet("LastRow")
|
||||
End Property ' SFDatabases.SF_Datasheet.LastRow
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get OrderBy() As Variant
|
||||
''' The Order is a SQL ORDER BY clause without the ORDER BY keywords
|
||||
OrderBy = _PropertyGet("OrderBy")
|
||||
End Property ' SFDocuments.SF_Form.OrderBy (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Let OrderBy(Optional ByVal pvOrderBy As Variant)
|
||||
''' Set the updatable property OrderBy
|
||||
''' Table and field names may be surrounded by square brackets
|
||||
''' When the argument is the zero-length string, the actual sort is removed
|
||||
_PropertySet("OrderBy", pvOrderBy)
|
||||
End Property ' SFDocuments.SF_Form.OrderBy (let)
|
||||
|
||||
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")
|
||||
End Property ' SFDatabases.SF_Datasheet.Source
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get SourceType() As String
|
||||
''' Returns thetype of source of the data: TABLE, QUERY or SQL
|
||||
SourceType = _PropertyGet("SourceType")
|
||||
End Property ' SFDatabases.SF_Datasheet.SourceType
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get XComponent() As Object
|
||||
''' Returns the com.sun.star.lang.XComponent UNO object representing the datasheet
|
||||
XComponent = _PropertyGet("XComponent")
|
||||
End Property ' SFDocuments.SF_Document.XComponent
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get XControlModel() As Object
|
||||
''' Returns the com.sun.star.lang.XControl UNO object representing the datasheet
|
||||
XControlModel = _PropertyGet("XControlModel")
|
||||
End Property ' SFDocuments.SF_Document.XControlModel
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Property Get XTabControllerModel() As Object
|
||||
''' Returns the com.sun.star.lang.XTabControllerModel UNO object representing the datasheet
|
||||
XTabControllerModel = _PropertyGet("XTabControllerModel")
|
||||
End Property ' SFDocuments.SF_Document.XTabControllerModel
|
||||
|
||||
REM ===================================================================== METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub Activate()
|
||||
''' Make the actual datasheet active
|
||||
''' Args:
|
||||
''' Returns:
|
||||
''' Examples:
|
||||
''' oSheet.Activate()
|
||||
|
||||
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
||||
Const cstThisSub = "SFDatabases.Datasheet.Activate"
|
||||
Const cstSubArgs = ""
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
|
||||
Check:
|
||||
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
|
||||
Try:
|
||||
Set oContainer = _Component.Frame.ContainerWindow
|
||||
With oContainer
|
||||
If .isVisible() = False Then .setVisible(True)
|
||||
.IsMinimized = False
|
||||
.setFocus()
|
||||
.toFront() ' Force window change in Linux
|
||||
Wait 1 ' Bypass desynchro issue in Linux
|
||||
End With
|
||||
|
||||
Finally:
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Sub
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Sub ' SFDatabases.SF_Datasheet.Activate
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function CloseDatasheet() As Boolean
|
||||
''' Close the actual datasheet
|
||||
''' Args:
|
||||
''' Returns:
|
||||
''' True when successful
|
||||
''' Examples:
|
||||
''' oSheet.CloseDatasheet()
|
||||
|
||||
Dim bClose As Boolean ' Return value
|
||||
Const cstThisSub = "SFDatabases.Datasheet.CloseDatasheet"
|
||||
Const cstSubArgs = ""
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
bClose = False
|
||||
|
||||
Check:
|
||||
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
|
||||
Try:
|
||||
_TabControllerModel.close()
|
||||
_Frame.close(True)
|
||||
_Frame.dispose()
|
||||
Dispose()
|
||||
bClose = True
|
||||
|
||||
Finally:
|
||||
CloseDatasheet = bClose
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
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
|
||||
''' Args:
|
||||
''' PropertyName: the name of the property as a string
|
||||
''' Returns:
|
||||
''' The actual value of the propRATTCerty
|
||||
''' If the property does not exist, returns Null
|
||||
|
||||
Const cstThisSub = "SFDatabases.Datasheet.GetProperty"
|
||||
Const cstSubArgs = ""
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
GetProperty = Null
|
||||
|
||||
Check:
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
||||
End If
|
||||
|
||||
Try:
|
||||
GetProperty = _PropertyGet(PropertyName)
|
||||
|
||||
Finally:
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet.GetProperty
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function GetText(Optional ByVal Column As Variant) As String
|
||||
''' Get the text in the given column of the current row.
|
||||
''' Args:
|
||||
''' Column: the name of the column as a string or its position (>= 1). Default = the current column
|
||||
''' If the argument exceeds the number of columns, the last column is selected.
|
||||
''' Returns:
|
||||
''' The text in the cell as a string as how it is displayed
|
||||
''' Note that the position of the cursor is left unchanged.
|
||||
''' Examples:
|
||||
''' oSheet.GetText("ShipCity")) ' Extract the text on the current row from the column "ShipCity"
|
||||
|
||||
Dim sText As String ' Return Text
|
||||
Dim lCol As Long ' Numeric index of Column in lists of columns
|
||||
Dim lMaxCol As Long ' Index of last column
|
||||
Const cstThisSub = "SFDatabases.Datasheet.GetText"
|
||||
Const cstSubArgs = "[Column=0]"
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
sText = ""
|
||||
|
||||
Check:
|
||||
If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
If VarType(Column) <> V_STRING Then
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
|
||||
Else
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
|
||||
End If
|
||||
End If
|
||||
|
||||
Try:
|
||||
' Position the column - The index to be passed starts at 0
|
||||
With _ControlView
|
||||
If VarType(Column) = V_STRING Then
|
||||
lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
|
||||
Else
|
||||
lCol = -1
|
||||
If Column >= 1 Then
|
||||
lMaxCol = .Count - 1
|
||||
If Column > lMaxCol + 1 Then lCol = lMaxCol Else lCol = Column - 1
|
||||
End If
|
||||
End If
|
||||
|
||||
If lCol >= 0 Then sText = .getByIndex(lCol).Text
|
||||
End With
|
||||
|
||||
Finally:
|
||||
GetText = sText
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet.GetText
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function GetValue(Optional ByVal Column As Variant) As Variant
|
||||
''' Get the value in the given column of the current row.
|
||||
''' Args:
|
||||
''' Column: the name of the column as a string or its position (>= 1). Default = the current column
|
||||
''' If the argument exceeds the number of columns, the last column is selected.
|
||||
''' Returns:
|
||||
''' The value in the cell as a valid Basic type
|
||||
''' Typical types are: STRING, INTEGER, LONG, FLOAT, DOUBLE, DATE, NULL
|
||||
''' Binary types are returned as a LONG giving their length, not their content
|
||||
''' An EMPTY return value means that the value could not be retrieved.
|
||||
''' Note that the position of the cursor is left unchanged.
|
||||
''' Examples:
|
||||
''' oSheet.GetValue("ShipCity")) ' Extract the value on the current row from the column "ShipCity"
|
||||
|
||||
Dim vValue As Variant ' Return value
|
||||
Dim lCol As Long ' Numeric index of Column in lists of columns
|
||||
Dim lMaxCol As Long ' Index of last column
|
||||
Const cstThisSub = "SFDatabases.Datasheet.GetValue"
|
||||
Const cstSubArgs = "[Column=0]"
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
vValue = Empty
|
||||
|
||||
Check:
|
||||
If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
If VarType(Column) <> V_STRING Then
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
|
||||
Else
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
|
||||
End If
|
||||
End If
|
||||
|
||||
Try:
|
||||
' Position the column - The index to be passed starts at 1
|
||||
If VarType(Column) = V_STRING Then
|
||||
lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False) + 1
|
||||
Else
|
||||
lCol = 0
|
||||
If Column >= 1 Then
|
||||
lMaxCol = _ControlView.Count
|
||||
If Column > lMaxCol Then lCol = lMaxCol Else lCol = Column
|
||||
End If
|
||||
End If
|
||||
|
||||
' The _TabControllerModel acts exactly as a result set, from which the generic _GetColumnValue can extract the searched value
|
||||
If lCol >= 1 Then vValue = _ParentDatabase._GetColumnValue(_TabControllerModel, lCol)
|
||||
|
||||
Finally:
|
||||
GetValue = vValue
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet.GetValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function GoToCell(Optional ByVal Row As Variant _
|
||||
, Optional ByVal Column As Variant _
|
||||
) As Boolean
|
||||
''' Set the cursor on the given row and the given column.
|
||||
''' If the requested row exceeds the number of available rows, the cursor is set on the last row.
|
||||
''' If the requested column exceeds the number of available columns, the selected column is the last one.
|
||||
''' Args:
|
||||
''' Row: the row number (>= 1) as a numeric value. Default= no change
|
||||
''' Column: the name of the column as a string or its position (>= 1). Default = the current column
|
||||
''' Returns:
|
||||
''' True when successful
|
||||
''' Examples:
|
||||
''' 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 list of columns
|
||||
Dim lMaxCol As Long ' Index of last column
|
||||
Const cstThisSub = "SFDatabases.Datasheet.GoToCell"
|
||||
Const cstSubArgs = "[Row=0], [Column=0]"
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
bGoTo = False
|
||||
|
||||
Check:
|
||||
If IsMissing(Row) Or IsEmpty(Row) Then Row = 0
|
||||
If IsMissing(Column) Or IsEmpty(Column) Then Column = 0
|
||||
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(Row, "Row", ScriptForge.V_NUMERIC) Then GoTo Catch
|
||||
If VarType(Column) <> V_STRING Then
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", ScriptForge.V_NUMERIC) Then GoTo Catch
|
||||
Else
|
||||
If Not ScriptForge.SF_Utils._Validate(Column, "Column", V_STRING, _ColumnHeaders) Then GoTo Catch
|
||||
End If
|
||||
End If
|
||||
|
||||
Try:
|
||||
' Position the row
|
||||
With _TabControllerModel
|
||||
If Row <= 0 Then Row = .Row Else .absolute(Row)
|
||||
' Does Row exceed the total number of rows ?
|
||||
If .IsRowCountFinal And Row > .RowCount Then .absolute(.RowCount)
|
||||
End With
|
||||
|
||||
' Position the column
|
||||
With _ControlView
|
||||
If VarType(Column) = V_STRING Then
|
||||
lCol = ScriptForge.SF_Array.IndexOf(_ColumnHeaders, Column, CaseSensitive := False)
|
||||
Else
|
||||
lCol = -1
|
||||
If Column >= 1 Then
|
||||
lMaxCol = .Count - 1
|
||||
If Column > lMaxCol + 1 Then lCol = lMaxCol Else lCol = Column - 1
|
||||
End If
|
||||
End If
|
||||
If lCol >= 0 Then .setCurrentColumnPosition(lCol)
|
||||
End With
|
||||
|
||||
bGoTo = True
|
||||
|
||||
Finally:
|
||||
GoToCell = bGoTo
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet.GoToCell
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Methods() As Variant
|
||||
''' Return the list of public methods of the Model service as an array
|
||||
|
||||
Methods = Array( _
|
||||
"Activate" _
|
||||
, "CloseDatasheet" _
|
||||
, "CreateMenu" _
|
||||
, "GetText" _
|
||||
, "GetValue" _
|
||||
, "GoToCell" _
|
||||
, "RemoveMenu" _
|
||||
)
|
||||
|
||||
End Function ' SFDatabases.SF_Datasheet.Methods
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function Properties() As Variant
|
||||
''' Return the list or properties of the Model class as an array
|
||||
|
||||
Properties = Array( _
|
||||
"ColumnHeaders" _
|
||||
, "CurrentColumn" _
|
||||
, "CurrentRow" _
|
||||
, "DatabaseFileName" _
|
||||
, "Filter" _
|
||||
, "LastRow" _
|
||||
, "OrderBy" _
|
||||
, "ParentDatabase" _
|
||||
, "Source" _
|
||||
, "SourceType" _
|
||||
, "XComponent" _
|
||||
, "XControlModel" _
|
||||
, "XTabControllerModel" _
|
||||
)
|
||||
|
||||
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 -----------------------------------------------------------------------------
|
||||
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
||||
, Optional ByRef Value As Variant _
|
||||
) As Boolean
|
||||
''' Set a new value to the given property
|
||||
''' Args:
|
||||
''' PropertyName: the name of the property as a string
|
||||
''' Value: its new value
|
||||
''' Exceptions
|
||||
''' ARGUMENTERROR The property does not exist
|
||||
|
||||
Const cstThisSub = "SFDatabases.Datasheet.SetProperty"
|
||||
Const cstSubArgs = "PropertyName, Value"
|
||||
|
||||
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
SetProperty = False
|
||||
|
||||
Check:
|
||||
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
||||
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
||||
End If
|
||||
|
||||
Try:
|
||||
SetProperty = _PropertySet(PropertyName, Value)
|
||||
|
||||
Finally:
|
||||
SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet.SetProperty
|
||||
|
||||
REM =========================================================== PRIVATE FUNCTIONS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _Initialize()
|
||||
''' Called immediately after instance creation to complete the initial values
|
||||
''' An eventual error must be trapped in the calling routine to cancel the instance creation
|
||||
|
||||
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:
|
||||
If IsNull([_Parent]) Then _ParentType = "" Else _ParentType = [_Parent].ObjectType
|
||||
|
||||
With _Component
|
||||
' The existence of _Component.Selection must be checked upfront
|
||||
_Command = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "Command")
|
||||
|
||||
iType = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "CommandType")
|
||||
Select Case iType
|
||||
Case com.sun.star.sdb.CommandType.TABLE : _SheetType = "TABLE"
|
||||
Case com.sun.star.sdb.CommandType.QUERY : _SheetType = "QUERY"
|
||||
Case com.sun.star.sdb.CommandType.COMMAND : _SheetType = "SQL"
|
||||
End Select
|
||||
|
||||
_BaseFileName = ScriptForge.SF_Utils._GetPropertyValue(.Selection, "DataSourceName")
|
||||
_DirectSql = Not ScriptForge.SF_Utils._GetPropertyValue(.Selection, "EscapeProcessing")
|
||||
|
||||
' Useful UNO objects
|
||||
Set _Frame = .Frame
|
||||
Set _ControlView = .CurrentControl
|
||||
Set _TabControllerModel = .com_sun_star_awt_XTabController_getModel()
|
||||
Set _ControlModel = _ControlView.getModel()
|
||||
End With
|
||||
|
||||
' Retrieve the parent database instance
|
||||
With _TabControllerModel
|
||||
Select Case _ParentType
|
||||
Case "BASE"
|
||||
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 = .getColumns().getElementNames()
|
||||
End With
|
||||
|
||||
Finally:
|
||||
Exit Sub
|
||||
End Sub ' SFDatabases.SF_Datasheet._Initialize
|
||||
|
||||
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
|
||||
''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
|
||||
''' Args:
|
||||
''' pbError: if True (default), raise a fatal error
|
||||
|
||||
Dim bAlive As Boolean ' Return value
|
||||
Dim sName As String ' Used in error message
|
||||
|
||||
On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
|
||||
If IsMissing(pbError) Then pbError = True
|
||||
|
||||
Try:
|
||||
' Check existence of datasheet
|
||||
bAlive = Not IsNull(_Component.ComponentWindow)
|
||||
|
||||
Finally:
|
||||
If pbError And Not bAlive Then
|
||||
sName = _Command
|
||||
Dispose()
|
||||
If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sName)
|
||||
End If
|
||||
_IsStillAlive = bAlive
|
||||
Exit Function
|
||||
Catch:
|
||||
bAlive = False
|
||||
On Error GoTo 0
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet._IsStillAlive
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
|
||||
''' Return the value of the named property
|
||||
''' Args:
|
||||
''' psProperty: the name of the property
|
||||
|
||||
Dim lRow As Long ' Actual row number
|
||||
Dim cstThisSub As String
|
||||
Const cstSubArgs = ""
|
||||
|
||||
cstThisSub = "SFDatabases.Datasheet.get" & psProperty
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
|
||||
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
If Not _IsStillAlive(False) Then GoTo Finally
|
||||
|
||||
Select Case psProperty
|
||||
Case "ColumnHeaders"
|
||||
_PropertyGet = _ColumnHeaders
|
||||
Case "CurrentColumn"
|
||||
_PropertyGet = _ColumnHeaders(_ControlView.getCurrentColumnPosition())
|
||||
Case "CurrentRow"
|
||||
_PropertyGet = _TabControllerModel.Row
|
||||
Case "DatabaseFileName"
|
||||
_PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_BaseFileName)
|
||||
Case "Filter"
|
||||
_PropertyGet = _TabControllerModel.Filter
|
||||
Case "LastRow"
|
||||
With _TabControllerModel
|
||||
If .IsRowCountFinal Then
|
||||
_PropertyGet = .RowCount
|
||||
Else
|
||||
lRow = .Row
|
||||
If lRow > 0 Then
|
||||
.last()
|
||||
_PropertyGet = .RowCount
|
||||
.absolute(lRow)
|
||||
Else
|
||||
_PropertyGet = 0
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
Case "OrderBy"
|
||||
_PropertyGet = _TabControllerModel.Order
|
||||
Case "ParentDatabase"
|
||||
Set _PropertyGet = _ParentDatabase
|
||||
Case "Source"
|
||||
_PropertyGet = _Command
|
||||
Case "SourceType"
|
||||
_PropertyGet = _SheetType
|
||||
Case "XComponent"
|
||||
Set _PropertyGet = _Component
|
||||
Case "XControlModel"
|
||||
Set _PropertyGet = _ControlModel
|
||||
Case "XTabControllerModel"
|
||||
Set _PropertyGet = _TabControllerModel
|
||||
Case Else
|
||||
_PropertyGet = Null
|
||||
End Select
|
||||
|
||||
Finally:
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet._PropertyGet
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _PropertySet(Optional ByVal psProperty As String _
|
||||
, Optional ByVal pvValue As Variant _
|
||||
) As Boolean
|
||||
''' Set the new value of the named property
|
||||
''' Args:
|
||||
''' psProperty: the name of the property
|
||||
''' pvValue: the new value of the given property
|
||||
''' Returns:
|
||||
''' True if successful
|
||||
|
||||
Dim bSet As Boolean ' Return value
|
||||
Dim cstThisSub As String
|
||||
Const cstSubArgs = "Value"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
bSet = False
|
||||
|
||||
cstThisSub = "SFDatabases.Datasheet.set" & psProperty
|
||||
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
||||
If Not _IsStillAlive() Then GoTo Finally
|
||||
|
||||
bSet = True
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Filter")
|
||||
If Not ScriptForge.SF_Utils._Validate(pvValue, "Filter", V_STRING) Then GoTo Finally
|
||||
With _TabControllerModel
|
||||
If Len(pvValue) > 0 Then .Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Filter = ""
|
||||
.ApplyFilter = ( Len(pvValue) > 0 )
|
||||
.reload()
|
||||
End With
|
||||
Case UCase("OrderBy")
|
||||
If Not ScriptForge.SF_Utils._Validate(pvValue, "OrderBy", V_STRING) Then GoTo Finally
|
||||
With _TabControllerModel
|
||||
If Len(pvValue) > 0 Then .Order = _ParentDatabase._ReplaceSquareBrackets(pvValue) Else .Order = ""
|
||||
.reload()
|
||||
End With
|
||||
Case Else
|
||||
bSet = False
|
||||
End Select
|
||||
|
||||
Finally:
|
||||
_PropertySet = bSet
|
||||
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Datasheet._PropertySet
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _Repr() As String
|
||||
''' Convert the Datasheet instance to a readable string, typically for debugging purposes (DebugPrint ...)
|
||||
''' Args:
|
||||
''' Return:
|
||||
''' "[DATASHEET]: tablename,base file url"
|
||||
|
||||
_Repr = "[DATASHEET]: " & _Command & "," & _BaseFileName
|
||||
|
||||
End Function ' SFDatabases.SF_Datasheet._Repr
|
||||
|
||||
REM ============================================ END OF SFDATABASES.SF_DATASHEET
|
||||
</script:module>
|
||||
@@ -0,0 +1,270 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
||||
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
||||
REM === The SFDatabases library is one of the associated libraries. ===
|
||||
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Compatible
|
||||
Option Explicit
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_Register
|
||||
''' ===========
|
||||
''' The ScriptForge framework includes
|
||||
''' the master ScriptForge library
|
||||
''' a number of "associated" libraries SF*
|
||||
''' any user/contributor extension wanting to fit into the framework
|
||||
'''
|
||||
''' The main methods in this module allow the current library to cling to ScriptForge
|
||||
''' - RegisterScriptServices
|
||||
''' Register the list of services implemented by the current library
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
|
||||
|
||||
REM ============================================================== PUBLIC METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub RegisterScriptServices() As Variant
|
||||
''' Register into ScriptForge the list of the services implemented by the current library
|
||||
''' Each library pertaining to the framework must implement its own version of this method
|
||||
'''
|
||||
''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
|
||||
''' with 2 arguments:
|
||||
''' ServiceName: the name of the service as a case-insensitive string
|
||||
''' ServiceReference: the reference as an object
|
||||
''' If the reference refers to a module, then return the module as an object:
|
||||
''' GlobalScope.Library.Module
|
||||
''' If the reference is a class instance, then return a string referring to the method
|
||||
''' containing the New statement creating the instance
|
||||
''' "libraryname.modulename.function"
|
||||
|
||||
With GlobalScope.ScriptForge.SF_Services
|
||||
.RegisterService("Database", "SFDatabases.SF_Register._NewDatabase") ' Reference to the function initializing the service
|
||||
.RegisterService("DatabaseFromDocument", "SFDatabases.SF_Register._NewDatabaseFromSource")
|
||||
.RegisterService("Datasheet", "SFDatabases.SF_Register._NewDatasheet")
|
||||
End With
|
||||
|
||||
End Sub ' SFDatabases.SF_Register.RegisterScriptServices
|
||||
|
||||
REM =========================================================== PRIVATE FUNCTIONS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _NewDatabase(Optional ByVal pvArgs As Variant) As Object
|
||||
''' Create a new instance of the SF_Database class
|
||||
''' Args:
|
||||
''' FileName : the name of the file (compliant with the SF_FileSystem.FileNaming notation)
|
||||
''' RegistrationName: mutually exclusive with FileName. Used when database is registered
|
||||
''' ReadOnly : (boolean). Default = True
|
||||
''' User : connection parameters
|
||||
''' Password
|
||||
''' Returns:
|
||||
''' The instance or Nothing
|
||||
''' Exceptions:
|
||||
''' BASEDOCUMENTOPENERROR The database file could not be opened or connected
|
||||
|
||||
Dim oDatabase As Object ' Return value
|
||||
Dim vFileName As Variant ' alias of pvArgs(0)
|
||||
Dim vRegistration As Variant ' Alias of pvArgs(1)
|
||||
Dim vReadOnly As Variant ' Alias of pvArgs(2)
|
||||
Dim vUser As Variant ' Alias of pvArgs(3)
|
||||
Dim vPassword As Variant ' Alias of pvArgs(4)
|
||||
Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
|
||||
Const cstService = "SFDatabases.Database"
|
||||
Const cstGlobal = "GlobalScope"
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
|
||||
Check:
|
||||
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
|
||||
If UBound(pvArgs) >= 0 Then vFileName = pvArgs(0) Else vFileName = ""
|
||||
If IsEmpty(vFileName) Then vFileName = ""
|
||||
If UBound(pvArgs) >= 1 Then vRegistration = pvArgs(1) Else vRegistration = ""
|
||||
If IsEmpty(vRegistration) Then vRegistration = ""
|
||||
If UBound(pvArgs) >= 2 Then vReadOnly = pvArgs(2) Else vReadOnly = True
|
||||
If IsEmpty(vReadOnly) Then vReadOnly = True
|
||||
If UBound(pvArgs) >= 3 Then vUser = pvArgs(3) Else vUser = ""
|
||||
If IsEmpty(vUser) Then vUser = ""
|
||||
If UBound(pvArgs) >= 4 Then vPassword = pvArgs(4) Else vPassword = ""
|
||||
If IsEmpty(vPassword) Then vPassword = ""
|
||||
If Not ScriptForge.SF_Utils._Validate(vFileName, "FileName", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(vRegistration, "RegistrationName", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(vReadOnly, "ReadOnly", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(vUser, "User", V_STRING) Then GoTo Finally
|
||||
If Not ScriptForge.SF_Utils._Validate(vPassword, "Password", V_STRING) Then GoTo Finally
|
||||
Set oDatabase = Nothing
|
||||
|
||||
' Check the existence of FileName
|
||||
With ScriptForge
|
||||
Set oDBContext = .SF_Utils._GetUNOService("DatabaseContext")
|
||||
If Len(vFileName) = 0 Then ' FileName has precedence over RegistrationName
|
||||
If Len(vRegistration) = 0 Then GoTo CatchError
|
||||
If Not oDBContext.hasRegisteredDatabase(vRegistration) Then GoTo CatchError
|
||||
vFileName = .SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(vRegistration))
|
||||
End If
|
||||
If Not .SF_FileSystem.FileExists(vFileName) Then GoTo CatchError
|
||||
End With
|
||||
|
||||
Try:
|
||||
' Create the database Basic object and initialize attributes
|
||||
Set oDatabase = New SF_Database
|
||||
With oDatabase
|
||||
Set .[Me] = oDatabase
|
||||
._Location = ConvertToUrl(vFileName)
|
||||
Set ._DataSource = oDBContext.getByName(._Location)
|
||||
Set ._Connection = ._DataSource.getConnection(vUser, vPassword)
|
||||
._ReadOnly = vReadOnly
|
||||
Set ._MetaData = ._Connection.MetaData
|
||||
._URL = ._MetaData.URL
|
||||
End With
|
||||
|
||||
Finally:
|
||||
Set _NewDatabase = oDatabase
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
CatchError:
|
||||
ScriptForge.SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", vFileName, "RegistrationName", vRegistration)
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Register._NewDatabase
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _NewDatabaseFromSource(Optional ByVal pvArgs As Variant) As Object
|
||||
' ByRef poDataSource As Object _
|
||||
' , ByVal psUser As String _
|
||||
' , ByVal psPassword As String _
|
||||
' ) As Object
|
||||
''' Create a new instance of the SF_Database class from the given datasource
|
||||
''' established in the SFDocuments.Base service
|
||||
''' THIS SERVICE MUST NOT BE CALLED FROM A USER SCRIPT
|
||||
''' Args:
|
||||
''' DataSource: com.sun.star.sdbc.XDataSource
|
||||
''' User, Password : connection parameters
|
||||
''' Returns:
|
||||
''' The instance or Nothing
|
||||
''' Exceptions:
|
||||
''' managed in the calling routines when Nothing is returned
|
||||
|
||||
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)
|
||||
|
||||
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
||||
Set oDatabase = Nothing
|
||||
|
||||
Try:
|
||||
' Get arguments
|
||||
Set oDataSource = pvArgs(0)
|
||||
sUser = pvArgs(1)
|
||||
sPassword = pvArgs(2)
|
||||
|
||||
' Setup the connection
|
||||
If oDataSource.IsPasswordRequired Then
|
||||
Set oConnection = oDataSource.getConnection(sUser, sPassword)
|
||||
Else
|
||||
Set oConnection = oDataSource.getConnection("", "")
|
||||
End If
|
||||
|
||||
' Create the database Basic object and initialize attributes
|
||||
If Not IsNull(oConnection) Then
|
||||
Set oDatabase = New SF_Database
|
||||
With oDatabase
|
||||
Set .[Me] = oDatabase
|
||||
._Location = ""
|
||||
Set ._DataSource = oDataSource
|
||||
Set ._Connection = oConnection
|
||||
._ReadOnly = oConnection.isReadOnly()
|
||||
Set ._MetaData = oConnection.MetaData
|
||||
._URL = ._MetaData.URL
|
||||
End With
|
||||
End If
|
||||
|
||||
Finally:
|
||||
Set _NewDatabaseFromSource = oDatabase
|
||||
Exit Function
|
||||
Catch:
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Register._NewDatabaseFromSource
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _NewDatasheet(Optional ByVal pvArgs As Variant) 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
|
||||
''' base.Datasheets()
|
||||
''' base.OpenTable()
|
||||
''' base.OpenQuery()
|
||||
''' database.OpenTable()
|
||||
''' database.OpenQuery()
|
||||
''' database.OpenSql()
|
||||
''' Args:
|
||||
''' 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, 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
|
||||
|
||||
Finally:
|
||||
Set _NewDatasheet = oDatasheet
|
||||
Exit Function
|
||||
Catch:
|
||||
Set oDatasheet = Nothing
|
||||
GoTo Finally
|
||||
End Function ' SFDatabases.SF_Register._NewDatasheet
|
||||
|
||||
REM ============================================== END OF SFDATABASES.SF_REGISTER
|
||||
</script:module>
|
||||
@@ -0,0 +1,26 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="__License" script:language="StarBasic" script:moduleType="normal">
|
||||
''' Copyright 2019-2022 Jean-Pierre LEDURE, Rafael LIMA, Alain ROMEDENNE
|
||||
|
||||
REM =======================================================================================================================
|
||||
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
||||
REM === The SFDatabases library is one of the associated libraries. ===
|
||||
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
''' ScriptForge is distributed in the hope that it will be useful,
|
||||
''' but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option):
|
||||
|
||||
''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not
|
||||
''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ .
|
||||
|
||||
''' 2) The GNU Lesser General Public License as published by
|
||||
''' the Free Software Foundation, either version 3 of the License, or
|
||||
''' (at your option) any later version. If a copy of the LGPL was not
|
||||
''' distributed with this file, see http://www.gnu.org/licenses/ .
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,3 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDatabases" library:readonly="false" library:passwordprotected="false"/>
|
||||
@@ -0,0 +1,8 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDatabases" library:readonly="false" library:passwordprotected="false">
|
||||
<library:element library:name="SF_Register"/>
|
||||
<library:element library:name="__License"/>
|
||||
<library:element library:name="SF_Database"/>
|
||||
<library:element library:name="SF_Datasheet"/>
|
||||
</library:library>
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user