Author Topic: Sample Of a Quitbox (Read 8939 times)

eoredson · « **on:** July 25, 2017, 08:52:37 pm »

I am working on a project (can't tell you what it is yet) and have decided to draw my own boxes (MessageBox, InputBox, etc.)

So, here is a sample of a QuitBox:

Code: QB64: [Select]

REM Sample of QuitBox.
 
' declare screen save arrays
DIM SHARED TempArrayY(1 TO 2000) AS INTEGER
DIM SHARED TempArrayZ(1 TO 2000) AS INTEGER
 
' declare box coordinates
DIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER
 
' declare mouse variables
DIM SHARED MouseX AS INTEGER, MouseY AS INTEGER
DIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGER
DIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGER
DIM SHARED MousePressed AS INTEGER
 
' declare box settings
CONST QuitBoxText$ = "Quit. Are you sure?"
DIM SHARED QuitBoxBorderColor AS INTEGER
DIM SHARED QuitBoxTitleColor AS INTEGER
DIM SHARED QuitBoxTextColor AS INTEGER
DIM SHARED QuitBoxButton1Color AS INTEGER
DIM SHARED QuitBoxButton2Color AS INTEGER
DIM SHARED QuitBoxBackGround AS INTEGER
DIM SHARED QuitBoxButtonBackGround AS INTEGER
 
' declare ascii variables
DIM SHARED Hline AS INTEGER, Vline AS INTEGER
DIM SHARED ULcorner AS INTEGER, URcorner AS INTEGER
DIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER
 
' declare color constants
CONST Black = 0
CONST Blue = 1
CONST Green = 2
CONST Cyan = 3
CONST Red = 4
CONST Magenta = 5
CONST Brown = 6
CONST White = 7
CONST Gray = 8
CONST LightBlue = 9
CONST LightGreen = 10
CONST LightCyan = 11
CONST LightRed = 12
CONST LightMagenta = 13
CONST Yellow = 14
CONST HighWhite = 15
 
' set box colors
QuitBoxBorderColor = Yellow
QuitBoxTitleColor = HighWhite
QuitBoxTextColor = HighWhite
QuitBoxButton1Color = HighWhite
QuitBoxButton2Color = White
QuitBoxBackGround = Blue
QuitBoxButtonBackGround = Black
 
' set ascii characters
Hline = 205
Vline = 186
ULcorner = 201
URcorner = 187
LLcorner = 200
LRcorner = 188
 
' declare box coordinates.
Xcoor3 = 10
Ycoor3 = 10
 
' start input loop
CLS
PRINT "Quitbox:"
DO
    COLOR Yellow, Black
    PRINT "Enter HELP or QUIT or TEST";
    COLOR HighWhite, Black
    INPUT X$
    X$ = UCASE$(X$)
    IF X$ = "QUIT" THEN END
    IF X$ = "HELP" THEN
        COLOR HighWhite, Black
        PRINT "Mouse: Click on <OK> or <Cancel>"
        PRINT "       Click on title, drag box."
        PRINT "Keyboard: Enter for OK/Cancel, Escape to cancel,"
        PRINT "          Cursor left/right, tab/shift-tab to select button,"
        PRINT "          Control-<cursor> to move box."
        PRINT "          Alt-<cursor> to move box 4 chars."
        PRINT "Colors: Ctrl-A Cycle box background, Ctrl-B Cycle button background,"
        PRINT "        Ctrl-D Cycle border, Ctrl-E Cycle title, Ctrl-F Cycle text,"
        PRINT "        Ctrl-G Cycle OK button, Ctrl-H Cycle Cancel button."
    END IF
    IF X$ = "TEST" THEN
        X = QuitBox
        IF X THEN
            PRINT "Entered OK"
        ELSE
            PRINT "Entered Cancel"
        END IF
    END IF
LOOP
END
 
FUNCTION QuitBox
' store screen area.
CurrentX = CSRLIN
CurrentY = POS(0)
CALL SaveScreen
 
' draw box
BoxButton = 1
GOSUB DrawQuitBox
 
' wait for keypress or mouse
_KEYCLEAR
DO
    _LIMIT 30
    X$ = INKEY$
    IF LEN(X$) THEN
        SELECT CASE LEN(X$)
            CASE 1
                SELECT CASE UCASE$(X$)
                    CASE "O"
                        BoxButton = 1
                        EXIT DO
                    CASE "C"
                        BoxButton = 2
                        EXIT DO
                    CASE CHR$(13)
                        EXIT DO
                    CASE CHR$(27)
                        BoxButton = 2
                        EXIT DO
                    CASE CHR$(9) ' tab
                        IF BoxButton = 1 THEN
                            BoxButton = 2
                        ELSE
                            BoxButton = 1
                        END IF
                        GOSUB DrawQuitBoxButtons
                    CASE CHR$(1) ' ctrl-a
                        QuitBoxBackGround = QuitBoxBackGround + 1
                        IF QuitBoxBackGround = 8 THEN
                            QuitBoxBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(2) ' ctrl-b
                        QuitBoxButtonBackGround = QuitBoxButtonBackGround + 1
                        IF QuitBoxButtonBackGround = 8 THEN
                            QuitBoxButtonBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(4) ' ctrl-d
                        QuitBoxBorderColor = QuitBoxBorderColor + 1
                        IF QuitBoxBorderColor = 16 THEN
                            QuitBoxBorderColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(5) ' ctrl-e
                        QuitBoxTitleColor = QuitBoxTitleColor + 1
                        IF QuitBoxTitleColor = 16 THEN
                            QuitBoxTitleColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(6) ' ctrl-f
                        QuitBoxTextColor = QuitBoxTextColor + 1
                        IF QuitBoxTextColor = 16 THEN
                            QuitBoxTextColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(7) ' ctrl-g
                        QuitBoxButton1Color = QuitBoxButton1Color + 1
                        IF QuitBoxButton1Color = 16 THEN
                            QuitBoxButton1Color = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(8) ' ctrl-h
                        QuitBoxButton2Color = QuitBoxButton2Color + 1
                        IF QuitBoxButton2Color = 16 THEN
                            QuitBoxButton2Color = 0
                        END IF
                        GOSUB DrawQuitBox
                END SELECT
            CASE 2
                SELECT CASE ASC(RIGHT$(X$, 1))
                    CASE 75, 15 ' left/shift-tab
                        IF BoxButton = 2 THEN
                            BoxButton = 1
                        ELSE
                            BoxButton = 2
                        END IF
                        GOSUB DrawQuitBoxButtons
                    CASE 77 ' right
                        IF BoxButton = 1 THEN
                            BoxButton = 2
                        ELSE
                            BoxButton = 1
                        END IF
                        GOSUB DrawQuitBoxButtons
                    CASE 141 ' ctrl-up
                        IF Xcoor3 > 1 THEN
                            Xcoor3 = Xcoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 145 ' ctrl-down
                        IF Xcoor3 < 18 THEN
                            Xcoor3 = Xcoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 115 ' ctrl-left
                        IF Ycoor3 > 1 THEN
                            Ycoor3 = Ycoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 116 ' ctrl-right
                        IF Ycoor3 < 48 THEN
                            Ycoor3 = Ycoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 152 ' alt-up
                        IF Xcoor3 > 4 THEN
                            Xcoor3 = Xcoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 > 1 THEN
                                Xcoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 160 ' alt-dn
                        IF Xcoor3 < 14 THEN
                            Xcoor3 = Xcoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 < 18 THEN
                                Xcoor3 = 18
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 155 ' alt-left
                        IF Ycoor3 > 4 THEN
                            Ycoor3 = Ycoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 > 1 THEN
                                Ycoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 157 ' alt-right
                        IF Ycoor3 < 44 THEN
                            Ycoor3 = Ycoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 < 48 THEN
                                Ycoor3 = 48
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                END SELECT
        END SELECT
    END IF
    X = MouseDriver
    IF MouseButton1 THEN
        ' hover over titlebar
        IF MouseX = Xcoor3 THEN
            IF MouseY >= Ycoor3 AND MouseY <= Ycoor3 + 31 THEN
                ' store mouse XY during click
                MouseTempX = MouseX
                MouseTempY = MouseY
                DO
                    X = MouseDriver
                    IF MouseX OR MouseY THEN ' drag
                        MoveBox = 0
                        ' difference in mouse X
                        IF MouseX <> MouseTempX THEN
                            IF MouseX >= 1 AND MouseX <= 18 THEN
                                Xcoor3 = MouseX
                                MouseTempX = MouseX
                                MoveBox = -1
                            END IF
                        END IF
                        ' difference in mouse Y
                        IF MouseY <> MouseTempY THEN
                            MoveY = Ycoor3 + (MouseY - MouseTempY)
                            IF MoveY >= 1 AND MoveY <= 48 THEN
                                Ycoor3 = MoveY
                                MouseTempY = MouseY
                                MoveBox = -1
                            END IF
                        END IF
                        ' move box
                        IF MoveBox THEN
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                    END IF
                LOOP UNTIL MouseButton1 = 0
            END IF
        ELSE
            IF MouseX = Xcoor3 + 4 THEN ' click on button
                IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                    BoxButton = 1
                    EXIT DO
                END IF
                IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                    BoxButton = 2
                    EXIT DO
                END IF
            END IF
        END IF
    ELSE
        IF MouseX = Xcoor3 + 4 THEN ' mouseover button
            IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                IF BoxButton = 2 THEN
                    BoxButton = 1
                    GOSUB DrawQuitBoxButtons
                END IF
            END IF
            IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                IF BoxButton = 1 THEN
                    BoxButton = 2
                    GOSUB DrawQuitBoxButtons
                END IF
            END IF
        END IF
    END IF
LOOP
_DELAY .2
_KEYCLEAR
_DELAY .2
 
' restore screen area.
CALL RestoreScreen
COLOR White, Black
LOCATE CurrentX, CurrentY, 1
IF BoxButton = 1 THEN
    QuitBox = -1
ELSE
    QuitBox = 0
END IF
EXIT FUNCTION
 
' draw box
DrawQuitBox:
COLOR QuitBoxBorderColor, QuitBoxBackGround
LOCATE Xcoor3, Ycoor3, 0
PRINT CHR$(ULcorner) + STRING$(30, Hline) + CHR$(URcorner);
FOR RowX1 = Xcoor3 + 1 TO Xcoor3 + 6
    LOCATE RowX1, Ycoor3, 0
    PRINT CHR$(Vline) + SPACE$(30) + CHR$(Vline);
NEXT
LOCATE Xcoor3 + 7, Ycoor3, 0
PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner);
COLOR QuitBoxTitleColor
LOCATE Xcoor3, Ycoor3 + 12, 0
PRINT " Quit ";
 
' display quit text
COLOR QuitBoxTextColor
LOCATE Xcoor3 + 2, Ycoor3 + 2, 0
PRINT QuitBoxText$
GOSUB DrawQuitBoxButtons
RETURN
 
' display buttuns
DrawQuitBoxButtons:
IF BoxButton = 1 THEN
    LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<OK>";
    LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
    COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
    PRINT "<Cancel>";
ELSE
    LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
    COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
    PRINT "<OK>";
    LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<Cancel>";
END IF
COLOR White, Black
RETURN
END FUNCTION
 
' screen save
SUB SaveScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        TempZ1 = SCREEN(Var1, Var2) ' screen char
        TempZ2 = SCREEN(Var1, Var2, 1) ' char color
        TempArrayY((Var1 - 1) * 80 + Var2) = TempZ1
        TempArrayZ((Var1 - 1) * 80 + Var2) = TempZ2
    NEXT
NEXT
END SUB
 
' screen restore
SUB RestoreScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        VarB = INT(TempArrayZ((Var1 - 1) * 80 + Var2) / 16)
        VarF = TempArrayZ((Var1 - 1) * 80 + Var2) MOD 16
        TempZ1 = TempArrayY((Var1 - 1) * 80 + Var2)
        LOCATE Var1, Var2, 1
        COLOR VarF, VarB
        _CONTROLCHR OFF
        PRINT CHR$(TempZ1);
        _CONTROLCHR ON
    NEXT
NEXT
END SUB
 
REM processes mouse activity.
FUNCTION MouseDriver
STATIC X1 AS INTEGER, Y1 AS INTEGER ' store old values
MouseX = 0: MouseY = 0
IF _MOUSEINPUT THEN
    X = CINT(_MOUSEX): Y = CINT(_MOUSEY) ' X,Y return single
    IF X <> X1 OR Y <> Y1 THEN
        X1 = X: Y1 = Y
        MouseX = Y: MouseY = X ' X,Y are reversed
        WHILE _MOUSEINPUT: WEND ' empty buffer
        MousePressed = -1
    END IF
    MouseButton1 = _MOUSEBUTTON(1)
    IF MouseButton1 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton2 = _MOUSEBUTTON(2)
    IF MouseButton2 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton3 = _MOUSEBUTTON(3)
    IF MouseButton3 THEN
        MousePressed = -1
    END IF
    MouseWheel = _MOUSEWHEEL
END IF
END FUNCTION
 

Tell me what you think.

Thanks, Erik.

Ashish · « **Reply #1 on:** July 25, 2017, 11:51:51 pm »

Nice Work! I like it! :D

STxAxTIC · « **Reply #2 on:** July 26, 2017, 09:01:03 am »

Howdy,

I like it. I was pleasantly surprised to type HELP and see that the mouse was enabled - that's not always obvious in screen 0 programs. I've always liked the screen 0 gui because it has that automatic "snap to grid" feeling about it.

If you hadn't noticed yet, it looks like one cannot drag the window all the way to the right; there is a one-character-wide gap left over.

Cant wait to see what you're using this for!

eoredson · « **Reply #3 on:** July 27, 2017, 12:03:38 am »

Ok, here is the QuitBox with:

Scrolls to right edge,
Allows button overrides,
Adds and centers title text.

Code: QB64: [Select]

REM Sample of a QuitBox. v1.1a PD 2017. -ejo
 
' declare screen save arrays
DIM SHARED TempArrayY(1 TO 2000) AS INTEGER
DIM SHARED TempArrayZ(1 TO 2000) AS INTEGER
 
' declare box coordinates
DIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER
 
' declare mouse variables
DIM SHARED MouseX AS INTEGER, MouseY AS INTEGER
DIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGER
DIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGER
DIM SHARED MousePressed AS INTEGER
 
