Hexidecimal Calculator
#1
Sample of a Hexidecimal-to-Decimal calculator:

Code:
REM Hex-To-Dec Calculator v1.1a.

' declare arrays at runtime.
REM $DYNAMIC

' declare default variables.
DEFINT A-Z

' declare common error routine.
ON ERROR GOTO Error.Routine

' make title
_TITLE "HEXCALC"

' Note: In HexCalc the following keys are active:
'   Ctrl-A - move up, Ctrl-B - move down
'   Ctrl-C - move left, Ctrl-D - move right
'   Ctrl-E, Ctrl-F - cycle foreground
'   Ctrl-J, Ctrl-K - cycle background

' init vars
GOSUB Get.Config1

' create edit box.
COLOR , Background2
CLS
GOSUB MakeBox

CalcBox = 1 ' reset to left box.

Box$ = "0" ' current box
Box1$ = "0" ' left box string
Box2$ = "0" ' right box string

GOSUB SelectBox2 ' display box 2.
GOSUB SelectBox1 ' display box 1.

DO ' calculator loop
    DO ' keystroke loop
        Var$ = INKEY$ ' get keystroke
        IF LEN(Var$) THEN ' check keystroke
            EXIT DO
        END IF
        _LIMIT 10
    LOOP
    SELECT CASE LEN(Var$)
        CASE 1 ' single ascii key
            SELECT CASE ASC(Var$)
                CASE 1 ' control-a (up)
                    IF Xcoor > 1 THEN
                        Xcoor = Xcoor - 1
                        GOSUB ResetBox
                    END IF
                CASE 2 ' control-b (down)
                    IF Xcoor < Max.Row - 2 THEN
                        Xcoor = Xcoor + 1
                        GOSUB ResetBox
                    END IF
                CASE 3 ' control-c (left)
                    IF Ycoor > 1 THEN
                        Ycoor = Ycoor - 1
                        GOSUB ResetBox
                    END IF
                CASE 4 ' control-d (right)
                    IF Ycoor < 50 THEN
                        Ycoor = Ycoor + 1
                        GOSUB ResetBox
                    END IF
                CASE 5 ' control-e
                    IF Foreground1 = 15 THEN
                        Foreground1 = 0
                    ELSE
                        Foreground1 = Foreground1 + 1
                    END IF
                    GOSUB ResetBox
                CASE 6 ' control-f
                    IF Foreground2 = 15 THEN
                        Foreground2 = 0
                    ELSE
                        Foreground2 = Foreground2 + 1
                    END IF
                    GOSUB ResetBox
                CASE 10 ' control-j
                    IF Background1 = 7 THEN
                        Background1 = 0
                    ELSE
                        Background1 = Background1 + 1
                    END IF
                    GOSUB ResetBox
                CASE 11 ' control-k
                    IF Background2 = 7 THEN
                        Background2 = 0
                    ELSE
                        Background2 = Background2 + 1
                    END IF
                    GOSUB ResetBox
                CASE 8 ' backspace
                    IF Ycoor1 - Column3 > 0 THEN
                        IF Ins THEN
                            Box$ = LEFT$(Box$, Ycoor1 - Column3 - 1) + MID$(Box$, Ycoor1 - Column3 + 1)
                            Ycoor1 = Ycoor1 - 1
                            LOCATE Xcoor1, Ycoor1, 1
                            Var$ = MID$(Box$, Ycoor1 - Column3 + 1) + " "
                            COLOR Foreground2, Background1
                            PRINT Var$;
                            LOCATE Xcoor1, Ycoor1, 1
                            GOSUB PrintBoxes
                        ELSE ' move left
                            Ycoor1 = Ycoor1 - 1
                            LOCATE Xcoor1, Ycoor1, 1
                        END IF
                    END IF
                CASE 9 ' tab
                    IF CalcBox = 1 THEN
                        CalcBox = 2
                        GOSUB SelectBox2
                        GOSUB PrintBoxes
                    END IF
                CASE 27 ' escape
                    EXIT DO
                CASE 63 ' ?
                    GOSUB HelpBox
                    GOSUB ResetBox
                CASE ELSE ' keystroke
                    VarX = 0 ' valid char flag
                    TempX$ = UCASE$(Var$)
                    SELECT CASE TempX$ ' validate char
                        CASE "0" TO "9"
                            VarX = -1
                        CASE "A" TO "F"
                            IF CalcBox = 1 THEN
                                VarX = -1
                            END IF
                    END SELECT
                    IF VarX THEN
                        IF Ycoor1 - Column3 + 1 <= LineLength THEN
                            ' insert digit
                            IF Ins THEN
                                Box$ = LEFT$(Box$, Ycoor1 - Column3) + TempX$ + MID$(Box$, Ycoor1 - Column3 + 1)
                                Box$ = LEFT$(Box$, LineLength)
                                LOCATE Xcoor1, Ycoor1, 1
                                Var$ = MID$(Box$, Ycoor1 - Column3 + 1)
                                COLOR Foreground2, Background1
                                PRINT Var$;
                                Ycoor1 = Ycoor1 + 1
                                LOCATE Xcoor1, Ycoor1, 1
                                GOSUB PrintBoxes
                            ELSE ' overstrike char
                                IF Ycoor1 - Column3 + 1 > LEN(Box$) THEN
                                    Box$ = Box$ + TempX$ ' append box
                                ELSE
                                    MID$(Box$, Ycoor1 - Column3 + 1, 1) = TempX$ ' replace
                                END IF
                                LOCATE Xcoor1, Ycoor1, 1
                                COLOR Foreground2, Background1
                                PRINT TempX$;
                                Ycoor1 = Ycoor1 + 1
                                LOCATE Xcoor1, Ycoor1, 1
                                GOSUB PrintBoxes
                            END IF
                        END IF
                    END IF
            END SELECT
        CASE 2 ' extended key
            SELECT CASE ASC(RIGHT$(Var$, 1))
                CASE 15 ' shift-tab
                    IF CalcBox = 2 THEN
                        CalcBox = 1
                        GOSUB SelectBox1
                        GOSUB PrintBoxes
                    END IF
                CASE 71 ' home
                    Ycoor1 = Column3
                CASE 79 ' end
                    Ycoor1 = LEN(Box$) + Column3
                CASE 77 ' right
                    IF Ycoor1 - Column3 + 1 <= LEN(Box$) THEN
                        Ycoor1 = Ycoor1 + 1
                    END IF
                CASE 75 ' left
                    IF Ycoor1 - Column3 > 0 THEN
                        Ycoor1 = Ycoor1 - 1
                    END IF
                CASE 82 ' insert
                    Ins = NOT Ins
                    GOSUB DisplayInsert
                CASE 83 ' delete
                    IF Ycoor1 - Column3 + 1 <= LEN(Box$) THEN
                        Box$ = LEFT$(Box$, Ycoor1 - Column3) + MID$(Box$, Ycoor1 - Column3 + 2)
                        LOCATE Xcoor1, Ycoor1, 1
                        Var$ = MID$(Box$, Ycoor1 - Column3 + 1) + " "
                        COLOR Foreground2, Background1
                        PRINT Var$;
                        LOCATE Xcoor1, Ycoor1, 1
                        GOSUB PrintBoxes
                    END IF
                CASE 119 ' control-home
                    Ycoor1 = Column3
                CASE 117 ' control-end
                    Ycoor1 = LEN(Box$) + Column3
            END SELECT
            LOCATE Xcoor1, Ycoor1, 1
    END SELECT
