Quelle  Currency.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   Licensed to the Apache Software Foundation (ASF) under one or more
 *   contributor license agreements. See the NOTICE file distributed
 *   with this work for additional information regarding copyright
 *   ownership. The ASF licenses this file to you under the Apache
 *   License, Version 2.0 (the "License"); you may not use this file
 *   except in compliance with the License. You may obtain a copy of
 *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<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>