' declare box settings
CONST QuitBoxTitle$ = " Quit "
CONST QuitBoxText$ = "Quit. Are you sure?"
 
' declare box colors
DIM SHARED QuitBoxBorderColor AS INTEGER
DIM SHARED QuitBoxTitleColor AS INTEGER
DIM SHARED QuitBoxTextColor AS INTEGER
DIM SHARED QuitBoxButton1Color AS INTEGER
DIM SHARED QuitBoxButton2Color AS INTEGER
DIM SHARED QuitBoxBackGround AS INTEGER
DIM SHARED QuitBoxButtonBackGround AS INTEGER
 
' declare ascii variables
DIM SHARED Hline AS INTEGER, Vline AS INTEGER
DIM SHARED ULcorner AS INTEGER, URcorner AS INTEGER
DIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER
 
' declare color constants
CONST Black = 0
CONST Blue = 1
CONST Green = 2
CONST Cyan = 3
CONST Red = 4
CONST Magenta = 5
CONST Brown = 6
CONST White = 7
CONST Gray = 8
CONST LightBlue = 9
CONST LightGreen = 10
CONST LightCyan = 11
CONST LightRed = 12
CONST LightMagenta = 13
CONST Yellow = 14
CONST HighWhite = 15
 
' set box colors
QuitBoxBorderColor = Yellow
QuitBoxTitleColor = HighWhite
QuitBoxTextColor = HighWhite
QuitBoxButton1Color = HighWhite
QuitBoxButton2Color = White
QuitBoxBackGround = Blue
QuitBoxButtonBackGround = Black
 
' set ascii characters
Hline = 205
Vline = 186
ULcorner = 201
URcorner = 187
LLcorner = 200
LRcorner = 188
 
' declare box coordinates.
Xcoor3 = 10
Ycoor3 = 10
 
' set box button constants
CONST OKcancel = 1
CONST OK = 2
CONST cancel = 3
 
' start input loop
CLS
PRINT "Quitbox:"
DO
    COLOR Yellow, Black
    PRINT "Enter HELP or QUIT or TEST";
    COLOR HighWhite, Black
    INPUT X$
    X$ = UCASE$(X$)
    IF X$ = "QUIT" THEN END
    IF X$ = "HELP" THEN
        COLOR HighWhite, Black
        PRINT "Mouse: Click on <OK> or <Cancel>"
        PRINT "       Click on title, drag box."
        PRINT "Keyboard: Enter for OK/Cancel, Escape to cancel,"
        PRINT "          Cursor left/right, tab/shift-tab to select button,"
        PRINT "          Control-<cursor> to move box."
        PRINT "          Alt-<cursor> to move box 4 chars."
        PRINT "Colors: Ctrl-A Cycle box background, Ctrl-B Cycle button background,"
        PRINT "        Ctrl-D Cycle border, Ctrl-E Cycle title, Ctrl-F Cycle text,"
        PRINT "        Ctrl-G Cycle OK button, Ctrl-H Cycle Cancel button."
    END IF
    IF X$ = "TEST" THEN
        X = QuitBox(OKcancel)
        IF X THEN
            PRINT "Entered OK"
        ELSE
            PRINT "Entered Cancel"
        END IF
    END IF
LOOP
END
 
' Input: Var
'    1 = both buttons, 2 = ok, 3 = cancel
FUNCTION QuitBox (Var)
' store screen area.
CurrentX = CSRLIN
CurrentY = POS(0)
CALL SaveScreen
 
' draw box
IF Var = 1 OR Var = 2 THEN
    BoxButton = 1
ELSE
    BoxButton = 2
END IF
GOSUB DrawQuitBox
 
' wait for keypress or mouse
_KEYCLEAR
DO
    _LIMIT 30
    X$ = INKEY$
    IF LEN(X$) THEN
        SELECT CASE LEN(X$)
            CASE 1
                SELECT CASE UCASE$(X$)
                    CASE "O"
                        IF Var = 1 OR Var = 2 THEN
                            BoxButton = 1
                            EXIT DO
                        END IF
                    CASE "C"
                        IF Var = 1 OR Var = 3 THEN
                            BoxButton = 2
                            EXIT DO
                        END IF
                    CASE CHR$(13)
                        EXIT DO
                    CASE CHR$(27)
                        BoxButton = 2
                        EXIT DO
                    CASE CHR$(9) ' tab
                        IF BoxButton = 1 THEN
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE CHR$(1) ' ctrl-a
                        QuitBoxBackGround = QuitBoxBackGround + 1
                        IF QuitBoxBackGround = 8 THEN
                            QuitBoxBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(2) ' ctrl-b
                        QuitBoxButtonBackGround = QuitBoxButtonBackGround + 1
                        IF QuitBoxButtonBackGround = 8 THEN
                            QuitBoxButtonBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(4) ' ctrl-d
                        QuitBoxBorderColor = QuitBoxBorderColor + 1
                        IF QuitBoxBorderColor = 16 THEN
                            QuitBoxBorderColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(5) ' ctrl-e
                        QuitBoxTitleColor = QuitBoxTitleColor + 1
                        IF QuitBoxTitleColor = 16 THEN
                            QuitBoxTitleColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(6) ' ctrl-f
                        QuitBoxTextColor = QuitBoxTextColor + 1
                        IF QuitBoxTextColor = 16 THEN
                            QuitBoxTextColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(7) ' ctrl-g
                        QuitBoxButton1Color = QuitBoxButton1Color + 1
                        IF QuitBoxButton1Color = 16 THEN
                            QuitBoxButton1Color = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(8) ' ctrl-h
                        QuitBoxButton2Color = QuitBoxButton2Color + 1
                        IF QuitBoxButton2Color = 16 THEN
                            QuitBoxButton2Color = 0
                        END IF
                        GOSUB DrawQuitBox
                END SELECT
            CASE 2
                SELECT CASE ASC(RIGHT$(X$, 1))
                    CASE 75, 15 ' left/shift-tab
                        IF BoxButton = 2 THEN
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 77 ' right
                        IF BoxButton = 1 THEN
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 141 ' ctrl-up
                        IF Xcoor3 > 1 THEN
                            Xcoor3 = Xcoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 145 ' ctrl-down
                        IF Xcoor3 < 18 THEN
                            Xcoor3 = Xcoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 115 ' ctrl-left
                        IF Ycoor3 > 1 THEN
                            Ycoor3 = Ycoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 116 ' ctrl-right
                        IF Ycoor3 < 49 THEN
                            Ycoor3 = Ycoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 152 ' alt-up
                        IF Xcoor3 > 4 THEN
                            Xcoor3 = Xcoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 > 1 THEN
                                Xcoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 160 ' alt-dn
                        IF Xcoor3 < 14 THEN
                            Xcoor3 = Xcoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 < 18 THEN
                                Xcoor3 = 18
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 155 ' alt-left
                        IF Ycoor3 > 4 THEN
                            Ycoor3 = Ycoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 > 1 THEN
                                Ycoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 157 ' alt-right
                        IF Ycoor3 < 45 THEN
                            Ycoor3 = Ycoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 < 49 THEN
                                Ycoor3 = 49
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                END SELECT
        END SELECT
    END IF
    X = MouseDriver
    IF MouseButton1 THEN
        ' hover over titlebar
        IF MouseX = Xcoor3 THEN
            IF MouseY >= Ycoor3 AND MouseY <= Ycoor3 + 31 THEN
                ' store mouse XY during click
                MouseTempX = MouseX
                MouseTempY = MouseY
                DO
                    X = MouseDriver
                    IF MouseX OR MouseY THEN ' drag
                        MoveBox = 0
                        ' difference in mouse X
                        IF MouseX <> MouseTempX THEN
                            IF MouseX >= 1 AND MouseX <= 18 THEN
                                Xcoor3 = MouseX
                                MouseTempX = MouseX
                                MoveBox = -1
                            END IF
                        END IF
                        ' difference in mouse Y
                        IF MouseY <> MouseTempY THEN
                            MoveY = Ycoor3 + (MouseY - MouseTempY)
                            IF MoveY >= 1 AND MoveY <= 49 THEN
                                Ycoor3 = MoveY
                                MouseTempY = MouseY
                                MoveBox = -1
                            END IF
                        END IF
                        ' move box
                        IF MoveBox THEN
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                    END IF
                LOOP UNTIL MouseButton1 = 0
            END IF
        ELSE
            IF MouseX = Xcoor3 + 4 THEN ' click on button
                IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                    IF Var = 1 OR Var = 2 THEN
                        BoxButton = 1
                        EXIT DO
                    END IF
                END IF
                IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                    IF Var = 1 OR Var = 3 THEN
                        BoxButton = 2
                        EXIT DO
                    END IF
                END IF
            END IF
        END IF
    ELSE
        IF MouseX = Xcoor3 + 4 THEN ' mouseover button
            IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                IF BoxButton = 2 THEN
                    IF Var = 1 THEN
                        BoxButton = 1
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
            IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                IF BoxButton = 1 THEN
                    IF Var = 1 THEN
                        BoxButton = 2
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
        END IF
    END IF
