Chip 2002 December/Chip_2002-12_cd1.bin/tema/oo/install/f_0213/Common.xba

Extensible Markup Language | 2001-08-02 | 4.2 KB | 131 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Common" script:language="StarBasic">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(7, CurIndex)
    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
            End If
        End If
    Next i
    LoadNewStyles() = bLocWithBackGraphic
ErrorOcurred:
    If Err <> 0 Then
        MsgBox (WebWiz_gErrWhileLoadStyles$, 16, WebWiz_gWizardName$)
        CancelHTMLWizard()
    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
                    oStyleBack.GraphicUrl = 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 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 Sub


Sub    ToggleOptionButtons(DialogModel as Object, bDoEnable as Integer)
    DialogModel.optTiled.Enabled = bDoEnable
    DialogModel.optArea.Enabled = bDoEnable
    DialogModel.hlnBackground.Enabled = bDoEnable
End Sub


Function GetCurIndex(oListbox as Object, sList() as String, MaxIndex as Integer, FileIndex as Integer)
Dim i, n as Integer
Dim SelValue as String
    ' Get selected list entry
    n = oListbox.SelectedItems(0)
    SelValue = oListbox.StringItemList(n)
    ' Find field index for chosen list entry
    For i = 0 To MaxIndex
        If sList(1, i) = SelValue Then
            FileStr = sList(FileIndex, i)
            Exit For
        End If
    Next
    GetCurIndex = i
End Function

</script:module>