07-20-2022, 11:54 PM
Been working on a new version of my grain harvest database, and while building a support file editing section, I conceived of the need to quickly and easily display a row of button choices, along with the ability to accept hotkeys in lieu of mouse clicks.
It depends upon a few of my other library routines (included in the code), but anything could be easily adapted. I'm particularly indebted to Steve for his MBS function and SierraKen for his beveled calculator button algorithm.
It depends upon a few of my other library routines (included in the code), but anything could be easily adapted. I'm particularly indebted to Steve for his MBS function and SierraKen for his beveled calculator button algorithm.
Code: (Select All)
'Button & hotkey choosing routine. FUNCTION Chs_Key_Button% Coding by OldMoses
'supporting subroutines by Steve McNeill & SierraKen
'chose from aligned and identically sized and spaced controls in
'vertical or horizontal orientation, or use hotkeys
'Esc keypress returns -1
SCREEN _NEWIMAGE(1024, 512, 32)
DIM lbl(7) AS STRING '
DIM ani(5) AS STRING
lbl(1) = "One": lbl(2) = "Two": lbl(3) = "Three": lbl(4) = "Four": lbl(5) = "Five": lbl(6) = "Six": lbl(7) = "Seven"
ani(1) = "Dog": ani(2) = "Cat": ani(3) = "Horse": ani(4) = "Frog": ani(5) = "Jerk"
DO
CLS
scene% = scene% + 1
SELECT CASE scene%
CASE 1
x% = _SHR(_WIDTH(0), 1) ' screen centered (512,256), seven horizontal buttons
y% = _SHR(_HEIGHT(0), 1): w% = 60: h% = 32: sp% = 4: it% = 7
cho% = Chs_Key_Button%("1234567", "h", y%, it%, w%, h%, sp%, x%, lbl())
IF cho% > 0 THEN x$ = lbl(cho%)
CASE 2
x% = _SHR(_WIDTH(0), 1) ' screen centered (512,256), four horizontal buttons
y% = _SHR(_HEIGHT(0), 1): w% = 60: h% = 32: sp% = 20: it% = 4
cho% = Chs_Key_Button%("DCHF", "h", y%, it%, w%, h%, sp%, x%, ani())
IF cho% > 0 THEN x$ = ani(cho%)
CASE 3
x% = _SHR(_WIDTH(0), 2) ' screen left quarter (256,256), four vertical buttons
y% = _SHR(_HEIGHT(0), 1): w% = 60: h% = 32: sp% = 16: it% = 4
cho% = Chs_Key_Button%("1234", "v", x%, it%, w%, h%, sp%, y%, lbl())
IF cho% > 0 THEN x$ = lbl(cho%)
CASE 4
x% = _SHR(_WIDTH(0), 2) * 3 ' screen right quarter (768,256), four vertical buttons
y% = _SHR(_HEIGHT(0), 1): w% = 60: h% = 32: sp% = 16: it% = 5
cho% = Chs_Key_Button%("DCHFJ", "v", x%, it%, w%, h%, sp%, y%, ani())
IF cho% > 0 THEN x$ = ani(cho%)
CASE 5
x% = 137 ' upper right corner (137,20), five horizontal buttons
y% = 20: w% = 50: h% = 50: sp% = 6: it% = 5
cho% = Chs_Key_Button%("12345", "h", y%, it%, w%, h%, sp%, x%, lbl())
IF cho% > 0 THEN x$ = lbl(cho%)
END SELECT
LOCATE 1, 1
SELECT CASE cho%
CASE -1: EXIT DO
CASE ELSE: PRINT "You chose "; _TRIM$(x$); ";";
END SELECT
PRINT " press any key to continue"
SLEEP
IF scene% = 5 THEN scene% = 0
LOOP
END
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
'vchr: string of valid hotkey characters
'ori: "v" = vertical buttons "h" = horizontal buttons (anything other than 'v' will work for horizontal)
'ledgr: upper y edge of horizontal buttons, or left x edge of vertical buttons
'bl: number of buttons displayed
'bw: button pixel width
'bh: button pixel height
'space: space in pixels between buttons
'cent: center point of buttons in x for horizontal or y for vertical
FUNCTION Chs_Key_Button% (vchr AS STRING, ori AS STRING, ledgr AS INTEGER, bl AS INTEGER, bw AS INTEGER, bh AS INTEGER, space AS INTEGER, cent AS INTEGER, array() AS STRING)
m% = bw: n% = bh ' duplicate for Con_Blok before possible swap
IF ori = "v" THEN ' flip the axes for vertical orientation
hpos% = ledgr
vpos% = cent - _SHR(bh * bl + space * (bl - 1), 1)
hstp% = 0: vstp% = space + bh
SWAP bw, bh
ELSE
hpos% = cent - _SHR(bw * bl + space * (bl - 1), 1)
vpos% = ledgr
hstp% = space + bw: vstp% = 0
END IF
FOR a% = 0 TO bl - 1 ' Display buttons
Con_Blok hpos% + a% * hstp%, vpos% + a% * vstp%, m%, n%, _TRIM$(array(a% + 1)), 0, &HFF7F7F7F
NEXT a%
DO ' Choosing loop section
k$ = UCASE$(INKEY$)
IF k$ <> "" THEN
IF k$ = CHR$(27) THEN ' esc to abort, returning -1
choice% = -1: in% = -1
ELSE
choice% = INSTR(vchr, k$)
IF choice% <> 0 THEN in% = -1 ' if valid char then return with its index
END IF
END IF
ms = MBS
IF ms AND 1 THEN ' left mouse button clicked
Clear_MB 1 ' clear the mouse click
x% = _MOUSEX: y% = _MOUSEY ' we don't want to use mouse position directly
IF ori = "v" THEN SWAP x%, y% ' flip the axes for vertical orientation
rowrange% = _SHR(bh, 1) + ledgr ' this marks the center of button row
IF ABS(y% - rowrange%) < _SHR(bh, 1) THEN ' are we within the row of buttons
odd% = (bl MOD 2 <> 0) ' is there an odd number of buttons
full% = space + bw ' control width + space between
hfsp% = _SHR(space, 1) ' half space
hfbt% = _SHR(bw, 1) ' half button width
FOR z% = 1 TO bl
IF odd% THEN
md% = z% - _CEIL(bl / 2) ' midpoint multiplier, center button on 0
ps% = -(md% * full%) * (md% <> 0)
ELSE
md% = z% - INT(bl / 2) + (SGN(z% - INT(bl / 2)) < 1)
ps% = SGN(md%) * ((ABS(md%) - 1) * full% + _SHR(full%, 1))
END IF
IF ABS(x% - (cent + ps%)) < hfbt% THEN 'use ps% offset from center to position specific button ranges
choice% = z%: in% = -1
END IF
NEXT z%
'alternate code- replacing FOR z%...NEXT block above; both seem to work equally well
'IF odd% THEN
' start% = cent - full% * ((bl - 1) / 2) - hfbt%
'ELSE
' start% = cent - full% * (bl / 2 - 1) - (bw + hfsp%)
'END IF
'FOR z% = 1 TO bl
' md% = start% + (z% - 1) * full% + hfbt%
' IF ABS(x% - md%) < hfbt% THEN
' choice% = z%: in% = -1
' END IF
'NEXT z%
END IF ' end: if within row
END IF ' end: if left mouse click
_LIMIT 30
LOOP UNTIL in%
Chs_Key_Button% = choice%
END FUNCTION 'Chs_Key_Button%
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² coding by Steve McNeill
FUNCTION MBS%
STATIC StartTimer AS _FLOAT
STATIC ButtonDown AS INTEGER
'STATIC ClickCount AS INTEGER
CONST ClickLimit## = .4 'Less than 1/2 of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
SELECT CASE SGN(_MOUSEWHEEL)
CASE 1: tempMBS = tempMBS OR 512
CASE -1: tempMBS = tempMBS OR 1024
END SELECT
WEND
IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS OR 4
IF StartTimer = 0 THEN
IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(2) THEN
ButtonDown = 2: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(3) THEN
ButtonDown = 3: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
END IF
ELSE
BD = ButtonDown MOD 3
IF BD = 0 THEN BD = 3
IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit. It's a click
IF _MOUSEBUTTON(BD) = 0 THEN tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
ELSE
IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
ELSE 'We've now started the hold event
tempMBS = tempMBS OR 32 * 2 ^ ButtonDown
END IF
END IF
END IF
MBS% = tempMBS
END FUNCTION 'MBS%
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Clear_MB (var AS INTEGER)
DO UNTIL NOT _MOUSEBUTTON(var)
WHILE _MOUSEINPUT: WEND
LOOP
END SUB 'Clear_MB
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
SUB Con_Blok (xpos AS INTEGER, ypos AS INTEGER, xsiz AS INTEGER, ysiz AS INTEGER, label AS STRING, high AS INTEGER, col AS _UNSIGNED LONG)
'Create control block
CN& = _NEWIMAGE(xsiz, ysiz, 32)
_DEST CN&
COLOR , col
CLS
BevelB xsiz, ysiz, col
_PRINTMODE _KEEPBACKGROUND
x% = LEN(label)
sx = xsiz / 2 - x% * 4: sy = ysiz / 2 - 8
FOR p = 1 TO x% ' iterate through label characters
COLOR -4294901760 * (p = high) - 4278190080 * (p <> high) '&HFFFF0000 &HFF000000
IF col = &HFFC80000 THEN COLOR clr&(15)
_PRINTSTRING (sx + (p - 1) * 8, sy), MID$(label, p, 1)
NEXT p
_PUTIMAGE (xpos, ypos), CN&, A&
_FREEIMAGE CN&
END SUB 'Con_Blok
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²² adaptation of code by SierraKen
SUB BevelB (xsiz AS INTEGER, ysiz AS INTEGER, col AS _UNSIGNED LONG)
'Create control button bevels for 3D effect - called from Con_Blok
brdr = ABS(INT(ysiz / 4) * (ysiz <= xsiz) + INT(xsiz / 4) * (ysiz > xsiz)) 'select smaller 1/4 size border axis
FOR bb = 0 TO brdr
c = c + 100 / brdr
LINE (0 + bb, 0 + bb)-(xsiz - 1 - bb, ysiz - 1 - bb), _RGBA32(_RED32(col) - 100 + c, _GREEN32(col) - 100 + c, _BLUE32(col) - 100 + c, _ALPHA(col)), B
NEXT bb
END SUB 'BevelB
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
sha_na_na_na_na_na_na_na_na_na:
