office-gobmx/wizards/source/webwizard/Common.xba
2002-11-06 14:20:48 +00:00

145 lines
No EOL
4.4 KiB
XML

<?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&apos;, oStyle as Object
Dim StylesOptions(0) as New com.sun.star.beans.PropertyValue
If SourceFile &lt;&gt; &quot;&quot; Then
StylesOptions(0).Name = &quot;OverwriteStyles&quot;
StylesOptions(0).Value = True
oDocument.StyleFamilies.LoadStylesFromURL(SourceFile, StylesOptions())
End If
&apos; Read array fields for background, bullet &amp; graphics
BackgroundURL = Styles(CurIndex, 7)
If Left(BackgroundURL, 1) &lt;&gt; &quot;#&quot; Then
BackgroundURL = TextureDir + BackgroundURL
bLocWithBackGraphic = True
Else
BackColor = clng(&quot;&amp;H&quot; &amp; Right(BackgroundURL, Len(BackgroundURL)-1))
bLocWithBackGraphic = False
End If
oFamilies = oDocument.StyleFamilies
oFamily = oFamilies.GetbyName(&quot;PageStyles&quot;)
For i = 0 To oFamily.Count - 1
If oFamily.GetByIndex(i).IsInUse Then
oStyle = oFamily.GetbyIndex(i)
If oStyle.PropertySetInfo.HasPropertybyName(&quot;BackGraphicURL&quot;) Then
If Left(BackgroundURL, 1) = &quot;#&quot; Then
oStyle.BackGraphicURL = &quot;&quot;
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 &lt;&gt; 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(&quot;PageStyles&quot;)
For i = 0 To oPageFamily.Count - 1
If oPageFamily.GetByIndex(i).IsInUse Then
oStyle = oPageFamily.GetbyIndex(i)
If oStyle.PropertySetInfo.HasPropertybyName(&quot;BackGraphicURL&quot;) Then
If oStyle.BackGraphicUrl &lt;&gt; &quot;&quot; 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(&quot;PageStyles&quot;)
For i = 0 To oFamily.Count - 1
If oFamily.GetByIndex(i).IsInUse Then
oStyle = oFamily.GetbyIndex(i)
If oStyle.PropertySetInfo.HasPropertybyName(&quot;BackGraphicURL&quot;) 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
&apos; Startup for WebWizard
SelValue = sList(0,1)
Else
n = oListbox.SelectedItems(0)
SelValue = oListbox.StringItemList(n)
End If
&apos; 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>