From 940b4d1848e8c70ab7642901a68594e8016caffc Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sat, 27 Apr 2024 18:51:28 +0200 Subject: Adding upstream version 1:7.0.4. Signed-off-by: Daniel Baumann --- wizards/source/depot/Currency.xba | 195 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 195 insertions(+) create mode 100644 wizards/source/depot/Currency.xba (limited to 'wizards/source/depot/Currency.xba') diff --git a/wizards/source/depot/Currency.xba b/wizards/source/depot/Currency.xba new file mode 100644 index 000000000..d728424d3 --- /dev/null +++ b/wizards/source/depot/Currency.xba @@ -0,0 +1,195 @@ + + + +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 -- cgit v1.2.3