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