| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440 |
- <?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>
|