Database Search

TechHome

• Base64 Encoding
• BCD Conversion UDF
• Decimal to Hex conversion
• Floating point to HUGE numbers
• Format Number to Display
• Hex to Decimal Conversion
• Long to Dword UDF
• Number to Adjective acronym
• Numbers to text conversion
• Roman Numeral Conversions
• Sort a Numeric List
• Unicode to ASCII Converter
• xBaseConvert Base 10 to-from any other base

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Roman Numeral Conversions

;***************************************************************************
;; Num2Roman(integer)             -- Arabic ==> Roman
;; Roman2Num(valid roman numeral) -- Roman ==> Arabic
;***************************************************************************
GOSUB DefineUDFs

:TOP
testnum=AskLine("Arabic ==> Roman", "Enter a number", "")
testnum=Num2Roman(testnum)
Display(2,1,testnum)
testnum=Roman2Num(testnum)
Display(2,1,testnum)
GOSUB TOP
Exit

;***************************************************************************
;***************************************************************************
:DefineUDFs

;***************************************************************************
; Arabic number to Roman Numerals
; Roman numerals = M, CM, D, CD, C, XC, L, XL, X, IX, V, IV, I
;***************************************************************************
#DefineFunction Num2Roman(number)
roman = "";
While (number > 0) 
	If (number >= 1000) ;;;;;;;;;;; M=1000
		number=number-1000
		roman = StrCat(roman, "M")
		Continue
	Endif
	If (number >= 900)  
		number=number-900
		roman = StrCat(roman, "CM")
		Continue
	Endif
	If (number >= 500)  ;;;;;;;;;;; D=500
		number=number-500
		roman = StrCat(roman, "D")
		Continue
	Endif
	If (number >= 400) 
		number=number-400
		roman = StrCat(roman, "CD")
		Continue
	Endif
	If (number >= 100) ;;;;;;;;;;; C=100
		number=number-100
		roman = StrCat(roman, "C")
		Continue
	Endif
	If (number >= 90)
		number=number-90
		roman = StrCat(roman, "XC")
		Continue
	Endif
	If (number >= 50) ;;;;;;;;;;;; L=50
		number=number-50
		roman = StrCat(roman, "L")
		Continue
	Endif
	If (number >= 40)
		number=number-40
		roman = StrCat(roman, "XL")
		Continue
	Endif
	If (number >= 10) ;;;;;;;;;; X=10
		number=number-10
		roman = StrCat(roman, "X")
		Continue
	Endif
	If (number >= 9)
		number=number-9
		roman = StrCat(roman, "IX")
		Continue
	Endif
	If (number >= 5) ;;;;;;;;;;;;; V=5
		number=number-5
		roman = StrCat(roman, "V")
		Continue
	Endif
	If (number >= 4)
		number=number-4
		roman = StrCat(roman, "IV")
		Continue
	Endif
	If (number >= 1)
		number=number-1
		roman = StrCat(roman, "I")
		Continue
	Endif
EndWhile

	Return roman
#EndFunction
;***************************************************************************


;***************************************************************************
; Roman2Num - makes no effort to distinguish real RN from junk!!
; Best to use the above UDF to get numbers to Roman format
; Roman numerals = M, CM, D, CD, C, XC, L, XL, X, IX, V, IV, I
;***************************************************************************
#DefineFunction Roman2Num(string_roman)
arabic=0;
roman=StrUpper(string_roman)
length=StrLen(roman)

While length>0
	letter=StrSub(roman, length, -1)
	If letter=="M"
		arabic=arabic+1000
		subletter="C"
		subvalue=100
		GOSUB Subtract
	Endif
	If letter=="D"
		arabic=arabic+500
		subletter="C"
		subvalue=100
		GOSUB Subtract
	Endif
	If letter=="C"
		arabic=arabic+100
		subletter="X"
		subvalue=10
		GOSUB Subtract
	Endif
	If letter=="L"
		arabic=arabic+50
		subletter="X"
		subvalue=10
		GOSUB Subtract
	Endif
	If letter=="X"
		arabic=arabic+10
		subletter="I"
		subvalue=1
		GOSUB Subtract
	Endif
	If letter=="V"
		arabic=arabic+5
		subletter="I"
		subvalue=1
		GOSUB Subtract
	Endif
	If letter=="I"
		arabic=arabic+1
		subletter=""
		subvalue=0
		GOSUB Subtract
	Endif
;	Display(2,2, length)
EndWhile

Return arabic

;;Check that the preceding number does
;;not reduce the value. 
:Subtract
	letter2=StrSub(roman, length-1, 1)
;	dismess=StrCat("Subtract",@CRLF,"Letter=",letter,@CRLF,"Let-1=",letter2,@CRLF)
;	dismess=StrCat(dismess,"Sulet=",subletter,@CRLF,"Submin=",subvalue,@CRLF,"VALUE=",arabic)
;	Message("Subtract Routine",dismess)
	If letter2==subletter
		arabic=arabic-subvalue
		roman=StrSub(roman, 1, length-1)
		length=length-1
	Endif
	subleter=""
	subvalue=0
	roman=StrSub(roman, 1, length-1)
	length=length-1
Return

#EndFunction
;***************************************************************************

Return

Article ID:   W15006

File Created: 2001:11:08:12:41:20

Last Updated: 2001:11:08:12:41:20