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



Вопросы
  Подсчет времени какого-либо события
   Категория: Математика
  Упаковать TinyDB
   Категория: Базы данных
  Программно скрыть MainMenu
   Категория: Компоненты
  Сохраняем Bitmap в поле dbase
   Категория: Базы данных
  Узнать установлена ли BDE
   Категория: Базы данных
  Удалить свой же exe-шник
   Категория: Приложение
  Объект экрана — Screen
   Категория: Компоненты
  BDE. Расположение БД по псевдониму
   Категория: Базы данных

Delphi - База Знаний: Преобразовать Римские символы в Арабские и наоборот

  << Вернуться к Содержанию  

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;

//или

const
  R: array[1..13] of string[2] =
  ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
  A: array[1..13] of Integer =
  (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

  ..............

function ArabicToRoman(N: Integer): string; //Арабские в римские
var
  i: Integer;
begin
  Result := '';
  i := 13;
  while N > 0 do
  begin
    while A[i] > N do
      Dec(i);
    Result := Result + R[i];
    Dec(N, A[i]);
  end;
end;

function RomanToArabic(S: string): Integer; //Римские в арабские
var
  i, p: Integer;
begin
  Result := 0;
  i := 13;
  p := 1;
  while p <= Length(S) do
  begin
    while Copy(S, p, Length(R[i])) <> R[i] do
    begin
      Dec(i);
      if i = 0 then
        Exit;
    end;
    Result := Result + A[i];
    p := p + Length(R[i]);
  end;
end;
  << Вернуться к Содержанию