VPF::Римские числа - Форум программистов

Calypso

Дата 16.8.2004, 14:28 (ссылка)

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

Загрузка ...

Новичок

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

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

Темо говорит сама за себя:
Необходима функция для перевода римского числа в арабское, можно ещё и наоборот. Изобретать велосипед лень.. Дайте пожалуйста Текст функции\модуля или ссылочку.
Заранее спасибо.

Alex

Дата 16.8.2004, 14:57 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

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

Код

function RomanToDec(const Value: string): integer; 
var 
  i, lastValue, curValue: integer; 
begin 
  Result := 0; 
  lastValue := 0; 
  for i := Length(Value) downto 1 do 
  begin 
    case UpCase(Value[i]) of 
      'C': 
        curValue := 100; 
      'D': 
        curValue := 500; 
      'I': 
        curValue := 1; 
      'L': 
        curValue := 50; 
      'M': 
        curValue := 1000; 
      'V': 
        curValue := 5; 
      'X': 
        curValue := 10; 
    else 
      raise Exception.CreateFmt('Invalid character: %s', [Value[i]]); 
    end; 
    if curValue < lastValue then 
      Dec(Result, curValue) 
    else 
      Inc(Result, curValue); 
    lastValue := curValue; 
  end; 
end; 

function IntToRoman(num: Cardinal): String;  {returns num in capital roman digits} 
const 
  Nvals = 13; 
  vals: array [1..Nvals] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000); 
  roms: array [1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M'); 
var 
  b: 1..Nvals; 
begin 
  result := ''; 
  b := Nvals; 
  while num > 0 do 
  begin 
    while vals[b] > num do 
      dec(b); 
    dec (num, vals[b]); 
    result := result + roms[b] 
  end; 
end;

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

Написать можно все - главное четко представлять, что ты хочешь получить в конце.

Calypso

Дата 17.8.2004, 05:55 (ссылка)

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

Загрузка ...

Новичок

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

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

Спасибо, щас подключу и испытаю...

Burich-Caeser

Дата 17.8.2004, 07:21 (ссылка)

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

Загрузка ...

Шустрый

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

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

Calypso
http://delphiworld.narod.ru/download.html - велосипед больше не понадобится изобретать никогда.

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

Ты брошен вниз силой судьбы,Ты унижен и раздавлен,Время забыть то, кем ты был,Но помнить, кем ты стал...

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