Delphi World - Конвертация денежных сумм в строковое выражение
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Конвертация денежных сумм в строковое выражение

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

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Конвертация денежных сумм в строковое выражение

Конвертация денежных сумм в строковое выражение впоть до додециллиона,
причем легко наращивается. Небольшая по размеру.

Зависимости: System
Автор:       Раков Андрей, klopmail@mail.ru, Курчатов
Copyright:   Раков А.В.
Дата:        17 августа 2002 г.
***************************************************** }

function MoneyToStr(DD: string): string;
{(С) Раков А.В. 05.2002 e-mail: klopmail@mail.ru сайт: http://www.kursknet.ru/~klop}
type
  TTroyka = array[1..3] of Byte;
  TMyString = array[1..19] of string[12];
var
  S, OutS, S2: string;
  k, L, kk: Integer;
  Troyka: TTroyka;
  V1: TMyString;
  Mb: Byte;
const
  V11: TMyString =
  ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять',
    'десять', 'одиннадцать',
    'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать',
      'семнадцать', 'восемнадцать', 'девятнадцать');
  V2: array[1..8] of string =
  ('двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят',
    'восемьдесят', 'девяносто');
  V3: array[1..9] of string =
  ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот',
    'восемьсот', 'девятьсот');
  M1: array[1..13, 1..3] of string = (('тысяча', 'тысячи', 'тысяч'),
    ('миллион', 'миллиона', 'миллионов'),
    ('миллиард', 'миллиарда', 'миллиардов'),
    ('триллион', 'триллиона', 'триллионов'),
    ('квадриллион', 'квадриллиона', 'квадриллионов'),
    ('квинтиллион', 'квинтиллиона', 'квинтиллионов'),
    ('секстиллион', 'секстиллиона', 'секстиллионов'),
    ('сентиллион', 'сентиллиона', 'сентиллионов'),
    ('октиллион', 'октиллиона', 'октиллионов'),
    ('нониллион', 'нониллиона', 'нониллионов'),
    ('дециллион', 'дециллиона', 'дециллионов'),
    ('ундециллион', 'ундециллиона', 'ундециллионов'),
    ('додециллион', 'додециллиона', 'додециллионов'));
  R1: array[1..3] of string = ('рубль', 'рубля', 'рублей');
  R2: array[1..3] of string = ('копейка', 'копейки', 'копеек');
  function TroykaToStr(L: ShortInt; TR: TTroyka): string;
  var
    S: string;
  begin
    S := '';
    if Abs(L) = 1 then
    begin
      V1[1] := 'одна';
      V1[2] := 'две';
    end
    else
    begin
      V1[1] := 'один';
      V1[2] := 'два';
    end;
    if Troyka[2] = 1 then
    begin
      Troyka[2] := 0;
      Troyka[3] := 10 + Troyka[3];
    end;
    if Troyka[3] <> 0 then
      S := V1[Troyka[3]];
    if Troyka[2] <> 0 then
      S := V2[Troyka[2] - 1] + ' ' + S;
    if Troyka[1] <> 0 then
      S := V3[Troyka[1]] + ' ' + S;
    if (L > 0) and (S <> '') then
      case Troyka[3] of
        1: S := S + ' ' + M1[L, 1] + ' ';
        2..4: S := S + ' ' + M1[L, 2] + ' ';
      else
        S := S + ' ' + M1[L, 3] + ' ';
      end;
    TroykaToStr := S;
  end;
begin
  V1 := V11;
  L := 0;
  OutS := '';
  kk := Pos(',', DD);
  if kk = 0 then
    S := DD
  else
    S := Copy(DD, 1, kk - 1);
  if S = '0' then
    S2 := ''
  else
    S2 := S;
  repeat
    for k := 3 downto 1 do
      if Length(S) > 0 then
      begin
        Troyka[k] := StrToInt(S[Length(S)]);
        Delete(S, Length(S), 1);
      end
      else
        Troyka[k] := 0;
    OutS := TroykaToStr(L, Troyka) + OutS;
    if L = 0 then
      Mb := Troyka[3];
    Inc(L);
  until Length(S) = 0;
  case Mb of
    0: if Length(S2) > 0 then
        OutS := OutS + ' ' + R1[3] + ' ';
    1: OutS := OutS + ' ' + R1[1] + ' ';
    2..4: OutS := OutS + ' ' + R1[2] + ' ';
  else
    OutS := OutS + ' ' + R1[3] + ' ';
  end;
  S2 := '';
  if kk <> 0 then
  begin
    DD := Copy(DD, kk + 1, 2);
    if Length(DD) = 1 then
      DD := DD + '0';
    k := StrToInt(DD);
    Troyka[1] := 0;
    Troyka[2] := k div 10;
    Troyka[3] := k mod 10;
    S2 := TroykaToStr(-1, Troyka);
    case Troyka[3] of
      0: if Troyka[2] = 0 then
          S := ''
        else
          S := R2[3];
      1: S := R2[1];
      2..4: S := R2[2];
    else
      S := R2[3];
    end;
  end;
  // MoneyToStr:=OutS+IntToStr(k)+' '+S; // если копейки нужны цифрой-эту строку раскоментировать
  MoneyToStr := OutS + S2 + ' ' + S; // а эту закоментировать
end;

Пример использования:

S := MoneyToStr('76576876876976576437654365,98'); 
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования