diff options
Diffstat (limited to 'wizards/source/depot/Internet.xba')
| -rw-r--r-- | wizards/source/depot/Internet.xba | 356 |
1 files changed, 356 insertions, 0 deletions
diff --git a/wizards/source/depot/Internet.xba b/wizards/source/depot/Internet.xba new file mode 100644 index 000000000..d3393bc72 --- /dev/null +++ b/wizards/source/depot/Internet.xba @@ -0,0 +1,356 @@ +<?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="Internet" script:language="StarBasic">REM ***** BASIC ***** +Option Explicit +Public sNewSheetName as String + +Function CheckHistoryControls() +Dim bLocGoOn as Boolean +Dim Firstdate as Date +Dim LastDate as Date + LastDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date) + FirstDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date) + bLocGoOn = FirstDate <> 0 And LastDate <> 0 + If bLocGoOn Then + If FirstDate >= LastDate Then + Msgbox(sMsgStartDatebeforeEndDate,16, sProductname) + bLocGoOn = False + End If + End If + CheckHistoryControls = bLocGoon +End Function + + +Sub InsertCompanyHistory() +Dim StockName as String +Dim CurRow as Integer +Dim sMsgInternetError as String +Dim CurRate as Double +Dim oCell as Object +Dim sStockID as String +Dim ChartSource as String + If CheckHistoryControls() Then + StartDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date) + EndDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date) + DlgStockRates.EndExecute() + If StockRatesModel.optDaily.State = 1 Then + sInterval = "d" + iStep = 1 + ElseIf StockRatesModel.optWeekly.State = 1 Then + sInterval = "w" + iStep = 7 + StartDate = StartDate - WeekDay(StartDate) + 2 + EndDate = EndDate - WeekDay(EndDate) + 2 + End If + iEndDay = Day(EndDate) + iEndMonth = Month(EndDate) + iEndYear = Year(EndDate) + iStartDay = Day(StartDate) + iStartMonth = Month(StartDate) + iStartYear = Year(StartDate) +' oDocument.AddActionLock() + UnprotectSheets(oSheets) + InitializeStatusline("", 10, 1) + oBackGroundSheet = oSheets.GetbyName("Background") + StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem() + CurRow = GetStockRowIndex(Stockname) + sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, CurRow).String + ChartSource = ReplaceString(HistoryChartSource, sStockID, "<StockID>") + ChartSource = ReplaceString(ChartSource, iStartDay, "<StartDay>") + ChartSource = ReplaceString(ChartSource, cStr(iStartMonth-1), "<StartMonth>") + ChartSource = ReplaceString(ChartSource, iStartYear, "<StartYear>") + ChartSource = ReplaceString(ChartSource, iEndDay, "<EndDay>") + ChartSource = ReplaceString(ChartSource, cStr(iEndMonth-1), "<EndMonth>") + ChartSource = ReplaceString(ChartSource, iEndYear, "<EndYear>") + ChartSource = ReplaceString(ChartSource, sInterval, "<interval>") + oStatusLine.SetValue(2) + If GetCurrentRate(ChartSource, CurRate, 1) Then + oStatusLine.SetValue(8) + UpdateValue(StockName, Today, CurRate) + oStatusLine.SetValue(9) + UpdateChart(StockName) + oStatusLine.SetValue(10) + Else + sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings + Msgbox(sMsgInternetError, 16, sProductname) + End If + ProtectSheets(oSheets) + oStatusLine.End + If oSheets.HasbyName(sNewSheetName) Then + oController.ActiveSheet = oSheets.GetByName(sNewSheetName) + End If +' oDocument.RemoveActionLock() + End If +End Sub + + + +Sub InternetUpdate() +Dim i as Integer +Dim StocksCount as Integer +Dim iStartRow as Integer +Dim sUrl as String +Dim StockName as String +Dim CurRate as Double +Dim oCell as Object +Dim sMsgInternetError as String +Dim sStockID as String +Dim ChartSource as String +' oDocument.AddActionLock() + Initialize(True) + UnprotectSheets(oSheets) + StocksCount = GetStocksCount(iStartRow) + InitializeStatusline("", StocksCount + 1, 1) + Today = CDate(Date) + For i = iStartRow + 1 To iStartRow + StocksCount + StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, i).String + sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String + ChartSource = ReplaceString(sCurChartSource, sStockID, "<StockID>") + If GetCurrentRate(ChartSource, CurRate, 0) Then + InsertCurrentValue(CurRate, i, Now) + Else + sMsgInternetError = Stockname & ": " & sNoInternetDataAvailable & chr(13) & sCheckInternetSettings + Msgbox(sMsgInternetError, 16, sProductname) + End If + oStatusline.SetValue(i - iStartRow + 1) + Next + ProtectSheets(oSheets) + oStatusLine.End +' oDocument.RemoveActionLock +End Sub + + + +Function GetCurrentRate(sUrl as String, fValue As Double, iValueRow as Integer) as Boolean +Dim sFilter As String +Dim sOptions As String +Dim oLinkSheet As Object +Dim sDate as String + If oSheets.hasByName("Link") Then + oLinkSheet = oSheets.getByName("Link") + Else + oLinkSheet = oDocument.createInstance("com.sun.star.sheet.Spreadsheet") + oSheets.insertByName("Link", oLinkSheet) + oLinkSheet.IsVisible = False + End If + + sFilter = "Text - txt - csv (StarCalc)" + sOptions = sCurSeparator & ",34,SYSTEM,1,1/10/2/10/3/10/4/10/5/10/6/10/7/10/8/10/9/10" + + oLinkSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE + oLinkSheet.link(sUrl, "", sFilter, sOptions, 1 ) + fValue = oLinkSheet.getCellByPosition(iValueCol, iValueRow).Value + If fValue = 0 Then + Dim sValue as String + sValue = oLinkSheet.getCellByPosition(1, iValueRow).String + sValue = ReplaceString(sValue, ".",",") + fValue = Val(sValue) + End If + GetCurrentRate = fValue <> 0 +End Function + + + +Sub UpdateValue(ByVal sName As String, fDate As Double, fValue As Double ) +Dim oSheet As Object +Dim iColumn As Long +Dim iRow As Long +Dim i as Long +Dim oCell As Object +Dim LastDate as Date +Dim bLeaveLoop as Boolean +Dim RemoveCount as Long +Dim iLastRow as Long +Dim iLastLinkRow as Long +Dim dDate as Date +Dim CurDate as Date +Dim oLinkSheet as Object +Dim StartIndex as Long +Dim iCellValue as Long + ' Insert Sheet with Company - Chart + sName = CheckNewSheetname(oSheets, sName) + If NOT oSheets.hasByName(sName) Then + oSheets.CopybyName("Background", sName, oSheets.Count) + oSheet = oSheets.getByName(sName) + iCurRow = SBSTARTROW + iMaxRow = iCurRow + oCell = oSheet.getCellByPosition(SBDATECOLUMN, iCurRow) + oCell.Value = fDate + End If + sNewSheetName = sName + oLinkSheet = oSheets.GetByName("Link") + oSheet = oSheets.getByName(sName) + iLastRow = GetLastUsedRow(oSheet)- 2 + iLastLinkRow = GetLastUsedRow(oLinkSheet) + iCurRow = iLastRow + bLeaveLoop = False + RemoveCount = 0 + ' Delete all Cells in Date Area + Do + oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow) + If oCell.CellStyle = sColumnHeader Then + bLeaveLoop = True + StartIndex = iCurRow + iCurRow = iCurRow + 1 + Else + RemoveCount = RemoveCount + 1 + iCurRow = iCurRow - 1 + End If + Loop Until bLeaveLoop + If RemoveCount > 1 Then + oSheet.Rows.RemoveByIndex(iCurRow, RemoveCount-1) + End If + For i = 1 To iLastLinkRow + oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow) + iCellValue = oLinkSheet.GetCellByPosition(0,i).Value + If iCellValue > 0 Then + oCell.SetValue(oLinkSheet.GetCellByPosition(0,i).Value) + Else + oCell.SetValue(StringToDate(oLinkSheet.GetCellByPosition(0,i).String)) + End If + oCell = oSheet.GetCellbyPosition(SBVALUECOLUMN,iCurRow) + oCell.SetValue(oLinkSheet.GetCellByPosition(4,i).Value) + If i < iLastLinkRow Then + iCurRow = iCurRow + 1 + oSheet.Rows.InsertByIndex(iCurRow,1) + End If + Next i + iMaxRow = iCurRow +End Sub + + +Function StringToDate(DateString as String) as Date +Dim ShortMonths(11) +Dim DateList() as String +Dim MaxIndex as Integer +Dim i as Integer + ShortMonths(0) = "Jan" + ShortMonths(1) = "Feb" + ShortMonths(2) = "Mar" + ShortMonths(3) = "Apr" + ShortMonths(4) = "May" + ShortMonths(5) = "Jun" + ShortMonths(6) = "Jul" + ShortMonths(7) = "Aug" + ShortMonths(8) = "Sep" + ShortMonths(9) = "Oct" + ShortMonths(10) = "Nov" + ShortMonths(11) = "Dec" + For i = 0 To 11 + DateString = ReplaceString(DateString,CStr(i+1),ShortMonths(i)) + Next i + DateString = ReplaceString(DateString, ".", "-") + StringToDate = CDate(DateString) +End Function + + +Sub UpdateChart(sName As String) +Dim oSheet As Object +Dim oCell As Object, oCursor As Object +Dim oChartRange As Object +Dim oEmbeddedChart As Object, oCharts As Object +Dim oChart As Object, oDiagram As Object +Dim oYAxis As Object, oXAxis As Object +Dim fMin As Double, fMax As Double +Dim nDateFormat As Long +Dim aPos As Variant +Dim aSize As Variant +Dim oContainerChart as Object +Dim mRangeAddresses(0) as New com.sun.star.table.CellRangeAddress + mRangeAddresses(0).Sheet = GetSheetIndex(oSheets, sNewSheetName) + mRangeAddresses(0).StartColumn = SBDATECOLUMN + mRangeAddresses(0).StartRow = SBSTARTROW-1 + mRangeAddresses(0).EndColumn = SBVALUECOLUMN + mRangeAddresses(0).EndRow = iMaxRow + + oSheet = oDocument.Sheets.getByName(sNewSheetName) + oCharts = oSheet.Charts + + If Not oCharts.hasElements Then + oSheet.GetCellbyPosition(2,2).SetString(sName) + oChartRange = oSheet.getCellRangeByPosition(SBDATECOLUMN,6,5,SBSTARTROW-3) + aPos = oChartRange.Position + aSize = oChartRange.Size + + Dim oRectangleShape As New com.sun.star.awt.Rectangle + oRectangleShape.X = aPos.X + oRectangleShape.Y = aPos.Y + oRectangleShape.Width = aSize.Width + oRectangleShape.Height = aSize.Height + oCharts.addNewByName(sName, oRectangleShape, mRangeAddresses(), True, False) + oContainerChart = oCharts.getByName(sName) + oChart = oContainerChart.EmbeddedObject + oChart.Title.String = "" + oChart.HasLegend = False + oChart.diagram = oChart.createInstance("com.sun.star.chart.XYDiagram") + oDiagram = oChart.Diagram + oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS + oChart.Area.LineStyle = com.sun.star.drawing.LineStyle.SOLID + oXAxis = oDiagram.XAxis + oXAxis.TextBreak = False + nDateFormat = oXAxis.NumberFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocLocale) + + oYAxis = oDiagram.getYAxis() + oYAxis.AutoOrigin = True + Else + oChart = oCharts(0) + oChart.Ranges = mRangeAddresses() + oChart.HasRowHeaders = False + oEmbeddedChart = oChart.EmbeddedObject + oDiagram = oEmbeddedChart.Diagram + oXAxis = oDiagram.XAxis + End If + oXAxis.AutoStepMain = False + oXAxis.AutoStepHelp = False + oXAxis.StepMain = iStep + oXAxis.StepHelp = iStep + fMin = oSheet.getCellByPosition(SBDATECOLUMN,SBSTARTROW).Value + fMax = oSheet.getCellByPosition(SBDATECOLUMN,iMaxRow).Value + oXAxis.Min = fMin + oXAxis.Max = fMax + oXAxis.AutoMin = False + oXAxis.AutoMax = False +End Sub + + +Sub CalculateChartafterSplit(SheetName, NewNumber, OldNumber, NoteText, SplitDate) +Dim oSheet as Object +Dim i as Integer +Dim oValueCell as Object +Dim oDateCell as Object +Dim bLeaveLoop as Boolean + If oSheets.HasbyName(SheetName) Then + oSheet = oSheets.GetbyName(SheetName) + i = 0 + bLeaveLoop = False + Do + oValueCell = oSheet.GetCellbyPosition(SBVALUECOLUMN, SBSTARTROW + i) + If oValueCell.CellStyle = CurrCellStyle Then + SplitCellValue(oSheet, OldNumber, NewNumber, SBVALUECOLUMN, SBSTARTROW + i, "") + i = i + 1 + Else + bLeaveLoop = True + End If + Loop Until bLeaveLoop + oDateCell = oSheet.GetCellbyPosition(SBDATECOLUMN, SBSTARTROW + i-1) + oDateCell.Annotation.SetString(NoteText) + End If +End Sub +</script:module> |