Freelog 52/Freelog052.iso/Dossier/OpenOffice/f_0214/Depot.xba

Extensible Markup Language | 2002-11-21 | 17KB | 494 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="Depot" script:language="StarBasic">Option Explicit


Sub Initialize(Optional bChooseMarketPlace as Boolean)
Dim bEnableHistory as Boolean
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
'    oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory")
'    bEnableHistory = oMarketModel.Enabled
    ToggleWindow(False)
    Today = Date()
    bDebugmode = False
    oDocument = ThisComponent
    oController = oDocument.GetCurrentController
    oSheets = oDocument.Sheets
    oFirstSheet = oSheets(0)
    oMovementSheet = oSheets(1)
    oBankSheet = oSheets(2)
    oDocFormats = oDocument.NumberFormats
    oNumberFormatter = CreateUnoService("com.sun.star.util.NumberFormatter")
    oNumberFormatter.AttachNumberFormatsSupplier(oDocument)
    oDocLocale = oDocument.CharLocale
    sDocLanguage = oDocLocale.Language
    sDocCountry = oDocLocale.Country
    LoadLanguage()
    ToggleWindow(True)
'    oMarketModel.Enabled = bEnableHistory
    If Not IsMissing(bChooseMarketPlace) Then
        If bChoosemarketPlace Then
            ChooseMarket()
        End If
    Else
        ChooseMarket()
    End If
    If Not IsMissing(bChooseMarketPlace) Then
        If bChooseMarketPlace Then
            oMarketModel.Enabled = bEnableMarket
            oInternetModel.Enabled = bEnableInternet
        End If
    End If
End Sub


Sub Buy()
    Initialize(True)
     FillListbox(DlgTransaction.GetControl("lstBuyStocks"), TransactTitle(SBDIALOGBUY), False)
    SetupTransactionControls(SBDIALOGBUY)
    EnableTransactionControls(False)
    DlgTransaction.Execute()
End Sub


Sub Sell()
    Initialize(True)
    If FillListbox(DlgTransaction.GetControl("lstSellStocks"), TransactTitle(SBDIALOGSELL), True) Then
        SetupTransactionControls(SBDIALOGSELL)
        EnableTransactionControls(False)
        DlgTransaction.Execute()
    End If
End Sub


Sub Reset()
Dim TransactionCount as Integer
Dim StockCount, iStartRow, i as Integer
Dim oRows, oRange as Object
Dim StockName as String
    Initialize(True)
    ' Delete transactions and reset overview
    If MsgBox(sMsgDeleteAll, SBMSGYESNO+SBMSGQUESTION+SBMSGDEFAULTBTN2, sMsgAuthorization) = 6 Then
        ' Assumption: If and only if there is an overview, then there are transactions, too
        UnprotectSheets(oSheets)
        StockCount = GetStocksCount(iStartRow)

        For i = 1 To StockCount
            StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, iStartRow + i).String
            If oSheets.HasbyName(StockName) Then
                oSheets.RemoveByName(StockName)
            End If
        Next
        oDocument.AddActionLock
        RemoveStockRows(oFirstSheet, iStartRow + 1, StockCount)
        TransactionCount = GetTransactionCount(iStartRow)
        RemoveStockRows(oMovementSheet, iStartRow + 2, TransactionCount)
        ProtectSheets(oSheets)
        oDocument.RemoveActionLock
    End If
End Sub


Sub TransactionOk
Dim Sold as Long
Dim RestQuantity, Value, PartialValue, Profit
Dim iNewRow as Integer, iRow as Integer
Dim iStockRow as Long, iRestQuantity as Long
Dim oNameCell as Object
Dim CellStockName as String, SelStockName as String
Dim CurRate as Double
Dim TransactDate as Date
Dim LocStockName as String
    ' Check for rate entered
    If TransactModel.txtRate.Value = 0 Then
        If TransactModel.Step = SBDIALOGBUY Then
            If MsgBox(sMsgFreeStock, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then
                Exit Sub
            End If
        Else
            If MsgBox(sMsgTotalLoss, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then
                Exit Sub
            End If
        End If
    End If
    CurRate = TransactModel.txtRate.Value
    TransactDate = CDateFromISO(TransactModel.txtDate.Date)
    DlgTransaction.EndExecute()
    UnprotectSheets(oSheets)

    iNewRow = DuplicateRow(oMovementSheet, "HiddenRow3")

    If TransactModel.Step = SBDIALOGBUY Then
        CellStockName = TransactModel.lstBuyStocks.Text
        If Instr(1,CellStockName,"$") <> 0 Then
            CellStockName = "'" & CellStockName & "'"
        End If
        oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName
        oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = TransactModel.txtQuantity.Value
    Else
        CellStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem()
        oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName
        oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = -TransactModel.txtQuantity.Value
    End If

    oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iNewRow).Value = CDateFromISO(TransactModel.txtDate.Date)
    oMovementSheet.GetCellByPosition(SBCOLUMNRATE2, iNewRow).Value = TransactModel.txtRate.Value
    oMovementSheet.GetCellByPosition(SBCOLUMNPROVPERCENT2, iNewRow).Value = TransactModel.txtCommission.EffectiveValue
    oMovementSheet.GetCellByPosition(SBCOLUMNPROVMIN2, iNewRow).Value = TransactModel.txtMinimum.Value
    oMovementSheet.GetCellByPosition(SBCOLUMNPROVFIX2, iNewRow).Value = TransactModel.txtFix.Value

    ' Buy stocks: Update overview for new stocks
    If TransactModel.Step = SBDIALOGBUY Then
        iStockRow = GetStockRowIndex(CellStockName)
        If iStockRow = -1 Then
            iNewRow = DuplicateRow(oFirstSheet, "HiddenRow2")
            oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, iNewRow).String = CellStockName
            oFirstSheet.GetCellByPosition(SBCOLUMNID1, iNewRow).String = TransactModel.txtStockID.Text
            iStockRow = GetStockRowIndex(CellStockName)
        End If
    ' Sell stocks: Get transaction value, then update Transaction sheet
    ElseIf TransactModel.Step = SBDIALOGSELL Then
        Profit = oMovementSheet.GetCellByPosition(SBCOLUMNPROCEEDS2, iNewRow).Value
        Value = Profit
        Sold = TransactModel.txtQuantity.Value
        SelStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem()
        ' Go to first name
        If TransactMode = FIFO Then
            iRow = SBROWFIRSTTRANSACT2
        Else
            iRow = iNewRow-1
        End If

        ' Check that no transaction after split date exists else cancel split
        Do While Sold > 0
            oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
            CellStockName = oNameCell.String
            If CellStockName = SelStockName Then
                ' Update transactions: Note quantity sold
                RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value
                ' If there still is a rest left ...
                If RestQuantity > 0 Then
                    If RestQuantity < Sold Then
                        ' Recalculate profit of new transaction
                        Profit = Profit - oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value
                        AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, RestQuantity)
                        PartialValue = RestQuantity / Sold * Value
                        AddValueToCellContent(SBCOLUMNREALPROC2, iRow, PartialValue)
                        Sold = Sold - RestQuantity
                        Value = Value - PartialValue
                    Else
                        ' Recalculate profit of neTransactModel.lstBuyStocks.Textw transaction
                        PartialValue = oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value
                        Profit = Profit - PartialValue/RestQuantity * Sold
                        ' Update sold shares cell
                        AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, Sold)
                        ' Update sales turnover cell
                        AddValueToCellContent(SBCOLUMNREALPROC2, iRow, Value)
                        ' Update variables for rest of transaction
                        Sold = 0
                        Value = 0
                    End If
                End If
            End If
            iRow = iRow + TransactMode
        Loop
        oMovementSheet.GetCellByPosition(SBCOLUMNREALPROFIT2,iNewRow).Value = Profit
        iStockRow = GetStockRowIndex(SelStockName)
        iRestQuantity = oFirstSheet.GetCellbyPosition(SBCOLUMNQUANTITY1, iStockRow).Value
'        If iRestQuantity = 0 Then
'            If oSheets.HasbyName(SelStockName) Then
'                oSheets.RemoveByName(SelStockName)
'            End If
'        Else

'        End If
    End If
    InsertCurrentValue(CurRate, iStockRow,TransactDate)
    ProtectSheets(oSheets)
End Sub


Sub SelectStockname()
Dim iCurRow as Integer
Dim CurStockName as String
    With TransactModel
        ' Find row with stock name
        If TransactModel.Step = SBDIALOGBUY Then
            CurStockName = .lstBuyStocks.Text
            iCurRow = GetStockRowIndex(CurStockName)
            .txtQuantity.ValueMax = 10000000
        Else
            CurStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem()
            iCurRow = GetStockRowIndex(CurStockName)
            .txtQuantity.Value = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value
            .txtQuantity.ValueMax = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value
            .txtRate.Value = oFirstSheet.GetCellbyPosition(SBCOLUMNRATE1, iCurRow).Value
        End If
        .txtStockID.Enabled = .Step = SBDIALOGBUY
        .lblStockID.Enabled = .Step = SBDIALOGBUY
        ' Default settings for quantity and rate
        .txtStockID.Text = GetStockID(CurStockName, iCurRow)
    End With
    EnableTransactionControls(CurStockName <> "")
    TransactModel.cmdGoOn.DefaultButton = True
End Sub



Sub HandleStocks(Mode as Integer, oDialog as Object)
Dim DividendPerShare, DividendTotal, RestQuantity, OldValue
Dim SelStockName, CellStockName as String
Dim oNameCell as Object, oDateCell as Object
Dim iRow as Integer
Dim oDividendCell as Object
Dim Amount
Dim OldNumber, NewNumber as Integer
Dim  NoteText as String
Dim TotalStocksCount as Long
Dim oModel as Object
    oDocument.AddActionLock
    oDialog.EndExecute()
    oModel = oDialog.Model
    SelStockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
    Select Case Mode
        Case HANDLEDIVIDEND
            Dim bTakeTotal as Boolean
            ' Update transactions: Enter dividend paid for all Buy transactions not sold completely
            bTakeTotal = oModel.optTotal.State = 1
            If bTakeTotal Then
                DividendTotal = oModel.txtDividend.Value
                iRow = GetStockRowIndex(SelStockName)
                TotalStocksCount = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1,iRow).Value
                DividendPerShare = DividendTotal/TotalStocksCount
            Else
                DividendPerShare = oModel.txtDividend.Value
            End If

        Case HANDLESPLIT
            ' Store entered values in variables
            OldNumber = oModel.txtOldRate.Value
            NewNumber = oModel.txtNewRate.Value
            SplitDate = CDateFromISO(oModel.txtDate.Date)
            iRow = SBROWFIRSTTRANSACT2
            NoteText = cSplit & SplitDate & ", " & oModel.txtOldRate.Value & oModel.lblColon.Label & oModel.txtNewRate.Value
            Do
                oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
                CellStockName = oNameCell.String
                If CellStockName = SelStockName Then
                    oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow)
                    If oDateCell.Value >= SplitDate Then
                        MsgBox sMsgWrongExchangeDate, SBMSGOK + SBMSGSTOP, sMsgError
                        Exit Sub
                    End If
                End If
                iRow = iRow + 1
            Loop Until CellStockName = ""
    End Select
    iRow = SBROWFIRSTTRANSACT2
    UnprotectSheets(oSheets)
    Do
        oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow)
        CellStockName = oNameCell.String
        If CellStockName = SelStockName Then
            Select Case Mode
                Case HANDLEDIVIDEND
                    RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value
                    If RestQuantity > 0 Then
                        oDividendCell = oMovementSheet.GetCellByPosition(SBCOLUMNDIVIDEND2, iRow)
                        OldValue = oDividendCell.Value
                        oDividendCell.Value = OldValue + RestQuantity * DividendPerShare
                    End If
                Case HANDLESPLIT
                    oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow)
                     SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQUANTITY2, iRow, NoteText)
                     SplitCellValue(oMovementSheet, OldNumber, NewNumber, SBCOLUMNRATE2, iRow, "")
                     SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQTYSOLD2, iRow, "")
            End Select
        End If
        iRow = iRow + 1
    Loop Until CellStockName = ""
    If Mode = HANDLESPLIT Then
         CalculateChartafterSplit(SelStockName, NewNumber, OldNumber, NoteText, SplitDate)
    End If
    oDocument.CalculateAll()
    ProtectSheets(oSheets)
    oDocument.RemoveActionLock