LOOP
_DELAY .2
_KEYCLEAR
_DELAY .2
 
' restore screen area.
CALL RestoreScreen
COLOR White, Black
LOCATE CurrentX, CurrentY, 1
IF BoxButton = 1 THEN
    QuitBox = -1
ELSE
    QuitBox = 0
END IF
EXIT FUNCTION
 
' draw box
DrawQuitBox:
COLOR QuitBoxBorderColor, QuitBoxBackGround
LOCATE Xcoor3, Ycoor3, 0
PRINT CHR$(ULcorner) + STRING$(30, Hline) + CHR$(URcorner);
FOR RowX1 = Xcoor3 + 1 TO Xcoor3 + 6
    LOCATE RowX1, Ycoor3, 0
    PRINT CHR$(Vline) + SPACE$(30) + CHR$(Vline);
NEXT
LOCATE Xcoor3 + 7, Ycoor3, 0
PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner);
 
' display box title
COLOR QuitBoxTitleColor
XC = 16 - LEN(QuitBoxTitle$) / 2 ' center of titlebar
LOCATE Xcoor3, Ycoor3 + XC, 0
PRINT QuitBoxTitle$;
 
' display quit text
COLOR QuitBoxTextColor
LOCATE Xcoor3 + 2, Ycoor3 + 2, 0
PRINT QuitBoxText$
GOSUB DrawQuitBoxButtons
RETURN
 
' display buttuns
DrawQuitBoxButtons:
IF BoxButton = 1 THEN
    LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<OK>";
    IF Var = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<Cancel>";
    END IF
ELSE
    LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<Cancel>";
    IF Var = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<OK>";
    END IF
END IF
COLOR White, Black
RETURN
END FUNCTION
 
' screen save
SUB SaveScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        TempZ1 = SCREEN(Var1, Var2) ' screen char
        TempZ2 = SCREEN(Var1, Var2, 1) ' char color
        TempArrayY((Var1 - 1) * 80 + Var2) = TempZ1
        TempArrayZ((Var1 - 1) * 80 + Var2) = TempZ2
    NEXT
NEXT
END SUB
 
' screen restore
SUB RestoreScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        VarB = INT(TempArrayZ((Var1 - 1) * 80 + Var2) / 16)
        VarF = TempArrayZ((Var1 - 1) * 80 + Var2) MOD 16
        TempZ1 = TempArrayY((Var1 - 1) * 80 + Var2)
        LOCATE Var1, Var2, 1
        COLOR VarF, VarB
        _CONTROLCHR OFF
        PRINT CHR$(TempZ1);
        _CONTROLCHR ON
    NEXT
NEXT
END SUB
 
REM processes mouse activity.
FUNCTION MouseDriver
STATIC X1 AS INTEGER, Y1 AS INTEGER ' store old values
MouseX = 0: MouseY = 0
IF _MOUSEINPUT THEN
    X = CINT(_MOUSEX): Y = CINT(_MOUSEY) ' X,Y return single
    IF X <> X1 OR Y <> Y1 THEN
        X1 = X: Y1 = Y
        MouseX = Y: MouseY = X ' X,Y are reversed
        WHILE _MOUSEINPUT: WEND ' empty buffer
        MousePressed = -1
    END IF
    MouseButton1 = _MOUSEBUTTON(1)
    IF MouseButton1 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton2 = _MOUSEBUTTON(2)
    IF MouseButton2 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton3 = _MOUSEBUTTON(3)
    IF MouseButton3 THEN
        MousePressed = -1
    END IF
    MouseWheel = _MOUSEWHEEL
END IF
END FUNCTION
 

FellippeHeitor · « **Reply #4 on:** July 27, 2017, 12:08:26 am »

Hi, eoredson,

Good job on this one.

Minor bug report: Clicked ok, didn't move mouse, then entered TEST again. Ok was automatically clicked just because the mouse cursor was hovering it.

Do you plan on modularizing it to be used as a library, detached from your secret project?

eoredson · « **Reply #5 on:** July 27, 2017, 12:27:30 am »

Hi,

Mouse needs to hover over <OK> to click it as far as I can tell.

This QuitBox is going to be internal to my project.

Erik.

Hint: I am going to write my own InputBox as well..

FellippeHeitor · « **Reply #6 on:** July 27, 2017, 12:30:39 am »

I may not have reported it clearly enough. Steps are:

Entered TEST
Hovered AND clicked OK. - box closed.
Without moving my mouse pointer, entered TEST again - box showed up
Box closed WITHOUT me clicking OK, just because the mouse pointer was still in the same position as before, still hovering the OK button when the dialog came up again.

eoredson · « **Reply #7 on:** July 27, 2017, 01:00:38 am »

Hmm, odd.. I can't seem to duplicate the bug.

Perhaps the mouse button is getting stuck.

Try this:

Code: QB64: [Select]

REM Sample of a QuitBox. v1.1a PD 2017. -ejo
 
' declare screen save arrays
DIM SHARED TempArrayY(1 TO 2000) AS INTEGER
DIM SHARED TempArrayZ(1 TO 2000) AS INTEGER
 
' declare box coordinates
DIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER
 
' declare mouse variables
DIM SHARED MouseX AS INTEGER, MouseY AS INTEGER
DIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGER
DIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGER
DIM SHARED MousePressed AS INTEGER
 
' declare box settings
CONST QuitBoxTitle$ = " Quit "
CONST QuitBoxText$ = "Quit. Are you sure?"
 
' declare box colors
DIM SHARED QuitBoxBorderColor AS INTEGER
DIM SHARED QuitBoxTitleColor AS INTEGER
DIM SHARED QuitBoxTextColor AS INTEGER
DIM SHARED QuitBoxButton1Color AS INTEGER
DIM SHARED QuitBoxButton2Color AS INTEGER
DIM SHARED QuitBoxBackGround AS INTEGER
DIM SHARED QuitBoxButtonBackGround AS INTEGER
 
' declare ascii variables
DIM SHARED Hline AS INTEGER, Vline AS INTEGER
DIM SHARED ULcorner AS INTEGER, URcorner AS INTEGER
DIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER
 
' declare color constants
CONST Black = 0
CONST Blue = 1
CONST Green = 2
CONST Cyan = 3
CONST Red = 4
CONST Magenta = 5
CONST Brown = 6
CONST White = 7
CONST Gray = 8
CONST LightBlue = 9
CONST LightGreen = 10
CONST LightCyan = 11
CONST LightRed = 12
CONST LightMagenta = 13
CONST Yellow = 14
CONST HighWhite = 15
 
' set box colors
QuitBoxBorderColor = Yellow
QuitBoxTitleColor = HighWhite
QuitBoxTextColor = HighWhite
QuitBoxButton1Color = HighWhite
QuitBoxButton2Color = White
QuitBoxBackGround = Blue
QuitBoxButtonBackGround = Black
 
' set ascii characters
Hline = 205
Vline = 186
ULcorner = 201
URcorner = 187
LLcorner = 200
LRcorner = 188
 
' declare box coordinates.
Xcoor3 = 10
Ycoor3 = 10
 
' set box button constants
CONST OKcancel = 1
CONST OK = 2
CONST cancel = 3
 
' start input loop
CLS
PRINT "Quitbox:"
DO
    COLOR Yellow, Black
    PRINT "Enter HELP or QUIT or TEST";
    COLOR HighWhite, Black
    INPUT X$
    X$ = UCASE$(X$)
    IF X$ = "QUIT" THEN END
    IF X$ = "HELP" THEN
        COLOR HighWhite, Black
        PRINT "Mouse: Click on <OK> or <Cancel>"
        PRINT "       Click on title, drag box."
        PRINT "Keyboard: Enter for OK/Cancel, Escape to cancel,"
        PRINT "          Cursor left/right, tab/shift-tab to select button,"
        PRINT "          Control-<cursor> to move box."
        PRINT "          Alt-<cursor> to move box 4 chars."
        PRINT "Colors: Ctrl-A Cycle box background, Ctrl-B Cycle button background,"
        PRINT "        Ctrl-D Cycle border, Ctrl-E Cycle title, Ctrl-F Cycle text,"
        PRINT "        Ctrl-G Cycle OK button, Ctrl-H Cycle Cancel button."
    END IF
    IF X$ = "TEST" THEN
        X = QuitBox(OKcancel)
        IF X THEN
            PRINT "Entered OK"
        ELSE
            PRINT "Entered Cancel"
        END IF
    END IF
LOOP
END
 
' Input: Var
'    1 = both buttons, 2 = ok, 3 = cancel
FUNCTION QuitBox (Var)
' store screen area.
CurrentX = CSRLIN
CurrentY = POS(0)
CALL SaveScreen
 
' reset mouse buttons
MouseButton1 = 0
MouseButton2 = 0
MouseButton3 = 0
X = ClearMouse
 
' draw box
IF Var = 1 OR Var = 2 THEN
    BoxButton = 1
ELSE
    BoxButton = 2
END IF
GOSUB DrawQuitBox
 
' wait for keypress or mouse
_KEYCLEAR
DO
    _LIMIT 30
    X$ = INKEY$
    IF LEN(X$) THEN
        SELECT CASE LEN(X$)
            CASE 1
                SELECT CASE UCASE$(X$)
                    CASE "O"
                        IF Var = 1 OR Var = 2 THEN
                            BoxButton = 1
                            EXIT DO
                        END IF
                    CASE "C"
                        IF Var = 1 OR Var = 3 THEN
                            BoxButton = 2
                            EXIT DO
                        END IF
                    CASE CHR$(13)
                        EXIT DO
                    CASE CHR$(27)
                        BoxButton = 2
                        EXIT DO
                    CASE CHR$(9) ' tab
                        IF BoxButton = 1 THEN
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE CHR$(1) ' ctrl-a
                        QuitBoxBackGround = QuitBoxBackGround + 1
                        IF QuitBoxBackGround = 8 THEN
                            QuitBoxBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(2) ' ctrl-b
                        QuitBoxButtonBackGround = QuitBoxButtonBackGround + 1
                        IF QuitBoxButtonBackGround = 8 THEN
                            QuitBoxButtonBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(4) ' ctrl-d
                        QuitBoxBorderColor = QuitBoxBorderColor + 1
                        IF QuitBoxBorderColor = 16 THEN
                            QuitBoxBorderColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(5) ' ctrl-e
                        QuitBoxTitleColor = QuitBoxTitleColor + 1
                        IF QuitBoxTitleColor = 16 THEN
                            QuitBoxTitleColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(6) ' ctrl-f
                        QuitBoxTextColor = QuitBoxTextColor + 1
                        IF QuitBoxTextColor = 16 THEN
                            QuitBoxTextColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(7) ' ctrl-g
                        QuitBoxButton1Color = QuitBoxButton1Color + 1
                        IF QuitBoxButton1Color = 16 THEN
                            QuitBoxButton1Color = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(8) ' ctrl-h
                        QuitBoxButton2Color = QuitBoxButton2Color + 1
                        IF QuitBoxButton2Color = 16 THEN
                            QuitBoxButton2Color = 0
                        END IF
                        GOSUB DrawQuitBox
                END SELECT
            CASE 2
                SELECT CASE ASC(RIGHT$(X$, 1))
                    CASE 75, 15 ' left/shift-tab
                        IF BoxButton = 2 THEN
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 77 ' right
                        IF BoxButton = 1 THEN
                            IF Var = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Var = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 141 ' ctrl-up
                        IF Xcoor3 > 1 THEN
                            Xcoor3 = Xcoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 145 ' ctrl-down
                        IF Xcoor3 < 18 THEN
                            Xcoor3 = Xcoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 115 ' ctrl-left
                        IF Ycoor3 > 1 THEN
                            Ycoor3 = Ycoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 116 ' ctrl-right
                        IF Ycoor3 < 49 THEN
                            Ycoor3 = Ycoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 152 ' alt-up
                        IF Xcoor3 > 4 THEN
                            Xcoor3 = Xcoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 > 1 THEN
                                Xcoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 160 ' alt-dn
                        IF Xcoor3 < 14 THEN
                            Xcoor3 = Xcoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 < 18 THEN
                                Xcoor3 = 18
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 155 ' alt-left
                        IF Ycoor3 > 4 THEN
                            Ycoor3 = Ycoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 > 1 THEN
                                Ycoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 157 ' alt-right
                        IF Ycoor3 < 45 THEN
                            Ycoor3 = Ycoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 < 49 THEN
                                Ycoor3 = 49
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                END SELECT
        END SELECT
    END IF
    X = MouseDriver
    IF MouseButton1 THEN
        ' hover over titlebar
        IF MouseX = Xcoor3 THEN
            IF MouseY >= Ycoor3 AND MouseY <= Ycoor3 + 31 THEN
                ' store mouse XY during click
                MouseTempX = MouseX
                MouseTempY = MouseY
                DO
                    X = MouseDriver
                    IF MouseX OR MouseY THEN ' drag
                        MoveBox = 0
                        ' difference in mouse X
                        IF MouseX <> MouseTempX THEN
                            IF MouseX >= 1 AND MouseX <= 18 THEN
                                Xcoor3 = MouseX
                                MouseTempX = MouseX
                                MoveBox = -1
                            END IF
                        END IF
                        ' difference in mouse Y
                        IF MouseY <> MouseTempY THEN
                            MoveY = Ycoor3 + (MouseY - MouseTempY)
                            IF MoveY >= 1 AND MoveY <= 49 THEN
                                Ycoor3 = MoveY
                                MouseTempY = MouseY
                                MoveBox = -1
                            END IF
                        END IF
                        ' move box
                        IF MoveBox THEN
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                    END IF
                LOOP UNTIL MouseButton1 = 0
            END IF
        ELSE
            IF MouseX = Xcoor3 + 4 THEN ' click on button
                IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                    IF Var = 1 OR Var = 2 THEN
                        BoxButton = 1
                        EXIT DO
                    END IF
                END IF
                IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                    IF Var = 1 OR Var = 3 THEN
                        BoxButton = 2
                        EXIT DO
                    END IF
                END IF
            END IF
        END IF
    ELSE
        IF MouseX = Xcoor3 + 4 THEN ' mouseover button
            IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                IF BoxButton = 2 THEN
                    IF Var = 1 THEN
                        BoxButton = 1
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
            IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                IF BoxButton = 1 THEN
                    IF Var = 1 THEN
                        BoxButton = 2
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
        END IF
    END IF
