Calculatrice romaine

rem ============================================================================
rem                   Calculatrice romaine
rem ============================================================================
rem Comment faire des calculs avec les chiffres romains ?
rem Il suffit simplement d’effectuer une conversion des nombres romains en nombres
rem arabes et vice versa.
rem ============================================================================

label clic
dim i,romain$,n1,n2,r
dim op : ' Addition = 1; Soustraction = 2, Division = 3; Multiplication = 4
width 0,300 : height 0,250
alpha 10 : top 10,10 : left 10,30
font_color 10,0,0,255 : caption 10,"Calculatrice romaine"
edit 20 : top 20,50 : left 20,10 : height 20,30
button 030 : top 030,100 : left 030,010 : caption 030,"M"
button 040 : top 040,100 : left 040,060 : caption 040,"D"
button 050 : top 050,100 : left 050,110 : caption 050,"C"
button 060 : top 060,100 : left 060,160 : caption 060,"L"

button 070 : top 070,140 : left 070,010 : caption 070,"X"
button 080 : top 080,140 : left 080,060 : caption 080,"V"
button 090 : top 090,140 : left 090,110 : caption 090,"I"
button 100 : top 100,140 : left 100,210 : caption 100,"CE"
    
button 110 : top 110,180 : left 110,010 : caption 110,"+"
button 120 : top 120,180 : left 120,060 : caption 120,"-"
button 130 : top 130,180 : left 130,110 : caption 130,"÷"
button 140 : top 140,180 : left 140,160 : caption 140,"×"
button 150 : top 150,180 : left 150,210 : caption 150,"="
  
for i = 10 to 150 step 10
    width i,40 : font_bold i : font_name i,"tahoma" : font_size i,14
    on_click i,clic
next i
width 20,250
end
rem ============================================================================
Clic:
    i = number_click    
    if (i >= 30) and (i <= 90)
       romain$ = romain$ + caption$(i) : text 20,romain$
        n1 = Romain_to_Number(romain$)
    else
        romain$ = "" : text 20,romain$        
        select number_click
            case 100 : romain$ = "" : text 20,romain$
            case 110 : n2 = n1 : op = 1
            case 120 : n2 = n1 : op = 2
            case 130 : n2 = n1 : op = 3
            case 140 : n2 = n1 : op = 4
            case 150 : Resultat()          
        end_select
    end_if
return
rem ============================================================================
SUB Resultat()
    dim_local sign$
    select op
        case 0 : r = n1
        case 1 : r = n2 + n1
        case 2 : r = n2 - n1
        case 3 : r = n2 / n1
        case 4 : r = n2 * n1
    end_select
    if r < 0 then sign$ = "-" : else : sign$ = ""
    if abs(r) > 4999
       text 20,"Erreur de débordement !"
    else
       text 20, sign$ + Number_To_Romain$(abs(r))  + "  /  " + str$(r) : ' <--- en chiffres arabes
    end_if
    op = 0
END_SUB
rem ============================================================================
FNC Romain_to_Number(num$)
    dim_local i,n
    num$ = upper$(num$) : i = 1 : n = 0
' Calcul des milliers
    while mid$(num$,i,1) = "M" : n = n + 1000 : i = i + 1 : end_while
' Calcul des centaines
    if mid$(num$,i,2) = "CM"
       n = n + 900 : i = i + 2
    else
       if mid$(num$,i,2) = "CD"
          n = n + 400 : i = i + 2
       else
          if mid$(num$,i,1) = "D"
             n = n + 500 : i = i + 1
          end_if
       end_if
    end_if
    while mid$(num$,i,1) = "C" : n = n + 100 : i = i + 1 : end_while
' Calcul les dizaines
    if mid$(num$,i,2) = "XC"
       n = n + 90 : i = i + 2
    else
       if mid$(num$,i,2) = "XL"
          n = n + 40 : i = i + 2
       else
          if mid$(num$,i,1) = "L"
             n = n + 50 : i = i + 1
          end_if
       end_if
    end_if
    while mid$(num$,i,1) = "X" : n = n + 10 : i = i + 1 : end_while
' calcul les unités
    if mid$(num$,i,2) = "IX"
       n = n + 9 : i = i + 2
    else
       if mid$(num$,i,2) = "IV"
          n = n + 4 : i = i + 2
       else
          if mid$(num$,i,1) = "V"
             n = n + 5 : i = i + 1
          end_if
       end_if
    end_if
    while mid$(num$,i,1) = "I" : n = n + 1 : i = i + 1 : end_while
    result n
END_FNC
rem ============================================================================
FNC Number_To_Romain$(x)
    dim_local s$
    if x = 0 then result "nulla" : exit_fnc
    select int(mod(x,10000)/1000)
        case 1 : s$ = s$ + "M"
        case 2 : s$ = s$ + "MM"
        case 3 : s$ = s$ + "MMM"
        case 4 : s$ = s$ + "MMMM"
    end_select
    select int(mod(x,1000)/100)
        case 1 : s$ = s$ + "C"
        case 2 : s$ = s$ + "CC"
        case 3 : s$ = s$ + "CCC"
        case 4 : s$ = s$ + "CD"
        case 5 : s$ = s$ + "D"
        case 6 : s$ = s$ + "DC"
        case 7 : s$ = s$ + "DCC"
        case 8 : s$ = s$ + "DCCC"
        case 9 : s$ = s$ + "CM"
    end_select
    select int(mod(x,100)/10)
        case 1 : s$ = s$ + "X"
        case 2 : s$ = s$ + "XX"
        case 3 : s$ = s$ + "XXX"
        case 4 : s$ = s$ + "XL"
        case 5 : s$ = s$ + "L"
        case 6 : s$ = s$ + "LX"
        case 7 : s$ = s$ + "LXX"
        case 8 : s$ = s$ + "LXXX"
        case 9 : s$ = s$ + "XC"
    end_select
    select mod(x,10)
        case 1 : s$ = s$ + "I"
        case 2 : s$ = s$ + "II"
        case 3 : s$ = s$ + "III"
        case 4 : s$ = s$ + "IV"
        case 5 : s$ = s$ + "V"
        case 6 : s$ = s$ + "VI"
        case 7 : s$ = s$ + "VII"
        case 8 : s$ = s$ + "VIII"
        case 9 : s$ = s$ + "IX"
    end_select
    result s$    
END_FNC
rem ============================================================================