D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
lib
/
libreoffice
/
share
/
basic
/
FormWizard
/
Filename :
FormWizard.xba
back
Copy
<?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>