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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
<?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 *****
Option Explicit
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
If CurControlType = cImageControl Then
GetPreferredWidth() = 2000
Else
If Not IsMissing(LocText) Then
aPeerSize = GetPeerSize(oModel, oControl, LocText)
Else
aPeerSize = GetPeerSize(oModel, oControl)
End If
nWidth = aPeerSize.Width
GetPreferredWidth = (nWidth + 4) * XPixelFactor ' PixelTo100thmm(nWidth)
End If
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 = nHeight * YPixelFactor ' 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
If oControl.Model.EffectiveMax = 0 Then
' This is relevant for decimal fields
oControl.Model.EffectiveValue = 999.9999
Else
oControl.Model.EffectiveValue = oControl.Model.EffectiveMax
End If
ElseIf CurFieldType = com.sun.star.sdbc.DataType.BIT Then
aPeerSize = oPeer.PreferredSize
ElseIf Not IsMissing(LocText) Then
oControl.Text = LocText
ElseIf CurFieldType = com.sun.star.sdbc.DataType.DATE Then
oControl.Model.Date = Date
ElseIf CurFieldType = com.sun.star.sdbc.DataType.TIME Then
oControl.Time = Time
Else
' oControl.Text = Mid(SBSIZETEXT,1,CurFieldLength)
aPeerSize = oPeer.PreferredSize()
GetPeerSize() = aPeerSize
Exit Function
End If
aPeerSize = oPeer.PreferredSize()
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 PixelTo100thMMX(oControl as Object) as long
oPeer = oControl.GetPeer()
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterX/100000)
' PixelTo100thMM = nValue * 28 ' nur ungefähre Berechnung
End function
Function PixelTo100thMMY(oControl as Object) as long
oPeer = oControl.GetPeer()
PixelTo100mmX = Clng(Peer.GetInfo.PixelPerMeterY/100000)
' 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
ToggleLayoutPage(False)
oDocument.LockControllers
CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8)
sImportPath = Styles(8,CurIndex)
bWithBackGraphic = LoadNewStyles(oDocument, oDialogModel, CurIndex, sImportPath, Styles(), TexturePath)
ControlCaptionsToStandardLayout()
ToggleOptionButtons(oDialogModel, bWithBackGraphic)
ConfigurePageStyle()
oDocument.UnlockControllers
ToggleLayoutPage(True, "lstStyles")
End Sub
Function SetNumerics(ByVal oLocObject as Object, iLocFieldType as Integer) 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 iLocFieldType
Case com.sun.star.sdbc.DataType.BIGINT
oLocObOject.EffectiveMax = 2147483647 * 2147483647
oLocbject.EffectiveMin = -(-2147483648 * -2147483648)
oLocObject.DecimalAccuracy = 0
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
oLocObject.DecimalAccuracy = 0
Case com.sun.star.sdbc.DataType.TINYINT
oLocObject.EffectiveMax = 127
oLocObject.EffectiveMin = -128
oLocObject.DecimalAccuracy = 0
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
' oLocObject.Scale = 0
' Todo: Hier sollte die Property "Scale" zusammen mit der Precision abgefragt werden, um die Nachkommastellen richtig darzustellen,
' da ein EffectiveMax/EffectiveMin hier keinen Sinn macht
' oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen
Case com.sun.star.sdbc.DataType.CHAR, com.sun.star.sdbc.DataType.VARCHAR, com.sun.star.sdbc.DataType.LONGVARCHAR
If oLocObject.MaxTextLen = 0 Or oLocObject.MaxTextLen > 30 Then
oLocObject.MaxTextLen = 30
CurFieldLength = 30
Else
oLocObject.MaxTextLen = CurFieldLength
End If
oLocObject.DefaultText = Mid(SBSIZETEXT,1,CurFieldLength)
Case com.sun.star.sdbc.DataType.DATE, com.sun.star.sdbc.DataType.TIME
oLocObject.MaxTextLen = CurFieldLength
End Select
End Function
' Destroy all Shapes in Nirwana
Sub RemoveShapes()
Dim n as Integer
Dim oControl as Object
Dim oShape 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 CountItemsInArray(BigArray(), SearchItem)
Dim i as Integer
Dim MaxIndex as Integer
Dim ResCount as Integer
ResCount = 0
MaxIndex = Ubound(BigArray())
For i = 0 To MaxIndex
If SearchItem = BigArray(i) Then
ResCount = ResCount + 1
End If
Next i
CountItemsInArray() = ResCount
End Function
Function GetDBHeight(oDBModel as Object)
If CurControlType = cImageControl Then
nDBWidth = 2000
Else
If bIsVeryFirstValueField Then
' Todo: Hier wird vereinfachend davon ausgegangen, dass alle DB-Feldern immer die selbe Höhe wie Textfelder haben
nDBRefHeight = GetPreferredHeight(oDBModel)
bIsVeryFirstValueField = False
End If
'Todo: Vielleicht könnte man dieses Feld auch noch tiefer machen
If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then
oDBModel.MultiLine = True
nDBHeight = nDBRefHeight * 4
Else
nDBHeight = nDBRefHeight
End If
End If
GetDBHeight() = nDBHeight
End Function
</script:module>
|
