Option Explicit ' Todo: Gruppieren der DBControls mit den Textfeldern einbinden ' Evtl könnte dies auch am Ende geschehen Public DocumentName as String Public FormPath$, FormDBName$, FormReturnValue$ Public TemplatePath$ Public WizardPath as String Public WebWizardPath as String Public WorkPath as String Public TexturePath as String Public sQueryName as String Public NumberofStyles as Integer Public oDBConnection as Object 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 oDBContext as Object Public oUcb as Object Public oDocInfo as Object 'Public TemplateList(50,1) as String Public WidthList(15,4) Public ImgWidthList(3,4) Public sDBName as String Public Tablename as String ' Todo: Mit FS abschnacken, dass als CommandType Nur Queries und Tables zugelassen sind. Dabei müsste noch abgklärt werden ' wann ein Content ein 'Command' ist. Sub MainWithDefault(Optional DatasourceName as String, Optional CommandType as Integer, Optional sContent as String, Optional oConnection as Object) 'On Local Error Goto GlobalError BasicLibraries.LoadLibrary("Tools") BasicLibraries.LoadLibrary("WebWizard") ' Todo: Variable is initialized due to Bug#88329 CurArrangement = 0 bControlsareCreated = False 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") FormPath = GetOfficeSubPath("Template","wizard/bitmap") WebWizardPath = GetOfficeSubPath("Template","wizard/web") WizardPath = GetOfficeSubPath("Template","wizard/") TexturePath = GetOfficeSubPath("Gallery", "www-back/") WorkPath = GetPathSettings("Work") OpenFormDocument() GetDatabaseNames() InitializeWidthList() LoadLanguage bNeedFieldRefresh = True If Not IsMissing(DataSourceName) Then CreateForm(DatasourceName, CommandType, sContent, oConnection) Else CreateForm() End If GlobalError: If Err <> 0 Then ToggleWindow(True) MsgBox(sMsgErrMsg , 16, sMsgWizardName) End If End Sub Sub CreateForm(Optional DatasourceName as String, Optional CommandType as Integer, Optional sContent as String, Optional oConnection as Object) as String Dim i as Integer With oDialogModel .optIgnoreBinaries.State = True .cmdBack.Enabled = False .cmdGoOn.Enabled = False .lblTables.Enabled = False .lstSelFields.Tag = False .Step = 1 .lstDatabases.StringItemList()= sDatabaseList()' = AddItem(sDatabaseList(i) End With If Not IsMissing(DataSourceName) Then DlgFormDB.GetControl("lstDatabases").SelectItem(DataSourceName, True) Set oDBConnection = oConnection If GetDBMetaData() Then oDialogModel.lstTables.StringItemList() = AddListToList(TableNames(), QueryNames()) iCommandTypes() = CreateCommandTypeList() SelCount = CountItemsInArray() If SelCount = 1 Then DlgFormDB.GetControl("lstTables").SelectItem(sContent, True) Else ' Note here is no Error Handling in case that no valid content is transferred 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 Else ToggleListboxControls(oDialogModel, False) End If DlgFormDB.Title = WizardTitle(1) NumberofStyles = FillupWebListbox(oUcb, "/stl", DlgFormDB, "lstStyles", Styles()) ImportStyles() ToggleWindow(True) oDialogModel.imgTheme.ImageURL = FormPath & "FormWizard_1.bmp" DlgFormDB.Execute() Exit Sub GlobalError: MsgBox(sMsgErrMsg , 16, sMsgWizardName) ToggleWindow(True) DlgFormDB.Execute() Reset Stop 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 n = Ubound(oDialogModel.lstTables.SelectedItems()) If n > -1 Then SelIndex = oDialogModel.lstTables.SelectedItems(0) If bGetCommandType Then CurCommandType = iCommandTypes(SelIndex) End If Tablename = Tablenames(SelIndex) If CurCommandType = com.sun.star.sdb.CommandType.QUERY Then oColumns = oDBConnection.Queries.GetByName(TableName).Columns Else oColumns = oDBConnection.Tables.GetByName(Tablename).Columns End If GetSpecificFieldNames() ToggleListboxControls(oDialogModel, True) End If Exit Sub 'TODO: Diese Fehlermarke sinnvoll einbinden NOFIELDS: MsgBox sMsgErrCouldNotOpenObject, 16, sMsgWizardName End Sub Sub CancelFormWizard() DlgFormDB.EndExecute() DlgFormDB.Dispose() oDocument.Dispose() If Not IsNull(oDBConnection) Then oDBConnection.Dispose() End If Stop End Sub Sub PreviousStep() With oDialogModel .Step = 1 .cmdBack.Enabled = False .cmdGoOn.Enabled = True .lstSelFields.Tag = Not bControlsareCreated .cmdGoOn.Label = sGoOn .imgTheme.ImageUrl = FormPath & "FormWizard_1.bmp" End With DlgFormDB.Title = WizardTitle(1) End Sub Sub NextStep() Dim bOldVisible ' Note: Unfortunately it is not possible to query the visibility of the imagecontrol directly bOldVisible = oDialogModel.Height > 40 Select Case oDialogModel.Step Case 1 bControlsAreCreated = Not (CBool(oDialogModel.lstSelFields.Tag)) If Not bControlsAreCreated Then GetTableMetaData() CreateDBForm() RemoveShapes() InitializeLayoutSettings() oDBForm.Load End If oDialogModel.cmdGoOn.Label = sReady oDialogModel.cmdBack.Enabled = True oDialogModel.Step = 2 Case 2 StoreForm() End Select DlgFormDB.GetControl("imgTheme").Visible = bOldVisible oDialogModel.imgTheme.ImageUrl = FormPath & "FormWizard_" & oDialogModel.Step & ".bmp" DlgFormDB.Title = WizardTitle(oDialogModel.Step) End Sub Sub InitializeLayoutSettings() If oPageStyle.BackGraphicLocation = com.sun.star.style.GraphicLocation.TILED Then oDialogModel.optTiled.State = 1 Else oDialogModel.optArea.State = 1 End If SwitchArrangementButtons(cTabled) SwitchAlignMode(SBALIGNLEFT) SwitchBorderMode(SB3DBORDER) ToggleBorderGroup(bControlsAreCreated) ToggleAlignGroup(bControlsAreCreated) ArrangeControls() If OldAlignMode <> 0 Then DlgFormDB.GetControl("cmdAlign" & OldAlignmode).Model.State = 0 End If End Sub Sub ToggleDatabasePage(bDoEnable as Boolean) With oDialogModel .hlnBinaries.Enabled = bDoEnable .optIgnoreBinaries.Enabled = bDoEnable .optBinariesasGraphics.Enabled = bDoEnable .cmdHelp.Enabled = bDoEnable End With End Sub Sub StoreForm() Dim bDocIsStored as Boolean Dim FilterNames(1,2) as String Dim oMasterKey as Object Dim oFilters() as Object oMasterKey = GetRegistryKeyContent("org.openoffice.Office.TypeDetection/") oFilters() = oMasterKey.Types FilterNames(0,0) = oFilters.GetByName("writer_StarOffice_XML_Writer").UIName FilterNames(0,1) = "*.sxw" FilterNames(0,2) = "" FilterNames(1,0) = oFilters.GetByName("writer_StarOffice_XML_Writer_Template").UIName FilterNames(1,1) = "*.stw" FilterNames(1,2) = "swriter: writer_StarOffice_XML_Writer_Template" bDocIsStored = StoreDocument(oDocument, FilterNames(), "Form_" & sDBName & "." & TableName, WorkPath) If bDocIsStored Then DlgFormDB.EndExecute() oDBConnection.Dispose End If End Sub Sub HelperDialog() 'Todo: The String "start" can be replaced by a HelpIndex StarDesktop.LoadComponentfromUrl("vnd.sun.star.help://" & sDocType & "/start", "_OFFICE_HELP", 64, NoArgs()) End Sub