From ed5640d8b587fbcfed7dd7967f3de04b37a76f26 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 11:06:44 +0200 Subject: Adding upstream version 4:7.4.7. Signed-off-by: Daniel Baumann --- wizards/source/depot/tools.xba | 217 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 217 insertions(+) create mode 100644 wizards/source/depot/tools.xba (limited to 'wizards/source/depot/tools.xba') diff --git a/wizards/source/depot/tools.xba b/wizards/source/depot/tools.xba new file mode 100644 index 000000000..daadf4988 --- /dev/null +++ b/wizards/source/depot/tools.xba @@ -0,0 +1,217 @@ + + + +REM ***** BASIC ***** +Option Explicit + +Sub RemoveSheet() + If oSheets.HasbyName("Link") then + oSheets.RemovebyName("Link") + End If +End Sub + + +Sub InitializeStatusLine(StatusText as String, MaxValue as Integer, FirstValue as Integer) + oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator() + oStatusLine.Start(StatusText, MaxValue) + oStatusline.SetValue(FirstValue) +End Sub + + +Sub MakeRangeVisible(oSheet as Object, RangeName as String, BIsVisible as Boolean) +Dim oRangeAddress, oColumns as Object +Dim i, iStartColumn, iEndColumn as Integer + oRangeAddress = oSheet.GetCellRangeByName(RangeName).RangeAddress + iStartColumn = oRangeAddress.StartColumn + iEndColumn = oRangeAddress.EndColumn + oColumns = oSheet.Columns + For i = iStartColumn To iEndColumn + oSheet.Columns(i).IsVisible = bIsVisible + Next i +End Sub + + +Function GetRowIndex(oSheet as Object, RowName as String) +Dim oRange as Object + oRange = oSheet.GetCellRangeByName(RowName) + GetRowIndex = oRange.RangeAddress.StartRow +End Function + + +Function GetTransactionCount(iStartRow as Integer) +Dim iEndRow as Integer + iStartRow = GetRowIndex(oMovementSheet, "ColumnsToHide") + iEndRow = GetRowIndex(oMovementSheet, "HiddenRow3" ) + GetTransactionCount = iEndRow -iStartRow - 2 +End Function + + +Function GetStocksCount(iStartRow as Integer) +Dim iEndRow as Integer + iStartRow = GetRowIndex(oFirstSheet, "HiddenRow1") + iEndRow = GetRowIndex(oFirstSheet, "HiddenRow2") + GetStocksCount = iEndRow -iStartRow - 1 +End Function + + +Function FillListbox(ListboxControl as Object, MsgTitle as String, bShowMessage) as Boolean +Dim i, StocksCount as Integer +Dim iStartRow as Integer +Dim oCell as Object + ' Add stock names to empty list box + StocksCount = GetStocksCount(iStartRow) + If StocksCount > 0 Then + ListboxControl.Model.StringItemList() = NullList() + For i = 1 To StocksCount + oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i) + ListboxControl.AddItem(oCell.String, i-1) + Next + FillListbox() = True + Else + If bShowMessage Then + Msgbox(sInsertStockName, 16, MsgTitle) + FillListbox() = False + End If + End If +End Function + + +Sub CellValuetoControl(oSheet, oControl as Object, CellName as String) +Dim oCell as Object +Dim StringValue + oCell = GetCellByName(oSheet, CellName) + If oControl.PropertySetInfo.HasPropertyByName("EffectiveValue") Then + oControl.EffectiveValue = oCell.Value + Else + oControl.Value = oCell.Value + End If +' If oCell.FormulaResultType = 1 Then +' StringValue = oNumberFormatter.GetInputString(oCell.NumberFormat, oCell.Value) +' oControl.Text = DeleteStr(StringValue, "%") +' Else +' oControl.Text = oCell.String +' End If +End Sub + + +Sub RemoveStockRows(oSheet as Object, iStartRow, RowCount as Integer) + If RowCount > 0 Then + oSheet.Rows.RemoveByIndex(iStartRow, RowCount) + End If +End Sub + + +Sub AddValueToCellContent(iCellCol, iCellRow as Integer, AddValue) +Dim oCell as Object +Dim OldValue + oCell = oMovementSheet.GetCellByPosition(iCellCol, iCellRow) + OldValue = oCell.Value + oCell.Value = OldValue + AddValue +End Sub + + +Sub CheckInputDate(aEvent as Object) +Dim oRefDialog as Object +Dim oRefModel as Object +Dim oDateModel as Object + oDateModel = aEvent.Source.Model + oRefModel = DlgReference.GetControl("cmdGoOn").Model + oRefModel.Enabled = oDateModel.Date <> 0 +End Sub + + + +' Updates the cell with the CurrentValue after checking if the +' Newdate is later than the one that is referred to in the annotation +' of the cell +Sub InsertCurrentValue(CurValue as Double, iRow as Integer, Newdate as Date) +Dim oCell as Object +Dim OldDate as Date + oCell = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1, iRow) + OldDate = CDate(oCell.Annotation.Text.String) + If NewDate >= OldDate Then + oCell.SetValue(CurValue) + oCell.Annotation.Text.SetString(CStr(NewDate)) + End If +End Sub + + +Sub SplitCellValue(oSheet, FirstNumber, SecondNumber, iCol, iRow, NoteText) +Dim oCell as Object +Dim OldValue + oCell = oSheet.GetCellByPosition(iCol, iRow) + OldValue = oCell.Value + oCell.Value = OldValue * FirstNumber / SecondNumber + If NoteText <> "" Then + oCell.Annotation.SetString(NoteText) + End If +End Sub + + +Function GetStockRowIndex(ByVal Stockname) as Integer +Dim i, StocksCount as Integer +Dim iStartRow as Integer +Dim oCell as Object + StocksCount = GetStocksCount(iStartRow) + For i = 1 To StocksCount + oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i) + If oCell.String = Stockname Then + GetStockRowIndex = iStartRow + i + Exit Function + End If + Next + GetStockRowIndex = -1 +End Function + + +Function GetStockID(StockName as String, Optional iFirstRow as Integer) as String +Dim CellStockName as String +Dim i as Integer +Dim iCount as Integer +Dim iLastRow as Integer + If IsMissing(iFirstRow) Then + iFirstRow = GetRowIndex(oFirstSheet, "HiddenRow1") + End If + iCount = GetStocksCount(iFirstRow) + iLastRow = iFirstRow + iCount + For i = iFirstRow To iLastRow + CellStockName = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, i).String + If CellStockname = StockName Then + Exit For + End If + Next i + If i > iLastRow Then + GetStockID() = "" + Else + If Not IsMissing(iFirstRow) Then + iFirstRow = i + End If + GetStockID() = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String + End If +End Function + + +Function CheckDocLocale(LocLanguage as String, LocCountry as String) +Dim bIsDocLanguage as Boolean +Dim bIsDocCountry as Boolean + bIsDocLanguage = Instr(1, LocLanguage, sDocLanguage, SBBINARY) <> 0 + bIsDocCountry = Instr(1, LocCountry, sDocCountry, SBBINARY) <> 0 OR SDocCountry = "" + CheckDocLocale = (bIsDocLanguage And bIsDocCountry) +End Function + -- cgit v1.2.3