Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  125

•  TDictionary Custom Sort  3 312

•  Fast Watermark Sources  3 062

•  3D Designer  4 818

•  Sik Screen Capture  3 314

•  Patch Maker  3 528

•  Айболит (remote control)  3 628

•  ListBox Drag & Drop  2 992

•  Доска для игры Реверси  81 537

•  Графические эффекты  3 922

•  Рисование по маске  3 227

•  Перетаскивание изображений  2 608

•  Canvas Drawing  2 732

•  Рисование Луны  2 556

•  Поворот изображения  2 163

•  Рисование стержней  2 160

•  Paint on Shape  1 564

•  Генератор кроссвордов  2 223

•  Головоломка Paletto  1 764

•  Теорема Монжа об окружностях  2 209

•  Пазл Numbrix  1 682

•  Заборы и коммивояжеры  2 052

•  Игра HIP  1 278

•  Игра Go (Го)  1 224

•  Симулятор лифта  1 470

•  Программа укладки плитки  1 214

•  Генератор лабиринта  1 542

•  Проверка числового ввода  1 351

•  HEX View  1 489

•  Физический маятник  1 355

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Сумма прописью - Способ 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;





Похожие по теме исходники

Сумма прописью




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте