Active Forums > Programs
Sample Of a Quitbox
eoredson:
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: ---REM Sample of QuitBox. ' declare screen save arraysDIM SHARED TempArrayY(1 TO 2000) AS INTEGERDIM SHARED TempArrayZ(1 TO 2000) AS INTEGER ' declare box coordinatesDIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER ' declare mouse variablesDIM SHARED MouseX AS INTEGER, MouseY AS INTEGERDIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGERDIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGERDIM SHARED MousePressed AS INTEGER ' declare box settingsCONST QuitBoxText$ = "Quit. Are you sure?"DIM SHARED QuitBoxBorderColor AS INTEGERDIM SHARED QuitBoxTitleColor AS INTEGERDIM SHARED QuitBoxTextColor AS INTEGERDIM SHARED QuitBoxButton1Color AS INTEGERDIM SHARED QuitBoxButton2Color AS INTEGERDIM SHARED QuitBoxBackGround AS INTEGERDIM SHARED QuitBoxButtonBackGround AS INTEGER ' declare ascii variablesDIM SHARED Hline AS INTEGER, Vline AS INTEGERDIM SHARED ULcorner AS INTEGER, URcorner AS INTEGERDIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER ' declare color constantsCONST Black = 0CONST Blue = 1CONST Green = 2CONST Cyan = 3CONST Red = 4CONST Magenta = 5CONST Brown = 6CONST White = 7CONST Gray = 8CONST LightBlue = 9CONST LightGreen = 10CONST LightCyan = 11CONST LightRed = 12CONST LightMagenta = 13CONST Yellow = 14CONST HighWhite = 15 ' set box colorsQuitBoxBorderColor = YellowQuitBoxTitleColor = HighWhiteQuitBoxTextColor = HighWhiteQuitBoxButton1Color = HighWhiteQuitBoxButton2Color = WhiteQuitBoxBackGround = BlueQuitBoxButtonBackGround = Black ' set ascii charactersHline = 205Vline = 186ULcorner = 201URcorner = 187LLcorner = 200LRcorner = 188 ' declare box coordinates.Xcoor3 = 10Ycoor3 = 10 ' start input loopCLSPRINT "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 IFLOOPEND FUNCTION QuitBox' store screen area.CurrentX = CSRLINCurrentY = POS(0)CALL SaveScreen ' draw boxBoxButton = 1GOSUB DrawQuitBox ' wait for keypress or mouse_KEYCLEARDO _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 IFLOOP_DELAY .2_KEYCLEAR_DELAY .2 ' restore screen area.CALL RestoreScreenCOLOR White, BlackLOCATE CurrentX, CurrentY, 1IF BoxButton = 1 THEN QuitBox = -1ELSE QuitBox = 0END IFEXIT FUNCTION ' draw boxDrawQuitBox:COLOR QuitBoxBorderColor, QuitBoxBackGroundLOCATE Xcoor3, Ycoor3, 0PRINT 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);NEXTLOCATE Xcoor3 + 7, Ycoor3, 0PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner);COLOR QuitBoxTitleColorLOCATE Xcoor3, Ycoor3 + 12, 0PRINT " Quit "; ' display quit textCOLOR QuitBoxTextColorLOCATE Xcoor3 + 2, Ycoor3 + 2, 0PRINT QuitBoxText$GOSUB DrawQuitBoxButtonsRETURN ' display buttunsDrawQuitBoxButtons: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 IFCOLOR White, BlackRETURNEND FUNCTION ' screen saveSUB SaveScreenFOR 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 NEXTNEXTEND SUB ' screen restoreSUB RestoreScreenFOR 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 NEXTNEXTEND SUB REM processes mouse activity.FUNCTION MouseDriverSTATIC X1 AS INTEGER, Y1 AS INTEGER ' store old valuesMouseX = 0: MouseY = 0IF _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 = _MOUSEWHEELEND IFEND FUNCTION
Tell me what you think.
Thanks, Erik.
Ashish:
Nice Work! I like it! :D
STxAxTIC:
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:
Ok, here is the QuitBox with:
Scrolls to right edge,
Allows button overrides,
Adds and centers title text.
--- Code: QB64: ---REM Sample of a QuitBox. v1.1a PD 2017. -ejo ' declare screen save arraysDIM SHARED TempArrayY(1 TO 2000) AS INTEGERDIM SHARED TempArrayZ(1 TO 2000) AS INTEGER ' declare box coordinatesDIM SHARED Xcoor3 AS INTEGER, Ycoor3 AS INTEGER ' declare mouse variablesDIM SHARED MouseX AS INTEGER, MouseY AS INTEGERDIM SHARED MouseButton1 AS INTEGER, MouseButton2 AS INTEGERDIM SHARED MouseButton3 AS INTEGER, MouseWheel AS INTEGERDIM SHARED MousePressed AS INTEGER ' declare box settingsCONST QuitBoxTitle$ = " Quit "CONST QuitBoxText$ = "Quit. Are you sure?" ' declare box colorsDIM SHARED QuitBoxBorderColor AS INTEGERDIM SHARED QuitBoxTitleColor AS INTEGERDIM SHARED QuitBoxTextColor AS INTEGERDIM SHARED QuitBoxButton1Color AS INTEGERDIM SHARED QuitBoxButton2Color AS INTEGERDIM SHARED QuitBoxBackGround AS INTEGERDIM SHARED QuitBoxButtonBackGround AS INTEGER ' declare ascii variablesDIM SHARED Hline AS INTEGER, Vline AS INTEGERDIM SHARED ULcorner AS INTEGER, URcorner AS INTEGERDIM SHARED LLcorner AS INTEGER, LRcorner AS INTEGER ' declare color constantsCONST Black = 0CONST Blue = 1CONST Green = 2CONST Cyan = 3CONST Red = 4CONST Magenta = 5CONST Brown = 6CONST White = 7CONST Gray = 8CONST LightBlue = 9CONST LightGreen = 10CONST LightCyan = 11CONST LightRed = 12CONST LightMagenta = 13CONST Yellow = 14CONST HighWhite = 15 ' set box colorsQuitBoxBorderColor = YellowQuitBoxTitleColor = HighWhiteQuitBoxTextColor = HighWhiteQuitBoxButton1Color = HighWhiteQuitBoxButton2Color = WhiteQuitBoxBackGround = BlueQuitBoxButtonBackGround = Black ' set ascii charactersHline = 205Vline = 186ULcorner = 201URcorner = 187LLcorner = 200LRcorner = 188 ' declare box coordinates.Xcoor3 = 10Ycoor3 = 10 ' set box button constantsCONST OKcancel = 1CONST OK = 2CONST cancel = 3 ' start input loopCLSPRINT "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 IFLOOPEND ' Input: Var' 1 = both buttons, 2 = ok, 3 = cancelFUNCTION QuitBox (Var)' store screen area.CurrentX = CSRLINCurrentY = POS(0)CALL SaveScreen ' draw boxIF Var = 1 OR Var = 2 THEN BoxButton = 1ELSE BoxButton = 2END IFGOSUB DrawQuitBox ' wait for keypress or mouse_KEYCLEARDO _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 IFLOOP_DELAY .2_KEYCLEAR_DELAY .2 ' restore screen area.CALL RestoreScreenCOLOR White, BlackLOCATE CurrentX, CurrentY, 1IF BoxButton = 1 THEN QuitBox = -1ELSE QuitBox = 0END IFEXIT FUNCTION ' draw boxDrawQuitBox:COLOR QuitBoxBorderColor, QuitBoxBackGroundLOCATE Xcoor3, Ycoor3, 0PRINT 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);NEXTLOCATE Xcoor3 + 7, Ycoor3, 0PRINT CHR$(LLcorner) + STRING$(30, Hline) + CHR$(LRcorner); ' display box titleCOLOR QuitBoxTitleColorXC = 16 - LEN(QuitBoxTitle$) / 2 ' center of titlebarLOCATE Xcoor3, Ycoor3 + XC, 0PRINT QuitBoxTitle$; ' display quit textCOLOR QuitBoxTextColorLOCATE Xcoor3 + 2, Ycoor3 + 2, 0PRINT QuitBoxText$GOSUB DrawQuitBoxButtonsRETURN ' display buttunsDrawQuitBoxButtons: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 IFELSE 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 IFEND IFCOLOR White, BlackRETURNEND FUNCTION ' screen saveSUB SaveScreenFOR 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 NEXTNEXTEND SUB ' screen restoreSUB RestoreScreenFOR 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 NEXTNEXTEND SUB REM processes mouse activity.FUNCTION MouseDriverSTATIC X1 AS INTEGER, Y1 AS INTEGER ' store old valuesMouseX = 0: MouseY = 0IF _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 = _MOUSEWHEELEND IFEND FUNCTION
FellippeHeitor:
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?
Navigation
[0] Message Index
[#] Next page
Go to full version