перевода целого числа в римскую систему счисления

[enternity]

Разработка программы перевода целого числа в римскую систему счисления и наоборот
Обеспечить перевод чисел в интервале от 1 до 999

Как это сделать? хотя бы дайте толчок и задумку, если не затруднит то можете сделать если она легкая...

[Serge_Bliznykov]

зря не пользуетесь поиском. такие задачи здесь уже решались.

вот, например (в поиск мне лень идти, проще выложить готовый код!).
вариант 1

{Источник: "Наука и жизнь" N12 1986  cтр. 95 }
{Алгоритм: В. Птицын г.Москва }
{доработка 30.05.2010 - проверка входного римского числа на ошибочность}
type str2 = string[2];

const
   MaxVariant = 14;
const
   Rims : array[1..MaxVariant] of str2 = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I',' ');
   Arab : array[1..MaxVariant] of integer = (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1, 0);

var
  N, NI, I, J : integer;
  S    : string;

  function Arab2Rim(N : integer) : string;
  var S : string;
      I : integer;
  begin
    S := ''; I:=1;
    while N > 0 do begin
      while Arab[I]<=N do begin
        S := S + Rims[I];
        N := N - Arab[I]
      end;
      I:=I+1
    end;
    Arab2Rim := S
  end;

  function Rim2Arab (S:string) : integer;
  var I, N, Offset : integer;
    s0 : string;
  begin
    I:=1; N := 0; Offset := 0; s0 := S;
    while S<>'' do begin
      while Rims[I] = Copy(S, 1, Length(Rims[I]) ) do begin
        S := Copy( S, 1+Length(Rims[I]), 255);
        Offset := Offset + Length(Rims[I]);
        N := N + Arab[I]
      end;
      I:=I+1;
      if I>MaxVariant then begin
         WriteLn('Ошибка в исходной строке '+s0+' с позиции ',Offset:1);
         Rim2Arab := -1;
         exit
      end;
    end;
    Rim2Arab := N
  end;

begin
  WriteLn('Перевод из арабских цифр в римские. 1999 B_SA');
{  Write('Введите число для преобразования:'); ReadLn(N);}

{  for NI := 26 to 46 do
    WriteLn(NI,' = ',Arab2Rim(NI),' обратно ', Rim2Arab( Arab2Rim(NI) ));
}
  WriteLn(Rim2Arab('XCIXCI'));
end.

вариант 2.

{Перевод из арабской в римскую систему и наоборот

Алгоритм весьма прост и извлекается непосредственно из исходника.
}

{ Copyright MM Andrew Usachov }

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 Roman(N: Integer): string;
var Result: string;
  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;

  Roman := Result;

end;

function Arabic(S: string): Integer;
var Result: Integer;
  i, p: Integer;
begin
  Arabic := -1;
  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;
  if Roman(Result) = S then Arabic := Result
end;

var N, Err: Integer;
  S: string;
begin
  repeat
    ReadLn(S);
    if S = '' then Break;
    Val(S, N, Err);
    if Err = 0 then
      WriteLn(Roman(N))
    else
      WriteLn(Arabic(S));
  until false;
end.

[Sasha_Smirnov]

Полчаса искал более короткий код. Вот источник: http://programmersforum.ru/showthread.php?p=365036 (это если не для "сдачи", а так, для дома для семьи).

Sub MakeRoman() 'преобразует выделенное в документе Word целое число в римское
If Not IsNumeric(Trim(Selection.Text)) Then Exit Sub
ActiveDocument.Fields.Add(Selection.Range, wdFieldEmpty, "= " & Selection.Text & "\*Roman").Unlink
End Sub

Он работает для натуральных чисел до 32767 включительно. Сейчас приложу в контейнере.