Forum Liberty Basic France

Visiteur
Le 07/12/2011 à 14h35

Libertynaute Inactif

Groupe: Visiteur



Un petit inutilitaire pour les graveurs sur pierre et aussi pour les épigraphistes (qui déchiffrent ce que les précédents ont gravé) en supposant qu'ils ne puissent pas le faire mentalement. Le code est un peu long parce qu'il doit dépister les erreurs éventuellement commises dans la saisie du nombre romain. Beaucoup d'erreurs différentes peuvent être saisies, on ne peut donc pas utiliser des DATA et une boucle. Romain-Décimal ne corrige pas les erreurs, mais il les signale en fin de traitement. Vu le climat général des discussions sur le forum LB et LBB, je ne joins pas l'exécutable...

Claude

Je ne retrouve pas le fichier .bas que j'ai téléchargé, aussi le voici en texte. S'il ne fonctionne pas correctement, c'est une erreur de re-recopie ou de re-re-correction, merci de le signaler. D'ailleurs je ne me débrouille pas encore très bien sur le site.


Code :

' ROMAIN-DECIMAL.BAS        LB 4.04   -    23 nov 2011
' =============

'conversion nombres romains et nombres décimaux
'uniquement nombres entiers positifs, max 9999 ou "MMMMMMMMMCMXCIX"
'ce qui devrait suffire aux datations pour un bon moment

[Widgets]

NOMAINWIN

RadioButton #w.radio1, "Romain => Decimal", [SetFocusRom], , 20, 50, 150, 20
TextBox #w.ROMAIN, 170, 50, 140, 25
StyleBits #w.ROMAIN, _ES_UPPERCASE, 0, 0, 0
RadioButton #w.radio2, "Decimal => Romain", [SetFocusDec], , 20, 100, 150, 20
TextBox #w.DECIMAL, 170, 100, 140, 25
StyleBits #w.DECIMAL, _ES_NUMBER, 0, 0, 0
Button #w.Raz, "RAZ", [RAZ], UL, 50, 180, 50, 50
Button #w.Default, "CALC", [Select], UL, 155, 180, 50, 50
Button #w.Quit, "QUIT", [Terminate], UL, 260, 180, 50, 50

UpperLeftX = 100: UpperLeftY = 150
WindowHeight = 300: WindowWidth = 360
OPEN "Conversion Romain - Decimal" FOR DIALOG AS #w
#w "Font arial 10"
#w "TrapClose  [Terminate]"

PRINT #w.radio1, "set"
PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, "!setfocus"

WAIT


[SetFocusRom]

''' focus, reset, saisie du nombre romain R$

D = 0
R$ = ""
PRINT #w.ROMAIN, ""
PRINT #w.DECIMAL, ""
PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, "!setfocus"
PRINT #w.DECIMAL, "!disable"        'empêche les inputs parasites

WAIT

[SetFocusDec]

''' focus, reset, saisie du nombre décimal D

D = 0
R$ = ""
PRINT #w.DECIMAL, ""
PRINT #w.DECIMAL, "!enable"
PRINT #w.DECIMAL, "!setfocus"
PRINT #w.ROMAIN, ""
PRINT #w.ROMAIN, "!disable"          'empêche les inputs parasites

WAIT


[Select]

''' choisir Rom2Dec ou Dec2Rom

PRINT #w.ROMAIN, "!contents? R$";
IF R$ <> "" THEN GOTO [Rom2Dec]
PRINT #w.DECIMAL, "!contents? D$";
IF D$ <> "" THEN GOTO [Dec2Rom]

WAIT


[Rom2Dec]

''' CONVERSION ROMAIN VERS DECIMAL

''' TRES COURT EXEMPLE pour illustrer la méthode

''' soit un nombre Romain (R$) = "MCMXXXIV", et un nombre Décimal (D) = 0
''' de gauche à droite:
''' y a-t-il "M" (= 1000) ? Oui, donc D = D + 1000 et on supprime le "M" à gauche
''' par  R$ = MID$(R$, 2) = "CMXXXIV"
''' y a-t-il  "CM" (=900) ? Oui, donc D = D + 900 = 1900
''' R$ = MID$(R$, 3) = "CDXXXIV", "CM" a été éliminé
''' ...
''' y a-t-il "CD" (= 400) ? Non, R$ et D sont inchangés
''' ...
''' y a-t-il "X" (= 10)? Eh bien oui, trois fois, ce qui fait 30
''' donc D = D + 30 = 1930, R$ = MID$(R$, 4) = "IV"
''' maintenant il ne reste plus que "IV", D = D + 4 = 1934, and R$ = ""
''' terminé, le résultat est 1934 1934

D = 0

'combien de miliers ? ("M", max 9)

FOR i = 1 TO 9
    IF LEFT$ (R$, 1) = "M" THEN
    D = D + 1000
    R$ = MID$(R$, 2)
    END IF
NEXT i

'y a-t-il 900 ? (CM, max 1) ?

IF LEFT$(R$, 2) = "CM" THEN
D = D + 900
R$ = MID$(R$, 3)
END IF

'y a-t-il 400 (CD, max 1) ?

IF LEFT$(R$, 2) = "CD" THEN
D = D + 400
R$ = MID$(R$, 3)
END IF

'y a-t-il 500 ? (D, max 1)

IF LEFT$(R$, 1) = "D" THEN
D = D + 500
R$ = MID$(R$, 2)
END IF

'y-a-t-il 90 (XC, max 1)

IF LEFT$(R$, 2) = "XC" THEN
D = D + 90
R$ = MID$(R$, 3)
END IF

'reste-t-il des centaines ? (C, max 3) ?

FOR i = 1 TO 3
    IF LEFT$(R$, 1) = "C" THEN
    D = D + 100
    R$ = MID$(R$, 2)
    END IF
NEXT i

'y a-t-il 40 ? (XL, max 1) ?

IF LEFT$(R$, 2) = "XL" THEN
D = D + 40
R$ = MID$(R$, 3)
END IF

'y a-t-il 50 ? (L, max 1)

IF LEFT$(R$, 1) = "L" THEN
D = D + 50
R$ = MID$(R$, 2)
END IF

'reste-t-il des dizaines ? (X, max 3) ?

FOR i = 1 TO 3
IF LEFT$(R$, 1) = "X" THEN
D = D + 50
R$ = MID$(R$, 2)
END IF
NEXT i

'reste-t-il 9 ? (IX, max 1)

IF LEFT$(R$, 2) = "IX" THEN
D = D + 9
R$ = MID$(R$, 3)
END IF

'reste-t-il 4 ? (IV, max 1)

IF LEFT$(R$, 2) = "IV" THEN
D = D + 4
R$ = MID$(R$, 3)
END IF

'reste-t-il 5 ? (V, max 1)

IF LEFT$(R$, 1) = "V" THEN
D = D + 5
R$ = MID$(R$, 2)
END IF

'reste-t-il des unités ?  (I, max 3)

FOR i = 1 TO 3
IF LEFT$(R$, 1) = "I" THEN
D = D + 1
R$ = MID$(R$, 2)
END IF
NEXT i


'--Résultat de Rom2Dec


IF R$ <> "" THEN
    '* erreur, il reste des caractères erronnés ou mal placés
    PRINT #w.ROMAIN, "ERR : " + R$
    NOTICE "Nombre Romain erronné" + CHR$(13) + "caractères excédentaires ou inconnus"
ELSE
    '* correct, tous les caractères ont été traités
    PRINT #w.DECIMAL, "!enable"
    PRINT #w.DECIMAL, STR$(D)
END IF

WAIT


[Dec2Rom]

R$ = ""
D = VAL(D$)

IF D > 9999 THEN NOTICE "Nombre décimal incorrect" + CHR$(13) + "Pas plus de 9999": WAIT

n = INT(D / 1000)                                        '1000  ? => M
FOR i = 1 TO n: R$ = R$ + "M": NEXT i
D = D - n * 1000

IF D >= 900 THEN                                       '900 ? => CM
R$ = R$ + "CM"
D = D - 900
END IF

IF D >= 500 THEN                                       '500 ? => D
R$ = R$ + "D"
D = D - 500
END IF

IF D >= 400 THEN                                       '400 ? => CD
R$ = R$ + "CD"
D = D - 400
END IF

n = INT(D / 100)                                        '100 ? => C
FOR i = 1 TO n: R$ = R$ + "C": NEXT i
D = D - n * 100

IF D >= 90 THEN                                         '90  ? => XC
R$ = R$ + "XC"
D = D - 90
END IF

IF D >= 50 THEN                                         '50 ? => L
R$ = R$ + "L"
D = D - 50
END IF

IF D >=  40 THEN                                       '40 ? => XL
R$ = R$ + "XL"
D = D - 40
END IF

n = INT(D / 10)                                         '10 ? => X
FOR i = 1 TO n: R$ = R$ + "X": NEXT i
D = D - n * 10

IF D = 9 THEN                                           '9 ? => IX
R$ = R$ + "IX"
D = D - 9
END IF

IF D > 4 THEN                                           '5 ? => V
R$ = R$ + "V"
D = D - 5
END IF

IF D = 4 THEN                                           '4 ? => IV
R$ = R$ + "IV"
D = D - 4
END IF

n = D                                                   '1 ? =>  I
FOR i = 1 TO D
R$ = R$ + "I"
NEXT i

'--Résulat de Dec2Rom

PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, R$

WAIT


[RAZ]

''' remise à zéro avant un nouveau calcul

'PRINT #w.radio1, "reset"
'PRINT #w.radio2, "reset"
PRINT #w.ROMAIN, ""
PRINT #w.DECIMAL,  ""
R$ = ""
D = 0
WAIT


[Terminate]

CLOSE #w
END




Edité par Visiteur Le 17/12/2011 à 14h57
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 16/12/2011 à 22h05

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 362
Désolé, je ne peux pas tester ton logiciel, je n'ai pas LB.
Si j'ai bien compris, il permet de convertir des nombres en chiffre romain en un nombre en décimal ?
Par contre, je ne comprends pas bien cette histoire d'erreur ?

Cordialement
Jagang
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Visiteur
Le 17/12/2011 à 14h49

Libertynaute Inactif

Groupe: Visiteur



En effet, ce code ne fonctionne pas en JB, à cause des StyleBits, qui sont destinés à n'autoriser que les caractères alphabétiques majuscules dans le textbox "romain", et à n'autoriser que les caractères numériques dans le textbox "décimal". Comme les caractères alphabétiques pourraient être en minuscules, il faut ajouter un R$ = UPPER$(R$). En outre je m'aperçois que j'ai oublié le cas "XC" ou 90, je l'ajoute.
Je charge donc le "Romain-Décimal-JB" avec espoir et optimisme.
Les erreurs auxquelles je songeais, sont liées à la saisie d'un nombre romain erronné, par exemple "MMCMCDXLXVI", exemple que mon code n'élimine pas encore. Maintenant, pour une date normale, ça devrait aller. Si ça ne va toujours pas tu le dis. Mais si ça va, dis-le aussi.

Claude


Code :

' ROMAIN-DECIMAL.BAS        JB   -    17 déc 2011
' ==============

'conversion entre nombres romains et nombres décimaux
'uniquement nombres entiers positifs, max 9999 ou "MMMMMMMMMCMXCIX"
'ce qui devrait suffire aux datations pour un bon moment

[Widgets]

NOMAINWIN

RadioButton #w.radio1, "Roman => Decimal", [SetFocusRom], , 20, 50, 150, 20
TextBox #w.ROMAIN, 170, 50, 140, 25
'StyleBits #w.ROMAIN, _ES_UPPERCASE, 0, 0, 0
RadioButton #w.radio2, "Decimal => Roman", [SetFocusDec], , 20, 100, 150, 20
TextBox #w.DECIMAL, 170, 100, 140, 25
'StyleBits #w.DECIMAL, _ES_NUMBER, 0, 0, 0
Button #w.Raz, "RAZ", [RAZ], UL, 50, 180, 50, 50
Button #w.Default, "CALC", [Select], UL, 155, 180, 50, 50
Button #w.Quit, "QUIT", [Terminate], UL, 260, 180, 50, 50

UpperLeftX = 100: UpperLeftY = 150
WindowHeight = 300: WindowWidth = 360
OPEN "ROMAIN - Decimal Conversion" FOR DIALOG AS #w
#w "Font arial 10"
#w "TrapClose  [Terminate]"

PRINT #w.radio1, "set"
PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, "!setfocus"

WAIT


[SetFocusRom]

''' focus, reset, saisie du nombre romain R$

D = 0
R$ = ""
PRINT #w.DECIMAL, ""
PRINT #w.DECIMAL, "!disable"        'empêche les inputs parasites
PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, ""
PRINT #w.ROMAIN, "!setfocus"


WAIT


[SetFocusDec]

''' focus, reset, saisie du nombre décimal D

D = 0
R$ = ""
PRINT #w.ROMAIN, ""
PRINT #w.ROMAIN, "!disable"          'empêche les inputs parasites
PRINT #w.DECIMAL, "!enable"
PRINT #w.DECIMAL, ""
PRINT #w.DECIMAL, "!setfocus"

WAIT


[Select]

''' choisir Rom2Dec ou Dec2Rom

PRINT #w.ROMAIN, "!contents? R$";
IF R$ <> "" THEN GOTO [Rom2Dec]
PRINT #w.DECIMAL, "!contents? D$";
IF D$ <> "" THEN GOTO [Dec2Rom]

WAIT


[Rom2Dec]

''' CONVERSION ROMAIN VERS DECIMAL

''' TRES COURT EXEMPLE pour illustrer la méthode

''' soit un nombre Romain (R$) = "MCMXXXIV", et un nombre Décimal (D) = 0
''' de gauche à droite:
''' y a-t-il "M" (= 1000) ? Oui, donc D = D + 1000 et on supprime le "M" à gauche
''' par  R$ = MID$(R$, 2) = "CMXXXIV"
''' y a-t-il  "CM" (=900) ? Oui, donc D = D + 900 = 1900
''' R$ = MID$(R$, 3) = "CDXXXIV", "CM" a été éliminé
''' ...
''' y a-t-il "CD" (= 400) ? Non, R$ et D sont inchangés
''' ...
''' y a-t-il "X" (= 10)? Eh bien oui, trois fois, ce qui fait 30
''' donc D = D + 30 = 1930, R$ = MID$(R$, 4) = "IV"
''' maintenant il ne reste plus que "IV", D = D + 4 = 1934, and R$ = ""
''' terminé, le résultat est 1934 1934

R$ = UPPER$(R$)

D = 0

'combien de miliers ? ("M", max 9)

FOR i = 1 TO 9
    IF LEFT$ (R$, 1) = "M" THEN
    D = D + 1000
    R$ = MID$(R$, 2)
    END IF
NEXT i

'y a-t-il 900 ? (CM, max 1) ?

IF LEFT$(R$, 2) = "CM" THEN
D = D + 900
R$ = MID$(R$, 3)
END IF

'y a-t-il 400 (CD, max 1) ?

IF LEFT$(R$, 2) = "CD" THEN
D = D + 400
R$ = MID$(R$, 3)
END IF

'y a-t-il 500 ? (D, max 1)

IF LEFT$(R$, 1) = "D" THEN
D = D + 500
R$ = MID$(R$, 2)
END IF

'y-a-t-il 90 (XC, max 1)

IF LEFT$(R$, 2) = "XC" THEN
D = D + 90
R$ = MID$(R$, 3)
END IF

'reste-t-il des centaines ? (C, max 3) ?

FOR i = 1 TO 3
    IF LEFT$(R$, 1) = "C" THEN
    D = D + 100
    R$ = MID$(R$, 2)
    END IF
NEXT i

'y a-t-il 40 ? (XL, max 1) ?

IF LEFT$(R$, 2) = "XL" THEN
D = D + 40
R$ = MID$(R$, 3)
END IF

'y a-t-il 50 ? (L, max 1)

IF LEFT$(R$, 1) = "L" THEN
D = D + 50
R$ = MID$(R$, 2)
END IF

'reste-t-il des dizaines ? (X, max 3) ?

FOR i = 1 TO 3
IF LEFT$(R$, 1) = "X" THEN
D = D + 50
R$ = MID$(R$, 2)
END IF
NEXT i

'reste-t-il 9 ? (IX, max 1)

IF LEFT$(R$, 2) = "IX" THEN
D = D + 9
R$ = MID$(R$, 3)
END IF

'reste-t-il 4 ? (IV, max 1)

IF LEFT$(R$, 2) = "IV" THEN
D = D + 4
R$ = MID$(R$, 3)
END IF

'reste-t-il 5 ? (V, max 1)

IF LEFT$(R$, 1) = "V" THEN
D = D + 5
R$ = MID$(R$, 2)
END IF

'reste-t-il des unités ?  (I, max 3)

FOR i = 1 TO 3
IF LEFT$(R$, 1) = "I" THEN
D = D + 1
R$ = MID$(R$, 2)
END IF
NEXT i

'--Résultat de Rom2Dec

IF R$ <> "" THEN
    '* erreur, il reste des caractères erronnés ou mal placés
    PRINT #w.ROMAIN, "ERR : " + R$
    NOTICE "Nombre Romain erronné" + CHR$(13) + "caractères excédentaires ou inconnus"
ELSE
    '* correct, tous les caractères ont été traités
    PRINT #w.DECIMAL, "!enable"
    PRINT #w.DECIMAL, STR$(D)
END IF

WAIT


[Dec2Rom]

R$ = ""
D = VAL(D$)

IF D > 9999 THEN NOTICE "Nombre décimal incorrect" + CHR$(13) + "Pas plus de 9999": WAIT

n = INT(D / 1000)                                        '1000  ? => M
FOR i = 1 TO n: R$ = R$ + "M": NEXT i
D = D - n * 1000

IF D >= 900 THEN                                       '900 ? => CM
R$ = R$ + "CM"
D = D - 900
END IF

IF D >= 500 THEN                                       '500 ? => D
R$ = R$ + "D"
D = D - 500
END IF

IF D >= 400 THEN                                       '400 ? => CD
R$ = R$ + "CD"
D = D - 400
END IF

n = INT(D / 100)                                        '100 ? => C
FOR i = 1 TO n: R$ = R$ + "C": NEXT i
D = D - n * 100

IF D >= 90 THEN                                         '90  ? => XC
R$ = R$ + "XC"
D = D - 90
END IF

IF D >= 50 THEN                                         '50 ? => L
R$ = R$ + "L"
D = D - 50
END IF

IF D >=  40 THEN                                        '40 ? => XL
R$ = R$ + "XL"
D = D - 40
END IF

n = INT(D / 10)                                         '10 ? => X
FOR i = 1 TO n: R$ = R$ + "X": NEXT i
D = D - n * 10

IF D = 9 THEN                                           '9 ? => IX
R$ = R$ + "IX"
D = D - 9
END IF

IF D > 4 THEN                                           '5 ? => V
R$ = R$ + "V"
D = D - 5
END IF

IF D = 4 THEN                                           '4 ? => IV
R$ = R$ + "IV"
D = D - 4
END IF

n = D                                                   '1 ? =>  I
FOR i = 1 TO D
R$ = R$ + "I"
NEXT i

'--Résulat de Dec2Rom

PRINT #w.ROMAIN, "!enable"
PRINT #w.ROMAIN, R$

WAIT


[RAZ]

''' remise à zéro avant un nouveau calcul
'''celui qui a déjà le focus le garde
'PRINT #w.radio1, "reset"
'PRINT #w.radio2, "reset"
PRINT #w.ROMAIN, ""
PRINT #w.DECIMAL,  ""
R$ = ""
D = 0
WAIT


[Terminate]

CLOSE #w
END





Edité par Visiteur Le 17/12/2011 à 15h04
____________________
Omnium populorum gallicorum bravissimi sunt Belgae.

Web    
Le 17/12/2011 à 18h37

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 362
Pas mal
Il a l'aire de bien fonctionner :)
Bon boulot

Cordialement
Jagang
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie