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
|
<?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="Currency" script:language="StarBasic">REM ***** BASIC *****
Option Explicit
Dim bDoUnLoad as Boolean
Sub Startup()
Dim i as Integer
Dim a as Integer
Dim ListString as String
Dim MarketListBoxControl as Object
Initialize(False)
MarketListBoxControl = DlgStartUp.GetControl("lstMarkets")
a = 0
For i = 0 To Ubound(sMarket(),1)
ListString = sMarket(i,0)
If sMarket(i,0) <> "" Then
If sMarket(i,3) = "" Then
ListString = ListString & " (" & sNoInternetUpdate & ")"
Else
ListString = ListString & " (" & sMarketplace & " " & sMarket(i,2) & ")"
End If
MarketListBoxControl.AddItem(ListString, a)
a = a + 1
End If
Next i
MarketListBoxControl.SelectItemPos(GlobListIndex, True)
DlgStartUp.Title = sDepotCurrency
DlgStartUp.Model.cmdGoOn.DefaultButton = True
DlgStartUp.GetControl("lstMarkets").SetFocus()
DlgStartUp.Execute()
DlgStartUp.Dispose()
End Sub
Sub EnableGoOnButton()
StartUpModel.cmdGoOn.Enabled = True
StartUpModel.cmdGoOn.DefaultButton = True
End Sub
Sub CloseStartUpDialog()
DlgStartUp.EndExecute()
' oDocument.Dispose()
End Sub
Sub DisposeDocument()
If bDoUnload Then
oDocument.Dispose()
End If
End Sub
Sub ChooseMarket(Optional aEvent)
Dim Index as Integer
Dim bIsDocLanguage as Boolean
Dim bIsDocCountry as Boolean
oInternetModel = GetControlModel(oDocument.Sheets(0), "CmdInternet")
If Not IsMissing(aEvent) Then
Index = StartupModel.lstMarkets.SelectedItems(0)
oInternetModel.Tag = Index
Else
Index = oInternetModel.Tag
End If
oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory")
sCurCurrency = sMarket(Index,1)
If Index = 0 Then
HistoryChartSource = sMarket(Index,4)
End If
sCurStockIDLabel = sMarket(Index,5)
sCurExtension = sMarket(Index,8)
iValueCol = Val(sMarket(Index,10)
If Instr(sCurExtension,";") <> 0 Then
' Take the german extension as the stock place is Frankfurt
sCurExtension = "407"
End If
sCurChartSource = sMarket(Index,3)
bIsDocLanguage = Instr(1, sMarket(Index,6), sDocLanguage, SBBINARY) <> 0
bIsDocCountry = Instr(1, sMarket(Index,7), sDocCountry, SBBINARY) <> 0 OR SDocCountry = ""
sCurSeparator = sMarket(Index,9)
TransactModel.txtRate.CurrencySymbol = sCurCurrency
TransactModel.txtFix.CurrencySymbol = sCurCurrency
TransactModel.txtMinimum.CurrencySymbol = sCurCurrency
bEnableMarket = Index = 0
bEnableInternet = sCurChartSource <> ""
oMarketModel.Enabled = bEnableMarket
oInternetModel.Enabled = bEnableInternet
If Not IsMissing(aEvent) Then
ConvertStylesCurrencies()
bDoUnload = False
DlgStartUp.EndExecute()
End If
End Sub
Sub ConvertStylesCurrencies()
Dim m as integer
Dim aStyleFormat as Object
Dim StyleName as String
Dim bAddToList as Boolean
Dim oStyle as Object
Dim oStyles as Object
UnprotectSheets(oSheets)
oFirstSheet.GetCellByPosition(SBCOLUMNID1, SBROWHEADER1).SetString(sCurStockIDLabel)
oStyles = oDocument.StyleFamilies.GetbyIndex(0)
For m = 0 To oStyles.count-1
oStyle = oStyles.GetbyIndex(m)
StyleName = oStyle.Name
bAddToList = CheckFormatType(oStyle)
If bAddToList Then
SwitchNumberFormat(ostyle, oDocFormats, sCurCurrency, sCurExtension)
End If
Next m
ProtectSheets(oSheets)
End Sub
Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String, sNewExtension as String)
Dim nFormatLanguage as Integer
Dim nFormatDecimals as Integer
Dim nFormatLeading as Integer
Dim bFormatLeading as Integer
Dim bFormatNegRed as Integer
Dim bFormatThousands as Integer
Dim aNewStr as String
Dim iNumberFormat as Long
Dim sSimpleStr as String
Dim nSimpleKey as Long
Dim aFormat()
Dim oLocale as New com.sun.star.lang.Locale
' Numberformat with the new Symbol as Base for new Format
sSimpleStr = "0 [$" & sNewSymbol & "-" & sNewExtension & "]"
nSimpleKey = Numberformat(oFormats, sSimpleStr, oDocLocale)
On Local Error Resume Next
iNumberFormat = oObject.NumberFormat
If Err <> 0 Then
Msgbox "Error Reading the Number Format"
Resume CLERROR
End If
On Local Error GoTo NOKEY
aFormat() = oFormats.getByKey(iNumberFormat)
On Local Error GoTo 0
' set new currency format with according settings
nFormatDecimals = aFormat.Decimals
nFormatLeading = aFormat.LeadingZeros
bFormatNegRed = aFormat.NegativeRed
bFormatThousands = aFormat.ThousandsSeparator
oLocale = aFormat.Locale
aNewStr = oFormats.generateFormat(nSimpleKey, oLocale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
oObject.NumberFormat = Numberformat(oFormats, aNewStr, oLocale)
NOKEY:
If Err <> 0 Then
Resume CLERROR
End If
CLERROR:
End Sub
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Variant )
Dim nRetkey
nRetKey = oFormats.queryKey(aFormatStr, oLocale, True)
If nRetKey = -1 Then
nRetKey = oFormats.addNew( aFormatStr, oLocale )
If nRetKey = -1 Then nRetKey = 0
End If
Numberformat = nRetKey
End Function
Function CheckFormatType(oStyle as Object)
Dim oFormatofObject as Object
oFormatofObject = oDocFormats.getByKey(oStyle.NumberFormat)
CheckFormatType = INT(oFormatOfObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
End Function</script:module>
|
