09-06-2022, 01:49 AM
Trying to make my in house harvest database more usable for the non-technical members of my family, I came up with a GUI number pad for entering weight and moisture test data. The original was heavily dependent on my growing library of routines, but I incorporated all those into a single function to make it a little more universal for others to use. It will accept mouse click or keyboard input interchangeably. Numbers, period, enter or backspace are accepted.
Although it is for a 32 bit screen, it accepts LOCATE position data, in the row/column order as the second and third parameter. The first parameter sends a true if a floating point number is required, and a false if an integer is required by disabling the period input. It leaves the data echoed at the entry point.
Although it is for a 32 bit screen, it accepts LOCATE position data, in the row/column order as the second and third parameter. The first parameter sends a true if a floating point number is required, and a false if an integer is required by disabling the period input. It leaves the data echoed at the entry point.
Code: (Select All)
'OldMoses' number pad input subroutine - no sub/function dependencies
SCREEN _NEWIMAGE(1024, 512, 32)
CONST true = -1
CONST false = 0
DO
CLS
FOR x% = 0 TO 1024 STEP 64
LINE (0, x%)-(1023, x%), &H7F7F7F7F
LINE (x%, 0)-(x%, 511), &H7F7F7F7F
NEXT x%
LOCATE 4, 1
PRINT ">>>"
row% = 4: col% = 4
num! = Number_Pad(true, row%, col%)
LOCATE row%, col%
PRINT num!
IF num! <> 0 THEN
LOCATE 24, 5
PRINT "number @ 24,20>"
num2! = Number_Pad(true, 24, 20)
LOCATE 24, 20
PRINT num2!
'LOCATE 15, 15
'PRINT "number @ 15,30>"
x1% = INT(RND * 100) + 1
y1% = INT(RND * 30) + 1
num3& = Number_Pad(false, y1%, x1%)
LOCATE y1%, x1%
PRINT num3&
SLEEP
END IF
LOOP UNTIL num! = 0
END
'Description:
'Display a number pad at upper left (xpos, ypos) position
'Set flt to -1 to enable floating point, 0 to disable
FUNCTION Number_Pad (flt AS INTEGER, ypos AS INTEGER, xpos AS INTEGER)
backimg& = _COPYIMAGE(0) ' copy screen before number pad draw
pm% = _PRINTMODE ' get prior printmode state
c~& = &HFFAFAFAF ' set button color
_PRINTMODE _KEEPBACKGROUND
si% = _SHL(xpos, 3) ' set in position from left edge
sd% = _SHL(ypos, 4) ' set down position from top edge
IF sd% + 216 > _HEIGHT(0) THEN ' keep within screen limits, set vertical adjust & vertical offset
sd% = sd% - 216
va% = 200: vo% = 208
ELSE
va% = -16: vo% = -8
END IF
lb$ = "789456123.0E" ' button label characters
IF flt THEN al$ = "0123456789." ELSE al$ = "0123456789" ' allowable if float or not float
df& = _DEFAULTCOLOR ' save default text color
COLOR &HFF000000 ' button label color black
FOR row% = 0 TO 3 ' button vertical ranks iteration
sdr% = sd% + row% * 50
FOR col% = 0 TO 2 ' button horizontal ranks iteration
ps% = ps% + 1
LINE (si% + col% * 50, sdr%)-(si% + 49 + col% * 50, sdr% + 49), c~&, BF
c = 0
FOR bb = 0 TO 12 ' SierraKen's button bevel
c = c + 100 / 12
LINE (si% + col% * 50 + bb, sdr% + bb)-(si% + 50 + col% * 50 - 1 - bb, sdr% + 50 - 1 - bb),_
_RGBA32(_RED32(c~&) - 100 + c, _GREEN32(c~&) - 100 + c, _BLUE32(c~&) - 100 + c, _ALPHA(c~&)), B
NEXT bb
_PRINTSTRING (si% + 21 + col% * 50, sdr% + 18), _TRIM$(MID$(lb$, ps%, 1)) 'button label
IF NOT flt AND ps% = 10 THEN
LINE (si% + col% * 50, sdr%)-(si% + col% * 50 + 50, sdr% + 50), &HAF000000, BF 'blank period
END IF
NEXT col%, row%
COLOR df&
DO ' Building number loop
LINE (si%, sd% + va%)-(si% + 150, sd% + va% + 16), &HFF0000FF, BF ' blue number echo field
LINE (si% + 125, sd% + va%)-(si% + 150, sd% + va% + 16), &HFF7F7F00, BF 'backspace arrow field
_PRINTSTRING (si% + 125, sd% + va%), "®®®" ' backspace indicator
_PRINTSTRING (si%, sd% + va%), num$ ' entry echo
k$ = INKEY$
IF k$ = CHR$(13) THEN ' enter pressed
in% = -1
ELSE
IF k$ <> "" THEN GOSUB addstring
k$ = ""
END IF
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
DO UNTIL NOT _MOUSEBUTTON(1) ' Clear mouse button queue
WHILE _MOUSEINPUT: WEND ' to prevent multiple numbers / click
LOOP
IF ABS(_MOUSEY - (sd% + 25)) < 25 THEN ' within top button row
IF ABS(_MOUSEX - (si% + 25)) < 25 THEN k$ = "7": GOSUB addstring
IF ABS(_MOUSEX - (si% + 75)) < 25 THEN k$ = "8": GOSUB addstring
IF ABS(_MOUSEX - (si% + 125)) < 25 THEN k$ = "9": GOSUB addstring
ELSEIF ABS(_MOUSEY - (sd% + 75)) < 25 THEN ' within second button row
IF ABS(_MOUSEX - (si% + 25)) < 25 THEN k$ = "4": GOSUB addstring
IF ABS(_MOUSEX - (si% + 75)) < 25 THEN k$ = "5": GOSUB addstring
IF ABS(_MOUSEX - (si% + 125)) < 25 THEN k$ = "6": GOSUB addstring
ELSEIF ABS(_MOUSEY - (sd% + 125)) < 25 THEN ' within third button row
IF ABS(_MOUSEX - (si% + 25)) < 25 THEN k$ = "1": GOSUB addstring
IF ABS(_MOUSEX - (si% + 75)) < 25 THEN k$ = "2": GOSUB addstring
IF ABS(_MOUSEX - (si% + 125)) < 25 THEN k$ = "3": GOSUB addstring
ELSEIF ABS(_MOUSEY - (sd% + 175)) < 25 THEN ' within fourth button row
IF ABS(_MOUSEX - (si% + 25)) < 25 AND flt THEN k$ = ".": GOSUB addstring
IF ABS(_MOUSEX - (si% + 75)) < 25 THEN k$ = "0": GOSUB addstring
IF ABS(_MOUSEX - (si% + 125)) < 25 THEN in% = -1 'enter clicked
ELSEIF ABS(_MOUSEY - (sd% + vo%)) < 8 THEN ' withing number line/backspace row
IF ABS(_MOUSEX - (si% + 137)) < 12 THEN ' within backspace arrow in number line
IF LEN(num$) > 0 THEN num$ = LEFT$(num$, LEN(num$) - 1) 'if digits then remove least significant
END IF
END IF
END IF
_LIMIT 30
IF NOT _AUTODISPLAY THEN _DISPLAY ' display changes if in display mode
LOOP UNTIL in% ' loop until number entered
_PUTIMAGE , backimg& ' redisplay original screen
_FREEIMAGE backimg&
SELECT CASE pm% ' return to prior printmode
CASE 2: _PRINTMODE _ONLYBACKGROUND
CASE 3: _PRINTMODE _FILLBACKGROUND
END SELECT
Number_Pad = VAL(num$) ' return value
EXIT FUNCTION ' leave before gosub code
addstring:
IF k$ = CHR$(8) THEN ' if backspace pressed
IF LEN(num$) > 0 THEN num$ = LEFT$(num$, LEN(num$) - 1)
ELSE
IF INSTR(al$, k$) <> 0 THEN num$ = num$ + _TRIM$(k$) ' add number to string
END IF
k$ = ""
RETURN
END FUNCTION 'Number_Pad
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
sha_na_na_na_na_na_na_na_na_na:
