Code archives/Miscellaneous/Function Roman$
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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