Число прописью 14

Delphi , Синтаксис , Текст и Строки

Автор: Алексей
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.

Статья Число прописью 14 раздела Синтаксис Текст и Строки может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Текст и Строки ::