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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
<?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="tools" script:language="StarBasic">REM ***** BASIC *****
Function SetProgressValue(iValue as Integer)
If iValue = 0 Then
oProgressbar.End
End If
ProgressValue = iValue
oProgressbar.Value = iValue
End Function
Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText)
Dim aPeerSize as new com.sun.star.awt.Size
Dim nWidth as Integer
Dim oControl as Object
' Todo: Wie geht das mit ImageControls
' kann nur fest verdrahtet werden
If Not IsMissing(LocText) Then
aPeerSize = GetPeerSize(oModel, oControl, LocText)
Else
aPeerSize = GetPeerSize(oModel, oControl
End If
nWidth = aPeerSize.Width
GetPreferredWidth = PixelTo100thmm(nWidth)
End Function
Function GetPreferredHeight(oModel as Object, Optional LocText)
Dim aPeerSize as new com.sun.star.awt.Size
Dim nHeight as Integer
Dim oControl as Object
' Todo: Wie geht das mit ImageControls
If Not IsMissing(LocText) Then
aPeerSize = GetPeerSize(oModel, oControl, LocText)
Else
aPeerSize = GetPeerSize(oModel, oControl)
End If
nHeight = aPeerSize.Height
GetPreferredHeight = PixelTo100thmm(nHeight)
End Function
Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText)
Dim oPeer as Object
Dim aPeerSize as new com.sun.star.awt.Size
oControl = oController.GetControl(oModel)
oPeer = oControl.GetPeer()
If oControl.Model.PropertySetInfo.HasPropertybyName("EffectiveMax") Then
oControl.Model.EffectiveDefault = oControl.Model.EffectiveMax
' Todo: Remove this Hack due to Bug #88391
' oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
aPeerSize = oPeer.PreferredSize()
ElseIf Not IsMissing(LocText) Then
oControl.Text = LocText
aPeerSize = oPeer.PreferredSize()
Else
oControl.Text = "2222222222"
aPeerSize = oPeer.PreferredSize()
oControl.Text = ""
End If
GetPeerSize = aPeerSize
End Function
Function TwipToCM(BYVAL nValue as long) as String
TwipToCM = trim(str(nValue / 567)) + "cm"
End function
Function TwipTo100telMM(BYVAL nValue as long) as long
TwipTo100telMM = nValue / 0.567
End function
Function TwipToPixel(BYVAL nValue as long) as long ' nur ungefaehre Berechnung
TwipToPixel = nValue / 15
End function
Function PixelTo100thMM(BYVAL nValue as long) as long
PixelTo100thMM = nValue * 28 ' nur ungefähre Berechnung
End function
Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point
Dim aPoint as New com.sun.star.awt.Point
aPoint.X = xPos
aPoint.Y = yPos
GetPoint() = aPoint
End Function
Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
Dim aSize As New com.sun.star.awt.Size
aSize.Width = iWidth
aSize.Height = iHeight
GetSize() = aSize
End Function
Sub ImportStyles()
Dim CurIndex as Integer
Dim sImportPath as String
' oDocument.LockControllers
CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
sImportPath = Styles(8,CurIndex)
LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
ControlCaptionsToStandardLayout()
ConfigurePageStyle()
' oDocument.UnlockControllers
End Sub
Function SetNumerics(ByVal oLocObject as Object) as Object
' Todo: FS fragen, ob dies alles richtig ist
' Todo: Es sollte in der Hilfe darauf hingewiesen werden, dass der untere Wertbereich negativ ist.
Select Case CurFieldType
Case com.sun.star.sdbc.DataType.BIGINT
oLocObOject.EffectiveMax = 2147483647 * 2147483647
oLocbject.EffectiveMin = -(-2147483648 * -2147483648)
Case com.sun.star.sdbc.DataType.INTEGER
oLocObject.EffectiveMax = 2147483647
oLocObject.EffectiveMin = -2147483648
Case com.sun.star.sdbc.DataType.SMALLINT
oLocObject.EffectiveMax = 32767
oLocObject.EffectiveMin = -32768
Case com.sun.star.sdbc.DataType.TINYINT
oLocObject.EffectiveMax = 127
oLocObject.EffectiveMin = -128
Case com.sun.star.sdbc.DataType.FLOAT, com.sun.star.sdbc.DataType.REAL, com.sun.star.sdbc.DataType.DOUBLE, com.sun.star.sdbc.DataType.DECIMAL, com.sun.star.sdbc.DataType.NUMERIC
' Todo: Hier sollte der Numberformatter angeworfen werden um die Nachkommastellen
' festzulegen
' oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen
End Select
End Function
' Destroy all Shapes in Nirwana
Sub RemoveShapes()
Dim n as Integer
Dim oControl as Object
For n = oDrawPage.Count-1 To 0 Step -1
oShape = oDrawPage(n)
If oShape.Position.Y > -2000 Then
oDrawPage.Remove(oShape)
End If
Next n
End Sub
' Note as Shapes cannot be removed from the DrawPage without destroying
' the object we have to park them somewhere in Nirwana
Sub ShapesToNirwana()
Dim n as Integer
Dim oControl as Object
For n = 0 To oDrawPage.Count-1
oDrawPage(n).Position = GetPoint(-20, -10000)
Next n
End Sub
Function CalcUniqueContentName(BYVAL oContainer as Object, sBaseName as String) as String
Dim nPostfix as Integer
Dim sReturn as String
nPostfix = 2
sReturn = sBaseName
while (oContainer.hasByName(sReturn))
sReturn = sBaseName & nPostfix
nPostfix = nPostfix + 1
Wend
CalcUniqueContentName = sReturn
End Function
Function AddListtoList(FirstArray(), SecondArray(), Optional StarIndex)
Dim n as Integer
Dim m as Integer
Dim MaxIndex as Integer
MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1
Dim ResultArray(MaxIndex)
For m = 0 To Ubound(FirstArray())
ResultArray(m) = FirstArray(m)
Next m
For n = 0 To Ubound(SecondArray())
ResultArray(m) = SecondArray(n)
m = m + 1
Next n
AddListToList() = ResultArray()
End Function</script:module>
|