End Sub


Sub CancelStockRate()
    DlgStockRates.EndExecute()
End Sub


Sub CancelTransaction()
    DlgTransaction.EndExecute()
End Sub


Sub CommitStockRate()
Dim CurStep as Integer
    CurStep = StockRatesModel.Step
    Select Case CurStep
        Case 1
            ' Check for quantity entered
            If StockRatesModel.txtDividend.Value = 0 Then
                MsgBox sMsgNoDividend, SBMSGSTOP+SBMSGSTOP, sMsgError
                Exit Sub
            End If
            HandleStocks(HANDLEDIVIDEND, DlgStockRates)
        Case 2
            HandleStocks(HANDLESPLIT, DlgStockRates)
        Case 3
            InsertCompanyHistory()
    End Select
End Sub


Sub EnableTransactionControls(bEnable as Boolean)
    With TransactModel
        .lblQuantity.Enabled = bEnable
        .txtQuantity.Enabled = bEnable
        .lblRate.Enabled = bEnable
        .txtRate.Enabled = bEnable
        .lblDate.Enabled = bEnable
        .txtDate.Enabled = bEnable
        .lblCommission.Enabled = bEnable
        .txtCommission.Enabled = bEnable
        .lblMinimum.Enabled = bEnable
        .txtMinimum.Enabled = bEnable
        .lblFix.Enabled = bEnable
        .txtFix.Enabled = bEnable
        If TransactModel.Step = SBDIALOGSELL Then
            .cmdGoOn.Enabled = Ubound(TransactModel.lstSellStocks.SelectedItems()) > -1
            DlgTransaction.GetControl("lstSellStocks").SetFocus()
        Else
            .cmdGoOn.Enabled = TransactModel.lstBuyStocks.Text <> ""
            DlgTransaction.GetControl("lstBuyStocks").SetFocus()
        End If
        If bEnable Then
            TransactModel.cmdGoOn.DefaultButton = True
        End If
    End With
End Sub


Sub SetupTransactionControls(CurStep as Integer)
    DlgReference = DlgTransaction
    With TransactModel
        .txtDate.Date = CDateToISO(Date())
        .txtDate.DateMax = CDateToISO(Date())
        .txtStockID.Enabled = False
        .lblStockID.Enabled = False
        .lblStockID.Label = sCurStockIDLabel
        .txtRate.CurrencySymbol = sCurCurrency
        .txtFix.CurrencySymbol = sCurCurrency
        .Step = CurStep
    End With
    DlgTransaction.Title = TransactTitle(CurStep)
    CellValuetoControl(oBankSheet, TransactModel.txtCommission, "ProvisionPercent")
    CellValuetoControl(oBankSheet, TransactModel.txtMinimum, "ProvisionMinimum")
    CellValuetoControl(oBankSheet, TransactModel.txtFix, "ProvisionFix")
End Sub