LOOP
_DELAY .2
_KEYCLEAR
_DELAY .2
 
' restore screen area.
CALL RestoreScreen
COLOR White, Black
LOCATE CurrentX, CurrentY, 1
IF BoxButton = 1 THEN
    QuitBox = -1
ELSE
    QuitBox = 0
END IF
EXIT FUNCTION
 
' draw box
DrawQuitBox:
COLOR QuitBoxBorderColor, QuitBoxBackGround
LOCATE Xcoor3, Ycoor3, 0
PRINT CHR$(ULcorner) + STRING$(30, Hline) + CHR$(URcorner);
FOR RowX1 = Xcoor3 + 1 TO Xcoor3 + 6
    LOCATE RowX1, Ycoor3, 0
    PRINT CHR$(Vline) + SPACE$(30) + CHR$(Vline);
NEXT
LOCATE Xcoor3 + 7, Ycoor3, 0
PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner);
 
' display box title
XC = 16 - LEN(QuitBoxTitle$) / 2 ' center of titlebar
XC = Ycoor3 + XC
IF XC < 1 THEN XC = 1
COLOR QuitBoxTitleColor
LOCATE Xcoor3, XC, 0
PRINT QuitBoxTitle$;
 
' display quit text
COLOR QuitBoxTextColor
LOCATE Xcoor3 + 2, Ycoor3 + 2, 0
PRINT QuitBoxText$
GOSUB DrawQuitBoxButtons
RETURN
 
' display buttuns
DrawQuitBoxButtons:
IF BoxButton = 1 THEN
    LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<OK>";
    IF Var = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<Cancel>";
    END IF
ELSE
    LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<Cancel>";
    IF Var = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<OK>";
    END IF
END IF
COLOR White, Black
RETURN
END FUNCTION
 
' screen save
SUB SaveScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        TempZ1 = SCREEN(Var1, Var2) ' screen char
        TempZ2 = SCREEN(Var1, Var2, 1) ' char color
        TempArrayY((Var1 - 1) * 80 + Var2) = TempZ1
        TempArrayZ((Var1 - 1) * 80 + Var2) = TempZ2
    NEXT
NEXT
END SUB
 
' screen restore
SUB RestoreScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        VarB = INT(TempArrayZ((Var1 - 1) * 80 + Var2) / 16)
        VarF = TempArrayZ((Var1 - 1) * 80 + Var2) MOD 16
        TempZ1 = TempArrayY((Var1 - 1) * 80 + Var2)
        LOCATE Var1, Var2, 1
        COLOR VarF, VarB
        _CONTROLCHR OFF
        PRINT CHR$(TempZ1);
        _CONTROLCHR ON
    NEXT
NEXT
END SUB
 
REM clears mouse buffer.
FUNCTION ClearMouse
WHILE _MOUSEINPUT: WEND ' empty buffer
END FUNCTION
 
REM processes mouse activity.
FUNCTION MouseDriver
STATIC X1 AS INTEGER, Y1 AS INTEGER ' store old values
MouseX = 0: MouseY = 0
IF _MOUSEINPUT THEN
    X = CINT(_MOUSEX): Y = CINT(_MOUSEY) ' X,Y return single
    IF X <> X1 OR Y <> Y1 THEN
        X1 = X: Y1 = Y
        MouseX = Y: MouseY = X ' X,Y are reversed
        WHILE _MOUSEINPUT: WEND ' empty buffer
        MousePressed = -1
    END IF
    MouseButton1 = _MOUSEBUTTON(1)
    IF MouseButton1 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton2 = _MOUSEBUTTON(2)
    IF MouseButton2 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton3 = _MOUSEBUTTON(3)
    IF MouseButton3 THEN
        MousePressed = -1
    END IF
    MouseWheel = _MOUSEWHEEL
END IF
END FUNCTION
 

FellippeHeitor · « **Reply #8 on:** July 27, 2017, 01:37:46 am »

That seems to have fixed it.

eoredson · « **Reply #9 on:** July 27, 2017, 01:54:25 am »

Ok, excellent. Thanks for working on this with me.

One last hack and I'm finished with it.

Now allows title/text in function call:

Code: QB64: [Select]

REM Sample of a QuitBox. v1.1a PD 2017. -ejo
 
' declare screen save arrays
DIM SHARED TempArrayY(1 TO 2000) AS INTEGER
DIM SHARED TempArrayZ(1 TO 2000) AS INTEGER
 
' declare box coordinates
DIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER
 
' declare mouse variables
DIM SHARED MouseX AS INTEGER, MouseY AS INTEGER
DIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGER
DIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGER
DIM SHARED MousePressed AS INTEGER
 
' declare box colors
DIM SHARED QuitBoxBorderColor AS INTEGER
DIM SHARED QuitBoxTitleColor AS INTEGER
DIM SHARED QuitBoxTextColor AS INTEGER
DIM SHARED QuitBoxButton1Color AS INTEGER
DIM SHARED QuitBoxButton2Color AS INTEGER
DIM SHARED QuitBoxBackGround AS INTEGER
DIM SHARED QuitBoxButtonBackGround AS INTEGER
 
' declare ascii variables
DIM SHARED Hline AS INTEGER, Vline AS INTEGER
DIM SHARED ULcorner AS INTEGER, URcorner AS INTEGER
DIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER
 
