Une petite calculette en Hexa

' Calcul.bas calculette décimal/hexadécimal
DIM i%, j%, k%, d, vh$, lh%, ope$
DIM lb, hb, e, xb, yb, nb, nb1, nb2, nba, a$, ybc, lbc, yl, la, va, vm, v$, Mode$
DIM xbr, hl, nbh
LABEL Touche, Affich, Ret, DecHex, HexDec

DATA "0", "1", "2", "3"
DATA "4", "5", "6", "7"
DATA "8", "9", "A", "B"
DATA "C", "D", "E", "F"
DATA "+", "-", "x", "/", "="

lb = 30: hb = 20: e = 5: xb = 10: yl = 10: hl = hb+5
yb = yl + hl + 10: la = 10
Mode$ = "D": ' mode décimal
WIDTH 0, 5*(lb+e)+30: HEIGHT 0, yb+5*(hb+e)+40
COLOR 0, 128, 64, 0
CAPTION 0, " CALCULETTE"

nba = 30: nbh = nba + 1
LIST nba: TOP nba, yl: LEFT nba, xb: WIDTH nba, 4*lb+3*e: HEIGHT nba, hl
FONT_NAME nba, "Courier New": FONT_SIZE nba, 15: FONT_BOLD nba
COLOR nba, 220, 255, 255

LIST nbh: TOP nbh, yl: LEFT nbh, xb+4*(lb+e)+e: WIDTH nbh, lb-2*e: HEIGHT nbh, hl
COLOR nbh, 255, 200, 200: FONT_BOLD nbh
FONT_SIZE nbh, 12: ITEM_ADD nbh, Mode$

nb1 = 1: ' 16 touches chiffres de 1 à 16
FOR j% = 4 TO 1 STEP -1
    FOR i% = 0 TO 3
        READ a$: vh$ = a$: GOSUB HexDec: nb = d + 1
        BUTTON nb: TOP nb, yb + j%*(hb+e): LEFT nb, xb + i%*(lb+e)
        WIDTH nb, lb: HEIGHT nb, hb
        FONT_SIZE nb, 14: CAPTION nb, a$
    NEXT i%
NEXT j%
nb = 17
xbr =xb + 4*(lb+e): ' 5 touches opérations de 17 à 21
FOR j% = 4 TO 0 STEP -1
    BUTTON nb: TOP nb, yb + j%*(hb+e): LEFT nb, xbr
    WIDTH nb, lb: HEIGHT nb, hb
    READ a$: FONT_SIZE nb, 14: CAPTION nb, a$
    nb = nb + 1
NEXT j%

lbc = 3*lb/2+3
BUTTON nb: TOP nb, yb: LEFT nb, xb: WIDTH nb, lbc: HEIGHT nb, hb
FONT_SIZE nb, 11: CAPTION nb, "DEC": ' touche 22
nb = nb + 1
BUTTON nb: TOP nb, yb: LEFT nb, xb+lbc+e: WIDTH nb,lbc: HEIGHT nb, hb
FONT_SIZE nb, 11: CAPTION nb, "HEX": ' touche 23
nb = nb + 1
BUTTON nb: TOP nb, yb: LEFT nb, xb + 3*(lb+e): WIDTH nb, lb: HEIGHT nb, hb
FONT_SIZE nb, 14: CAPTION nb, "Clr": ' touche 24
nb2 = nb
FOR i% = nb1 TO nb2: ON_CLICK i%, Touche: NEXT i%

va = 0: vm = 0: GOSUB Affich

END

Touche:
FOR i% = nb1 TO nb2
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
IF i% < 17: ' touche chiffre (0 à 9 ou F)
    IF Mode$ = "H"
        va = va * 16
    ELSE
        IF i% > 10 THEN GOTO Ret
        va = va * 10
    END_IF
    va = va + i% - 1
    ' GOTO Ret
END_IF
SELECT i%
CASE 17: ope$ = "+": vm = va: va = 0
CASE 18: ope$ = "-": vm = va: va = 0
CASE 19: ope$ = "x": vm = va: va = 0
CASE 20: ope$ = "/": vm = va: va = 0
CASE 21: ' = calcul opération
    IF ope$ = "+"
        va = vm + va
    ELSE
        IF ope$ = "-"
            va = vm - va
        ELSE
            IF ope$ = "x"
                va = vm * va
            ELSE
                va = INT(vm/va)
            END_IF
        END_IF
    END_IF
    vm = 0
CASE 22: ' IF Mode$ = "D" THEN GOTO Ret
    Mode$ = "D": CLEAR nbh: ITEM_ADD nbh, "D"
CASE 23: ' IF Mode$ = "H" THEN GOTO Ret
    Mode$ = "H": CLEAR nbh: ITEM_ADD nbh, "H"
CASE 24: va = 0: vm = 0
END_SELECT
GOSUB Affich
Ret:
RETURN

Affich:
IF Mode$ = "D"
    v$ = STR$(va)
ELSE
    d = va: GOSUB DecHex: v$ = vh$
END_IF
v$ = RIGHT$(STRING$(la, " ") + v$, la)
CLEAR nba: ITEM_ADD nba, v$
RETURN

DecHex:
' conversion décimal/hexa de d, résultat vh$ (complété si utile à lh% caractères)
vh$="": IF lh% < 1 THEN lh% = 1
REPEAT
    vh$ = MID$("0123456789ABCDEF", 16*(d/16-INT(d/16))+1, 1) + vh$: d = INT(d/16)
UNTIL d <= 0
IF LEN(vh$) < lh% THEN vh$ = STRING$(lh% - LEN(vh$), "0") + vh$
RETURN

HexDec:
' conversion hexadécimal/décimal de vh$, résultat dans d
d = 0
FOR k% = 1 TO LEN(vh$)
    d = d*16 + INSTR("0123456789ABCDEF", MID$(vh$, k%, 1))-1
NEXT k%
RETURN