Sub AddShortCuttoControl()
Dim SelCompany as String
Dim iRow, SelIndex as Integer
    SelIndex = DlgTransaction.GetControl("lstBuyStocks").GetSelectedItemPos()
    If SelIndex <> -1 Then
        SelCompany = TransactModel.lstBuyStocks.StringItemList(SelIndex)
        iRow = GetStockRowIndex(SelCompany)
        If iRow <> -1 Then
            TransactModel.txtStockID.Text = oFirstSheet.GetCellByPosition(SBCOLUMNID1,iRow).String
            TransactModel.txtRate.Value = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1,iRow).Value
        Else
            TransactModel.txtStockID.Text = ""
            TransactModel.txtRate.Value = 0
        End If
    Else
        TransactModel.txtStockID.Text = ""
        TransactModel.txtRate.Value = 0
    End If
End Sub


Sub OpenStockRatePage(aEvent)
Dim CurStep as Integer
    Initialize(True)
    CurStep = aEvent.Source.Model.Tag
    If FillListbox(DlgStockRates.GetControl("lstStockNames"), StockRatesTitle(CurStep), True) Then
        StockRatesModel.Step = CurStep
        ToggleStockRateControls(False, CurStep)
        InitializeStockRatesControls(CurStep)
        DlgStockRates.Execute()
    End If
End Sub


Sub SelectStockNameForRates()
Dim StockName as String
    StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem()
    If StockName <> "" Then
        StockRatesModel.txtStockID.Text = GetStockID(StockName)
        ToggleStockRateControls(True, StockRatesModel.Step)
    End If
    StockRatesModel.cmdGoOn.DefaultButton = True
End Sub


Sub ToggleStockRateControls(bDoEnable as Boolean, CurStep as Integer)
    With StockRatesModel
        .lblStockID.Enabled = False
        .txtStockID.Enabled = False
        .cmdGoOn.Enabled = Ubound(StockRatesModel.lstStockNames.SelectedItems()) <> -1
        Select Case CurStep
            Case 1
                .optPerShare.Enabled = bDoEnable
                .optTotal.Enabled = bDoEnable
                .lblDividend.Enabled = bDoEnable
                .txtDividend.Enabled = bDoEnable
            Case 2
                .lblExchangeRate.Enabled = bDoEnable
                .lblDate.Enabled = bDoEnable
                .lblColon.Enabled = bDoEnable
                .txtOldRate.Enabled = bDoEnable
                .txtNewRate.Enabled = bDoEnable
                .txtDate.Enabled = bDoEnable
            Case 3
                .lblStartDate.Enabled = bDoEnable
                .lblEndDate.Enabled = bDoEnable
                .txtStartDate.Enabled = bDoEnable
                .txtEndDate.Enabled = bDoEnable
                .hlnInterval.Enabled = bDoEnable
                .optDaily.Enabled = bDoEnable
                .optWeekly.Enabled = bDoEnable
        End Select
    End With
End Sub


Sub InitializeStockRatesControls(CurStep as Integer)
    DlgReference = DlgStockRates
    DlgStockRates.Title = StockRatesTitle(CurStep)
    With StockRatesModel
        .txtStockID.Text = ""
        .lblStockID.Label = sCurStockIDLabel
        Select Case CurStep
            Case 1
                .txtDividend.Value = 0
                .optPerShare.State = 1
                .txtDividend.CurrencySymbol = sCurCurrency
            Case 2
                .txtOldRate.Value = 1
                .txtNewRate.Value = 1
                .txtDate.Date = CDateToISO(Date())
            Case 3
                .txtStartDate.DateMax = CDateToISO(CDate(Date())-1)
                .txtEndDate.DateMax = CDateToISO(CDate(Date())-1)
                .txtStartDate.Date = CDateToISO(CDate(Date())-8)
                .txtEndDate.Date = CDateToISO(CDate(Date())-1)
                .optDaily.State = 1
        End Select
    End With
End Sub</script:module>