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

Автор: Васильев Сергей Геннадьевич


function NumToStr(n: double; c: byte = 0): string;
(*

c=0 - 21.05 -> 'Двадцать один рубль 05 копеек.'
с=1 - 21.05 -> 'двадцать один'
c=2 - 21.05 -> '21-05', 21.00 -> '21='
*)
const

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

  ts, mln, mlrd, SecDes: Boolean;
  len: byte;
  summa: string;

  function NumberString(number: string): string;
  var
    d, pos: byte;

    function DigitToStr: string;
    begin
      result := '';
      if (d <> 0) and ((pos = 11) or (pos = 12)) then
        mlrd := true;
      if (d <> 0) and ((pos = 8) or (pos = 9)) then
        mln := true;
      if (d <> 0) and ((pos = 5) or (pos = 6)) then
        ts := true;
      if SecDes then
      begin
        case d of
          0: result := 'десять ';
          2: result := 'двенадцать '
        else
          result := digit[d] + 'надцать '
        end;
        case pos of
          4: result := result + 'тысяч ';
          7: result := result + 'миллионов ';
          10: result := result + 'миллиардов '
        end;
        SecDes := false;
        mln := false;
        mlrd := false;
        ts := false
      end
      else
      begin
        if (pos = 2) or (pos = 5) or (pos = 8) or (pos = 11) then
          case d of
            1: SecDes := true;
            2, 3: result := digit[d] + 'дцать ';
            4: result := 'сорок ';
            9: result := 'девяносто ';
            5..8: result := digit[d] + 'ьдесят '
          end;
        if (pos = 3) or (pos = 6) or (pos = 9) or (pos = 12) then
          case d of
            1: result := 'сто ';
            2: result := 'двести ';
            3: result := 'триста ';
            4: result := 'четыреста ';
            5..9: result := digit[d] + 'ьсот '
          end;
        if (pos = 1) or (pos = 4) or (pos = 7) or (pos = 10) then
          case d of
            1: result := 'один ';
            2, 3: result := digit[d] + ' ';
            4: result := 'четыре ';
            5..9: result := digit[d] + 'ь '
          end;
        if pos = 4 then
        begin
          case d of
            0: if ts then
                result := 'тысяч ';
            1: result := 'одна тысяча ';
            2: result := 'две тысячи ';
            3, 4: result := result + 'тысячи ';
            5..9: result := result + 'тысяч '
          end;
          ts := false
        end;
        if pos = 7 then
        begin
          case d of
            0: if mln then
                result := 'миллионов ';
            1: result := result + 'миллион ';
            2, 3, 4: result := result + 'миллиона ';
            5..9: result := result + 'миллионов '
          end;
          mln := false
        end;
        if pos = 10 then
        begin
          case d of
            0: if mlrd then
                result := 'миллиардов ';
            1: result := result + 'миллиард ';
            2, 3, 4: result := result + 'миллиарда ';
            5..9: result := result + 'миллиардов '
          end;
          mlrd := false
        end
      end
    end;

  begin
    result := '';
    ts := false;
    mln := false;
    mlrd := false;
    SecDes := false;
    len := length(number);
    if (len = 0) or (number = '0') then
      result := digit[0]
    else
      for pos := len downto 1 do
      begin
        d := StrToInt(copy(number, len - pos + 1, 1));
        result := result + DigitToStr
      end
  end;

  function MoneyString(number: string): string;
  var
    s: string[1];
    n: string;
  begin
    len := length(number);
    n := copy(number, 1, len - 3);
    result := NumberString(n);
    s := AnsiUpperCase(result[1]);
    delete(result, 1, 1);
    result := s + result;
    if len < 2 then
    begin
      if len = 0 then
        n := '0';
      len := 2;
      n := '0' + n
    end;
    if copy(n, len - 1, 1) = '1' then
      result := result + 'рублей'
    else
    begin
      case StrToInt(copy(n, len, 1)) of
        1: result := result + 'рубль';
        2, 3, 4: result := result + 'рубля'
      else
        result := result + 'рублей'
      end
    end;
    len := length(number);
    n := copy(number, len - 1, len);
    if copy(n, 1, 1) = '1' then
      n := n + ' копеек.'
    else
    begin
      case StrToInt(copy(n, 2, 1)) of
        1: n := n + ' копейка.';
        2, 3, 4: n := n + ' копейки.'
      else
        n := n + ' копеек.'
      end
    end;
    result := result + ' ' + n
  end;

  // Основная часть
begin

  case c of
    0: result := MoneyString(FormatFloat('0.00', n));
    1: result := NumberString(FormatFloat('0', n));
    2:
      begin
        summa := FormatFloat('0.00', n);
        len := length(summa);
        if copy(summa, len - 1, 2) = '00' then
        begin
          delete(summa, len - 2, 3);
          result := summa + '='
        end
        else
        begin
          delete(summa, len - 2, 1);
          insert('-', summa, len - 2);
          result := summa;
        end;
      end
  end;
end;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.