Quelle  Depot.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   Licensed to the Apache Software Foundation (ASF) under one or more
 *   contributor license agreements. See the NOTICE file distributed
 *   with this work for additional information regarding copyright
 *   ownership. The ASF licenses this file to you under the Apache
 *   License, Version 2.0 (the "License"); you may not use this file
 *   except in compliance with the License. You may obtain a copy of
 *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<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 = CDateFromUNODate(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 = CDateFromUNODate(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(aEvent as Object)
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
   Dim ListBoxList() as String
   ListBoxList() = GetSelectedListboxItems(aEvent.Source.getModel())
   CurStockName = ListBoxList(0)
'   CurStockName = DlgTransaction.GetControl(aEvent.Source.getModel.Name).GetSelectedItem()
   iCurRow = GetStockRowIndex(CurStockName)
   Dim fdouble as Double
   fdouble = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value
   .txtQuantity.Value = fdouble
   .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 = CDateFromUNODate(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 = CDateToUNODate(Date())
  .txtDate.DateMax = CDateToUNODate(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 = CDateToUNODate(Date())
   Case 3
    .txtStartDate.DateMax = CDateToUNODate(CDate(Date())-1)
    .txtEndDate.DateMax = CDateToUNODate(CDate(Date())-1)
    .txtStartDate.Date = CDateToUNODate(CDate(Date())-8)
    .txtEndDate.Date = CDateToUNODate(CDate(Date())-1)
    .optDaily.State = 1
  End Select
 End With
End Sub
</script:module>