wizards/source/depot/Internet.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="Internet" script:language="StarBasic">REM  *****  BASIC  *****
  21 Option Explicit
  22 Public sNewSheetName as String
  23
  24 Function CheckHistoryControls()
  25 Dim bLocGoOn as Boolean
  26 Dim Firstdate as Date
  27 Dim LastDate as Date
  28         LastDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date)
  29         FirstDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date)
  30         bLocGoOn = FirstDate &lt;&gt; 0 And LastDate &lt;&gt; 0
  31         If bLocGoOn Then
  32                 If FirstDate &gt;= LastDate Then
  33                         Msgbox(sMsgStartDatebeforeEndDate,16, sProductname)
  34                         bLocGoOn = False
  35                 End If
  36         End If
  37         CheckHistoryControls = bLocGoon
  38 End Function
  39
  40
  41 Sub InsertCompanyHistory()
  42 Dim StockName as String
  43 Dim CurRow as Integer
  44 Dim sMsgInternetError as String
  45 Dim CurRate as Double
  46 Dim oCell as Object
  47 Dim sStockID as String
  48 Dim ChartSource as String
  49         If CheckHistoryControls() Then
  50                 StartDate = CDateFromUNODate(StockRatesModel.txtStartDate.Date)
  51                 EndDate = CDateFromUNODate(StockRatesModel.txtEndDate.Date)
  52                 DlgStockRates.EndExecute()
  53                 If StockRatesModel.optDaily.State = 1 Then
  54                         sInterval = &quot;d&quot;
  55                         iStep = 1
  56                 ElseIf StockRatesModel.optWeekly.State = 1 Then
  57                         sInterval = &quot;w&quot;
  58                         iStep = 7
  59                         StartDate = StartDate - WeekDay(StartDate) + 2
  60                         EndDate = EndDate - WeekDay(EndDate) + 2
  61                 End If
  62                 iEndDay = Day(EndDate)
  63                 iEndMonth = Month(EndDate)
  64                 iEndYear = Year(EndDate)
  65                 iStartDay = Day(StartDate)
  66                 iStartMonth = Month(StartDate)
  67                 iStartYear = Year(StartDate)
  68 &apos;          oDocument.AddActionLock()
  69                 UnprotectSheets(oSheets)
  70                 InitializeStatusline(&quot;&quot;, 10, 1)
  71                 oBackGroundSheet = oSheets.GetbyName(&quot;Background&quot;)
  72                 StockName = DlgStockRates.GetControl(&quot;lstStockNames&quot;).GetSelectedItem()
  73                 CurRow = GetStockRowIndex(Stockname)
  74                 sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, CurRow).String
  75                 ChartSource = ReplaceString(HistoryChartSource, sStockID, &quot;&lt;StockID&gt;&quot;)
  76                 ChartSource = ReplaceString(ChartSource, iStartDay, &quot;&lt;StartDay&gt;&quot;)
  77                 ChartSource = ReplaceString(ChartSource, cStr(iStartMonth-1), &quot;&lt;StartMonth&gt;&quot;)
  78                 ChartSource = ReplaceString(ChartSource, iStartYear, &quot;&lt;StartYear&gt;&quot;)
  79                 ChartSource = ReplaceString(ChartSource, iEndDay, &quot;&lt;EndDay&gt;&quot;)
  80                 ChartSource = ReplaceString(ChartSource, cStr(iEndMonth-1), &quot;&lt;EndMonth&gt;&quot;)
  81                 ChartSource = ReplaceString(ChartSource, iEndYear, &quot;&lt;EndYear&gt;&quot;)
  82                 ChartSource = ReplaceString(ChartSource, sInterval, &quot;&lt;interval&gt;&quot;)
  83                 oStatusLine.SetValue(2)
  84                 If GetCurrentRate(ChartSource, CurRate, 1) Then
  85                         oStatusLine.SetValue(8)
  86                         UpdateValue(StockName, Today, CurRate)
  87                         oStatusLine.SetValue(9)
  88                         UpdateChart(StockName)
  89                         oStatusLine.SetValue(10)
  90                 Else
  91                         sMsgInternetError = Stockname &amp; &quot;: &quot; &amp; sNoInternetDataAvailable &amp; chr(13) &amp; sCheckInternetSettings
  92                         Msgbox(sMsgInternetError, 16, sProductname)
  93                 End If
  94                 ProtectSheets(oSheets)
  95                 oStatusLine.End
  96                 If oSheets.HasbyName(sNewSheetName) Then
  97                         oController.ActiveSheet = oSheets.GetByName(sNewSheetName)
  98                 End If
  99 &apos;          oDocument.RemoveActionLock()
 100         End If
 101 End Sub
 102
 103
 104
 105 Sub InternetUpdate()
 106 Dim i as Integer
 107 Dim StocksCount as Integer
 108 Dim iStartRow as Integer
 109 Dim sUrl as String
 110 Dim StockName as String
 111 Dim CurRate as Double
 112 Dim oCell as Object
 113 Dim sMsgInternetError as String
 114 Dim sStockID as String
 115 Dim ChartSource as String
 116 &apos;  oDocument.AddActionLock()
 117         Initialize(True)
 118         UnprotectSheets(oSheets)
 119         StocksCount = GetStocksCount(iStartRow)
 120         InitializeStatusline(&quot;&quot;, StocksCount + 1, 1)
 121         Today = CDate(Date)
 122         For i = iStartRow + 1 To iStartRow + StocksCount
 123                 StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, i).String
 124                 sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
 125                 ChartSource = ReplaceString(sCurChartSource, sStockID, &quot;&lt;StockID&gt;&quot;)
 126                 If GetCurrentRate(ChartSource, CurRate, 0) Then
 127                         InsertCurrentValue(CurRate, i, Now)
 128                 Else
 129                         sMsgInternetError = Stockname &amp; &quot;: &quot; &amp; sNoInternetDataAvailable &amp; chr(13) &amp; sCheckInternetSettings
 130                         Msgbox(sMsgInternetError, 16, sProductname)
 131                 End If
 132                 oStatusline.SetValue(i - iStartRow + 1)
 133         Next
 134         ProtectSheets(oSheets)
 135         oStatusLine.End
 136 &apos;  oDocument.RemoveActionLock
 137 End Sub
 138
 139
 140
 141 Function GetCurrentRate(sUrl as String, fValue As Double, iValueRow as Integer) as Boolean
 142 Dim sFilter As String
 143 Dim sOptions As String
 144 Dim oLinkSheet As Object
 145 Dim sDate as String
 146         If oSheets.hasByName(&quot;Link&quot;) Then
 147                 oLinkSheet = oSheets.getByName(&quot;Link&quot;)
 148         Else
 149                 oLinkSheet = oDocument.createInstance(&quot;com.sun.star.sheet.Spreadsheet&quot;)
 150                 oSheets.insertByName(&quot;Link&quot;, oLinkSheet)
 151                 oLinkSheet.IsVisible = False
 152         End If
 153
 154         sFilter = &quot;Text - txt - csv (StarCalc)&quot;
 155         sOptions = sCurSeparator &amp; &quot;,34,SYSTEM,1,1/10/2/10/3/10/4/10/5/10/6/10/7/10/8/10/9/10&quot;
 156
 157         oLinkSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
 158         oLinkSheet.link(sUrl, &quot;&quot;, sFilter, sOptions, 1 )
 159         fValue = oLinkSheet.getCellByPosition(iValueCol, iValueRow).Value
 160         If fValue = 0 Then
 161                 Dim sValue as String
 162                 sValue = oLinkSheet.getCellByPosition(1, iValueRow).String
 163                 sValue = ReplaceString(sValue, &quot;.&quot;,&quot;,&quot;)
 164                 fValue = Val(sValue)
 165         End If
 166         GetCurrentRate = fValue &lt;&gt; 0
 167 End Function
 168
 169
 170
 171 Sub UpdateValue(ByVal sName As String, fDate As Double, fValue As Double )
 172 Dim oSheet As Object
 173 Dim iColumn As Long
 174 Dim iRow As Long
 175 Dim i as Long
 176 Dim oCell As Object
 177 Dim LastDate as Date
 178 Dim bLeaveLoop as Boolean
 179 Dim RemoveCount as Long
 180 Dim iLastRow as Long
 181 Dim iLastLinkRow as Long
 182 Dim dDate as Date
 183 Dim CurDate as Date
 184 Dim oLinkSheet as Object
 185 Dim StartIndex as Long
 186 Dim iCellValue as Long
 187         &apos; Insert Sheet with Company - Chart
 188         sName = CheckNewSheetname(oSheets, sName)
 189         If NOT oSheets.hasByName(sName) Then
 190                 oSheets.CopybyName(&quot;Background&quot;, sName, oSheets.Count)
 191                 oSheet = oSheets.getByName(sName)
 192                 iCurRow = SBSTARTROW
 193                 iMaxRow = iCurRow
 194                 oCell = oSheet.getCellByPosition(SBDATECOLUMN, iCurRow)
 195                 oCell.Value = fDate
 196         End If
 197         sNewSheetName = sName
 198         oLinkSheet = oSheets.GetByName(&quot;Link&quot;)
 199         oSheet = oSheets.getByName(sName)
 200         iLastRow = GetLastUsedRow(oSheet)- 2
 201         iLastLinkRow = GetLastUsedRow(oLinkSheet)
 202         iCurRow = iLastRow
 203         bLeaveLoop = False
 204         RemoveCount = 0
 205         &apos; Delete all Cells in Date Area
 206         Do
 207                 oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
 208                 If oCell.CellStyle = sColumnHeader Then
 209                         bLeaveLoop = True
 210                         StartIndex = iCurRow
 211                         iCurRow = iCurRow + 1
 212                 Else
 213                         RemoveCount = RemoveCount + 1
 214                         iCurRow = iCurRow - 1
 215                 End If
 216         Loop Until bLeaveLoop
 217         If RemoveCount &gt; 1 Then
 218                 oSheet.Rows.RemoveByIndex(iCurRow, RemoveCount-1)
 219         End If
 220         For i = 1 To iLastLinkRow
 221                 oCell = oSheet.GetCellbyPosition(SBDATECOLUMN,iCurRow)
 222                 iCellValue = oLinkSheet.GetCellByPosition(0,i).Value
 223                 If iCellValue &gt; 0 Then
 224                         oCell.SetValue(oLinkSheet.GetCellByPosition(0,i).Value)
 225                 Else
 226                         oCell.SetValue(StringToDate(oLinkSheet.GetCellByPosition(0,i).String))
 227                 End If
 228                 oCell = oSheet.GetCellbyPosition(SBVALUECOLUMN,iCurRow)
 229                 oCell.SetValue(oLinkSheet.GetCellByPosition(4,i).Value)
 230                 If i &lt; iLastLinkRow Then
 231                         iCurRow = iCurRow + 1
 232                         oSheet.Rows.InsertByIndex(iCurRow,1)
 233                 End If
 234         Next i
 235         iMaxRow = iCurRow
 236 End Sub
 237
 238
 239 Function StringToDate(DateString as String) as Date
 240 Dim ShortMonths(11)
 241 Dim DateList() as String
 242 Dim MaxIndex as Integer
 243 Dim i as Integer
 244         ShortMonths(0) = &quot;Jan&quot;
 245         ShortMonths(1) = &quot;Feb&quot;
 246         ShortMonths(2) = &quot;Mar&quot;
 247         ShortMonths(3) = &quot;Apr&quot;
 248         ShortMonths(4) = &quot;May&quot;
 249         ShortMonths(5) = &quot;Jun&quot;
 250         ShortMonths(6) = &quot;Jul&quot;
 251         ShortMonths(7) = &quot;Aug&quot;
 252         ShortMonths(8) = &quot;Sep&quot;
 253         ShortMonths(9) = &quot;Oct&quot;
 254         ShortMonths(10) = &quot;Nov&quot;
 255         ShortMonths(11) = &quot;Dec&quot;
 256         For i = 0 To 11
 257                 DateString = ReplaceString(DateString,CStr(i+1),ShortMonths(i))
 258         Next i
 259         DateString = ReplaceString(DateString, &quot;.&quot;, &quot;-&quot;)
 260         StringToDate = CDate(DateString)
 261 End Function
 262
 263
 264 Sub UpdateChart(sName As String)
 265 Dim oSheet As Object
 266 Dim oCell As Object, oCursor As Object
 267 Dim oChartRange As Object
 268 Dim oEmbeddedChart As Object, oCharts As Object
 269 Dim oChart As Object, oDiagram As Object
 270 Dim oYAxis As Object, oXAxis As Object
 271 Dim fMin As Double, fMax As Double
 272 Dim nDateFormat As Long
 273 Dim aPos As Variant
 274 Dim aSize As Variant
 275 Dim oContainerChart as Object
 276 Dim mRangeAddresses(0) as New com.sun.star.table.CellRangeAddress
 277         mRangeAddresses(0).Sheet = GetSheetIndex(oSheets, sNewSheetName)
 278         mRangeAddresses(0).StartColumn = SBDATECOLUMN
 279         mRangeAddresses(0).StartRow = SBSTARTROW-1
 280         mRangeAddresses(0).EndColumn = SBVALUECOLUMN
 281         mRangeAddresses(0).EndRow = iMaxRow
 282
 283         oSheet = oDocument.Sheets.getByName(sNewSheetName)
 284         oCharts = oSheet.Charts
 285
 286         If Not oCharts.hasElements Then
 287                 oSheet.GetCellbyPosition(2,2).SetString(sName)
 288                 oChartRange = oSheet.getCellRangeByPosition(SBDATECOLUMN,6,5,SBSTARTROW-3)
 289                 aPos = oChartRange.Position
 290                 aSize = oChartRange.Size
 291
 292                 Dim oRectangleShape As New com.sun.star.awt.Rectangle
 293                 oRectangleShape.X = aPos.X
 294                 oRectangleShape.Y = aPos.Y
 295                 oRectangleShape.Width = aSize.Width
 296                 oRectangleShape.Height = aSize.Height
 297                 oCharts.addNewByName(sName, oRectangleShape, mRangeAddresses(), True, False)
 298                 oContainerChart = oCharts.getByName(sName)
 299                 oChart = oContainerChart.EmbeddedObject
 300                 oChart.Title.String     = &quot;&quot;
 301                 oChart.HasLegend = False
 302                 oChart.diagram = oChart.createInstance(&quot;com.sun.star.chart.XYDiagram&quot;)
 303                 oDiagram = oChart.Diagram
 304                 oDiagram.DataRowSource = com.sun.star.chart.ChartDataRowSource.COLUMNS
 305                 oChart.Area.LineStyle = com.sun.star.drawing.LineStyle.SOLID
 306                 oXAxis = oDiagram.XAxis
 307                 oXAxis.TextBreak = False
 308                 nDateFormat = oXAxis.NumberFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocLocale)
 309
 310                 oYAxis = oDiagram.getYAxis()
 311                 oYAxis.AutoOrigin = True
 312         Else
 313                 oChart = oCharts(0)
 314                 oChart.Ranges = mRangeAddresses()
 315                 oChart.HasRowHeaders = False
 316                 oEmbeddedChart = oChart.EmbeddedObject
 317                 oDiagram = oEmbeddedChart.Diagram
 318                 oXAxis = oDiagram.XAxis
 319         End If
 320         oXAxis.AutoStepMain = False
 321         oXAxis.AutoStepHelp = False
 322         oXAxis.StepMain = iStep
 323         oXAxis.StepHelp = iStep
 324         fMin = oSheet.getCellByPosition(SBDATECOLUMN,SBSTARTROW).Value
 325         fMax = oSheet.getCellByPosition(SBDATECOLUMN,iMaxRow).Value
 326         oXAxis.Min = fMin
 327         oXAxis.Max = fMax
 328         oXAxis.AutoMin = False
 329         oXAxis.AutoMax = False
 330 End Sub
 331
 332
 333 Sub CalculateChartafterSplit(SheetName, NewNumber, OldNumber, NoteText, SplitDate)
 334 Dim oSheet as Object
 335 Dim i as Integer
 336 Dim oValueCell as Object
 337 Dim oDateCell as Object
 338 Dim bLeaveLoop as Boolean
 339         If oSheets.HasbyName(SheetName) Then
 340                 oSheet = oSheets.GetbyName(SheetName)
 341                 i = 0
 342                 bLeaveLoop = False
 343                 Do
 344                         oValueCell = oSheet.GetCellbyPosition(SBVALUECOLUMN, SBSTARTROW + i)
 345                         If oValueCell.CellStyle = CurrCellStyle Then
 346                                 SplitCellValue(oSheet, OldNumber, NewNumber, SBVALUECOLUMN, SBSTARTROW + i, &quot;&quot;)
 347                                 i = i + 1
 348                         Else
 349                                 bLeaveLoop = True
 350                         End If
 351                 Loop Until bLeaveLoop
 352                 oDateCell = oSheet.GetCellbyPosition(SBDATECOLUMN, SBSTARTROW + i-1)
 353                 oDateCell.Annotation.SetString(NoteText)
 354         End If
 355 End Sub
 356 </script:module>