Перевод целого неотрицательного числа из строкового представления в прописное

Delphi , Синтаксис , Преобразования

Автор: Александр
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
дык выше было, не попавшее туда будет в примере
примечание: код легко расширяется как на знак входных данных так и на диапазон

Зависимости: ничего сверхестественного
Автор:       Александр
Copyright:   default
Дата:        14 февраля 2004 г.
***************************************************** }

const
  Mas1: array['0'..'9', 1..3] of string =
  (('', '', ''),
    ('сто ', '', 'один '),
    ('двести ', 'двадцать ', 'два '),
    ('триста ', 'тридцать ', 'три '),
    ('четыреста ', 'сорок ', 'четыре '),
    ('пятьсот ', 'пятьдесят ', 'пять '),
    ('шестьсот ', 'шестьдесят ', 'шесть '),
    ('семьсот ', 'семьдесят ', 'семь '),
    ('восемьсот ', 'восемьдесят ', 'восемь '),
    ('девятьсот ', 'девяносто ', 'девять '));
  Mas2: array['0'..'9'] of string =
  ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ',
    'восемнадцать ', 'девятнадцать ');
  Mas3: array['1'..'2'] of string = ('одна ', 'две ');
  Mas4: array['0'..'9', 1..4] of string =
  (('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяча ', 'миллион ', 'миллиард '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '));

function GetRepresentationInWords(S: string): string;
var
  i: Byte;
  Str: PChar;
begin

  Result := '';
  if S = '' then
    Exit;
  for i := 1 to Length(S) do
    if S[i] <> '0' then
      Break;
  if i = Length(S) + 1 then
  begin
    Result := 'Ноль';
    Exit
  end;
  Str := @S[1];
  while Length(S) mod 3 <> 0 do
    Insert('0', S, 1);
  for i := Length(S) div 3 downto 1 do
  begin
    if (Str[0] = '0') and (Str[1] = '0') and (Str[2] = '0') then
    begin
      Inc(Str, 3);
      Continue;
    end;
    Result := Result + Mas1[Str[0], 1];
    if Str[1] = '1' then
      Result := Result + Mas2[Str[2]] + Mas4['0', i]
    else
    begin
      Result := Result + Mas1[Str[1], 2];
      if (i = 2) and (Str[2] in ['1'..'2']) then
        Result := Result + Mas3[Str[2]]
      else
        Result := Result + Mas1[Str[2], 3];
      Result := Result + Mas4[Str[2], i];
    end;
    Inc(Str, 3)
  end;
  SetLength(Result, Length(Result) - 1)

end;

Пример использования:

Memo1.Lines.Text := GetRepresentationInWords(IntToStr(High(Cardinal)));

Перевод контента на русский язык:

Программа Delphi конвертирует целое число в его словесное представление, используя четыре массива Mas1, Mas2, Mas3 и Mas4, которые содержат слова для чисел от 0 до 999 и соответствующие тысячные, миллионные и млрд-ные суффиксы.

Описание работы кода:

1. Функция GetRepresentationInWords принимает строку как аргумент, которая представляет целое число для конвертации.
2. Она инициализирует переменную Result в виде пустой строки, которая будет хранить словесное представление числа.
3. Если входная строка пуста, функция выходит из цикла и возвращает пустую строку.
4. Затем она проходит по символам входной строки слева направо. Если она находит ненулевой символ, она выходит из цикла.
5. Если все символы нулевые, она устанавливает Result в 'Ноль' (что означает "ноль" на русском языке) и выходит из функции.
6. Код затем добавляет нули к входной строке, пока ее длина не будет кратна 3.
7. Затем она проходит по символам входной строки справа налево, обрабатывая группы из трех символов одновременно.
8. Для каждой группы из трех символов она добавляет соответствующее словесное представление из Mas1 или Mas2 (в зависимости от того, является ли первый символ нулевым) и добавляет подходящий тысячный/миллионный/млрд-ный суффикс из Mas4.
9. Наконец, она удаляет завершающий пробел из Result.

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

Альтернативное решение с использованием рекурсивных функций и более элегантной подхода:

function GetRepresentationInWords(S: string): string;
var
  i, j: Integer;
  Str: PChar;
begin
  Result := '';
  if S = '' then
    Exit;

  for i := Length(S) downto 1 do
  begin
    if S[i] <> '0' then
      Break;
  end;

  if i = Length(S) + 1 then
  begin
    Result := 'Ноль';
    Exit;
  end;

  Str := @S[1];

  while Length(S) mod 3 <> 0 do
    Insert('0', S, 1);

  for j := Length(S) div 3 downto 1 do
  begin
    if (Str[0] = '0') and (Str[1] = '0') and (Str[2] = '0') then
    begin
      Inc(Str, 3);
      Continue;
    end;

    Result := GetThousandsRepresentation(InStr(S, Str)) + Mas4['0', j];
    Dec(Length(S), 3);

    if Length(S) > 0 then
      Result := GetTensRepresentation(InStr(S, Str)) + Result
    else
      Exit;
  end;
end;

function GetThousandsRepresentation(S: string): string;
var
  i: Integer;
begin
  if S = '100' then
    Result := Mas3[InStr(S, '1')]
  else if S = '200' then
    Result := Mas2[InStr(S, '2')]
  else if S = '300' then
    Result := Mas2[InStr(S, '3')]
  else
    Result := Mas1[InStr(S[0]), InStr(S[1])];
end;

function GetTensRepresentation(S: string): string;
var
  i: Integer;
begin
  if S = '10' then
    Result := Mas2['1']
  else if S = '11' then
    Result := Mas2['1' + InStr(S, '1')]
  else if S = '12' then
    Result := Mas3[InStr(S, '1')] + Mas2['2']
  else
    Result := Mas2[InStr(S)];
end;

В этом коде используются два вспомогательных функции GetThousandsRepresentation и GetTensRepresentation, чтобы рекурсивно разбить число на его словесное представление. Он также устраняет необходимость вручной конкатенации строк и делает код более читаемым и поддерживаемым.

В статье описывается алгоритм перевода целого неотрицательного числа из строкового представления в прописное.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Преобразования ::