Сумма прописью - Способ 14

Автор: Алексей
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование целого числа 0-999999999 в строку (прописью)

Я думаю, всё итак понятно, что не понятно пишите письма

Зависимости: SysUtils
Автор:       Алексей, ARojkov@okil.ru, СПб
Copyright:   b0b
Дата:        12 марта 2004 г.
***************************************************** }

unit UIntToStroka;

interface

uses SysUtils;

const
  N1: array[0..9] of string = ("ноль",
    "один",
    "два",
    "три",
    "четыре",
    "пять",
    "шесть",
    "семь",
    "восемь",
    "девять");

const
  N1000: array[1..9] of string = ("одна",
    "две",
    "три",
    "четыре",
    "пять",
    "шесть",
    "семь",
    "восемь",
    "девять");

const
  N11: array[0..9] of string = ("десять",
    "одиннадцать",
    "двенадцать",
    "тринадцать",
    "четырнадцать",
    "пятнадцать",
    "шестнадцать",
    "семнадцать",
    "восемнадцать",
    "девятнадцать");

const
  N2: array[1..9] of string = ("десять",
    "двадцать",
    "тридцать",
    "сорок",
    "пятьдесят",
    "шестьдесят",
    "семьдесят",
    "восемьдесят",
    "девяносто"
    );

const
  N3: array[1..9] of string = ("сто",
    "двести",
    "триста",
    "четыреста",
    "пятьсот",
    "шестьсот",
    "семьсот",
    "восемьсот",
    "девятьсот"
    );

const
  NThousand: array[1..3] of string = ("тысяча ",
    "тысячи ",
    "тысяч ");

const
  NMillion: array[1..3] of string = ("миллион ",
    "миллиона ",
    "миллионов ");

function IntToStroka(n: Integer): AnsiString;

implementation

function IntToStroka(n: Integer): AnsiString;
var
  i, j, dec, j0: Integer;
  s: string;
  degt, degm: boolean;
  buf: string;
begin
  degt := false;
  degm := false;
  s := IntToStr(n);
  Result := "";
  for i := length(s) downto 1 do
  begin
    dec := (length(s) - i + 1); // получим разряд
    j := StrToInt(s[i]); // получим цифру

    if j = 0 then
      j0 := 0;
    if (not (j in [1..9])) and (dec <> 1) then
      Continue;

    if Dec in [1, 4, 7, 10] then
    try
      if StrToInt(s[i - 1]) = 1 then
      begin
        j0 := j;
        Continue;
      end; // подготовка к 10..19 тысяч/миллионов
    except
    end;

    if Dec in [2, 5, 8, 11] then
      if j = 1 then
      begin
        case dec of
          2: Result := N11[j0] + " "; // если 10..19 тысяч/миллионов
          5:
            begin
              Result := N11[j0] + " " + NThousand[3] + Result;
              degt := true;
            end;
          8:
            begin
              Result := N11[j0] + " " + NMillion[3] + Result;
              degm := true;
            end;
        end;
        Continue;
      end;

    if DEC in [4..6] then
    begin
      if (j <> 0) and (not degt) then
      begin
        if dec = 4 then
          case j of
            1: buf := NThousand[1];
            2..4: buf := NThousand[2];
              // прибавим слово тысяча если ещё не добавляли
            5..9: buf := NThousand[3];
          end
        else
          buf := NThousand[3];
        degt := true;
      end;
    end;

    if DEC in [7..9] then
    begin
      if (j <> 0) and (not degm) then
      begin
        if dec = 7 then
          case j of
            1: buf := NMillion[1];
            2..4: buf := NMillion[2];
              // прибавим слово миллион если ещё не добавляли
            5..9: buf := NMillion[3];
          end
        else
          buf := NMillion[3];
        degm := true;
      end;
    end;

    Result := buf + Result;

    while dec > 3 do
      dec := dec - 3;

    case Dec of
      1: if j <> 0 then
          if degt and (not degm) then
            Result := N1000[j] + " " + Result
          else
            Result := N1[j] + " " + Result; // 3 три
      2: Result := N2[j] + " " + Result; // 23 двадцать три
      3: Result := N3[j] + " " + Result; // 123 сто двадцать три
    end;
    Buf := "";
    j0 := j;
  end;
end;

end.

Обсудить статью на форуме