PC World 2004 January/PCWorld_2004-01_cd.bin/akce/openoffice/f_0212/Internet.xba

Extensible Markup Language | 2002-11-21 | 11.2 KB | 342 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<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 = CDateFromISO(StockRatesModel.txtEndDate.Date)
    FirstDate = CDateFromISO(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
Dim oCell as Object
Dim sStockID as String
Dim ChartSource as String
    If CheckHistoryControls() Then
        StartDate = CDateFromISO(StockRatesModel.txtStartDate.Date)
        EndDate = CDateFromISO(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
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 Integer
Dim oCell As Object
Dim LastDate as Date
Dim bLeaveLoop as Boolean
Dim RemoveCount as Integer
Dim iLastRow as Integer
Dim iLastLinkRow as Integer
Dim dDate as Date
Dim CurDate as Date
Dim oLinkSheet as Object
Dim StartIndex as Integer
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
    CurDate = EndDate
    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.SetValue(CurDate)
        CurDate = CurDate - iStep
        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>