Функция перевода чисел из римского в арабское
Function myodd(s1:integer):integer;
begin
if s1 mod 2 =0 then result:=0
else result:=1;
end;
function RomanToArabic( const romanNumber : string) : integer ;
const
romanChars = 'IVXLCDMvxlcdm?!#' ;
decades : array [0..8] of integer = (
0, 1, 10, 100, 1000, 10000, 100000,
1000000, 10000000) ;
OneFive : array [0..1] of byte = (1, 5) ;
var
newValue, oldValue : integer ;
cIdx, P : byte ;
begin
result := 0;
oldValue := 0 ;
for cIdx := Length(romanNumber) downto 1 do
begin
P := Succ(Pos(romanNumber[cIdx], romanChars)) ;
newValue := OneFive[myodd(p)] * decades[P div 2] ;
if newValue = 0 then
begin
result := -1;
Exit;
end ;
if newValue < oldValue then newValue := - newValue ;
Inc(result, newValue) ;
oldValue := newValue
end ;
end;
Функция перевода чисел из арабских в римские
function Arab2Roman(arab:integer):string;
var
i:integer;
d:integer;
arab_str:string;
arab_len:integer;
begin
Result := '';
arab_str := IntToStr(arab);
arab_len := Length(arab_str);
for i := 0 to arab_len-1 do begin
d := StrToInt(arab_str[arab_len-i]);
if (d+1) mod 5 = 0 then
Result := Copy('IXCM', 1+i, 1) + Copy('VXLCDM', i*2 + (d+1) div 5, 1) + Result
else
Result := Copy('VLD', 1+i, d div 5) + Copy('IIIXXXCCCMMM', 1+i*3, d mod 5) + Result;
end;
end;
|