' declare color constants
CONST Black = 0
CONST Blue = 1
CONST Green = 2
CONST Cyan = 3
CONST Red = 4
CONST Magenta = 5
CONST Brown = 6
CONST White = 7
CONST Gray = 8
CONST LightBlue = 9
CONST LightGreen = 10
CONST LightCyan = 11
CONST LightRed = 12
CONST LightMagenta = 13
CONST Yellow = 14
CONST HighWhite = 15
 
' set box colors
QuitBoxBorderColor = Yellow
QuitBoxTitleColor = HighWhite
QuitBoxTextColor = HighWhite
QuitBoxButton1Color = HighWhite
QuitBoxButton2Color = White
QuitBoxBackGround = Blue
QuitBoxButtonBackGround = Black
 
' set ascii characters
Hline = 205
Vline = 186
ULcorner = 201
URcorner = 187
LLcorner = 200
LRcorner = 188
 
' declare box coordinates.
Xcoor3 = 10
Ycoor3 = 10
 
' set box button constants
CONST OKcancel = 1
CONST OK = 2
CONST cancel = 3
 
' start input loop
CLS
PRINT "Quitbox:"
DO
    COLOR Yellow, Black
    PRINT "Enter HELP or QUIT or TEST";
    COLOR HighWhite, Black
    INPUT X$
    X$ = UCASE$(X$)
    IF X$ = "QUIT" THEN END
    IF X$ = "HELP" THEN
        COLOR HighWhite, Black
        PRINT "Mouse: Click on <OK> or <Cancel>"
        PRINT "       Click on title, drag box."
        PRINT "Keyboard: Enter for OK/Cancel, Escape to cancel,"
        PRINT "          Cursor left/right, tab/shift-tab to select button,"
        PRINT "          Control-<cursor> to move box."
        PRINT "          Alt-<cursor> to move box 4 chars."
        PRINT "Colors: Ctrl-A Cycle box background, Ctrl-B Cycle button background,"
        PRINT "        Ctrl-D Cycle border, Ctrl-E Cycle title, Ctrl-F Cycle text,"
        PRINT "        Ctrl-G Cycle OK button, Ctrl-H Cycle Cancel button."
    END IF
    IF X$ = "TEST" THEN
        X = QuitBox(OKcancel, " Quit ", "Quit. Are you sure?")
        IF X THEN
            PRINT "Entered OK"
        ELSE
            PRINT "Entered Cancel"
        END IF
    END IF
LOOP
END
 
' Input: Buttons
'    1 = both buttons, 2 = ok, 3 = cancel
FUNCTION QuitBox (Buttons, QuitBoxTitle$, QuitBoxText$)
' store screen area.
CurrentX = CSRLIN
CurrentY = POS(0)
CALL SaveScreen
 
' reset mouse buttons
MouseButton1 = 0
MouseButton2 = 0
MouseButton3 = 0
X = ClearMouse
 
' draw box
IF Buttons = 1 OR Buttons = 2 THEN
    BoxButton = 1
ELSE
    BoxButton = 2
END IF
GOSUB DrawQuitBox
 
' wait for keypress or mouse
_KEYCLEAR
DO
    _LIMIT 30
    X$ = INKEY$
    IF LEN(X$) THEN
        SELECT CASE LEN(X$)
            CASE 1
                SELECT CASE UCASE$(X$)
                    CASE "O"
                        IF Buttons = 1 OR Buttons = 2 THEN
                            BoxButton = 1
                            EXIT DO
                        END IF
                    CASE "C"
                        IF Buttons = 1 OR Buttons = 3 THEN
                            BoxButton = 2
                            EXIT DO
                        END IF
                    CASE CHR$(13)
                        EXIT DO
                    CASE CHR$(27)
                        BoxButton = 2
                        EXIT DO
                    CASE CHR$(9) ' tab
                        IF BoxButton = 1 THEN
                            IF Buttons = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Buttons = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE CHR$(1) ' ctrl-a
                        QuitBoxBackGround = QuitBoxBackGround + 1
                        IF QuitBoxBackGround = 8 THEN
                            QuitBoxBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(2) ' ctrl-b
                        QuitBoxButtonBackGround = QuitBoxButtonBackGround + 1
                        IF QuitBoxButtonBackGround = 8 THEN
                            QuitBoxButtonBackGround = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(4) ' ctrl-d
                        QuitBoxBorderColor = QuitBoxBorderColor + 1
                        IF QuitBoxBorderColor = 16 THEN
                            QuitBoxBorderColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(5) ' ctrl-e
                        QuitBoxTitleColor = QuitBoxTitleColor + 1
                        IF QuitBoxTitleColor = 16 THEN
                            QuitBoxTitleColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(6) ' ctrl-f
                        QuitBoxTextColor = QuitBoxTextColor + 1
                        IF QuitBoxTextColor = 16 THEN
                            QuitBoxTextColor = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(7) ' ctrl-g
                        QuitBoxButton1Color = QuitBoxButton1Color + 1
                        IF QuitBoxButton1Color = 16 THEN
                            QuitBoxButton1Color = 0
                        END IF
                        GOSUB DrawQuitBox
                    CASE CHR$(8) ' ctrl-h
                        QuitBoxButton2Color = QuitBoxButton2Color + 1
                        IF QuitBoxButton2Color = 16 THEN
                            QuitBoxButton2Color = 0
                        END IF
                        GOSUB DrawQuitBox
                END SELECT
            CASE 2
                SELECT CASE ASC(RIGHT$(X$, 1))
                    CASE 75, 15 ' left/shift-tab
                        IF BoxButton = 2 THEN
                            IF Buttons = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Buttons = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 77 ' right
                        IF BoxButton = 1 THEN
                            IF Buttons = 1 THEN
                                BoxButton = 2
                                GOSUB DrawQuitBoxButtons
                            END IF
                        ELSE
                            IF Buttons = 1 THEN
                                BoxButton = 1
                                GOSUB DrawQuitBoxButtons
                            END IF
                        END IF
                    CASE 141 ' ctrl-up
                        IF Xcoor3 > 1 THEN
                            Xcoor3 = Xcoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 145 ' ctrl-down
                        IF Xcoor3 < 18 THEN
                            Xcoor3 = Xcoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 115 ' ctrl-left
                        IF Ycoor3 > 1 THEN
                            Ycoor3 = Ycoor3 - 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 116 ' ctrl-right
                        IF Ycoor3 < 49 THEN
                            Ycoor3 = Ycoor3 + 1
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                        _KEYCLEAR
                    CASE 152 ' alt-up
                        IF Xcoor3 > 4 THEN
                            Xcoor3 = Xcoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 > 1 THEN
                                Xcoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 160 ' alt-dn
                        IF Xcoor3 < 14 THEN
                            Xcoor3 = Xcoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Xcoor3 < 18 THEN
                                Xcoor3 = 18
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 155 ' alt-left
                        IF Ycoor3 > 4 THEN
                            Ycoor3 = Ycoor3 - 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 > 1 THEN
                                Ycoor3 = 1
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                    CASE 157 ' alt-right
                        IF Ycoor3 < 45 THEN
                            Ycoor3 = Ycoor3 + 4
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        ELSE
                            IF Ycoor3 < 49 THEN
                                Ycoor3 = 49
                                CALL RestoreScreen
                                GOSUB DrawQuitBox
                            END IF
                        END IF
                        _KEYCLEAR
                END SELECT
        END SELECT
    END IF
    X = MouseDriver
    IF MouseButton1 THEN
        ' hover over titlebar
        IF MouseX = Xcoor3 THEN
            IF MouseY >= Ycoor3 AND MouseY <= Ycoor3 + 31 THEN
                ' store mouse XY during click
                MouseTempX = MouseX
                MouseTempY = MouseY
                DO
                    X = MouseDriver
                    IF MouseX OR MouseY THEN ' drag
                        MoveBox = 0
                        ' difference in mouse X
                        IF MouseX <> MouseTempX THEN
                            IF MouseX >= 1 AND MouseX <= 18 THEN
                                Xcoor3 = MouseX
                                MouseTempX = MouseX
                                MoveBox = -1
                            END IF
                        END IF
                        ' difference in mouse Y
                        IF MouseY <> MouseTempY THEN
                            MoveY = Ycoor3 + (MouseY - MouseTempY)
                            IF MoveY >= 1 AND MoveY <= 49 THEN
                                Ycoor3 = MoveY
                                MouseTempY = MouseY
                                MoveBox = -1
                            END IF
                        END IF
                        ' move box
                        IF MoveBox THEN
                            CALL RestoreScreen
                            GOSUB DrawQuitBox
                        END IF
                    END IF
                LOOP UNTIL MouseButton1 = 0
            END IF
        ELSE
            IF MouseX = Xcoor3 + 4 THEN ' click on button
                IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                    IF Buttons = 1 OR Buttons = 2 THEN
                        BoxButton = 1
                        EXIT DO
                    END IF
                END IF
                IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                    IF Buttons = 1 OR Buttons = 3 THEN
                        BoxButton = 2
                        EXIT DO
                    END IF
                END IF
            END IF
        END IF
    ELSE
        IF MouseX = Xcoor3 + 4 THEN ' mouseover button
            IF MouseY >= Ycoor3 + 2 AND MouseY <= Ycoor3 + 5 THEN
                IF BoxButton = 2 THEN
                    IF Buttons = 1 THEN
                        BoxButton = 1
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
            IF MouseY >= Ycoor3 + 8 AND MouseY <= Ycoor3 + 15 THEN
                IF BoxButton = 1 THEN
                    IF Buttons = 1 THEN
                        BoxButton = 2
                        GOSUB DrawQuitBoxButtons
                    END IF
                END IF
            END IF
        END IF
    END IF
