;==========================================================================================================================================
; udfArabicToRoman (ArabicNumber) ; Returns roman number string for given arabic number 0..99999.
; udfRomanToArabic (RomanNumber) ; Returns arabic number 0..99999 for given roman number string (-1 if argstr is invalid).
;==========================================================================================================================================
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarabictoroman",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarabictoroman
#DefineFunction udfArabicToRoman (ArabicNumber)
iANLen = StrLen(ArabicNumber)
If (iANLen > 5) Then Return ("")
If !(IsInt(ArabicNumber)) Then Return ("")
If (ArabicNumber <= 0) Then Return ("")
aDigit0 = Arrayize(",I,II,III,IV,V,VI,VII,VIII,IX",",")
aDigit1 = Arrayize(",X,XX,XXX,XL,L,LX,LXX,LXXX,XC",",")
aDigit2 = Arrayize(",C,CC,CCC,CD,D,DC,DCC,DCCC,CM",",")
aDigit3 = Arrayize(",M,MM,MMM,MF,F,FM,FMM,FMMM,MT",",") ; special symbols !
aDigit4 = Arrayize(",T,TT,TTT,TY,Y,YT,YTT,YTTT,TH",",") ; special symbols !
sRomanNumber = ""
iHigh = iAnLen-1
For i=iHigh To 0 By -1
sDigit = StrSub(ArabicNumber,iANLen-i,1)
sRomanNumber = StrCat(sRomanNumber,aDigit%i%[sDigit])
Next i
Return (sRomanNumber)
;..........................................................................................................................................
; Returns string roman number for numbers 0..99999.
; Roman numbers 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 exists 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 an very special alternative this function uses F=5000, T=10000, Y=50000 H=100000.
; Function works in range 0..99999.
;
; Detlev Dalitz.20010325
;..........................................................................................................................................
#EndFunction
:skip_udfarabictoroman
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfromantoarabic",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfromantoarabic
#DefineFunction udfRomanToArabic (sRomanNumber)
If (StrLen(sRomanNumber) > 20) Then Return (-1)
If (StrLen(sRomanNumber) == 0) Then Return (0)
sRomanNumber = StrUpper(sRomanNumber)
sCleanStr = StrClean(sRomanNumber," HYTFMDCLXVI","",@FALSE,2)
If (StrCmp(sCleanStr,sRomanNumber)<>0) Then Return (-1)
aDigit = Arrayize("9,4,8,7,6,5,3,2,1",",")
sTList = ""
sTList = StrCat(sTList,"TH,MT,CM,XC,IX,")
sTList = StrCat(sTList,"TY,MF,CD,XL,IV,")
sTList = StrCat(sTList,"YTTT,FMMM,DCCC,LXXX,VIII,")
sTList = StrCat(sTList,"YTT,FMM,DCC,LXX,VII,")
sTList = StrCat(sTList,"YT,FM,DC,LX,VI,")
sTList = StrCat(sTList,"Y,F,D,L,V,")
sTList = StrCat(sTList,"TTT,MMM,CCC,XXX,III,")
sTList = StrCat(sTList,"TT,MM,CC,XX,II,")
sTList = StrCat(sTList,"T,M,C,X,I")
aToken = Arrayize(sTList,",")
Drop(sTList)
iArabicNumber = 0
i = 0
While 1
iLenPre = StrLen(sRomanNumber)
sToken = aToken[i]
sRomanNumber = StrReplace(sRomanNumber,sToken,"")
iLenPost = StrLen(sRomanNumber)
If (iLenPre<>iLenPost)
iDigitValue = aDigit[i/5] * (10**(4-(i mod 5)))
iArabicNumber = iArabicNumber + iDigitValue
EndIf
If !iLenPost Then Break
i = i+1
EndWhile
Return (iArabicNumber)
;..........................................................................................................................................
; Returns number 0..99999 (-1 if argstr is invalid).
; Roman numbers 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 exists 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 an very special alternative this function uses F=5000, T=10000, Y=50000 H=100000.
; Function works in range 0..99999.
;
; Detlev Dalitz.20010325
;..........................................................................................................................................
#EndFunction
:skip_udfromantoarabic
;------------------------------------------------------------------------------------------------------------------------------------------
;--- test ---
While 1
; Break the loop by pushing "cancel" in dialog Askline.
AskNum = AskLine("Roman / Arabic Number Conversion", "Enter a number (should be in range 0..99999)", "")
sOut = ""
RomanNumber = udfArabicToRoman(AskNum)
ArabicNumber = udfRomanToArabic(RomanNumber)
sOut = StrCat(sOut, AskNum," = ", RomanNumber, " = ", ArabicNumber, @LF, @LF)
sOut = StrCat(sOut, "known symbols", @TAB, @TAB,"special symbols" , @LF)
sOut = StrCat(sOut, "M", @TAB,"= 1000" , @TAB, @TAB,"H", @TAB,"= 100000", @LF)
sOut = StrCat(sOut, "D", @TAB,"= 500" , @TAB, @TAB,"Y", @TAB,"= 50000" , @LF)
sOut = StrCat(sOut, "C", @TAB,"= 100" , @TAB, @TAB,"T", @TAB,"= 10000" , @LF)
sOut = StrCat(sOut, "L", @TAB,"= 50" , @TAB, @TAB,"F", @TAB,"= 5000" , @LF)
sOut = StrCat(sOut, "X", @TAB,"= 10" , @LF)
sOut = StrCat(sOut, "I", @TAB,"= 1" , @TAB, @TAB,"range = 0..99999", @LF)
Pause("Number Conversion: Arabic ==> Roman ==> Arabic", sOut)
EndWhile
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
