REM ***** BASIC ***** Option Explicit Function LoadNewStyles(oDocument as Object, oDialogModel as Object, CurIndex as Integer, SourceFile as String, Styles() as String, TextureDir as String) as Boolean Dim BackGroundURL as String Dim oBackGraph as Object Dim i, BackColor as Long Dim bLocWithBackGraphic as Boolean Dim oFamilies as Object, oFamily as Object', oStyle as Object Dim StylesOptions(0) as New com.sun.star.beans.PropertyValue If SourceFile <> "" Then StylesOptions(0).Name = "OverwriteStyles" StylesOptions(0).Value = True oDocument.StyleFamilies.LoadStylesFromURL(SourceFile, StylesOptions()) End If ' Read array fields for background, bullet & graphics BackgroundURL = Styles(CurIndex, 7) If Left(BackgroundURL, 1) <> "#" Then BackgroundURL = TextureDir + BackgroundURL bLocWithBackGraphic = True Else BackColor = clng("&H" & Right(BackgroundURL, Len(BackgroundURL)-1)) bLocWithBackGraphic = False End If oFamilies = oDocument.StyleFamilies oFamily = oFamilies.GetbyName("PageStyles") For i = 0 To oFamily.Count - 1 If oFamily.GetByIndex(i).IsInUse Then oStyle = oFamily.GetbyIndex(i) If oStyle.PropertySetInfo.HasPropertybyName("BackGraphicURL") Then If Left(BackgroundURL, 1) = "#" Then oStyle.BackGraphicURL = "" oStyle.BackColor = BackColor oStyle.BackTransparent = False Else oStyle.BackGraphicUrl = BackGroundURL SetTileBackgroundorNot(oDialogModel, oStyle) End If Exit For End If End If Next i LoadNewStyles() = bLocWithBackGraphic ErrorOcurred: If Err <> 0 Then MsgBox (WebWiz_gErrWhileLoadStyles$, 16, WebWiz_gWizardName$) RESUME EXITSUB EXITSUB: End If End Function Sub ChangeBackGraphicUrl(SavePath as String) Dim oPageFamily as Object Dim i as Integer oPageFamily = oBaseDocument.StyleFamilies.GetbyName("PageStyles") For i = 0 To oPageFamily.Count - 1 If oPageFamily.GetByIndex(i).IsInUse Then oStyle = oPageFamily.GetbyIndex(i) If oStyle.PropertySetInfo.HasPropertybyName("BackGraphicURL") Then If oStyle.BackGraphicUrl <> "" Then oStyle.BackGraphicUrl = CopyFile(oStyle.BackGraphicUrl, SavePath) Exit Sub End If End If End If Next i End Sub Sub SetBackGraphicStyle(oEvent as Object) Dim oFamilies as Object Dim oFamily as Object Dim i as Integer Dim oOptModel as Object Dim iBackgroundValue as Integer Dim oLocDocument as Object ooptModel = oEvent.Source.Model iBackgroundValue = Val(ooptModel.Tag) oLocDocument = StarDesktop.ActiveFrame.Controller.Model oLocDocument.LockControllers oFamilies = oLocDocument.StyleFamilies oFamily = oFamilies.GetbyName("PageStyles") For i = 0 To oFamily.Count - 1 If oFamily.GetByIndex(i).IsInUse Then oStyle = oFamily.GetbyIndex(i) If oStyle.PropertySetInfo.HasPropertybyName("BackGraphicURL") Then oStyle.BackGraphicLocation = iBackgroundValue End If End If Next i oLocDocument.UnlockControllers End Sub Sub SetTileBackgroundorNot(DialogModel as Object, oStyle as Object) If Not IsNull(DialogModel) Then If DialogModel.optTiled.State = 1 Then oStyle.BackGraphicLocation = com.sun.star.style.GraphicLocation.TILED Else oStyle.BackGraphicLocation = com.sun.star.style.GraphicLocation.AREA End If End If End Sub Sub ToggleOptionButtons(DialogModel as Object, bDoEnable as Integer) If Not IsNull(DialogModel) Then DialogModel.optTiled.Enabled = bDoEnable DialogModel.optArea.Enabled = bDoEnable DialogModel.hlnBackground.Enabled = bDoEnable End If End Sub Function GetCurIndex(oListbox as Object, sList() as String, FileIndex as Integer) Dim i as Integer Dim n as Integer Dim SelValue as String Dim MaxIndex as Integer If IsNull(oListBox) Then ' Startup for WebWizard SelValue = sList(0,1) Else n = oListbox.SelectedItems(0) SelValue = oListbox.StringItemList(n) End If ' Find field index for chosen list entry MaxIndex = Ubound(sList) For i = 0 To MaxIndex If sList(i,1) = SelValue Then FileStr = sList(i, FileIndex) Exit For End If Next GetCurIndex = i End Function