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