Телефон: +7 (926) 245-03-63

Функция «Сумма прописью» на Delphi

Следующая статья: Переменная в качестве имени процедуры.

Очень часто в финансовых приложениях сумму нужно писать прописью. Как сумму, представленную цифрой, преобразовать в строку прописью?

Внимание! в функции допущено нескольк ошибок, чтобы вы перед тем как просто скопировали функцию, нужно было подумать и вьехать в суть алгоритма, так как понятие данного алгоритма в дальнейшей существенно поможет в создании подобных функци и процедур. Поверьте таких функцию приходится писать довольно много.

function Conv999(M: longint; fm: integer): string;
const
c1to9m: array [1..9] of string[6]=
 ('один','два','три','четыре','пять','шесть','семь','восемь','девять');

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

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

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

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

var
s: String;
i: Longint;
begin
  s:='';
  i:=M div 100;
  if I<>0 then s:=c100to900[i]+'';
  M:=M mod 100;
  i:=M div 10;
  if (M>10) and (M<20)
  then
  begin
    s:=s+c11to19[M-10]+'';
  end
  else
  begin
    if I<>0 then s:=s+c10to90[i]+'';
    M:=M mod 10;
    if M<>0 then
    begin 
     if fm=0 then s:=s+c1to9f[M]+'' else s:=s+c1to9m[M]+'';
    end;
    Conv999:=s;
  end;

function TextSum(S: double): string;
var
i: Longint;
j: Longint;
r: Real;
t: String;

begin
  t:='';
  j:=Trunc(S / 1000000000.0);
  r:=j;
  r:=S - r*1000000000.0;
  i:=Trunc(r);
  if j<>0 then begin t:=t+Conv999(j, 1)+'миллиард';
  j:=j mod 100;
  if (j > 10) and (j < 20)
  then
  begin
    t:=t+'ов';
  end;
  else
  begin
    case j mod 10 of
    0: t:=t+'ов';
    1: t:=t+' ';
    2..4: t:=t+'а';
    5..9: t:=t+'ов';
    end;// case
  end;
  j:=i div 1000000;
  if j<>0 then
  begin
    t:=t+Conv999(j, 1)+'миллион';
    j:=j mod 100;
    if (j > 10) and (j < 20) then
    begin 
      t:=t+'ов';
    end
    else
    begin
      case j mod 10 of
      0: t:=t+'ов';
      1: t:=t+'';
      2..4: t:=t+'а';
      5..9: t:=t+'ов';
      end;// case
    end;
  end;
  i:=i mod 1000000;
  j:=i div 1000;
  if j<>0 then begin
  t:=t+Conv999(j, 0)+'тысяч';
  j:=j mod 100;
  if (j > 10) and (j < 20) then
  begin
    t:=t+'';
  end;
  else
  begin
    case j mod 10 of
    0: t:=t+'';
    1: t:=t+'а';
    2..4: t:=t+'и';
    5..9: t:=t+'';
    end;// case 
  end;
  i:=i mod 1000;
  j:=i;
  if j<>0 then t:=t+Conv999(j, 1);
  t:=t+'руб.';
  i:=Round(Frac(S)*100.0);
  t:=t+IntToStr(i)+' коп.';
  TextSum:=t;
end;