Code archives/Miscellaneous/Function Roman$

This code has been declared by its author to be Public Domain code.

Download source code

Function Roman$ by DJWoodgate2001
Two functions by me to convert a string to roman numerals and display it. The display routine is a bit corny, but you could covert it to use a bitmap font of your own devising for a more professional effect.
; Returns a string with the Roman numerals for value v
; This will Not be accurate for numbers > 3999 as the number
; 5000 should be represented as an M with a line above it etc, however as we
; do not have such a character I have used N, O, P.. etc for larger numbers, but see printroman...
Function roman$(v%)
	r$="IVXLCDMNPQRSTUWYZ"
	n$=v : i=Len(n$)*2-1
	For x=1 To Len(n$)
		d=Mid$(n$,x,1)
		Select d
		Case 1,2,3	: rom$=rom$+String$(Mid$(r$,i,1),d)
		Case 4		: rom$=Rom$+Mid$(r$,i,1)+Mid$(r$,i+1,1)
		Case 5		: rom$=rom$+Mid$(r$,i+1,1)
		Case 6,7,8	: rom$=rom$+Mid$(r$,i+1,1)+String$(Mid$(r$,i,1),d-5)
		Case 9		: rom$=rom$+Mid$(r$,i,1)+Mid$(R$,i+2,1)
		End Select
		i=i-2
	Next
	Return rom$
End Function

; Print Roman characters in graphics mode to x,y
; Uses character mapping from roman$() to produce
; M with bars for large numbers.  It all gets a bit
; silly if numbers are realy large however.
; Works best with larger font sizes
Function Printroman(r$,x,y)
h=StringHeight("M"):w=StringWidth("M")
Locate x,y
For s=1 To Len(r$)
	t$=Mid$(r$,s,1)
	p=Instr("NPQRSTUWYZ",t$,1)
	If p>0
		x=x+w
		Write "M"
		For l=1 To p
			Locate x-w+w/5,y-(l-1)*h/10
			Write "¯"
		Next
		Locate x,y
	Else
		x=x+StringWidth(t$)
		Write t$
	End If
Next
End Function

Comments

None.

Code Archives Forum