Главная страницаОбратная связьКарта сайта

Сумма прописью - Способ 8

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


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;


Обсудить статью на форуме


Если Вас заинтересовала или понравилась информация по разработке на Delph - "Сумма прописью - Способ 8", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

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


Copyright © 2008 - 2024 Дискета.info