LOOP
_DELAY .2
_KEYCLEAR
_DELAY .2
 
' restore screen area.
CALL RestoreScreen
COLOR White, Black
LOCATE CurrentX, CurrentY, 1
IF BoxButton = 1 THEN
    QuitBox = -1
ELSE
    QuitBox = 0
END IF
EXIT FUNCTION
 
' draw box
DrawQuitBox:
COLOR QuitBoxBorderColor, QuitBoxBackGround
LOCATE Xcoor3, Ycoor3, 0
PRINT CHR$(ULcorner) + STRING$(30, Hline) + CHR$(URcorner);
FOR RowX1 = Xcoor3 + 1 TO Xcoor3 + 6
    LOCATE RowX1, Ycoor3, 0
    PRINT CHR$(Vline) + SPACE$(30) + CHR$(Vline);
NEXT
LOCATE Xcoor3 + 7, Ycoor3, 0
PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner);
 
' display box title
XC = 16 - LEN(QuitBoxTitle$) / 2 ' center of titlebar
XC = Ycoor3 + XC
IF XC < 1 THEN XC = 1
COLOR QuitBoxTitleColor
LOCATE Xcoor3, XC, 0
PRINT QuitBoxTitle$;
 
' display quit text
COLOR QuitBoxTextColor
LOCATE Xcoor3 + 2, Ycoor3 + 2, 0
PRINT QuitBoxText$
GOSUB DrawQuitBoxButtons
RETURN
 
' display buttuns
DrawQuitBoxButtons:
IF BoxButton = 1 THEN
    LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<OK>";
    IF Buttons = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<Cancel>";
    END IF
ELSE
    LOCATE Xcoor3 + 4, Ycoor3 + 8, 0
    COLOR QuitBoxButton1Color, QuitBoxButtonBackGround
    PRINT "<Cancel>";
    IF Buttons = 1 THEN
        LOCATE Xcoor3 + 4, Ycoor3 + 2, 0
        COLOR QuitBoxButton2Color, QuitBoxButtonBackGround
        PRINT "<OK>";
    END IF
END IF
COLOR White, Black
RETURN
END FUNCTION
 
' screen save
SUB SaveScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        TempZ1 = SCREEN(Var1, Var2) ' screen char
        TempZ2 = SCREEN(Var1, Var2, 1) ' char color
        TempArrayY((Var1 - 1) * 80 + Var2) = TempZ1
        TempArrayZ((Var1 - 1) * 80 + Var2) = TempZ2
    NEXT
NEXT
END SUB
 
' screen restore
SUB RestoreScreen
FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
        VarB = INT(TempArrayZ((Var1 - 1) * 80 + Var2) / 16)
        VarF = TempArrayZ((Var1 - 1) * 80 + Var2) MOD 16
        TempZ1 = TempArrayY((Var1 - 1) * 80 + Var2)
        LOCATE Var1, Var2, 1
        COLOR VarF, VarB
        _CONTROLCHR OFF
        PRINT CHR$(TempZ1);
        _CONTROLCHR ON
    NEXT
NEXT
END SUB
 
REM clears mouse buffer.
FUNCTION ClearMouse
WHILE _MOUSEINPUT: WEND ' empty buffer
END FUNCTION
 
REM processes mouse activity.
FUNCTION MouseDriver
STATIC X1 AS INTEGER, Y1 AS INTEGER ' store old values
MouseX = 0: MouseY = 0
IF _MOUSEINPUT THEN
    X = CINT(_MOUSEX): Y = CINT(_MOUSEY) ' X,Y return single
    IF X <> X1 OR Y <> Y1 THEN
        X1 = X: Y1 = Y
        MouseX = Y: MouseY = X ' X,Y are reversed
        WHILE _MOUSEINPUT: WEND ' empty buffer
        MousePressed = -1
    END IF
    MouseButton1 = _MOUSEBUTTON(1)
    IF MouseButton1 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton2 = _MOUSEBUTTON(2)
    IF MouseButton2 THEN
        MouseX = Y1
        MouseY = X1
        MousePressed = -1
    END IF
    MouseButton3 = _MOUSEBUTTON(3)
    IF MouseButton3 THEN
        MousePressed = -1
    END IF
    MouseWheel = _MOUSEWHEEL
END IF
END FUNCTION
 

News:

Author Topic: Sample Of a Quitbox (Read 8939 times)

eoredson

Sample Of a Quitbox

Ashish

Re: Sample Of a Quitbox

STxAxTIC

Re: Sample Of a Quitbox

eoredson

Re: Sample Of a Quitbox

FellippeHeitor

Re: Sample Of a Quitbox

eoredson

Re: Sample Of a Quitbox

FellippeHeitor

Re: Sample Of a Quitbox

eoredson

Re: Sample Of a Quitbox

FellippeHeitor

Re: Sample Of a Quitbox

eoredson

Re: Sample Of a Quitbox