VPF::программа для перевода числового значения в текст

жека2905

Дата 25.2.2012, 23:32 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 19.10.2011

Репутация: нет
Всего: нет

Всем доброго времени суток! У меня такая просьба я нашел в интернете исходный код программы для перевода целого неотрицательного числа из строкового представления в прописное написанный на Dilphi , но не могу в нем разобраться может кто нибудь помочь я хочу реализовать этот код в Visual Basic.
Вот код

Код


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;

не могу понять что вот здесь происходит

Код


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;

Данкинг

Дата 25.2.2012, 23:58 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 11
Всего: 130

Вот рабочая функция из ДРКБ:

Код


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


function SumToStrin(Value: string): string;
var
  s, t: string;
  p, pp, i, k: integer;
begin
  s := value;
  if s = '0' then
    t := 'Ноль '
  else
  begin
    p := length(s);
    pp := p;
    if p > 1 then
      if (s[p - 1] = '1') and (s[p] >= '0') then
      begin
        t := b[strtoint(s[p])];
        pp := pp - 2;
      end;
    i := pp;
    while i > 0 do
    begin
      if (i = p - 3) and (p > 4) then
        if s[p - 4] = '1' then
        begin
          t := b[strtoint(s[p - 3])] + 'тысяч ' + t;
          i := i - 2;
        end;
      if (i = p - 6) and (p > 7) then
        if s[p - 7] = '1' then
        begin
          t := b[strtoint(s[p - 6])] + 'миллионов ' + t;
          i := i - 2;
        end;
      if i > 0 then
      begin
        k := strtoint(s[i]);
        t := a[p - i, k] + t;
        i := i - 1;
      end;
    end;
  end;
  result := t;
end;

--------------------

There's nothing left but silent epitaphs.

жека2905

Дата 26.2.2012, 14:39 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 19.10.2011

Репутация: нет
Всего: нет

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

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »