vbscript 用于KTM的Scansation Advanced Amount Formatter

Posted 2021-05-22

' ##### KTM Formatter Script ##### '

Private Sub FmtScansationAmounts_FormatField(ByVal FieldText As String, ByRef FormattedText As String, ByRef ErrDescription As String, ByRef ValidFormat As Boolean)
   On Error GoTo ErrorHandler

   SetAmountFormatterOptions AllowEmptyField:=False, Allow3DecimalPlaces:=False, RequireDecimalPoint:=False, NoOfDecimalPlaces:=6, CurrencyPhrases:=GetInternalLookupResultsSpecifiedColArray("CurrencyData", "Abv_Symbol", "%", 0), DecimalSymbol:="."

   Dim sSSFormattedText As String

   sSSFormattedText = GetFormattedAmount(FieldText, ErrDescription)

   If ErrDescription <> "" Then
      FormattedText = sSSFormattedText
      ValidFormat = False
      Exit Sub
   End If

   FormattedText = sSSFormattedText
   ValidFormat = True

Exit Sub
ErrorHandler:
   General_Error_Handler("FmtScansationAmounts_FormatField", LOG_ERROR, DISPLAY_TO_USER)
End Sub


' ##### Setup Scansation formatter Options #####
' Can be called from anywhere within KTM, imeediately prior to required amount formatting

Private Sub Batch_Open(ByVal pXRootFolder As CASCADELib.CscXFolder)

   OutputDebugString "KfxKTM_Batch_Open ModuleName|Instance: " & GetScriptExecutionName(Project.ScriptExecutionMode) & " | " & CStr(Project.ScriptExecutionInstance)
   OutputDebugString "KfxKTM_Batch Name|Dir: " & GetBatchName(pXRootFolder) & " | " & GetBatchDir(pXRootFolder)

   ' Log Batch Information
   If Project.ScriptExecutionMode = CscScriptModeServer And Project.ScriptVariables.ItemByName("Project_LogBatchData").Value = "True" Then
      LogBatchData(pXRootFolder)
   End If

   ' Set Formatter options for Scansation Custom Formatter
   Select Case Project.ScriptExecutionMode
      Case CscScriptModeValidation, CscScriptModeServer, CscScriptModeServerDesign
         SetAmountFormatterOptions Allow3DecimalPlaces:=True,  RequireDecimalPoint:=False, NoOfDecimalPlaces:=6, CurrencyPhrases:=Array("EU", "EURO", "EUR"), DecimalSymbol:="."
         'SetAmountFormatterOptions Allow3DecimalPlaces:=True,  RequireDecimalPoint:=False, NoOfDecimalPlaces:=6, CurrencyPhrases:=GetInternalLookupResultsSpecifiedColArray("CurrencyData", "Abv_Symbol", "%", 0), DecimalSymbol:="."
   	 'SetAmountFormatterOptions AllowEmptyField:=False, Allow3DecimalPlaces:=False, RequireDecimalPoint:=False, NoOfDecimalPlaces:=6, CurrencyPhrases:=GetInternalLookupResultsSpecifiedColArray("CurrencyData", "Abv_Symbol", "%", 0), DecimalSymbol:="."   
   End Select

End Sub






' ##### Apply Scansation Formatter Options #####

