1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48:
| function DecToRoman (iDecimal: longint): string; const aRomans: array [ 1..13 ] of string = ( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' ); aArabics: array [ 1..13 ] of integer = ( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000 ); var i : integer; begin for i := 13 downto 1 do while (iDecimal >= aArabics[i]) do begin iDecimal := iDecimal - aArabics[i]; Result := Result + aRomans[i]; end; end;
function RomanToDec (iRoman: string): integer; const aRomans: array [ 1..13 ] of string = ( 'I', 'V', 'IV', 'X', 'IX', 'L', 'XL', 'C', 'XC', 'D', 'CD', 'M', 'CM' ); aArabics: array [ 1..13 ] of integer = ( 1, 5, 4, 10, 9, 50, 40, 100, 90, 500, 400, 1000, 900 ); var i : integer;
procedure ConvertDigit (var AText: string; var IntRes: integer; const Rom: string; const Arab: integer); var p : integer; begin for p := 1 to Length (AText) do AText[p] := UpCase(AText[p]);
Repeat p := Pos (Rom, AText); if P > 0 then begin inc (IntRes, Arab); Delete (AText, p, Length (Rom)); end; until P=0; end;
begin Result := 0; for i := 13 downto 1 do ConvertDigit (iRoman, Result, aRomans[i], aArabics[i]); end; |