_TITLE "getClick testing with mBox and inputBox" ' by bplus 2018-05-12" '2019-01-02 added _KEYCLEAR to clear keys hit waiting for enter press at INPUT
'2019-03-02 discovered this does not work with mBox, can it be tested and fixed?
' Nope, impossible.
'can I get mBox to use getClick? No because I want to allow mouse to move mBox by grabbing title bar
'OK added stuff to clear old mb and they are now working together
'2019-08-06 More tests with mBox and now inputBox$()
' OK test if getClick plays nice with last update of mBox (2019-07-31) and vice versa
' and also inputBox. Discovered 2019-08-06 mBox did need a _KEYCLEAR! inputBox already had it.
m$ = "To exit this mBox click X box, press enter, spacebar or escape, to exit this tester press escape (again?) after mBox is off screen."
m$
= m$
+ CHR$(10) + "Otherwise when this box is off screen, click screen or enter letters."m$
= m$
+ CHR$(10) + "Once screen is clicked or enter is pressed you should see an inputBox$ come up."
'CLS
toggle
= (toggle
+ 1) MOD 2 mBox "Test mBox with getClick", m$
PRINT "mBox (Message Box) is a sub that returns nothing, it only provides info. " PRINT "If you pressed esacpe from mBox, press again if want to quit." 'test inputBox
r$ = inputBox$("Enter a string for inputBox to return to main program.", "Testing getClick with inputBox function.", 76)
IF r$
= "" THEN PRINT "You entered nothing or escaped inputBox." ELSE PRINT "inputBox Returned: *" + r$
+ "*" PRINT " To test getClick (now), click (and drag if want) screen or make a single keypress." PRINT "What you did should be detected by getClick and reported back to you here on main screen."
'x = -1: y = -1: k = 0 'need this?
getClick x, y, k
PRINT "All additional mouse clicks or keypresses will be ignored until:" INPUT "PRESS ENTER TO CONTINUE with another mBox or inputBox$() test... "; wate$
'getClick returns the mouse x, y position WHEN THE MOUSE WAS RELEASED! or keypress ASC 27 or 32 to 125
'2019-08-06 Test now with new mBox and inputBox procedures
'found mBox needed a _KEYCLEAR, how about inputBox? OK had _KEYCLEAR already
mx = -1: my = -1: q = 0
'IF mb THEN
'title$ limit is 57 chars, all lines are 58 chars max, version 2019-08-06
'THIS SUB NOW NEEDS SUB scnState(restoreTF) for saving and restoring screen settings
bg = &HBB000033
fg = &HFF33AAFF
'first screen dimensions and items to restore at exit
'screen and current settings to restore at end ofsub
scnState 0
_KEYCLEAR '<<<<<<<<<<<<<<<<<<<< do i still need this? YES! 2019-08-06 update!
'screen snapshot
'setup t() to store strings with ti as index, linit 58 chars per line max, b is for build
'are there any new line signals, CR, LF or both? take CRLF or LFCR as one break but dbl LF or CR means blank line
tail = "": ff = 0
FOR j
= LEN(b
) TO 1 STEP -1 'backup until find a space, save the tail end for next line ff = 1 'found space flag
tail = d + tail 'the tail grows!
b = b + c 'just keep building the line
t(ti) = b
bxH = ti + 3: bxW = limit + 2
'draw message box
'now for the action
'convert to pixels the top left corner of box at moment
bxW = bxW * 8: bxH = bxH * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
'now allow user to move it around or just read it
IF mx
>= tlx
AND mx
<= tlx
+ bxW
AND my
>= tly
AND my
<= tly
+ 16 THEN 'mouse down on title bar grabx = mx - tlx: graby = my - tly
IF mx
- grabx
>= 0 AND mx
- grabx
<= sw
- bxW
AND my
- graby
>= 0 AND my
- graby
<= sh
- bxH
THEN 'attempt to speed up with less updates
IF ((lastx
- (mx
- grabx
)) ^ 2 + (lasty
- (my
- graby
)) ^ 2) ^ .5 > 10 THEN tlx = mx - grabx: tly = my - graby
lastx = tlx: lasty = tly
'put things back
scnState 1 'Thanks Steve McNeill
' for saving and restoring screen settins
COLOR DefaultColor
, BackGroundColor
' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
'colors
ForeColor = &HFF000055 '< change as desired prompt text color, back color or type in area
BackColor = &HFF6080CC '< change as desired used fore color in type in area
White = &HFFFFFFFF
'items to restore at exit
scnState 0
'screen snapshot
'moving box around on screen
'draw message box
bxW = boxWidth * 8: bxH = 7 * 16
COLOR ForeColor
, BackColor
'convert to pixels the top left corner of box at moment
bxW = boxWidth * 8: bxH = 5 * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
'now allow user to move it around or just read it
IF mx
>= tlx
AND mx
<= tlx
+ bxW
AND my
>= tly
AND my
<= tly
+ 16 THEN 'mouse down on title bar grabx = mx - tlx: graby = my - tly
IF mx
- grabx
>= 0 AND mx
- grabx
<= sw
- bxW
AND my
- graby
>= 0 AND my
- graby
<= sh
- bxH
THEN 'attempt to speed up with less updates
IF ((lastx
- (mx
- grabx
)) ^ 2 + (lasty
- (my
- graby
)) ^ 2) ^ .5 > 10 THEN tlx = mx - grabx: tly = my - graby
lastx = tlx: lasty = tly
SELECT CASE kh&
'whew not much for the main event!
'put things back
scnState 1 'need fg and bg colors set to cls
CLS '? is this needed YES!! scnState 1 'because we have to call _display, we have to call this again
finishBox:
COLOR BackColor
, ForeColor