Автор: Н. Е. Г.

Задача. Требуется функция, оперирующая с 14 разрядами в целой и 2 разрядами в дробной части.

Изучив два попавшихся под руку алгоритма, обнаружил ряд недостатков:

   1. Алгоритм, использующий аргумент типа Long,  ограничен всего 10 рязрядами (~2,14 млрд);
   2. Алгоритм, использующий аргумент типа Double, накапливает случайную ошибку в дробной части, когда целая часть превышает 12 разрядов (см. Listing 1);
   3. Ошибки в русском языке при формировании числительных;
   4. Нарушение нормативных требований для записи денежных величин прописью;
   5. Невозможность записи прописью вещественных величин с дробной частью.

_____________
Listing 1
#include <stdio.h>
int main(void)
{
    printf("%f\n", (double)99999999999997.74 + (double)1.);
    return 0;
}
stdout: 99999999999998.734375
-------------------
Для устранение перечисленных недостатков предприняты следующие меры:

   1. Использован тип Currency, гарантирующий 14 разрядов для целой части и 4 разряда для дробной части.

   2. Ошибки переполнения исключены за счёт символьного представления чисел внутри алгоритма;

_________________
Listing 2
REM  *****  BASIC  *****

Option Base 0
Option Explicit

const    LIMIT_C = 99999999999999.99
const    ERR_C_MSG = «ПЕРЕПОЛНЕНИЕ!!! Параметр > abs( 99 999 999 999 999.99 )»
const    ZERO =  «ноль»
const    MINUS = «минус»

public Function Currency2Scribe(ByVal money as Currency) as String

Dim RUB() as String: RUB= array(«рубль», «рубля», «рублей»)
Dim COP() as String: COP = array(«копейка», «копейки», «копеек»)

Dim MoneyStr as String
Dim OutString as String
Dim ncop as Integer
   
if Fix(money) = 0 and Sgn(money) < 0 then
  MoneyStr = MINUS + " " + ZERO
else
  MoneyStr = Int2Scribe(money)
end if

if MoneyStr <> ERR_C_MSG then
  OutString = Str(money)

  Dim i as Integer, l as Integer
  l = Len(OutString)
  Dim s as String

  for i = 1 to l
    s = Mid(OutString, i, 1)
    if s = "." or s = "," then
      ncop = Val(Mid(OutString, i + 1, 4)) / 100.
      if ncop = 100 then
        ncop = ncop — 1
      end if

      OutString = Right(Left(OutString, i — 1), 2)
      exit for
    end if
  next

  Dim c as Long
  c = Abs(Val(OutString))

  if c < 20 and c > 9 then
    c = 0
  else
    c = c mod 10
  end if

  Select Case c
    Case 1:
      MoneyStr = MoneyStr + " " + RUB(0)
    Case  2, 3, 4:
      MoneyStr = MoneyStr + " " + RUB(1)
    Case Else:
      MoneyStr = MoneyStr + " " + RUB(2)
  End Select

  MoneyStr = MoneyStr + " " + Format (ncop, «00»)

  if ncop < 20 and ncop > 9  then
    ncop = 0
  else
    ncop = ncop mod 10
  end if

  Select Case ncop
    Case 1:
      MoneyStr = MoneyStr + " " + COP(0)
    Case  2, 3, 4:
      MoneyStr = MoneyStr + " " + COP(1)
    Case Else:
      MoneyStr = MoneyStr + " " + COP(2)
  End Select
end if

Currency2Scribe = Trim$(UCase(Left(MoneyStr, 1)) + Right(MoneyStr, Len(MoneyStr) — 1))

End Function

private Function Int2Scribe(ByVal value as Currency, Optional frac_only as Boolean) as String

Dim postfix() as String: postfix = array("", "", "", «тысяча», «тысячи», «тысяч», «миллион», «миллиона», «миллионов», «миллиард», «миллиардa», «миллиардов»,  «триллион», «триллиона», «триллионов», «триллиард», «триллиардa», «триллиардов»)
Dim hundreds() as String: hundreds= array("", «сто», «двести», «триста», «четыреста», «пятьсот», «шестьсот», «семьсот», «восемьсот», «девятьсот»)
Dim tens() as String: tens= array("", "", «двадцать», «тридцать», «сорок», «пятьдесят», «шестьдесят», «семьдесят», «восемьдесят», «девяносто»)
Dim units() as String: units = array("", «один», «два», «три», «четыре», «пять», «шесть», «семь», «восемь», «девять», «десять», «одиннадцать», «двенадцать», «тринадцать», «четырнадцать», «пятнадцать», «шестнадцать», «семнадцать», «восемнадцать», «девятнадцать»)
Dim units_th() as String: units_th = array("", «одна», «двe»)

Dim negative as Boolean: negative = false
Dim Scribe as String: Scribe = ""

Dim units_th_only as Boolean: units_th_only = not IsMissing(frac_only)

if LIMIT_C < abs(value) then
  Scribe = ERR_C_MSG
else
  if value < 0 then
    value = value * (-1.)
    negative = true
  end if

  Dim StrNumber as String
  StrNumber = Format(Int(value), "#0")

  if Int(value) = 0 then
    Scribe =ZERO
  else
    DIm d, n, u, p as Long: p = 0
    do
      n = Val(Right(StrNumber, 3))
      u = Len(StrNumber)
      if  u > 3 then
        StrNumber = Left(StrNumber, u — 3)
      else
        StrNumber = ""
      end if

      d = n mod 100
      u = d mod 10

      Dim TempStr as String: TempStr = ""

      if d > 0 then
        if d < 20 then
          if (p = 1 or (p = 0 and units_th_only)) and d < 3 then
            TempStr = units_th(u)
          else
            TempStr = units(d)
          end if
        else
          if (p = 1 or (p = 0 and units_th_only))  and u < 3 then
            TempStr = tens(Int(d / 10)) + " " + units_th(u)
          else
            TempStr = tens(Int(d / 10)) + " " + units(u)
          end if
        end if
      end if

      TempStr = Trim$(hundreds(Int(n / 100)) + " " + Trim$(TempStr))

      if p > 0 and (d > 0 or n > 0) then
        if d < 20 and d > 9 then
          d = 0
        else
          d = d mod 10
        end if

        Select Case d
          Case 1:
            TempStr = TempStr + " " + postfix(p * 3)
          Case  2, 3, 4:
            TempStr = TempStr + " " + postfix(p * 3 + 1)
          Case Else:
            TempStr = TempStr + " " + postfix(p * 3 + 2)
        End Select
      end if

      p = p + 1       

      Scribe = Trim$(TempStr + " " + Scribe)

    loop until StrNumber = ""

    if negative then
      Scribe = MINUS + " " + Scribe
    end if
  end if
end if

Int2Scribe = Scribe

End Function

Н. Е. Г.
Источник.