Delphi - база знаний


Число русской строкой


Число русской строкой




Автор Александр

{------------------------Деньги прописью ---------------------}
function TextSum(S: double): string;

  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
      s := s + c11to19[M - 10] + ' '
    else
      begin
        if i <> 0 then s := s + c10to90[i] + ' ';
        M := M mod 10;
        if M <> 0 then
          if fm = 0 then
            s := s + c1to9f[M] + ' '
          else
            s := s + c1to9m[M] + ' ';
      end;
    Conv999 := s;
  end;

{--------------------------------------------------------------}
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
        t := t + 'ов '
      else
        case j mod 10 of
          0: t := t + 'ов ';
          1: t := t + ' ';
          2..4: t := t + 'а ';
          5..9: t := t + 'ов ';
        end;
    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
        t := t + 'ов '
      else
        case j mod 10 of
          0: t := t + 'ов ';
          1: t := t + ' ';
          2..4: t := t + 'а ';
          5..9: t := t + 'ов ';
        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
        t := t + ' '
      else
        case j mod 10 of
          0: t := t + ' ';
          1: t := t + 'а ';
          2..4: t := t + 'и ';
          5..9: t := t + ' ';
        end;
    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 + Long2Str(i) + ' коп.';
  TextSum := t;
end;

unit RoubleUnit;
{$D Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.htm }
{ 1000011.01->'Один миллион одинадцать рублей 01 копейка'               }
interface
function RealToRouble(c: Extended): string;
implementation
uses SysUtils, math;
const Max000 = 6; {Кол-во триплетов - 000}
  MaxPosition = Max000 * 3; {Кол-во знаков в числе }
//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости
function IIF(i: Boolean; s1, s2: Char): Char; overload; begin if i then
    result := s1
  else
    result := s2 end;
function IIF(i: Boolean; s1, s2: string): string; overload; begin if i then
    result := s1
  else
    result := s2 end;

function NumToStr(s: string): string{Возвращает число прописью}
const c1000: array[0..Max000] of string = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион');

  c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False);
  w: array[False..True, '0'..'9'] of string[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '),
    (' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' '));
  function Num000toStr(S: string; woman: Boolean): string{Num000toStr возвращает число для триплета}
  const c100: array['0'..'9'] of string = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
    c10: array['0'..'9'] of string = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
    c11: array['0'..'9'] of string = ('', 'один', 'две', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят');
    c1: array[False..True, '0'..'9'] of string = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '),
      ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '));
  begin {Num000toStr}
    Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]);
  end{Num000toStr}

var s000: string[3];

  isw, isMinus: Boolean;
  i: integer; //Счётчик триплетов
begin

  Result := ''; i := 0;
  isMinus := (s <> '') and (s[1] = '-');
  if isMinus then s := Copy(s, 2, Length(s) - 1);
  while not ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do
    begin
      s000 := Copy('00' + s, Length(s) - i * 3, 3);
      isw := c1000w[i];
      if (i > 0) and (s000 <> '000') then //тысячи и т.д.
        Result := c1000[i] + w[Isw, iif(s000[2] = '1', '0', s000[3])] + Result;
      Result := Num000toStr(s000, isw) + Result;
      Inc(i)
    end;
  if Result = '' then Result := 'ноль';
  if isMinus then Result := 'минус ' + Result;
end{NumToStr}

function RealToRouble(c: Extended): string;

const ruble: array['0'..'9'] of string[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей');
  Kopeek: array['0'..'9'] of string[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек');

  function ending(const s: string): Char;
  var l: Integer; //С l на 8 байт коротче $50->$48->$3F
  begin //Возвращает индекс окончания
    l := Length(s);
    Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]);
  end;

var rub: string[MaxPosition + 3]; kop: string[2];
begin {Возвращает число прописью с рублями и копейками}

  Str(c: MaxPosition + 3: 2, Result);
  if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99
    begin
      rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));
      kop := Copy(Result, Length(Result) - 1, 2);
      Result := NumToStr(rub) + ' рубл' + ruble[ending(rub)]
        + ' ' + kop + ' копе' + Kopeek[ending(kop)];
      Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);
    end;
end;
end.


Редянов Денис