LOOP
COLOR 7, 0
END

' display edit box
ResetBox:
COLOR , Background2
CLS
GOSUB MakeBox
Xcoor1 = Xcoor + 1
Ymove = Ycoor1 - Column3

' display box area 1
COLOR Foreground2, Background1
LOCATE Xcoor1, Ycoor + 3, 1
PRINT SPACE$(8);
LOCATE Xcoor1, Ycoor + 3, 1
IF CalcBox = 1 THEN
    PRINT Box$;
ELSE
    PRINT Box1$;
END IF

' display box area 2
COLOR Foreground2, Background1
LOCATE Xcoor1, Ycoor + 15, 1
PRINT SPACE$(10);
LOCATE Xcoor1, Ycoor + 15, 1
IF CalcBox = 2 THEN
    PRINT Box$;
ELSE
    PRINT Box2$;
END IF

' reset editing area
IF CalcBox = 1 THEN
    Ycoor1 = Ycoor + 3
    Column3 = Ycoor1
    Ycoor1 = Ycoor1 + Ymove
    LineLength = 8
ELSE
    Ycoor1 = Ycoor + 15
    Column3 = Ycoor1
    Ycoor1 = Ycoor1 + Ymove
    LineLength = 10
END IF
LOCATE Xcoor1, Ycoor1, 1
RETURN

