Convert Integer values to Roman values

[Flype]

Code updated For 5.20+

Code: Select all

    ;
    ; Integer value -> Roman value
    ; Philippe Carpentier - 2005
    ;

    Procedure.s RomVal(num)
     
      res.s = ""
     
      For i = 1 To 13
        a.s = StringField("1000,M;900,CM;500,D;400,CD;100,C;90,XC;50,L;40,XL;10,X;9,IX;5,V;4,IV;1,I", i, ";")
        b = Val(StringField(a, 1, ","))
        c.s = StringField(a, 2, ",")
        While num >= b
          res + c : num - b
        Wend
      Next
     
      ProcedureReturn res
     
    EndProcedure

    ;- exemple

    For i = 1 To 50
      msg.s + RomVal(i) + Chr(10)
    Next

    MessageRequester("",msg)

It will be faster by using an array or a list, but works well.
best regards.

[Flype]

optimised one (with reverse procedure) :

Code: Select all

Global Dim RC.l('X') ; RC.l($FFFF) for unicode
RC('I') = 0001
RC('V') = 0005
RC('X') = 0010
RC('L') = 0050
RC('C') = 0100
RC('D') = 0500
RC('M') = 1000

Global Dim RL.l(12)
RL(00) = 1000
RL(01) = 0900
RL(02) = 0500
RL(03) = 0400
RL(04) = 0100
RL(05) = 0090
RL(06) = 0050
RL(07) = 0040
RL(08) = 0010
RL(09) = 0009
RL(10) = 0005
RL(11) = 0004
RL(12) = 0001

Global Dim RS.s(12)
RS(00) = "M" 
RS(01) = "CM"
RS(02) = "D" 
RS(03) = "CD"
RS(04) = "C" 
RS(05) = "XC"
RS(06) = "L" 
RS(07) = "XL"
RS(08) = "X" 
RS(09) = "IX"
RS(10) = "V" 
RS(11) = "IV"
RS(12) = "I" 

Procedure.s StrR(number.l)
  Protected i.l, result.s
  For i = 0 To 12
    While number >= RL(i) 
      number - RL(i) 
      result + RS(i) 
    Wend 
  Next 
  ProcedureReturn result 
EndProcedure 

Procedure.l ValR(number.s)
  Protected oldvalue.l, result.l
  Protected *num.Character = @number + Len(number) * SizeOf(Character) - SizeOf(Character)
  While *num\c
    If oldvalue > RC(*num\c)
      result - RC(*num\c)
    Else
      result + RC(*num\c)
    EndIf
    oldvalue = RC(*num\c)
    *num - SizeOf(Character)
  Wend
  ProcedureReturn result 
EndProcedure

[Konne]

Nice

[Flype]

and unicode ready.

maybe droopy can embed it in his userlib.
and could be useful (for me but also for others) in conjonction with PurePDF to make what you guess...

[kenmo]

Cool, but...

Code: Select all

Global Dim RC.l($FFFF) 

There's gotta be a more efficient way to do it than allocating 65535 longs and only using 7 of them!

[Flype]

yes but it's for unicode-length cars and for speed i don't think it's a problem, and it works with Global Dim RC('X').
but i made for my own plenty of differents way, stringfield way is the shortest, but slower. array is the longest but the faster.
as long as there's no associative array in pb...

[Konne]

Sry but for such a thing a array with this size ! That's insane!!!

[Flype]

a array of Dim('X') is only (88*4)=352 bytes.

but, ok, i take care of your remarks and i publish a modified version
based on Select/Case/EndSelect method which is just a little bit slower.

Code: Select all

Procedure.s StrR(number.l)
  Protected i.l, value.l, result.s
  For i = 0 To 12
    Select i
      Case  0: value = 1000
      Case  1: value = 900
      Case  2: value = 500
      Case  3: value = 400
      Case  4: value = 100
      Case  5: value = 90
      Case  6: value = 50
      Case  7: value = 40
      Case  8: value = 10
      Case  9: value = 9
      Case 10: value = 5
      Case 11: value = 4
      Case 12: value = 1
    EndSelect
    While number >= value
      Select i
        Case  0: result + "M" 
        Case  1: result + "CM"
        Case  2: result + "D" 
        Case  3: result + "CD"
        Case  4: result + "C" 
        Case  5: result + "XC"
        Case  6: result + "L" 
        Case  7: result + "XL"
        Case  8: result + "X" 
        Case  9: result + "IX"
        Case 10: result + "V" 
        Case 11: result + "IV"
        Case 12: result + "I" 
      EndSelect
      number - value
    Wend
  Next 
  ProcedureReturn result 
EndProcedure 

Procedure.l ValR(number.s)
  Protected oldvalue.l, value.l, result.l, offset = Len(number)
  While offset
    Select Asc(Mid(number, offset, 1))
      Case 'I': value = 1 
      Case 'V': value = 5 
      Case 'X': value = 10 
      Case 'L': value = 50 
      Case 'C': value = 100 
      Case 'D': value = 500 
      Case 'M': value = 1000 
    EndSelect 
    If oldvalue > value
      result - value
    Else
      result + value
    EndIf
    oldvalue = value
    offset - 1
  Wend
  ProcedureReturn result 
EndProcedure