xref: /trunk/main/wizards/source/depot/Internet.xba (revision 3e02b54d)
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 &lt;&gt; 0 And LastDate &lt;&gt; 0
34	If bLocGoOn Then
35		If FirstDate &gt;= 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 = &quot;d&quot;
58			iStep = 1
59		ElseIf StockRatesModel.optWeekly.State = 1 Then
60			sInterval = &quot;w&quot;
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&apos;		oDocument.AddActionLock()
72		UnprotectSheets(oSheets)
73		InitializeStatusline(&quot;&quot;, 10, 1)
74		oBackGroundSheet = oSheets.GetbyName(&quot;Background&quot;)
75		StockName = DlgStockRates.GetControl(&quot;lstStockNames&quot;).GetSelectedItem()
76		CurRow = GetStockRowIndex(Stockname)
77		sStockID = oFirstSheet.GetCellByPosition(SBCOLUMNID1, CurRow).String
78		ChartSource = ReplaceString(HistoryChartSource, sStockID, &quot;&lt;StockID&gt;&quot;)
79		ChartSource = ReplaceString(ChartSource, iStartDay, &quot;&lt;StartDay&gt;&quot;)
80		ChartSource = ReplaceString(ChartSource, cStr(iStartMonth-1), &quot;&lt;StartMonth&gt;&quot;)
81		ChartSource = ReplaceString(ChartSource, iStartYear, &quot;&lt;StartYear&gt;&quot;)
82		ChartSource = ReplaceString(ChartSource, iEndDay, &quot;&lt;EndDay&gt;&quot;)
83		ChartSource = ReplaceString(ChartSource, cStr(iEndMonth-1), &quot;&lt;EndMonth&gt;&quot;)
84		ChartSource = ReplaceString(ChartSource, iEndYear, &quot;&lt;EndYear&gt;&quot;)
85		ChartSource = ReplaceString(ChartSource, sInterval, &quot;&lt;interval&gt;&quot;)
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 &amp; &quot;: &quot; &amp; sNoInternetDataAvailable &amp; chr(13) &amp; 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&apos;		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&apos;	oDocument.AddActionLock()
120	Initialize(True)
121	UnprotectSheets(oSheets)
122	StocksCount = GetStocksCount(iStartRow)
123	InitializeStatusline(&quot;&quot;, 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, &quot;&lt;StockID&gt;&quot;)
129		If GetCurrentRate(ChartSource, CurRate, 0) Then
130			InsertCurrentValue(CurRate, i, Now)
131		Else
132			sMsgInternetError = Stockname &amp; &quot;: &quot; &amp; sNoInternetDataAvailable &amp; chr(13) &amp; sCheckInternetSettings
133			Msgbox(sMsgInternetError, 16, sProductname)
134		End If
135		oStatusline.SetValue(i - iStartRow + 1)
136	Next
137	ProtectSheets(oSheets)
138	oStatusLine.End
139&apos;	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(&quot;Link&quot;) Then
150		oLinkSheet = oSheets.getByName(&quot;Link&quot;)
151	Else
152		oLinkSheet = oDocument.createInstance(&quot;com.sun.star.sheet.Spreadsheet&quot;)
153		oSheets.insertByName(&quot;Link&quot;, oLinkSheet)
154		oLinkSheet.IsVisible = False
155	End If
156
157	sFilter = &quot;Text - txt - csv (StarCalc)&quot;
158	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;
159
160	oLinkSheet.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
161	oLinkSheet.link(sUrl, &quot;&quot;, 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, &quot;.&quot;,&quot;,&quot;)
167		fValue = Val(sValue)
168	End If
169	GetCurrentRate = fValue &lt;&gt; 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	&apos; Insert Sheet with Company - Chart
191	sName = CheckNewSheetname(oSheets, sName)
192	If NOT oSheets.hasByName(sName) Then
193		oSheets.CopybyName(&quot;Background&quot;, 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(&quot;Link&quot;)
202	oSheet = oSheets.getByName(sName)
203	iLastRow = GetLastUsedRow(oSheet)- 2
204	iLastLinkRow = GetLastUsedRow(oLinkSheet)
205	iCurRow = iLastRow
206	bLeaveLoop = False
207	RemoveCount = 0
208	&apos; 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 &gt; 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 &gt; 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 &lt; 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) = &quot;Jan&quot;
248	ShortMonths(1) = &quot;Feb&quot;
249	ShortMonths(2) = &quot;Mar&quot;
250	ShortMonths(3) = &quot;Apr&quot;
251	ShortMonths(4) = &quot;May&quot;
252	ShortMonths(5) = &quot;Jun&quot;
253	ShortMonths(6) = &quot;Jul&quot;
254	ShortMonths(7) = &quot;Aug&quot;
255	ShortMonths(8) = &quot;Sep&quot;
256	ShortMonths(9) = &quot;Oct&quot;
257	ShortMonths(10) = &quot;Nov&quot;
258	ShortMonths(11) = &quot;Dec&quot;
259	For i = 0 To 11
260		DateString = ReplaceString(DateString,CStr(i+1),ShortMonths(i))
261	Next i
262	DateString = ReplaceString(DateString, &quot;.&quot;, &quot;-&quot;)
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	= &quot;&quot;
304		oChart.HasLegend = False
305		oChart.diagram = oChart.createInstance(&quot;com.sun.star.chart.XYDiagram&quot;)
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, &quot;&quot;)
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