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

•  TDictionary Custom Sort  531

•  Fast Watermark Sources  898

•  3D Designer  1 825

•  Sik Screen Capture  1 472

•  Patch Maker  1 481

•  Айболит (remote control)  1 404

•  ListBox Drag & Drop  1 174

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

•  Графические эффекты  1 352

•  Рисование по маске  1 292

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

•  Canvas Drawing  968

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

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

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

•  Paint on Shape  493

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

•  Головоломка Paletto  667

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

•  Пазл Numbrix  616

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

•  Игра HIP  557

•  Игра Go (Го)  527

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

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

•  Генератор лабиринта  564

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

•  HEX View  600

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

•  Задача коммивояжера  559

 
скрыть


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

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



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




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.





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

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




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

Группа ВКонтакте   Facebook   Ссылка на Twitter   Ссылка на Telegram