udfArabicToRoman<br>udfRomanToArabic

;==========================================================================================================================================
; udfArabicToRoman (intArabicNumber) ; Returns a roman number string for a given arabic number 0..99999.
; udfRomanToArabic (strRomanNumber)  ; Returns an arabic number 0..99999 for a given roman number string.
;==========================================================================================================================================

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfArabicToRoman (intArabicNumber)
intArabicNumber = Min (99999, Max (0, intArabicNumber)) ; Limit range for sure.
If intArabicNumber == 0 Then Return ""
strList = ",I,II,III,IV,V,VI,VII,VIII,IX"
strList = strList : ",,X,XX,XXX,XL,L,LX,LXX,LXXX,XC"
strList = strList : ",,C,CC,CCC,CD,D,DC,DCC,DCCC,CM"
strList = strList : ",,M,MM,MMM,MF,F,FM,FMM,FMMM,MT"
strList = strList : ",,T,TT,TTT,TY,Y,YT,YTT,YTTT,TH"
arrRomanDigits = Arrayize (strList, ",") ; Special symbols appended.
Drop (strList)
strRomanNumber = ""
intI = 0
While intArabicNumber > 0
   intArabicValue = intArabicNumber mod 10
   intArabicNumber = intArabicNumber / 10
   strRomanNumber = arrRomanDigits [intArabicValue + 10 * intI] : strRomanNumber
   intI = intI + 1
EndWhile
Return strRomanNumber
;..........................................................................................................................................
; This UDF "udfArabicToRoman" returns a roman number string for a given arabic number in the range 0..99999.
; Roman numbers are: M=1000, CM=900, D=500, CD=400, C=100, XC=90, L=50, XL=40, X=10, IX=9, V=5, IV=4, I=1.
; There also exist historical roman symbols for the values 5.000, 10.000, 100.000, 1.000.000.
; But sadly there exist no applicable symbols in standard computer character set.
; As a very special alternative this function uses F=5000, T=10000, Y=50000 H=100000.
; This function works for arabic numbers in the range 0..99999.
;
; Detlev Dalitz.20010325.20090708.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfRomanToArabic (strRomanNumber)
If strRomanNumber == "" Then Return 0  ; String is empty.
strRomanNumber = StrUpper (StrTrim (StrFixLeft (strRomanNumber, "", 20))) ; Limit string length.
strCleanStr = StrClean (strRomanNumber, " HYTFMDCLXVI", "", @TRUE, 2)
If StrCmp (strCleanStr, strRomanNumber) != 0 Then Return -1 ; String is invalid.
arrArabicDigits = Arrayize ("9,4,8,7,6,5,3,2,1", ",")
strList = "TH,MT,CM,XC,IX"
strList = strList : ",TY,MF,CD,XL,IV"
strList = strList : ",YTTT,FMMM,DCCC,LXXX,VIII"
strList = strList : ",YTT,FMM,DCC,LXX,VII"
strList = strList : ",YT,FM,DC,LX,VI"
strList = strList : ",Y,F,D,L,V"
strList = strList : ",TTT,MMM,CCC,XXX,III"
strList = strList : ",TT,MM,CC,XX,II"
strList = strList : ",T,M,C,X,I"
arrRomanDigits = Arrayize (strList, ",")
Drop (strList)
intArabicNumber = 0
intI = 0
While @TRUE
   strRomanDigit = arrRomanDigits [intI]
   If !!StrIndex (strRomanNumber, strRomanDigit, 1, @FWDSCAN)
      strRomanNumber = StrReplace (strRomanNumber, strRomanDigit, "")
      intArabicValue = arrArabicDigits [intI / 5] * (10 ** (4 - (intI mod 5)))
      intArabicNumber = intArabicNumber + intArabicValue
      If strRomanNumber == "" Then Break
   EndIf
   intI = intI + 1
EndWhile
Return intArabicNumber
;..........................................................................................................................................
; This UDF "udfRomanToArabic" returns an integer number in the range 0..99999 (resp. -1 if argstr is invalid).
; Roman numbers are: M=1000, CM=900, D=500, CD=400, C=100, XC=90, L=50, XL=40, X=10, IX=9, V=5, IV=4, I=1.
; There also exist historical roman symbols for 5.000, 10.000, 100.000, 1.000.000.
; But sadly there exist no applicable symbols in standard computer character set.
; As a very special alternative this function uses F=5000, T=10000, Y=50000 H=100000.
; This function works for arabic numbers in the range 0..99999.
;
; Detlev Dalitz.20010325.20090708.20120109.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


; Test.

While @TRUE
   ; To break the loop press "Cancel" button while in dialog Askline or in dialog Pause.
   intAskNum = AskLine ("Roman / Arabic Number Conversion", "Enter a number (should be in range 0..99999)", "0")
   strRomanNumber = udfArabicToRoman (intAskNum)
   intArabicNumber = udfRomanToArabic (strRomanNumber)
   strOut = intAskNum : " = " : strRomanNumber : " = " : intArabicNumber : @LF : @LF
   strOut = strOut : "Known symbols" : @TAB : @TAB : "Special symbols" : @LF
   strOut = strOut : "M" : @TAB : "= 1000" : @TAB : @TAB : "H" : @TAB : "= 100000" : @LF
   strOut = strOut : "D" : @TAB : "= 500" : @TAB : @TAB : "Y" : @TAB : "= 50000" : @LF
   strOut = strOut : "C" : @TAB : "= 100" : @TAB : @TAB : "T" : @TAB : "= 10000" : @LF
   strOut = strOut : "L" : @TAB : "= 50" : @TAB : @TAB : "F" : @TAB : "= 5000" : @LF
   strOut = strOut : "X" : @TAB : "= 10" : @LF
   strOut = strOut : "I" : @TAB : "= 1" : @TAB : @TAB : "Range = 0..99999" : @LF
   Pause ("Number Conversion:  Arabic ==> Roman ==> Arabic", strOut)
EndWhile

:CANCEL
Exit
; This WinBatch code example was written by Detlev Dalitz.20090708.1900.CEST


;------------------------------------------------------------------------------------------------------------------------------------------
; Old version of udfRomanToArabic
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfRomanToArabic (strRomanNumber)
If strRomanNumber == "" Then Return 0  ; String is empty.
strRomanNumber = StrUpper (StrTrim (StrFixLeft (strRomanNumber, "", 20))) ; Limit string length.
strCleanStr = StrClean (strRomanNumber, " HYTFMDCLXVI", "", @TRUE, 2)
If StrCmp (strCleanStr, strRomanNumber) != 0 Then Return -1 ; String is invalid.
arrArabicDigits = Arrayize ("9,4,8,7,6,5,3,2,1", ",")
strList = "TH,MT,CM,XC,IX"
strList = strList : ",TY,MF,CD,XL,IV"
strList = strList : ",YTTT,FMMM,DCCC,LXXX,VIII"
strList = strList : ",YTT,FMM,DCC,LXX,VII"
strList = strList : ",YT,FM,DC,LX,VI"
strList = strList : ",Y,F,D,L,V"
strList = strList : ",TTT,MMM,CCC,XXX,III"
strList = strList : ",TT,MM,CC,XX,II"
strList = strList : ",T,M,C,X,I"
arrRomanDigits = Arrayize (strList, ",")
Drop (strList)
intArabicNumber = 0
intI = 0
While @TRUE
   intLenPre = StrLen (strRomanNumber)
   strRomanDigit = arrRomanDigits [intI]
   strRomanNumber = StrReplace (strRomanNumber, strRomanDigit, "")
   intLenPost = StrLen (strRomanNumber)
   If intLenPre != intLenPost
      intArabicValue = arrArabicDigits [intI / 5] * (10 ** (4 - (intI mod 5)))
      intArabicNumber = intArabicNumber + intArabicValue
   EndIf
   If !intLenPost Then Break
   intI = intI + 1
EndWhile
Return intArabicNumber
;..........................................................................................................................................
; This UDF "udfRomanToArabic" returns an integer number in the range 0..99999 (resp. -1 if argstr is invalid).
; Roman numbers are: M=1000, CM=900, D=500, CD=400, C=100, XC=90, L=50, XL=40, X=10, IX=9, V=5, IV=4, I=1.
; There also exist historical roman symbols for 5.000, 10.000, 100.000, 1.000.000.
; But sadly there exist no applicable symbols in standard computer character set.
; As a very special alternative this function uses F=5000, T=10000, Y=50000 H=100000.
; This function works for arabic numbers in the range 0..99999.
;
; Detlev Dalitz.20010325.20090708.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------