Option Explicit Public DocumentName as String Public FormPath as String Public WizardPath as String Public WebWizardPath as String Public WorkPath 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() 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 ' 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 SelList(0) = 0 BasicLibraries.LoadLibrary("Tools") BasicLibraries.LoadLibrary("WebWizard") 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","dbw") 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 = 5 GetDatabaseNames() oProgressBar.Value = 10 InitializeWidthList() oProgressBar.Value = 20 LoadLanguage() oProgressBar.Value = 30 Styles() = getListBoxArrays(oUcb, "/stl") CurIndex = GetCurIndex(DialogModel, Styles(), 2) oProgressBar.Value = 40 ConfigurePageStyle() oProgressBar.Value = 50 InitializeLabelValues() bNeedFieldRefresh = True SetDialogLanguage() With DialogModel .cmdBack.Enabled = False .cmdGoOn.Enabled = False .lblTables.Enabled = False .lstSelFields.Tag = False .Step = 1 .lstDatabases.StringItemList()= sDatabaseList()' = AddItem(sDatabaseList(i) End With oProgressBar.Value = 60 If Not IsMissing(DataSourceName) Then sDBName = DataSourceName DlgFormDB.GetControl("lstDatabases").SelectItem(DataSourceName, True) 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 DialogModel.lstTables.StringItemList() = AddListToList(TableNames(), QueryNames()) iCommandTypes = CreateCommandTypeList() If Not IsMissing(sContent) Then ' Scenario 4: all parameters (data source name, connection, object type and object) are given 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) End If End If Else ' Scenario 2: Only Datasourcename is given, but no connection and no Content GetSelectedDBMetaData() 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.bmp" ToggleDatabasePage(True) oProgressBar.Value = 100 DlgFormDB.GetControl("lstDatabases").SetFocus() oProgressbar.End RetValue = DlgFormDB.Execute() DlgFormDB.Dispose() If Not IsNull(oDBConnection) Then oDBConnection.Dispose() End If If bDisposeDoc Then DisposeDocument(oDocument) ElseIf RetValue = 0 Then RemoveNirwanaShapes() End If WIZARDERROR: If Err <> 0 Then Msgbox(sMsgErrMsg, 16, GetProductName()) Resume LOCERROR LOCERROR: End If End Sub Sub FormGetFields() Dim i as Integer ToggleDatabasePage(False) FillUpFieldsListbox(True) ToggleDatabasePage(True) End Sub Sub FillUpFieldsListbox(bGetCommandType as Boolean) Dim n as Integer Dim SelIndex as Integer Dim QueryIndex as Integer If Not bDebug Then On Local Error GoTo NOFIELDS End If n = Ubound(DialogModel.lstTables.SelectedItems()) If n > -1 Then SelIndex = DialogModel.lstTables.SelectedItems(0) 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) Else EmptyFieldsListboxes() End If Else EmptyFieldsListboxes() End If 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.bmp" 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() End Select DialogModel.imgTheme.ImageUrl = FormPath & "FormWizard_" & DialogModel.Step & ".bmp" 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 StoreForm() Dim sTargetPath as String Dim TypeNames(0,2) as String Dim oMasterKey as Object Dim oTypes() as Object oMasterKey = GetRegistryKeyContent("org.openoffice.Office.TypeDetection/") oTypes() = oMasterKey.Types TypeNames(0,0) = oTypes.GetByName("writer_StarOffice_XML_Writer").UIName TypeNames(0,1) = "*.sxw" TypeNames(0,2) = "" sTargetPath = StoreDocument(oDocument, TypeNames(), "Form_" & sDBName & "_" & TableName & ".sxw", WorkPath, 1) If sTargetPath <> "" Then DlgFormDB.EndExecute() End If End Sub Sub EmptyFieldsListboxes() Dim NullList() as String ToggleListboxControls(DialogModel, False) DialogModel.lstFields.StringItemList() = NullList() DialogModel.lstSelFields.StringItemList() = NullList() bEnableBinaryOptionGroup = False End Sub