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