Weekly Qbasic and Qb64 Lesson Topics
March 28, 2024, 10:33:52 am
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News: Want to see a specific Tutorial? ASK!
 
  Home Help Search Arcade Links Staff List Login Register  

Calculator

Pages: [1]
  Print  
Author Topic: Calculator  (Read 229 times)
GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« on: March 26, 2012, 08:49:05 am »

This is a qb64 calculator program, originaly written by Dusty bear,
Code:
REM

DIM SHARED TxtPosition
DIM SHARED mx%, my%, mbl%, mbr%
DIM SHARED Shown AS SINGLE
DIM SHARED Sum AS SINGLE
DIM SHARED BttnX(4, 2) AS INTEGER
DIM SHARED BttnY(5, 2) AS INTEGER
DIM SHARED WnSize AS INTEGER
DIM SHARED txty AS INTEGER
DIM SHARED Action&
DIM SHARED Video&
CONST Lft = 1
CONST Rght = 2
txty = 23
SCREEN 12
COLOR _RGB(0, 0, 0), _RGB(200, 200, 200)
CLS
LOCATE 10, 10
PRINT "Select screen size 1,2 or 3: ?";
s$ = INPUT$(1)
sz = VAL(s$)

_DELAY .2 'Just to make it look like a lot is happening LOL

IF sz = 0 THEN
    sz = 2
END IF

Action& = _NEWIMAGE(260, 215, 32)

IF sz = 1 THEN
    Video& = _NEWIMAGE(260, 215, 32)
    WnSize = 1 ' for small windows mouse detect settings
END IF
IF sz = 2 THEN
    Video& = _NEWIMAGE(520, 430, 32)
    WnSize = 2 ' for midsize window mouse detect settings
END IF
IF sz = 3 THEN
    Video& = _NEWIMAGE(800, 600, 32)
    WnSize = 3 ' for large window mouse detect settings
END IF
ReadXY ' read the data for detection

SCREEN Video&

_SCREENMOVE _MIDDLE
_MOUSESHOW

_DEST Action&
COLOR _RGB(0, 0, 0), _RGB(200, 200, 200)
CLS


' Make the Calculater graphics

DrawCalculater
_PUTIMAGE , Action&, Video&,
_DELAY 1
ClckBttns

SLEEP
SYSTEM
'_____________________________________________


Smallsize:
DATA 22,65,76,121,132,179,190,233
DATA 51,75,82,104,111,135,142,165,171,195
Midsize:
DATA 43,134,155,245,266,356,380,468
DATA 102,150,164,210,224,270,284,330,344,392
Largesize:
DATA 67,202,240,374,412,547,584,719
DATA 144,208,229,292,313,375,395,459,480,544


'----------------------Read X , Y ----------------
SUB ReadXY
RESTORE
DIM x(54)
FOR xx = 1 TO 54 ' have to read all so we can read selected data
    READ x(xx)
NEXT xx

IF WnSize = 1 THEN
    RESTORE Smallsize ' select data to  read
END IF

IF WnSize = 2 THEN
    RESTORE Midsize
END IF

IF WnSize = 3 THEN
    RESTORE Largesize
END IF

FOR x = 1 TO 4
    READ BttnX(x, Lft)
    READ BttnX(x, Rght)
NEXT x
FOR x = 1 TO 5
    READ BttnY(x, Lft)
    READ BttnY(x, Rght)
NEXT x

END SUB
'___________________________________________

SUB ClckBttns
' -------- Box around color box -----------

txtpos = 220
DO
    '  _DEST Action&
    rrr = _MOUSEINPUT

    ' ____________Test Purposes______________
    'LOCATE 1, 1: PRINT _MOUSEX; _MOUSEY;
    ' _____________________________________

    ' --------- Row 1 --- SqrR ------------------------
    IF _MOUSEX > BttnX(1, Lft) AND _MOUSEX < BttnX(1, Rght) AND _MOUSEY > BttnY(1, Lft) AND _MOUSEY < BttnY(1, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            txtpos = 220: _PRINTSTRING (21, txty), "                          "

            Sum = Shown
            Shown = SQR(Sum)
            Shonum$ = RTRIM$(STR$(Shown))
            L = LEN(Shonum$)
            L = L * 8 - 8
            txtpos = 220 - L
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$

            Shownum$ = ""

        END IF

    END IF

    '----------- Row 1 --- Percent -----------------------
    IF _MOUSEX > BttnX(2, Lft) AND _MOUSEX < BttnX(2, Rght) AND BttnY(1, Lft) AND _MOUSEY < BttnY(1, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            txtpos = 220: _PRINTSTRING (21, txty), "                          "
            Answer$ = "PerCnt"
            Sum = Shown
            Shown = 0
            Shonum$ = ""
        END IF

    END IF

    '----------- Row 1 --- Remove last diget entered per mouse click
    IF _MOUSEX > BttnX(3, Lft) AND _MOUSEX < BttnX(3, Rght) AND _MOUSEY > BttnY(1, Lft) AND _MOUSEY < BttnY(1, Rght) THEN

        IF _MOUSEBUTTON(1) THEN
            L = LEN(Shonum$)
            Shonum$ = LEFT$(Shonum$, L - 1)
            Shownum = VAL(Shonum$)
            IF L > 0 THEN
                Shown = VAL(Shonum$): txtpos = txtpos + 8:
                _PUTIMAGE , Action&, Video&
                _PRINTSTRING (21, 22), "                          "
                _PRINTSTRING (txtpos, txty), Shonum$
            ELSE
                txtpos = 220: Shonum$ = "": _PRINTSTRING (21, txty), "                          "
            END IF
        END IF
    END IF
    ' -------------Row 1  --- Clears the view window and resets the VARS
    ' --- Clear
    IF _MOUSEX > BttnX(4, Lft) AND _MOUSEX < BttnX(4, Rght) AND _MOUSEY > BttnY(1, Lft) AND _MOUSEY < BttnY(1, Rght) THEN
        IF _MOUSEBUTTON(1) THEN Shown = 0: Sum = 0: Shonum$ = "": txtpos = 220: _PUTIMAGE , Action&, Video&: _PRINTSTRING (21, txty), "                          "
    END IF

    ' -----------  Row 2 ---- Number 7 -------------
    ' ---  '7'
    IF _MOUSEX > BttnX(1, Lft) AND _MOUSEX < BttnX(1, Rght) AND _MOUSEY > BttnY(2, Lft) AND _MOUSEY < BttnY(2, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(7))
            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$


        END IF
    END IF

    ' ------------ row 2 --- Number 8 -------------
    IF _MOUSEX > BttnX(2, Lft) AND _MOUSEX < BttnX(2, Rght) AND _MOUSEY > BttnY(2, Lft) AND _MOUSEY < BttnY(2, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(8))
            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ------------Row 2 --- Number 9 ----------
    IF _MOUSEX > BttnX(3, Lft) AND _MOUSEX < BttnX(3, Rght) AND _MOUSEY > BttnY(2, Lft) AND _MOUSEY < BttnY(2, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(9))
            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ------------- Row 2 ---Divide ------------
    IF _MOUSEX > BttnX(4, Lft) AND _MOUSEX < BttnX(4, Rght) AND _MOUSEY > BttnY(2, Lft) AND _MOUSEY < BttnY(2, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            _PUTIMAGE , Action&, Video&
            txtpos = 220: _PRINTSTRING (100, 23), "                "
            Answer$ = "Div"
            Sum = Shown
            Shown = 0
            Shonum$ = ""
        END IF
    END IF

    ' ------------- Row 3 ---Number 4 -------------------------
    IF _MOUSEX > BttnX(1, Lft) AND _MOUSEX < BttnX(1, Rght) AND _MOUSEY > BttnY(3, Lft) AND _MOUSEY < BttnY(3, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(4))
            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ----------- Row 3 ----- Number 5 ------------------------
    IF _MOUSEX > BttnX(2, Lft) AND _MOUSEX < BttnX(2, Rght) AND _MOUSEY > BttnY(3, Lft) AND _MOUSEY < BttnY(3, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(5))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ----------- Row 3 ----- Number 6 --------------------
    IF _MOUSEX > BttnX(3, Lft) AND _MOUSEX < BttnX(3, Rght) AND _MOUSEY > BttnY(3, Lft) AND _MOUSEY < BttnY(3, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(6))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$

        END IF
    END IF
    ' ------------- Row 3 ------- Multiply  ----------------------
    ' ---  X
    IF _MOUSEX > BttnX(4, Lft) AND _MOUSEX < BttnX(4, Rght) AND _MOUSEY > BttnY(3, Lft) AND _MOUSEY < BttnY(3, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            _PUTIMAGE , Action&, Video&
            txtpos = 220: _PRINTSTRING (21, 23), "                          "
            Answer$ = "Mult"
            Sum = Shown
            Shown = 0
            Shonum$ = ""

        END IF
    END IF

    ' ------------- Row 4 ----- Number 1 -----------------------
    IF _MOUSEX > BttnX(1, Lft) AND _MOUSEX < BttnX(1, Rght) AND _MOUSEY > BttnY(4, Lft) AND _MOUSEY < BttnY(4, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(1))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' -------------Row 4 ------ Number 2 -----------------------
    IF _MOUSEX > BttnX(2, Lft) AND _MOUSEX < BttnX(2, Rght) AND _MOUSEY > BttnY(4, Lft) AND _MOUSEY < BttnY(4, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(2))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ------------Row 4 -------- Number 3 -----------------
    IF _MOUSEX > BttnX(3, Lft) AND _MOUSEX < BttnX(3, Rght) AND _MOUSEY > BttnY(4, Lft) AND _MOUSEY < BttnY(4, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shonum$) < 16 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(3))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' ---------- Row 4 ------------- Subtract -----------------------------
    IF _MOUSEX > BttnX(4, Lft) AND _MOUSEX < BttnX(4, Rght) AND _MOUSEY > BttnY(4, Lft) AND _MOUSEY < BttnY(4, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            _PUTIMAGE , Action&, Video&
            txtpos = 220: _PRINTSTRING (21, txty), "                          "
            Answer$ = "Sub"
            Sum = Shown
            Shown = 0
            Shonum$ = ""

        END IF
    END IF
    ' --------- Row 5 ------ Number 0 ----------------------------
    IF _MOUSEX > BttnX(1, Lft) AND _MOUSEX < BttnX(1, Rght) AND _MOUSEY > BttnY(5, Lft) AND _MOUSEY < BttnY(5, Rght) THEN
        IF _MOUSEBUTTON(1) AND LEN(Shownum$) < 12 THEN
            Shonum$ = Shonum$ + LTRIM$(STR$(0))

            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
            '  _PUTIMAGE , Action&, Video&
        END IF
    END IF

    ' -------- Row 5 ----------- Decimal point ---------
    IF _MOUSEX > BttnX(2, Lft) AND _MOUSEX < BttnX(2, Rght) AND _MOUSEY > BttnY(5, Lft) AND _MOUSEY < BttnY(5, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            Shonum$ = Shonum$ + LTRIM$(".")
            L = LEN(Shonum$)
            L = L * 8 - 16
            txtpos = 220 - L
            txtpos = txtpos - 8
            Shown = VAL(Shonum$)
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (txtpos, txty), Shonum$
        END IF
    END IF

    ' --------Row 5 ------------ Equals works ------------------------
    IF _MOUSEX > BttnX(3, Lft) AND _MOUSEX < BttnX(3, Rght) AND _MOUSEY > BttnY(5, Lft) AND _MOUSEY < BttnY(5, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            _PUTIMAGE , Action&, Video&
            _PRINTSTRING (21, txty), "                          "

            IF Answer$ = "PerCnt" THEN
                Sum = Sum / 100
                Shown = Sum * Shown
            END IF
            IF Answer$ = "Sub" THEN
                Shown = Sum - Shown
            END IF
            IF Answer$ = "add" THEN
                Shown = Shown + Sum
            END IF
            IF Answer$ = "Mult" THEN
                Shown = Shown * Sum
            END IF
            IF Answer$ = "Div" THEN
                Shown = Sum / Shown
            END IF
            IF Answer$ = "Mod" THEN
                Shown = Sum \ Shown
            END IF


            Shonum$ = RTRIM$(STR$(Shown))
            L = LEN(Shonum$)
            L = L * 8 - 8
            txtpos = 220 - L
            _PRINTSTRING (txtpos, txty), Shonum$
            Shownum$ = ""
        END IF

    END IF

    '----------- Row 5 -------------------- add works--------------------
    IF _MOUSEX > BttnX(4, Lft) AND _MOUSEX < BttnX(4, Rght) AND _MOUSEY > BttnY(5, Lft) AND _MOUSEY < BttnY(5, Rght) THEN
        IF _MOUSEBUTTON(1) THEN
            txtpos = 220: _PRINTSTRING (21, txty), "                          "
            Answer$ = "add"
            Sum = Shown
            Shown = 0
            Shonum$ = ""
        END IF
    END IF
    ' ------------- End Button Routines -----------------------------
    _PUTIMAGE , Action&, Video&,



    mbl% = _MOUSEBUTTON(1)
    IF mbl% = -1 THEN MousePoll



LOOP

END SUB


'____________________________________________________________
'------------------------------------------------------------
SUB DrawCalculater

'---- Size of calculater
LX = 0
RX = 255
TY = 0
BY = 260
'---- Outline of calculater
'LINE (LX, TY)-(RX, BY), _RGB(70, 70, 70), B
'LINE (LX, TY)-(LX, BY), _RGB(255, 255, 255)
'LINE (LX, TY)-(RX, TY), _RGB(255, 255, 255)

'---- Display Box
LINE (LX + 20, TY + 20)-(RX - 20, TY + 40), _RGB(70, 70, 70), B
LINE (LX + 20, TY + 40)-(RX - 20, TY + 40), _RGB(250, 250, 250)
LINE (RX - 20, TY + 20)-(RX - 20, TY + 40), _RGB(250, 250, 250)


'Draw Buttons
FOR TY = 1 TO 130 STEP 30
    FOR LX = 1 TO 169 STEP 56
        LINE (LX + 20, TY + 50)-(LX + 65, TY + 74), _RGB(70, 70, 70), B
        LINE (LX + 20, TY + 50)-(LX + 20, TY + 74), _RGB(250, 250, 250)
        LINE (LX + 20, TY + 50)-(LX + 65, TY + 50), _RGB(250, 250, 250)
    NEXT LX
NEXT TY

' ----------- Put Lables on buttons
' --- Row 1
_PRINTSTRING (28, 55), "SqrR": _PRINTSTRING (97, 55), "%"
_PRINTSTRING (145, 55), CHR$(0) + CHR$(26): _PRINTSTRING (192, 55), "Clear"

' --- Row 2
_PRINTSTRING (40, 87), "7": _PRINTSTRING (96, 87), "8"
_PRINTSTRING (150, 88), "9": _PRINTSTRING (200, 87), CHR$(0) + CHR$(246)
' --- Row 3
_PRINTSTRING (40, 117), "4": _PRINTSTRING (96, 117), "5"
_PRINTSTRING (150, 117), "6": _PRINTSTRING (208, 117), "x"
' --- Row 4
_PRINTSTRING (40, 146), "1": _PRINTSTRING (96, 146), "2"
_PRINTSTRING (150, 146), "3": _PRINTSTRING (208, 146), "-"
' --- Row 5
_PRINTSTRING (40, 176), "0": _PRINTSTRING (96, 176), "."
_PRINTSTRING (150, 176), "=": _PRINTSTRING (208, 176), "+"

END SUB

'------------------- MousePoll ---------------

SUB MousePoll ()
_DELAY .3
DO WHILE _MOUSEINPUT

    mbl% = _MOUSEBUTTON(1): mbr% = _MOUSEBUTTON(2) ': mx% = _MOUSEX: my% = _MOUSEY:
LOOP
END SUB
'--------------------------------------------
 
Pretty neat!
Report Spam   Logged

Share on Facebook Share on Twitter


Pages: [1]
  Print  
 
Jump to:  

Powered by EzPortal
Bookmark this site! | Upgrade This Forum
SMF For Free - Create your own Forum


Powered by SMF | SMF © 2016, Simple Machines
Privacy Policy