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

•  TDictionary Custom Sort  3 225

•  Fast Watermark Sources  2 991

•  3D Designer  4 750

•  Sik Screen Capture  3 259

•  Patch Maker  3 467

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

•  ListBox Drag & Drop  2 904

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

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

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

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

•  Canvas Drawing  2 672

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

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

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

•  Paint on Shape  1 525

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

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

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

•  Пазл Numbrix  1 649

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

•  Игра HIP  1 262

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

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

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

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

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

•  HEX View  1 466

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

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

 
скрыть


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

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



Delphi Sources

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



Автор: Алексей

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование целого числа 0-999999999 в строку (прописью)

Я думаю, всё итак понятно, что не понятно пишите письма

Зависимости: SysUtils
Автор:       Алексей, ARojkov@okil.ru, СПб
Copyright:   b0b
Дата:        12 марта 2004 г.
***************************************************** }

unit UIntToStroka;

interface

uses SysUtils;

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

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

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

const
  N2: array[1..9] of string = ('десять',
    'двадцать',
    'тридцать',
    'сорок',
    'пятьдесят',
    'шестьдесят',
    'семьдесят',
    'восемьдесят',
    'девяносто'
    );

const
  N3: array[1..9] of string = ('сто',
    'двести',
    'триста',
    'четыреста',
    'пятьсот',
    'шестьсот',
    'семьсот',
    'восемьсот',
    'девятьсот'
    );

const
  NThousand: array[1..3] of string = ('тысяча ',
    'тысячи ',
    'тысяч ');

const
  NMillion: array[1..3] of string = ('миллион ',
    'миллиона ',
    'миллионов ');

function IntToStroka(n: Integer): AnsiString;

implementation

function IntToStroka(n: Integer): AnsiString;
var
  i, j, dec, j0: Integer;
  s: string;
  degt, degm: boolean;
  buf: string;
begin
  degt := false;
  degm := false;
  s := IntToStr(n);
  Result := '';
  for i := length(s) downto 1 do
  begin
    dec := (length(s) - i + 1); // получим разряд
    j := StrToInt(s[i]); // получим цифру

    if j = 0 then
      j0 := 0;
    if (not (j in [1..9])) and (dec <> 1) then
      Continue;

    if Dec in [1, 4, 7, 10] then
    try
      if StrToInt(s[i - 1]) = 1 then
      begin
        j0 := j;
        Continue;
      end; // подготовка к 10..19 тысяч/миллионов
    except
    end;

    if Dec in [2, 5, 8, 11] then
      if j = 1 then
      begin
        case dec of
          2: Result := N11[j0] + ' '; // если 10..19 тысяч/миллионов
          5:
            begin
              Result := N11[j0] + ' ' + NThousand[3] + Result;
              degt := true;
            end;
          8:
            begin
              Result := N11[j0] + ' ' + NMillion[3] + Result;
              degm := true;
            end;
        end;
        Continue;
      end;

    if DEC in [4..6] then
    begin
      if (j <> 0) and (not degt) then
      begin
        if dec = 4 then
          case j of
            1: buf := NThousand[1];
            2..4: buf := NThousand[2];
              // прибавим слово тысяча если ещё не добавляли
            5..9: buf := NThousand[3];
          end
        else
          buf := NThousand[3];
        degt := true;
      end;
    end;

    if DEC in [7..9] then
    begin
      if (j <> 0) and (not degm) then
      begin
        if dec = 7 then
          case j of
            1: buf := NMillion[1];
            2..4: buf := NMillion[2];
              // прибавим слово миллион если ещё не добавляли
            5..9: buf := NMillion[3];
          end
        else
          buf := NMillion[3];
        degm := true;
      end;
    end;

    Result := buf + Result;

    while dec > 3 do
      dec := dec - 3;

    case Dec of
      1: if j <> 0 then
          if degt and (not degm) then
            Result := N1000[j] + ' ' + Result
          else
            Result := N1[j] + ' ' + Result; // 3 три
      2: Result := N2[j] + ' ' + Result; // 23 двадцать три
      3: Result := N3[j] + ' ' + Result; // 123 сто двадцать три
    end;
    Buf := '';
    j0 := j;
  end;
end;

end.




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

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




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

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