' create help box.
HelpBox:
DO
    COLOR , HBackground2
    CLS
    ' make help box
    COLOR HForeground1, HBackground1
    LOCATE Xcoor2 + 1, Ycoor2, 1
    PRINT CHR$(201) + STRING$(39, 205) + CHR$(187);
    LOCATE Xcoor2 + 2, Ycoor2, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 2, Ycoor2 + 40, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 3, Ycoor2, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 3, Ycoor2 + 40, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 4, Ycoor2, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 4, Ycoor2 + 40, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 5, Ycoor2, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 5, Ycoor2 + 40, 1
    PRINT CHR$(186);
    LOCATE Xcoor2 + 6, Ycoor2, 1
    PRINT CHR$(200) + STRING$(39, 205) + CHR$(188);
    ' make help box contents
    COLOR HForeground2, HBackground1
    LOCATE Xcoor2, Ycoor2 + 10, 1
    PRINT " Additional Keys ";
    LOCATE Xcoor2 + 2, Ycoor2 + 1, 1
    PRINT "Ctrl-A = Move Up, Ctrl-B = Move Down   ";
    LOCATE Xcoor2 + 3, Ycoor2 + 1, 1
    PRINT "Ctrl-C = Move Left, Ctrl-D = Move Right";
    LOCATE Xcoor2 + 4, Ycoor2 + 1, 1
    PRINT "Ctrl-E, Ctrl-F = Cycle Foreground      ";
    LOCATE Xcoor2 + 5, Ycoor2 + 1, 1
    PRINT "Ctrl-J, Ctrl-K = Cycle Background      ";
    LOCATE Xcoor2 + 6, Ycoor2 + 9, 1
    PRINT "Press <esc> to Exit:";
    ' help box loop
    DO
        X$ = INKEY$
        IF LEN(X$) = 2 THEN ' extended key
            SELECT CASE ASC(RIGHT$(X$, 1))
                CASE 0 ' control-break
                    RETURN
                CASE 76, 143 ' center
                    Xcoor2 = 4
                    Ycoor2 = 6
                    EXIT DO
                CASE 75, 155 ' left/alt-left
                    IF Ycoor2 > 1 THEN
                        Ycoor2 = Ycoor2 - 1
                        EXIT DO
                    END IF
                CASE 77, 157 ' right/alt-right
                    IF Ycoor2 < 39 THEN
                        Ycoor2 = Ycoor2 + 1
                        EXIT DO
                    END IF
                CASE 72, 141, 152 ' up/ctrl-up/alt-up
                    IF Xcoor2 > 1 THEN
                        Xcoor2 = Xcoor2 - 1
                        EXIT DO
                    END IF
                CASE 80, 145, 160 ' down/ctrl-dn/alt-dn
                    IF Xcoor2 < Max.Row - 6 THEN
                        Xcoor2 = Xcoor2 + 1
                        EXIT DO
                    END IF
            END SELECT
        END IF
        IF LEN(X$) = 1 THEN
            SELECT CASE ASC(X$)
                CASE 1 ' control-a (up)
                    IF Xcoor2 > 1 THEN
                        Xcoor2 = Xcoor2 - 1
                        EXIT DO
                    END IF
                CASE 2 ' control-b (down)
                    IF Xcoor2 < Max.Row - 6 THEN
                        Xcoor2 = Xcoor2 + 1
                        EXIT DO
                    END IF
                CASE 3 ' control-c (left)
                    IF Ycoor2 > 1 THEN
                        Ycoor2 = Ycoor2 - 1
                        EXIT DO
                    END IF
                CASE 4 ' control-d (right)
                    IF Ycoor2 < 39 THEN
                        Ycoor2 = Ycoor2 + 1
                        EXIT DO
                    END IF
                CASE 5 ' control-e
                    IF HForeground1 = 15 THEN
                        HForeground1 = 0
                    ELSE
                        HForeground1 = HForeground1 + 1
                    END IF
                    EXIT DO
                CASE 6 ' control-f
                    IF HForeground2 = 15 THEN
                        HForeground2 = 0
                    ELSE
                        HForeground2 = HForeground2 + 1
                    END IF
                    EXIT DO
                CASE 10 ' control-j
                    IF HBackground1 = 7 THEN
                        HBackground1 = 0
                    ELSE
                        HBackground1 = HBackground1 + 1
                    END IF
                    EXIT DO
                CASE 11 ' control-k
                    IF HBackground2 = 7 THEN
                        HBackground2 = 0
                    ELSE
                        HBackground2 = HBackground2 + 1
                    END IF
                    EXIT DO
                CASE 27 ' escape
                    RETURN
            END SELECT
        END IF
    LOOP
LOOP
RETURN

' create edit box.
MakeBox:
' Y-coordinate of editing boxes.
box1 = Ycoor + 3
box2 = Ycoor + 15
' display editing box.
COLOR Foreground1, Background2
LOCATE Xcoor, Ycoor, 1
Var$ = " " + CHR$(201) + STRING$(1, 205) + "<esc>=Quit,?=Help" + STRING$(9, 205) + CHR$(187) + " "
PRINT Var$;
LOCATE Xcoor + 1, Ycoor, 1
Var1$ = Box1$ + SPACE$(8 - LEN(Box1$))
Var2$ = Box2$ + SPACE$(10 - LEN(Box2$))
Var$ = " " + CHR$(186) + " " + Var1$ + "Hex" + " " + Var2$ + "Dec " + CHR$(186) + " "
PRINT Var$;
LOCATE Xcoor + 2, Ycoor, 1
Var$ = " " + CHR$(200) + STRING$(1, 205) + "<tab>/<shift-tab>=switch" + STRING$(2, 205) + CHR$(188) + " "
PRINT Var$;

' display insert state
DisplayInsert:
COLOR Foreground1, Background2
LOCATE Xcoor, Ycoor + 24, 1
IF Ins THEN
    PRINT "<ins>";
ELSE
    PRINT STRING$(5, 205);
END IF
COLOR Foreground2, Background1
RETURN

' move to box 1 (left box).
SelectBox1:
Box2$ = Box$ ' store right box.
Box$ = Box1$ ' reset to left box.

' reset editing parameters.
Xcoor1 = Xcoor + 1
Ycoor1 = Ycoor + 3
Column3 = Ycoor1
LineLength = 8

' display left box.
COLOR Foreground2, Background1
LOCATE Xcoor1, Ycoor1, 1
PRINT SPACE$(8);
LOCATE Xcoor1, Ycoor1, 1
PRINT Box$;
Ycoor1 = Ycoor1 + LEN(Box$)
LOCATE Xcoor1, Ycoor1, 1
RETURN

' move to box 2 (right box).
SelectBox2:
Box1$ = Box$ ' store left box.
Box$ = Box2$ ' reset to right box.

' reset editing parameters.
Xcoor1 = Xcoor + 1
Ycoor1 = Ycoor + 15
Column3 = Ycoor1
LineLength = 10

' display right box.
COLOR Foreground2, Background1
LOCATE Xcoor1, Ycoor1, 1
PRINT SPACE$(10);
LOCATE Xcoor1, Ycoor1, 1
PRINT Box$;
Ycoor1 = Ycoor1 + LEN(Box$)
LOCATE Xcoor1, Ycoor1, 1
RETURN

' calculates value of current box,
'  displays result in calculated form in opposite box.
PrintBoxes:
IF CalcBox = 1 THEN ' is in hex box.
    ' strip leading zeroes for signed bit conversion.
    TempBox$ = Box$
    DO
        IF LEFT$(TempBox$, 1) = "0" THEN
            TempBox$ = MID$(TempBox$, 2)
        ELSE
            EXIT DO
        END IF
    LOOP
    Value# = VAL("&H" + TempBox$) ' retreive decimal value.
    IF Value# < 0# THEN ' check twos-complement from signed value.
        IF LEN(TempBox$) = 8 THEN ' 8000 0000 to FFFF FFFF
            Value# = Value# + 4294967296#
        ELSE
            IF LEN(TempBox$) = 4 THEN ' 8000 to FFFF
                Value# = Value# + 65536#
            END IF
        END IF
    END IF
    ' display decimal value.
    Box2$ = MID$(STR$(Value#), 2)
    COLOR Foreground2, Background1
    LOCATE Xcoor1, box2, 1
    PRINT SPACE$(10);
    LOCATE Xcoor1, box2, 1
    PRINT Box2$;
END IF
IF CalcBox = 2 THEN ' is in decimal box.
    Value# = VAL(Box$) ' retreive hex value.
    IF Value# >= 4294967296# THEN ' check overflow.
        COLOR Foreground2, Background1
        LOCATE Xcoor1, box1, 1
        Var$ = "overflow"
        PRINT Var$;
        Box1$ = "0"
    ELSE
        IF Value# > 2147483647# THEN ' force to twos-complement.
            Value# = Value# - 4294967296# ' 8000 0000 to FFFF FFFF
        END IF
        ' display hex value.
        Box1$ = HEX$(Value#)
        COLOR Foreground2, Background1
        LOCATE Xcoor1, box1, 1
        PRINT SPACE$(8);
        LOCATE Xcoor1, box1, 1
        PRINT Box1$;
    END IF
END IF
LOCATE Xcoor1, Ycoor1, 1
RETURN

Get.Config1:
' upper-left coordinate of editing box on screen.
Xcoor = 4
Ycoor = 6

' upper-left coordinate of help box on screen.
Xcoor2 = 4
Ycoor2 = 6

' reset insert mode.
Ins = -1

' reset colors of editing box
Background1 = 0 ' black
Background2 = 1 ' blue
Foreground1 = 14 ' yellow
Foreground2 = 15 ' white

' reset colors of help box
HBackground1 = 0 ' black
HBackground2 = 1 ' blue
HForeground1 = 14 ' yellow
HForeground2 = 15 ' white

Max.Row = 24
RETURN

' trap any error
Error.Routine:
ErrorData = ERR
COLOR 7, 0
CLS
COLOR 15, 0
PRINT "Hexcalc crashed!"
COLOR 14, 0
PRINT "Error: " + STR$(ErrorData)
COLOR 7, 0
END
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply