Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version

WinBatch Scripting - Conversion Functions



Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

Arabic Roman Number Conversions

;==========================================================================================================================================
; 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*



Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version