1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
<?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>
|