Public Sub SetAmountFormatterOptions(Optional ByVal AllowNegativeAmounts As Boolean = True, _
                                      Optional ByVal RequireDecimalPoint As Boolean = True, _
                                      Optional ByVal Allow3DecimalPlaces As Boolean = False, _
                                      Optional ByVal AllowEmptyField As Boolean = False, _
                                      Optional ByVal DecimalSymbol As String = "", _
                                      Optional ByVal NoOfDecimalPlaces As Byte = 2, _
                                      Optional ByVal CurrencyPhrases As Variant)
   Const PROCNAME = "SetAmountFormatterOptions"
   Dim vCurrencyPhrase As Variant
   Dim lIndex As Long
   Dim lHole As Long

   ' Validate the parameters.
   If Len(DecimalSymbol) > 1 Then Err.Raise AMT_OPTION_ERROR_CODE, PROCNAME, AMT_ERR001
   If IsMissing(CurrencyPhrases) Then CurrencyPhrases = Array("")
   If Not IsArray(CurrencyPhrases) Then Err.Raise AMT_OPTION_ERROR_CODE, PROCNAME, AMT_ERR002
   If LBound(CurrencyPhrases) <> 0 Then Err.Raise AMT_OPTION_ERROR_CODE, PROCNAME, AMT_ERR004

   ' Validate and sort the phrases (largest first) in the same loop for effiency.
   For lIndex = 0 To UBound(CurrencyPhrases)
      vCurrencyPhrase = CurrencyPhrases(lIndex)

      If VarType(vCurrencyPhrase) <> vbString Then
         Err.Raise AMT_OPTION_ERROR_CODE, PROCNAME, AMT_ERR003
      End If

      If lIndex > 0 Then
         lHole = lIndex

         Do While lHole > 0 And Len(CurrencyPhrases(lHole - 1)) < Len(vCurrencyPhrase)
            CurrencyPhrases(lHole) = CurrencyPhrases(lHole - 1)
            lHole = lHole - 1

            If lHole = 0 Then
               Exit Do
            End If
         Loop

         CurrencyPhrases(lHole) = vCurrencyPhrase
      End If
   Next

   ' Get the default decimal symbol, if neccessary.
   If DecimalSymbol = "" Then
      DecimalSymbol = GetSystmDefaultDecimalSymbol
   End If

   ' Set the options.
   With tAmountFormatterOptions
      .AllowNegativeAmounts = AllowNegativeAmounts
      .RequireDecimalPoint = RequireDecimalPoint
      .Allow3DecimalPlaces = Allow3DecimalPlaces
      .AllowEmptyField = AllowEmptyField
      .DecimalSymbol = DecimalSymbol
      .NoOfDecimalPlaces = NoOfDecimalPlaces
      .CurrencyPhrases = CurrencyPhrases
   End With

End Sub



' ##### Scansation Amount Formatter #####

Private Const AMT_ERR001 = "DecimalSymbol must be a single character."
Private Const AMT_ERR002 = "CurrencyPhrases must be an array."
Private Const AMT_ERR003 = "All elements of CurrencyPhrases must be strings"
Private Const AMT_ERR004 = "Only zero-based arrays are supported."
Private Const AMT_ERR006 = "The amount field contains non-numeric characters."
Private Const AMT_ERR007 = "The amount field does not contain a valid amount."
Private Const AMT_ERR008 = "No decimal symbol inside amount."
Private Const AMT_OPTION_ERROR_CODE = 6000
Private Const AMT_FORMATTER_ERROR_CODE = 6001

Private Type AmountFormatterOptions
   AllowNegativeAmounts As Boolean
   RequireDecimalPoint As Boolean
   Allow3DecimalPlaces As Boolean
   AllowEmptyField As Boolean
   DecimalSymbol As String
   NoOfDecimalPlaces As Byte
   CurrencyPhrases As Variant
End Type

Private tAmountFormatterOptions As AmountFormatterOptions

Public Function GetFormattedAmount(ByVal unformattedAmount As String, ByRef errorMessage As String) As String

   Dim strCleanedAmount As String


   Dim strFormat As String
   Dim lCount As Long
   Dim strFormattedAmount As String
   Dim strSystemDecimalSymbol As String

   ' Clean the amount first.
   strCleanedAmount = GetCleanedAmount(unformattedAmount, errorMessage)

   ' Short circuit exit if the value is blank.
   If strCleanedAmount = "" Then
      If tAmountFormatterOptions.AllowEmptyField Then
         ' Blanks are allowed.
         Exit Function
      Else
         ' Blanks are not allowed.
         errorMessage = AMT_ERR007
         Exit Function
      End If
   End If

   ' Generate the format for the amount.
   strFormat = "0"

   If tAmountFormatterOptions.NoOfDecimalPlaces > 0 Then
      strFormat = strFormat & "."

      For lCount = 1 To tAmountFormatterOptions.NoOfDecimalPlaces
         strFormat = strFormat & "0"
      Next
   End If

   ' Format the amount.
   strFormattedAmount = Format(strCleanedAmount, strFormat)

   ' Replace the localised decimal separator with the specified one.
   strSystemDecimalSymbol = GetSystmDefaultDecimalSymbol
   strFormattedAmount = Replace(strFormattedAmount, strSystemDecimalSymbol, _
                                tAmountFormatterOptions.DecimalSymbol)



   ' Return the result.

   GetFormattedAmount = strFormattedAmount
End Function

Private Function GetCleanedAmount(ByVal uncleanedAmount As String, ByRef errorMessage As String) As String

   Dim strCleanedAmount As String
   Dim vPhrase As Variant
   Dim strSystemDefaultDecimal As String
   Dim strDefaultDecimalSymbol As String
   Dim lIndex As Long
   Dim ch As String
   Dim strTemp As String
   Dim bIsPositive As Boolean
   Dim lDecimalSymbolsFound As Long
   Dim strDecimalPart As String
   Dim bFoundLeastSignificantDecimal As Boolean
   Dim bFoundFirstDecimalSymbol As Boolean

   strCleanedAmount = uncleanedAmount

   ' Strip currency phrases.  These are allowed to exist in the input string, but are stripped.
   strCleanedAmount = RemoveSubstrings(strCleanedAmount, tAmountFormatterOptions.CurrencyPhrases)

   ' Get the system default decimal symbol (used in multiple places below).
   strSystemDefaultDecimal = GetSystmDefaultDecimalSymbol


   ' Strip any other non-numeric characters, and populate the errorMessage variable if any exist.
   ' We loop backwards here because we must remove all but the last decimal symbol.
   strTemp = strCleanedAmount

   strCleanedAmount = ""

   For lIndex = Len(strTemp) To 1 Step -1
      ch = Mid(strTemp, lIndex, 1)

      If IsNumeric(ch) Then
         ' Keep numeric chars.
         strCleanedAmount = ch & strCleanedAmount

         If Not bFoundLeastSignificantDecimal Then
            bFoundLeastSignificantDecimal = True
         End If
      ElseIf ch Like "[ ,.]" Then
         ' Remove these chars, except for the first (i.e. last) one found after the first (last!)
         ' numeric char, in which case substitute it for the localised decimal symbol.
         If Not bFoundFirstDecimalSymbol Then
            If bFoundLeastSignificantDecimal Then
               ' Get the cleaned decimal part (for use in 3 decimal char checking).
               strDecimalPart = RemoveSubstrings(strCleanedAmount, Array("+", "-"))

               ' Output
               strCleanedAmount = strSystemDefaultDecimal & strCleanedAmount
               bFoundFirstDecimalSymbol = True
            End If
         End If
      ElseIf ch Like "[+-]" Then
         ' Retain positive and negative symbols (for now, at least).
         strCleanedAmount = ch & strCleanedAmount
      Else
         errorMessage = AMT_ERR006
      End If
   Next

   If (Not bFoundFirstDecimalSymbol) And tAmountFormatterOptions.RequireDecimalPoint Then
      ' If no decimals found, the error message will indicate that over other errors.
      errorMessage = AMT_ERR008
   ElseIf Len(strDecimalPart) = 3 And Not tAmountFormatterOptions.Allow3DecimalPlaces Then
      ' 3-char decimals not allowed, so assume they are part of the digits
      ' (i.e. remove the decimal point).


      strCleanedAmount = Replace(strCleanedAmount, strSystemDefaultDecimal, "")

      If tAmountFormatterOptions.RequireDecimalPoint Then
         ' Options specify that we require a decimal point, but we have just removed it in the
         ' Replace() above, so indicate an error has occurred.
         errorMessage = AMT_ERR008
      End If
   End If


   ' Determine if the remainder is positive or negative, and strip plus and minus symbols.
   ' symbols.  (Minus will be added back in below, if needed.)
   bIsPositive = IsAmountPositive(strCleanedAmount)
   strCleanedAmount = RemoveSubstrings(strCleanedAmount, Array("+", "-"))

   ' Re-add a single minus symbol if necessary.
   If (Not bIsPositive) And (tAmountFormatterOptions.AllowNegativeAmounts) Then
      strCleanedAmount = "-" & strCleanedAmount
   End If

   GetCleanedAmount = strCleanedAmount
End Function

Private Function RemoveSubstrings(ByVal fullString As String, ByVal subStrings As Variant) As String
   Dim strOutput As String
   Dim vSubString As Variant

   strOutput = fullString

   For Each vSubString In subStrings
      strOutput = Replace(strOutput, CStr(vSubString), "")
   Next

   RemoveSubstrings = strOutput
End Function

Private Function IsAmountPositive(ByVal amount As String) As Boolean
   IsAmountPositive = True

   If Right(amount, 1) = "-" Then
      IsAmountPositive = False
      Exit Function
   End If

   If Left(amount, 1) = "-" Then
      IsAmountPositive = False
      Exit Function
   End If
End Function

Private Function GetSystmDefaultDecimalSymbol() As String
   GetSystmDefaultDecimalSymbol = Mid(CStr(1.1), 2, 1)
End Function