wizards/source/depot/Currency.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <!--
   4  * This file is part of the LibreOffice project.
   5  *
   6  * This Source Code Form is subject to the terms of the Mozilla Public
   7  * License, v. 2.0. If a copy of the MPL was not distributed with this
   8  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
   9  *
  10  * This file incorporates work covered by the following license notice:
  11  *
  12  *   Licensed to the Apache Software Foundation (ASF) under one or more
  13  *   contributor license agreements. See the NOTICE file distributed
  14  *   with this work for additional information regarding copyright
  15  *   ownership. The ASF licenses this file to you under the Apache
  16  *   License, Version 2.0 (the "License"); you may not use this file
  17  *   except in compliance with the License. You may obtain a copy of
  18  *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  19 -->
  20 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Currency" script:language="StarBasic">REM  *****  BASIC  *****
  21 Option Explicit
  22
  23 Dim bDoUnLoad as Boolean
  24
  25
  26 Sub Startup()
  27 Dim i as Integer
  28 Dim a as Integer
  29 Dim ListString as String
  30 Dim MarketListBoxControl as Object
  31         Initialize(False)
  32         MarketListBoxControl = DlgStartUp.GetControl(&quot;lstMarkets&quot;)
  33         a = 0
  34         For i = 0 To Ubound(sMarket(),1)
  35                 ListString = sMarket(i,0)
  36                 If sMarket(i,0) &lt;&gt; &quot;&quot; Then
  37                         If sMarket(i,3) = &quot;&quot; Then
  38                                 ListString = ListString &amp; &quot;    (&quot; &amp; sNoInternetUpdate &amp; &quot;)&quot;
  39                         Else
  40                                 ListString = ListString &amp; &quot;    (&quot; &amp; sMarketplace &amp; &quot; &quot; &amp; sMarket(i,2) &amp; &quot;)&quot;
  41                         End If
  42                         MarketListBoxControl.AddItem(ListString, a)
  43                         a = a + 1
  44                 End If
  45         Next i
  46         MarketListBoxControl.SelectItemPos(GlobListIndex, True)
  47         DlgStartUp.Title = sDepotCurrency
  48         DlgStartUp.Model.cmdGoOn.DefaultButton = True
  49         DlgStartUp.GetControl(&quot;lstMarkets&quot;).SetFocus()
  50         DlgStartUp.Execute()
  51         DlgStartUp.Dispose()
  52 End Sub
  53
  54
  55 Sub EnableGoOnButton()
  56         StartUpModel.cmdGoOn.Enabled = True
  57         StartUpModel.cmdGoOn.DefaultButton = True
  58 End Sub
  59
  60
  61 Sub CloseStartUpDialog()
  62         DlgStartUp.EndExecute()
  63 &apos;  oDocument.Dispose()
  64 End Sub
  65
  66
  67 Sub DisposeDocument()
  68         If bDoUnload Then
  69                 oDocument.Dispose()
  70         End If
  71 End Sub
  72
  73
  74 Sub ChooseMarket(Optional aEvent)
  75 Dim Index as Integer
  76 Dim bIsDocLanguage as Boolean
  77 Dim bIsDocCountry as Boolean
  78         oInternetModel = GetControlModel(oDocument.Sheets(0), &quot;CmdInternet&quot;)
  79         If Not IsMissing(aEvent) Then
  80                 Index = StartupModel.lstMarkets.SelectedItems(0)
  81                 oInternetModel.Tag = Index
  82         Else
  83                 Index = oInternetModel.Tag
  84         End If
  85         oMarketModel = GetControlModel(oDocument.Sheets(0), &quot;CmdHistory&quot;)
  86         sCurCurrency = sMarket(Index,1)
  87         If Index = 0 Then
  88                 HistoryChartSource = sMarket(Index,4)
  89         End If
  90         sCurStockIDLabel = sMarket(Index,5)
  91         sCurExtension = sMarket(Index,8)
  92         iValueCol = Val(sMarket(Index,10))
  93         If Instr(sCurExtension,&quot;;&quot;) &lt;&gt; 0 Then
  94                 &apos; Take the german extension as the stock place is Frankfurt
  95                 sCurExtension = &quot;407&quot;
  96         End If
  97         sCurChartSource = sMarket(Index,3)
  98         bIsDocLanguage = Instr(1, sMarket(Index,6), sDocLanguage, SBBINARY) &lt;&gt; 0
  99         bIsDocCountry = Instr(1, sMarket(Index,7), sDocCountry, SBBINARY) &lt;&gt; 0  OR SDocCountry = &quot;&quot;
 100         sCurSeparator = sMarket(Index,9)
 101         TransactModel.txtRate.CurrencySymbol = sCurCurrency
 102         TransactModel.txtFix.CurrencySymbol = sCurCurrency
 103         TransactModel.txtMinimum.CurrencySymbol = sCurCurrency
 104         bEnableMarket = Index = 0
 105         bEnableInternet = sCurChartSource &lt;&gt; &quot;&quot;
 106         oMarketModel.Enabled = bEnableMarket
 107         oInternetModel.Enabled = bEnableInternet
 108         If Not IsMissing(aEvent) Then
 109                 ConvertStylesCurrencies()
 110                 bDoUnload = False
 111                 DlgStartUp.EndExecute()
 112         End If
 113 End Sub
 114
 115
 116 Sub ConvertStylesCurrencies()
 117 Dim m as integer
 118 Dim aStyleFormat as Object
 119 Dim StyleName as String
 120 Dim bAddToList as Boolean
 121 Dim oStyle as Object
 122 Dim oStyles as Object
 123         UnprotectSheets(oSheets)
 124         oFirstSheet.GetCellByPosition(SBCOLUMNID1, SBROWHEADER1).SetString(sCurStockIDLabel)
 125         oStyles = oDocument.StyleFamilies.GetbyIndex(0)
 126         For m = 0 To oStyles.count-1
 127                 oStyle = oStyles.GetbyIndex(m)
 128                 StyleName = oStyle.Name
 129                 bAddToList = CheckFormatType(oStyle)
 130                 If bAddToList Then
 131                         SwitchNumberFormat(ostyle, oDocFormats, sCurCurrency, sCurExtension)
 132                 End If
 133         Next m
 134         ProtectSheets(oSheets)
 135 End Sub
 136
 137
 138 Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String, sNewExtension as String)
 139 Dim nFormatLanguage as Integer
 140 Dim nFormatDecimals as Integer
 141 Dim nFormatLeading as Integer
 142 Dim bFormatLeading as Integer
 143 Dim bFormatNegRed as Integer
 144 Dim bFormatThousands as Integer
 145 Dim aNewStr as String
 146 Dim iNumberFormat as Long
 147 Dim sSimpleStr as String
 148 Dim nSimpleKey as Long
 149 Dim aFormat()
 150 Dim oLocale as New com.sun.star.lang.Locale
 151         &apos; Numberformat with the new Symbol as Base for new Format
 152         sSimpleStr = &quot;0 [$&quot; &amp; sNewSymbol &amp; &quot;-&quot; &amp; sNewExtension &amp; &quot;]&quot;
 153         nSimpleKey = Numberformat(oFormats, sSimpleStr, oDocLocale)
 154         On Local Error Resume Next
 155         iNumberFormat = oObject.NumberFormat
 156         If Err &lt;&gt; 0 Then
 157                 Msgbox &quot;Error Reading the Number Format&quot;
 158                 Resume CLERROR
 159         End If
 160
 161         On Local Error GoTo NOKEY
 162         aFormat() = oFormats.getByKey(iNumberFormat)
 163         On Local Error GoTo 0
 164         &apos; set new currency format with according settings
 165         nFormatDecimals = aFormat.Decimals
 166         nFormatLeading = aFormat.LeadingZeros
 167         bFormatNegRed = aFormat.NegativeRed
 168         bFormatThousands = aFormat.ThousandsSeparator
 169         oLocale = aFormat.Locale
 170         aNewStr = oFormats.generateFormat(nSimpleKey, oLocale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
 171         oObject.NumberFormat = Numberformat(oFormats, aNewStr, oLocale)
 172         NOKEY:
 173         If Err &lt;&gt; 0 Then
 174                 Resume CLERROR
 175         End If
 176         CLERROR:
 177 End Sub
 178
 179
 180 Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Variant )
 181 Dim nRetkey
 182         nRetKey = oFormats.queryKey(aFormatStr, oLocale, True)
 183         If nRetKey = -1 Then
 184                 nRetKey = oFormats.addNew( aFormatStr, oLocale )
 185                 If nRetKey = -1 Then nRetKey = 0
 186         End If
 187         Numberformat = nRetKey
 188 End Function
 189
 190
 191 Function CheckFormatType(oStyle as Object)
 192 Dim oFormatofObject as Object
 193         oFormatofObject = oDocFormats.getByKey(oStyle.NumberFormat)
 194         CheckFormatType = INT(oFormatOfObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
 195 End Function</script:module>