PC World 2004 May/PCWorld_2004-05_cd.bin/akce/openoffice/f_0109/Common.xba

Extensible Markup Language | 2002-11-06 | 5KB | 145 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(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

</script:module>