function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string;
{Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19

Padeg - 1-нормально 2- одна, две }

var i: Integer;
begin

  i := StrToInt(Cifr);
  if Pr = 1 then
    case i of
      1: CifrToStr := 'сто';
      2: CifrToStr := 'двести';
      3: CifrToStr := 'триста';
      4: CifrToStr := 'четыреста';
      5: CifrToStr := 'пятьсот';
      6: CifrToStr := 'шестьсот';
      7: CifrToStr := 'семьсот';
      8: CifrToStr := 'восемьсот';
      9: CifrToStr := 'девятьсот';
      0: CifrToStr := '';
    end
  else if Pr = 2 then
    case i of
      1: CifrToStr := '';
      2: CifrToStr := 'двадцать';
      3: CifrToStr := 'тридцать';
      4: CifrToStr := 'сорок';
      5: CifrToStr := 'пятьдесят';
      6: CifrToStr := 'шестьдесят';
      7: CifrToStr := 'семьдесят';
      8: CifrToStr := 'восемьдесят';
      9: CifrToStr := 'девяносто';
      0: CifrToStr := '';
    end
  else if Pr = 3 then
    case i of
      1: if Padeg = 1 then
          CifrToStr := 'один'
        else
          CifrToStr := 'одна';
      2: if Padeg = 1 then
          CifrToStr := 'два'
        else
          CifrToStr := 'две';
      3: CifrToStr := 'три';
      4: CifrToStr := 'четыре';
      5: CifrToStr := 'пять';
      6: CifrToStr := 'шесть';
      7: CifrToStr := 'семь';
      8: CifrToStr := 'восемь';
      9: CifrToStr := 'девять';
      0: CifrToStr := '';
    end
  else if Pr = 4 then
    case i of
      1: CifrToStr := 'одиннадцать';
      2: CifrToStr := 'двенадцать';
      3: CifrToStr := 'тринадцать';
      4: CifrToStr := 'четырнадцать';
      5: CifrToStr := 'пятнадцать';
      6: CifrToStr := 'шестнадцать';
      7: CifrToStr := 'семнадцать';
      8: CifrToStr := 'восемнадцать';
      9: CifrToStr := 'девятнадцать';
      0: CifrToStr := 'десять';

    end;
end;

function Rasryad(K: Integer; V: string): string;
{Функция возвращает наименование разряда в зависимости от последних 2 цифр его}
var j: Integer;
begin

  j := StrToInt(Copy(v, Length(v), 1));
  if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then
    case K of
      0: Rasryad := '';
      1: Rasryad := 'тысяч';
      2: Rasryad := 'миллионов';
      3: Rasryad := 'миллиардов';
      4: Rasryad := 'триллионов';
    end
  else
    case K of
      0: Rasryad := '';
      1: case j of
          1: Rasryad := 'тысяча';
          2..4: Rasryad := 'тысячи';
        else
          Rasryad := 'тысяч';
        end;
      2: case j of
          1: Rasryad := 'миллион';
          2..4: Rasryad := 'миллионa';
        else
          Rasryad := 'миллионов';
        end;
      3: case j of
          1: Rasryad := 'миллиард';
          2..4: Rasryad := 'миллиарда';
        else
          Rasryad := 'миллиардов';
        end;
      4: case j of
          1: Rasryad := 'триллион';
          2..4: Rasryad := 'триллиона';
        else
          Rasryad := 'триллионов';
        end;
    end;
end;

function GroupToStr(Group: string; Padeg: Integer): string;
{Функция возвращает прописью 3 цифры}
var i: Integer;

  S: string;
begin

  S := '';
  if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then
    begin
      if Length(Group) = 3 then
        S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg);
      S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg);
    end
  else
    for i := 1 to Length(Group) do
      S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg);
  GroupToStr := S;
end;

{Функция возвращает сумму прописью}
function RubToStr(Rubs: Currency; Rub, Kop: string): string;
var i, j: Integer;

  R, K, S: string;
begin

  S := CurrToStr(Rubs);
  S := Trim(S);
  if Pos(',', S) = 0 then
    begin
      R := S;
      K := '00';
    end
  else
    begin
      R := Copy(S, 0, (Pos(',', S) - 1));
      K := Copy(S, (Pos(',', S) + 1), Length(S));
    end;

  S := '';
  i := 0;
  j := 1;
  while Length(R) > 3 do
    begin
      if i = 1 then
        j := 2
      else
        j := 1;
      S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S;
      R := Copy(R, 1, Length(R) - 3);
      i := i + 1;
    end;
  if i = 1 then
    j := 2
  else
    j := 1;
  S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop);
  S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1);
  RubToStr := S;
end;


Вот еще одно решение, присланное Олегом Клюкач.


unit Numinwrd;

interface
function sMoneyInWords(Nin: currency): stringexport;
function szMoneyInWords(Nin: currency): PChar; export;
{ Денежная сумма Nin в рублях и копейках прописью

1997, в.2.1, by О.В.Болдырев}


implementation
uses SysUtils, Dialogs, Math;

type

  tri = string[4];
  mood = 1..2;
  gender = (m, f);
  uns = array[0..9] of string[7];
  tns = array[0..9] of string[13];
  decs = array[0..9] of string[12];
  huns = array[0..9] of string[10];
  nums = array[0..4] of string[8];
  money = array[1..2] of string[5];
  endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}

const

  units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ',
    'семнадцать ', 'восемнадцать ', 'девятнадцать ');
  decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ',
    'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ',
    'девяносто ');
  hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ',
    'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ',
    'девятьсот ');
  numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион');
  RusMon: money = ('рубл', 'копе');
  ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')),
    (('а', 'и', ''), ('йка', 'йки', 'ек')));
threadvar

  str: string;

function EndingIndex(Arg: integer): integer;
begin

  if ((Arg div 10) mod 10) <> 1 then
    case (Arg mod 10) of
      1: Result := 1;
      2..4: Result := 2;
    else
      Result := 3;
    end
  else
    Result := 3;
end;

function sMoneyInWords(Nin: currency): string{ Число Nin прописью, как функция }
var
//  str: string;

  g: gender; //род
  Nr: comp; {целая часть числа}
  Fr: integer; {дробная часть числа}
  i, iTri, Order: longint; {триада}

  procedure Triad;
  var
    iTri2: integer;
    un, de, ce: byte; //единицы, десятки, сотни

    function GetDigit: byte;
    begin
      Result := iTri2 mod 10;
      iTri2 := iTri2 div 10;
    end;

  begin
    iTri := trunc(Nr / IntPower(1000, i));
    Nr := Nr - int(iTri * IntPower(1000, i));
    iTri2 := iTri;
    if iTri > 0 then
      begin
        un := GetDigit;
        de := GetDigit;
        ce := GetDigit;
        if i = 1 then
          g := f
        else
          g := m; {женского рода только тысяча}

        str := TrimRight(str) + ' ' + Hundreds[ce];
        if de = 1 then
          str := TrimRight(str) + ' ' + Teens[un]
        else
          begin
            str := TrimRight(str) + ' ' + Decades[de];
            case g of
              m: str := TrimRight(str) + ' ' + Units[un];
              f: str := TrimRight(str) + ' ' + UnitsF[un];
            end;
          end;

        if length(numericals[i]) > 1 then
          begin
            str := TrimRight(str) + ' ' + numericals[i];
            str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)];
          end;
      end//triad is 0 ?

    if i = 0 then Exit;
    Dec(i);
    Triad;
  end;

begin

  str := '';
  Nr := int(Nin);
  Fr := round(Nin * 100 + 0.00000001) mod 100;
  if Nr > 0 then
    Order := trunc(Log10(Nr) / 3)
  else
    begin
      str := 'ноль';
      Order := 0
    end;
  if Order > High(numericals) then
    raise Exception.Create('Слишком большое число для суммы прописью');
  i := Order;
  Triad;
  str :=
    Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)],
    Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]);
  str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1];
  str[Length(str) + 1] := #0;
  Result := str;
end;

function szMoneyInWords(Nin: currency): PChar;
begin

  sMoneyInWords(Nin);
  Result := @(str[1]);
end;

end.


Взято из

Советов по Delphi от


Сборник Kuliba





Начало  Назад  Вперед



Книжный магазин