Developing.ru

Код: Выделить всё

{Источник: "Наука и жизнь" N12 1986  cтр. 95 }
{Алгоритм: В. Птицын г.Москва }
type str2 = string[2];
   
const
   Rims : array[1..14] of str2 = ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I',' ');
   Arab : array[1..14] 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 : integer;
  begin
    I:=1; N := 0;
    while S<>'' do begin
      while Rims[I] = Copy(S, 1, Length(Rims[I]) ) do begin
        S := Copy( S, 1+Length(Rims[I]), 255);
        N := N + Arab[I]
      end;
      I:=I+1
    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) ));
end.