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="Depot" script:language="StarBasic">Option Explicit 24 25 26Sub Initialize(Optional bChooseMarketPlace as Boolean) 27Dim bEnableHistory as Boolean 28 GlobalScope.BasicLibraries.LoadLibrary("Tools") 29' oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory") 30' bEnableHistory = oMarketModel.Enabled 31 ToggleWindow(False) 32 Today = Date() 33 bDebugmode = False 34 oDocument = ThisComponent 35 oController = oDocument.GetCurrentController 36 oSheets = oDocument.Sheets 37 oFirstSheet = oSheets(0) 38 oMovementSheet = oSheets(1) 39 oBankSheet = oSheets(2) 40 oDocFormats = oDocument.NumberFormats 41 oNumberFormatter = CreateUnoService("com.sun.star.util.NumberFormatter") 42 oNumberFormatter.AttachNumberFormatsSupplier(oDocument) 43 oDocLocale = oDocument.CharLocale 44 sDocLanguage = oDocLocale.Language 45 sDocCountry = oDocLocale.Country 46 LoadLanguage() 47 ToggleWindow(True) 48' oMarketModel.Enabled = bEnableHistory 49 If Not IsMissing(bChooseMarketPlace) Then 50 If bChoosemarketPlace Then 51 ChooseMarket() 52 End If 53 Else 54 ChooseMarket() 55 End If 56 If Not IsMissing(bChooseMarketPlace) Then 57 If bChooseMarketPlace Then 58 oMarketModel.Enabled = bEnableMarket 59 oInternetModel.Enabled = bEnableInternet 60 End If 61 End If 62End Sub 63 64 65Sub Buy() 66 Initialize(True) 67 FillListbox(DlgTransaction.GetControl("lstBuyStocks"), TransactTitle(SBDIALOGBUY), False) 68 SetupTransactionControls(SBDIALOGBUY) 69 EnableTransactionControls(False) 70 DlgTransaction.Execute() 71End Sub 72 73 74Sub Sell() 75 Initialize(True) 76 If FillListbox(DlgTransaction.GetControl("lstSellStocks"), TransactTitle(SBDIALOGSELL), True) Then 77 SetupTransactionControls(SBDIALOGSELL) 78 EnableTransactionControls(False) 79 DlgTransaction.Execute() 80 End If 81End Sub 82 83 84Sub Reset() 85Dim TransactionCount as Integer 86Dim StockCount, iStartRow, i as Integer 87Dim oRows, oRange as Object 88Dim StockName as String 89 Initialize(True) 90 ' Delete transactions and reset overview 91 If MsgBox(sMsgDeleteAll, SBMSGYESNO+SBMSGQUESTION+SBMSGDEFAULTBTN2, sMsgAuthorization) = 6 Then 92 ' Assumption: If and only if there is an overview, then there are transactions, too 93 UnprotectSheets(oSheets) 94 StockCount = GetStocksCount(iStartRow) 95 96 For i = 1 To StockCount 97 StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, iStartRow + i).String 98 If oSheets.HasbyName(StockName) Then 99 oSheets.RemoveByName(StockName) 100 End If 101 Next 102 oDocument.AddActionLock 103 RemoveStockRows(oFirstSheet, iStartRow + 1, StockCount) 104 TransactionCount = GetTransactionCount(iStartRow) 105 RemoveStockRows(oMovementSheet, iStartRow + 2, TransactionCount) 106 ProtectSheets(oSheets) 107 oDocument.RemoveActionLock 108 End If 109End Sub 110 111 112Sub TransactionOk 113Dim Sold as Long 114Dim RestQuantity, Value, PartialValue, Profit 115Dim iNewRow as Integer, iRow as Integer 116Dim iStockRow as Long, iRestQuantity as Long 117Dim oNameCell as Object 118Dim CellStockName as String, SelStockName as String 119Dim CurRate as Double 120Dim TransactDate as Date 121Dim LocStockName as String 122 ' Check for rate entered 123 If TransactModel.txtRate.Value = 0 Then 124 If TransactModel.Step = SBDIALOGBUY Then 125 If MsgBox(sMsgFreeStock, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then 126 Exit Sub 127 End If 128 Else 129 If MsgBox(sMsgTotalLoss, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then 130 Exit Sub 131 End If 132 End If 133 End If 134 CurRate = TransactModel.txtRate.Value 135 TransactDate = CDateFromISO(TransactModel.txtDate.Date) 136 DlgTransaction.EndExecute() 137 UnprotectSheets(oSheets) 138 139 iNewRow = DuplicateRow(oMovementSheet, "HiddenRow3") 140 141 If TransactModel.Step = SBDIALOGBUY Then 142 CellStockName = TransactModel.lstBuyStocks.Text 143 If Instr(1,CellStockName,"$") <> 0 Then 144 CellStockName = "'" & CellStockName & "'" 145 End If 146 oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName 147 oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = TransactModel.txtQuantity.Value 148 Else 149 CellStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem() 150 oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName 151 oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = -TransactModel.txtQuantity.Value 152 End If 153 154 oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iNewRow).Value = CDateFromISO(TransactModel.txtDate.Date) 155 oMovementSheet.GetCellByPosition(SBCOLUMNRATE2, iNewRow).Value = TransactModel.txtRate.Value 156 oMovementSheet.GetCellByPosition(SBCOLUMNPROVPERCENT2, iNewRow).Value = TransactModel.txtCommission.EffectiveValue 157 oMovementSheet.GetCellByPosition(SBCOLUMNPROVMIN2, iNewRow).Value = TransactModel.txtMinimum.Value 158 oMovementSheet.GetCellByPosition(SBCOLUMNPROVFIX2, iNewRow).Value = TransactModel.txtFix.Value 159 160 ' Buy stocks: Update overview for new stocks 161 If TransactModel.Step = SBDIALOGBUY Then 162 iStockRow = GetStockRowIndex(CellStockName) 163 If iStockRow = -1 Then 164 iNewRow = DuplicateRow(oFirstSheet, "HiddenRow2") 165 oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, iNewRow).String = CellStockName 166 oFirstSheet.GetCellByPosition(SBCOLUMNID1, iNewRow).String = TransactModel.txtStockID.Text 167 iStockRow = GetStockRowIndex(CellStockName) 168 End If 169 ' Sell stocks: Get transaction value, then update Transaction sheet 170 ElseIf TransactModel.Step = SBDIALOGSELL Then 171 Profit = oMovementSheet.GetCellByPosition(SBCOLUMNPROCEEDS2, iNewRow).Value 172 Value = Profit 173 Sold = TransactModel.txtQuantity.Value 174 SelStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem() 175 ' Go to first name 176 If TransactMode = FIFO Then 177 iRow = SBROWFIRSTTRANSACT2 178 Else 179 iRow = iNewRow-1 180 End If 181 182 ' Check that no transaction after split date exists else cancel split 183 Do While Sold > 0 184 oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) 185 CellStockName = oNameCell.String 186 If CellStockName = SelStockName Then 187 ' Update transactions: Note quantity sold 188 RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value 189 ' If there still is a rest left ... 190 If RestQuantity > 0 Then 191 If RestQuantity < Sold Then 192 ' Recalculate profit of new transaction 193 Profit = Profit - oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value 194 AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, RestQuantity) 195 PartialValue = RestQuantity / Sold * Value 196 AddValueToCellContent(SBCOLUMNREALPROC2, iRow, PartialValue) 197 Sold = Sold - RestQuantity 198 Value = Value - PartialValue 199 Else 200 ' Recalculate profit of neTransactModel.lstBuyStocks.Textw transaction 201 PartialValue = oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value 202 Profit = Profit - PartialValue/RestQuantity * Sold 203 ' Update sold shares cell 204 AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, Sold) 205 ' Update sales turnover cell 206 AddValueToCellContent(SBCOLUMNREALPROC2, iRow, Value) 207 ' Update variables for rest of transaction 208 Sold = 0 209 Value = 0 210 End If 211 End If 212 End If 213 iRow = iRow + TransactMode 214 Loop 215 oMovementSheet.GetCellByPosition(SBCOLUMNREALPROFIT2,iNewRow).Value = Profit 216 iStockRow = GetStockRowIndex(SelStockName) 217 iRestQuantity = oFirstSheet.GetCellbyPosition(SBCOLUMNQUANTITY1, iStockRow).Value 218' If iRestQuantity = 0 Then 219' If oSheets.HasbyName(SelStockName) Then 220' oSheets.RemoveByName(SelStockName) 221' End If 222' Else 223 224' End If 225 End If 226 InsertCurrentValue(CurRate, iStockRow,TransactDate) 227 ProtectSheets(oSheets) 228End Sub 229 230 231Sub SelectStockname(aEvent as Object) 232Dim iCurRow as Integer 233Dim CurStockName as String 234 With TransactModel 235 ' Find row with stock name 236 If TransactModel.Step = SBDIALOGBUY Then 237 CurStockName = .lstBuyStocks.Text 238 iCurRow = GetStockRowIndex(CurStockName) 239 .txtQuantity.ValueMax = 10000000 240 Else 241 Dim ListBoxList() as String 242 ListBoxList() = GetSelectedListboxItems(aEvent.Source.getModel()) 243 CurStockName = ListBoxList(0) 244' CurStockName = DlgTransaction.GetControl(aEvent.Source.getModel.Name).GetSelectedItem() 245 iCurRow = GetStockRowIndex(CurStockName) 246 Dim fdouble as Double 247 fdouble = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value 248 .txtQuantity.Value = fdouble 249 .txtQuantity.ValueMax = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value 250 .txtRate.Value = oFirstSheet.GetCellbyPosition(SBCOLUMNRATE1, iCurRow).Value 251 End If 252 .txtStockID.Enabled = .Step = SBDIALOGBUY 253 .lblStockID.Enabled = .Step = SBDIALOGBUY 254 ' Default settings for quantity and rate 255 .txtStockID.Text = GetStockID(CurStockName, iCurRow) 256 End With 257 EnableTransactionControls(CurStockName <> "") 258 TransactModel.cmdGoOn.DefaultButton = True 259End Sub 260 261 262 263Sub HandleStocks(Mode as Integer, oDialog as Object) 264Dim DividendPerShare, DividendTotal, RestQuantity, OldValue 265Dim SelStockName, CellStockName as String 266Dim oNameCell as Object, oDateCell as Object 267Dim iRow as Integer 268Dim oDividendCell as Object 269Dim Amount 270Dim OldNumber, NewNumber as Integer 271Dim NoteText as String 272Dim TotalStocksCount as Long 273Dim oModel as Object 274 oDocument.AddActionLock 275 oDialog.EndExecute() 276 oModel = oDialog.Model 277 SelStockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem() 278 Select Case Mode 279 Case HANDLEDIVIDEND 280 Dim bTakeTotal as Boolean 281 ' Update transactions: Enter dividend paid for all Buy transactions not sold completely 282 bTakeTotal = oModel.optTotal.State = 1 283 If bTakeTotal Then 284 DividendTotal = oModel.txtDividend.Value 285 iRow = GetStockRowIndex(SelStockName) 286 TotalStocksCount = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1,iRow).Value 287 DividendPerShare = DividendTotal/TotalStocksCount 288 Else 289 DividendPerShare = oModel.txtDividend.Value 290 End If 291 292 Case HANDLESPLIT 293 ' Store entered values in variables 294 OldNumber = oModel.txtOldRate.Value 295 NewNumber = oModel.txtNewRate.Value 296 SplitDate = CDateFromISO(oModel.txtDate.Date) 297 iRow = SBROWFIRSTTRANSACT2 298 NoteText = cSplit & SplitDate & ", " & oModel.txtOldRate.Value & oModel.lblColon.Label & oModel.txtNewRate.Value 299 Do 300 oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) 301 CellStockName = oNameCell.String 302 If CellStockName = SelStockName Then 303 oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow) 304 If oDateCell.Value >= SplitDate Then 305 MsgBox sMsgWrongExchangeDate, SBMSGOK + SBMSGSTOP, sMsgError 306 Exit Sub 307 End If 308 End If 309 iRow = iRow + 1 310 Loop Until CellStockName = "" 311 End Select 312 iRow = SBROWFIRSTTRANSACT2 313 UnprotectSheets(oSheets) 314 Do 315 oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) 316 CellStockName = oNameCell.String 317 If CellStockName = SelStockName Then 318 Select Case Mode 319 Case HANDLEDIVIDEND 320 RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value 321 If RestQuantity > 0 Then 322 oDividendCell = oMovementSheet.GetCellByPosition(SBCOLUMNDIVIDEND2, iRow) 323 OldValue = oDividendCell.Value 324 oDividendCell.Value = OldValue + RestQuantity * DividendPerShare 325 End If 326 Case HANDLESPLIT 327 oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow) 328 SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQUANTITY2, iRow, NoteText) 329 SplitCellValue(oMovementSheet, OldNumber, NewNumber, SBCOLUMNRATE2, iRow, "") 330 SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQTYSOLD2, iRow, "") 331 End Select 332 End If 333 iRow = iRow + 1 334 Loop Until CellStockName = "" 335 If Mode = HANDLESPLIT Then 336 CalculateChartafterSplit(SelStockName, NewNumber, OldNumber, NoteText, SplitDate) 337 End If 338 oDocument.CalculateAll() 339 ProtectSheets(oSheets) 340 oDocument.RemoveActionLock 341End Sub 342 343 344Sub CancelStockRate() 345 DlgStockRates.EndExecute() 346End Sub 347 348 349Sub CancelTransaction() 350 DlgTransaction.EndExecute() 351End Sub 352 353 354Sub CommitStockRate() 355Dim CurStep as Integer 356 CurStep = StockRatesModel.Step 357 Select Case CurStep 358 Case 1 359 ' Check for quantity entered 360 If StockRatesModel.txtDividend.Value = 0 Then 361 MsgBox sMsgNoDividend, SBMSGSTOP+SBMSGSTOP, sMsgError 362 Exit Sub 363 End If 364 HandleStocks(HANDLEDIVIDEND, DlgStockRates) 365 Case 2 366 HandleStocks(HANDLESPLIT, DlgStockRates) 367 Case 3 368 InsertCompanyHistory() 369 End Select 370End Sub 371 372 373Sub EnableTransactionControls(bEnable as Boolean) 374 With TransactModel 375 .lblQuantity.Enabled = bEnable 376 .txtQuantity.Enabled = bEnable 377 .lblRate.Enabled = bEnable 378 .txtRate.Enabled = bEnable 379 .lblDate.Enabled = bEnable 380 .txtDate.Enabled = bEnable 381 .lblCommission.Enabled = bEnable 382 .txtCommission.Enabled = bEnable 383 .lblMinimum.Enabled = bEnable 384 .txtMinimum.Enabled = bEnable 385 .lblFix.Enabled = bEnable 386 .txtFix.Enabled = bEnable 387 If TransactModel.Step = SBDIALOGSELL Then 388 .cmdGoOn.Enabled = Ubound(TransactModel.lstSellStocks.SelectedItems()) > -1 389 DlgTransaction.GetControl("lstSellStocks").SetFocus() 390 Else 391 .cmdGoOn.Enabled = TransactModel.lstBuyStocks.Text <> "" 392 DlgTransaction.GetControl("lstBuyStocks").SetFocus() 393 End If 394 If bEnable Then 395 TransactModel.cmdGoOn.DefaultButton = True 396 End If 397 End With 398End Sub 399 400 401Sub SetupTransactionControls(CurStep as Integer) 402 DlgReference = DlgTransaction 403 With TransactModel 404 .txtDate.Date = CDateToISO(Date()) 405 .txtDate.DateMax = CDateToISO(Date()) 406 .txtStockID.Enabled = False 407 .lblStockID.Enabled = False 408 .lblStockID.Label = sCurStockIDLabel 409 .txtRate.CurrencySymbol = sCurCurrency 410 .txtFix.CurrencySymbol = sCurCurrency 411 .Step = CurStep 412 End With 413 DlgTransaction.Title = TransactTitle(CurStep) 414 CellValuetoControl(oBankSheet, TransactModel.txtCommission, "ProvisionPercent") 415 CellValuetoControl(oBankSheet, TransactModel.txtMinimum, "ProvisionMinimum") 416 CellValuetoControl(oBankSheet, TransactModel.txtFix, "ProvisionFix") 417End Sub 418 419 420Sub AddShortCuttoControl() 421Dim SelCompany as String 422Dim iRow, SelIndex as Integer 423 SelIndex = DlgTransaction.GetControl("lstBuyStocks").GetSelectedItemPos() 424 If SelIndex <> -1 Then 425 SelCompany = TransactModel.lstBuyStocks.StringItemList(SelIndex) 426 iRow = GetStockRowIndex(SelCompany) 427 If iRow <> -1 Then 428 TransactModel.txtStockID.Text = oFirstSheet.GetCellByPosition(SBCOLUMNID1,iRow).String 429 TransactModel.txtRate.Value = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1,iRow).Value 430 Else 431 TransactModel.txtStockID.Text = "" 432 TransactModel.txtRate.Value = 0 433 End If 434 Else 435 TransactModel.txtStockID.Text = "" 436 TransactModel.txtRate.Value = 0 437 End If 438End Sub 439 440 441Sub OpenStockRatePage(aEvent) 442Dim CurStep as Integer 443 Initialize(True) 444 CurStep = aEvent.Source.Model.Tag 445 If FillListbox(DlgStockRates.GetControl("lstStockNames"), StockRatesTitle(CurStep), True) Then 446 StockRatesModel.Step = CurStep 447 ToggleStockRateControls(False, CurStep) 448 InitializeStockRatesControls(CurStep) 449 DlgStockRates.Execute() 450 End If 451End Sub 452 453 454Sub SelectStockNameForRates() 455Dim StockName as String 456 StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem() 457 If StockName <> "" Then 458 StockRatesModel.txtStockID.Text = GetStockID(StockName) 459 ToggleStockRateControls(True, StockRatesModel.Step) 460 End If 461 StockRatesModel.cmdGoOn.DefaultButton = True 462End Sub 463 464 465Sub ToggleStockRateControls(bDoEnable as Boolean, CurStep as Integer) 466 With StockRatesModel 467 .lblStockID.Enabled = False 468 .txtStockID.Enabled = False 469 .cmdGoOn.Enabled = Ubound(StockRatesModel.lstStockNames.SelectedItems()) <> -1 470 Select Case CurStep 471 Case 1 472 .optPerShare.Enabled = bDoEnable 473 .optTotal.Enabled = bDoEnable 474 .lblDividend.Enabled = bDoEnable 475 .txtDividend.Enabled = bDoEnable 476 Case 2 477 .lblExchangeRate.Enabled = bDoEnable 478 .lblDate.Enabled = bDoEnable 479 .lblColon.Enabled = bDoEnable 480 .txtOldRate.Enabled = bDoEnable 481 .txtNewRate.Enabled = bDoEnable 482 .txtDate.Enabled = bDoEnable 483 Case 3 484 .lblStartDate.Enabled = bDoEnable 485 .lblEndDate.Enabled = bDoEnable 486 .txtStartDate.Enabled = bDoEnable 487 .txtEndDate.Enabled = bDoEnable 488 .hlnInterval.Enabled = bDoEnable 489 .optDaily.Enabled = bDoEnable 490 .optWeekly.Enabled = bDoEnable 491 End Select 492 End With 493End Sub 494 495 496Sub InitializeStockRatesControls(CurStep as Integer) 497 DlgReference = DlgStockRates 498 DlgStockRates.Title = StockRatesTitle(CurStep) 499 With StockRatesModel 500 .txtStockID.Text = "" 501 .lblStockID.Label = sCurStockIDLabel 502 Select Case CurStep 503 Case 1 504 .txtDividend.Value = 0 505 .optPerShare.State = 1 506 .txtDividend.CurrencySymbol = sCurCurrency 507 Case 2 508 .txtOldRate.Value = 1 509 .txtNewRate.Value = 1 510 .txtDate.Date = CDateToISO(Date()) 511 Case 3 512 .txtStartDate.DateMax = CDateToISO(CDate(Date())-1) 513 .txtEndDate.DateMax = CDateToISO(CDate(Date())-1) 514 .txtStartDate.Date = CDateToISO(CDate(Date())-8) 515 .txtEndDate.Date = CDateToISO(CDate(Date())-1) 516 .optDaily.State = 1 517 End Select 518 End With 519End Sub 520</script:module> 521