12-13-2022, 10:29 AM
What's that Steve? You say you need a right click popup menu with that? ALRIGHTY THEN...
Pete
Code: (Select All)
DIM SHARED shift%
REDIM menu$(1)
' Single line keyboard routine for input.
LOCATE , 3, 1 ' Show cursor.
pw = 0 ' 1 sets "*" display on for password privacy, zero shows keyboard input.
mr = 51 ' Margin right.
start_column = POS(0)
y = CSRLIN: x = POS(0) ' Initial cursor position.
DO
_LIMIT 120
string_pos = POS(0) - start_column ' Track cursor and word position.
CALL kb_mse(b$, lb, mx, drag, menu$())
IF lb THEN GOSUB mouse_event
IF LEN(b$) THEN
SELECT CASE b$
CASE CHR$(27) ' Esc key.
SYSTEM
CASE CHR$(13) ' Enter key.
EXIT DO
CASE CHR$(8) ' Backspace key.
IF string_pos > 0 THEN GOSUB backspace
CASE CHR$(0) + "S" ' Delete key.
GOSUB delete
CASE CHR$(0) + "M" ' Arrow right key.
IF string_pos < LEN(word$) THEN GOSUB cursor_forward
CASE CHR$(0) + "K" ' Arrow left key.
IF string_pos > 0 THEN GOSUB cursor_back
CASE CHR$(0) + "t" ' Ctrl + Arrow right key.
IF string_pos < LEN(word$) THEN GOSUB ctrl_rt
CASE CHR$(0) + "s" ' Ctrl + Arrow left key.
IF string_pos > 0 THEN GOSUB ctrl_lt
CASE CHR$(0) + "G" ' Home
LOCATE , start_column
CASE CHR$(0) + "O" ' End
LOCATE , start_column - 1 + LEN(word$)
IF POS(0) < mr THEN LOCATE , POS(0) + 1
CASE CHR$(0) + "R" ' Insert/overwrite toggel
ovw = 1 - ovw
IF ovw = 0 THEN LOCATE , , 1, 7, 7 ELSE LOCATE , , 1, 7, 30
CASE CHR$(22) ' Ctrl + V - Paste
IF LEN(_CLIPBOARD$) THEN GOSUB paste
CASE CHR$(3) ' Ctrl + C - Copy
GOSUB copy
CASE CHR$(24) ' Ctrl + X - Cut
GOSUB cut
CASE CHR$(1) ' Select all.
GOSUB select_all
CASE CHR$(32) TO "z"
IF string_pos + start_column < mr THEN GOSUB print_chr
END SELECT
y = CSRLIN: x = POS(0) ' Track cursor.
END IF
LOOP
END
print_chr:
IF hl THEN COLOR 7, 0: hl = 0
SELECT CASE ovw
CASE 0
IF start_column + LEN(word$) < mr THEN
word$ = MID$(word$, 1, string_pos) + b$ + MID$(word$, string_pos + 1)
LOCATE , start_column: PRINT SPACE$(LEN(word$) + 1);
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , x + 1
END IF
CASE ELSE
word$ = MID$(word$, 1, string_pos) + b$ + MID$(word$, string_pos + 1)
IF pw THEN PRINT "*"; ELSE PRINT b$;
END SELECT
RETURN
backspace:
IF hl THEN COLOR 7, 0: hl = 0
word$ = MID$(word$, 1, string_pos - 1) + MID$(word$, string_pos + 1)
LOCATE , start_column: PRINT SPACE$(LEN(word$) + 1);
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , x - 1
hl = 0
RETURN
delete:
IF hl THEN
GOSUB cut
COLOR 7, 0: hl = 0
ELSE
word$ = MID$(word$, 1, string_pos) + MID$(word$, string_pos + 2)
LOCATE , start_column: PRINT SPACE$(LEN(word$) + 1);
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , x
END IF
RETURN
cursor_forward:
IF shift% AND POS(0) < mr THEN
IF hl < 0 THEN COLOR 7, 0 ELSE COLOR 0, 7
hl = hl + 1
IF pw THEN PRINT "*"; ELSE PRINT MID$(word$, string_pos + 1, 1);
COLOR 7, 0
ELSE
IF hl THEN GOSUB hl_off
IF POS(0) < mr THEN LOCATE , POS(0) + 1
END IF
RETURN
cursor_back:
IF shift% THEN
IF hl > 0 THEN COLOR 7, 0 ELSE COLOR 0, 7
hl = hl - 1
LOCATE , POS(0) - 1
IF pw THEN PRINT "*"; ELSE PRINT MID$(word$, string_pos, 1);
COLOR 7, 0
ELSE
IF hl THEN GOSUB hl_off
END IF
LOCATE , POS(0) - 1
RETURN
ctrl_rt:
i = 0
DO
i = i + 1 ' Do not use this variable in cursor_forward routine.
GOSUB cursor_forward
string_pos = POS(0) - start_column
LOOP UNTIL MID$(word$, string_pos, 1) = " " OR string_pos >= LEN(word$)
RETURN
ctrl_lt:
i = 0
DO
i = i - 1 ' Do not use this variable in cursor_forward routine.
GOSUB cursor_back
string_pos = POS(0) - start_column
LOOP UNTIL MID$(word$, string_pos, 1) = " " OR POS(0) = start_column
RETURN
hl_off:
LOCATE , start_column
COLOR 7, 0
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , x
hl = 0
RETURN
cut:
SELECT CASE hl
CASE IS > 0
IF b$ <> CHR$(0) + "S" THEN _CLIPBOARD$ = MID$(word$, string_pos + 1 - hl, hl)
j = POS(0) - hl
LOCATE , start_column
PRINT SPACE$(LEN(word$));
word$ = MID$(word$, 1, string_pos - hl) + MID$(word$, string_pos + 1)
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , j
CASE 0
' Do nothing
CASE IS < 0
IF b$ <> CHR$(0) + "S" THEN _CLIPBOARD$ = MID$(word$, string_pos + 1, ABS(hl))
LOCATE , start_column
PRINT SPACE$(LEN(word$));
word$ = MID$(word$, 1, string_pos) + MID$(word$, string_pos + 1 + ABS(hl))
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , start_column + string_pos
END SELECT
RETURN
copy:
SELECT CASE hl
CASE IS > 0
_CLIPBOARD$ = MID$(word$, string_pos + 1 - hl, hl)
CASE 0
' Do nothing
CASE IS < 0
_CLIPBOARD$ = MID$(word$, string_pos + 1, ABS(hl))
END SELECT
RETURN
paste:
tmp$ = _CLIPBOARD$
IF start_column + LEN(word$) + LEN(tmp$) < mr THEN
word$ = MID$(word$, 1, string_pos) + tmp$ + MID$(word$, string_pos + 1)
LOCATE , start_column
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
LOCATE , start_column + string_pos + LEN(tmp$)
END IF
RETURN
select_all:
hl = LEN(word$)
LOCATE , start_column
COLOR 0, 7
IF pw THEN PRINT STRING$(LEN(word$), "*"); ELSE PRINT word$;
RETURN
mouse_event:
IF drag = 0 AND hl THEN GOSUB hl_off
IF mx >= start_column AND mx <= start_column + LEN(word$) THEN
IF drag THEN
IF drag > 0 THEN
IF mx > POS(0) - 1 THEN
shift% = -1: GOSUB cursor_forward
string_pos = POS(0) - start_column
y = CSRLIN: x = POS(0)
END IF
ELSE
IF mx < POS(0) THEN
shift% = -1: GOSUB cursor_back
string_pos = POS(0) - start_column
y = CSRLIN: x = POS(0)
END IF
END IF
ELSE
LOCATE , mx
y = CSRLIN: x = POS(0)
END IF
END IF
RETURN
SUB kb_mse (b$, lb, mx, drag, menu$())
STATIC oldmy, oldmx, z1
IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN shift% = -1 ELSE IF shift% THEN shift% = 0
b$ = INKEY$
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
IF _MOUSEBUTTON(1) THEN
IF lb = 0 THEN
IF ABS(TIMER - z1) < .3 THEN SOUND 1000, .3: z1 = TIMER ELSE lb = 1: z1 = TIMER
END IF
IF oldmy AND oldmx <> mx OR oldmy AND oldmy <> my THEN
drag = SGN(mx - oldmx)
END IF
ELSE
IF lb THEN lb = 0: drag = 0
END IF
IF _MOUSEBUTTON(2) THEN
CALL MyWindow_Menu(menu$(), menu.var)
LOCATE , , 1 ' Show cursor
COLOR 7, 0 '''' should be done in popup.
SELECT CASE menu.var
CASE 1: b$ = CHR$(24)
CASE 2: b$ = CHR$(3)
CASE 3: b$ = CHR$(22)
CASE 4: b$ = CHR$(0) + "S"
CASE 5: b$ = CHR$(1)
CASE 6 ' Do nothing.
CASE 7: SYSTEM
END SELECT
END IF
oldmy = my: oldmx = mx
END SUB
SUB MyWindow_Menu (menu$(), menu.var) ' Self-contained subroutine.
STATIC initialize_menu, WinCon.noi
IF initialize_menu = 0 THEN
initialize_menu = 1
RESTORE WinMenuData
WinCon.noi = 0
DO
READ tmp$
IF tmp$ = "eof" THEN EXIT DO
WinCon.noi = WinCon.noi + 1
REDIM _PRESERVE menu$(WinCon.noi)
menu$(WinCon.noi) = tmp$
LOOP
WinMenuData:
'-------------------------------------User Defined here.--------------------------------------
DATA Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
'---------------------------------------------------------------------------------------------
DATA Close..........Esc,Quit........Alt+F4,eof
END IF
y = CSRLIN: x = POS(0)
LOCATE , , 0 ' Hide cursor
DIM atmp AS STRING
h = 5 ' Variable to determine margin spaces from the right of menu.
FOR i = 1 TO WinCon.noi
j = LEN(menu$(i))
IF j > k THEN k = j
NEXT
mwidth = k + h
mheight = WinCon.noi * 2 + 1 ' Add one for the separate border element.
MenuT = 3: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
DO
_LIMIT 30
'''''''z = GetCursorPos(WinMse)
SELECT CASE menu.var
CASE -1
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
IF my \ 2 = my / 2 AND my AND my <> oldmy THEN
IF MenuHL THEN
atmp = SPACE$(mwidth - 2)
LOCATE MenuHL, MenuL + 2 - 1
COLOR 0, 5
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
PRINT atmp;
END IF
atmp = SPACE$(mwidth - 2)
LOCATE my, MenuL + 2 - 1
COLOR 5, 0
MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
PRINT atmp;
COLOR 0, 5
MenuHL = my
oldmy = my ' <-----------------------'''''
END IF
IF _MOUSEBUTTON(1) THEN
menu.var = (my - MenuT) \ 2 + 1
EXIT DO
END IF
ELSE
' Toggle close menu.
IF _MOUSEBUTTON(1) THEN
IF my >= _SCREENY AND my <= _SCREENY + 24 AND mx >= _SCREENX + 36 AND mx <= _SCREENX + 48 THEN
menu.var = 0: EXIT DO ' Close menu.
ELSE
IF my >= _SCREENY AND my <= _SCREENY + _FONTHEIGHT * (_HEIGHT + 1) AND mx >= _SCREENX AND mx <= _SCREENX + _FONTWIDTH * _WIDTH THEN
ELSE ' Outside of app window.
menu.var = 0: EXIT DO ' Close menu.
END IF
END IF
END IF
IF _MOUSEBUTTON(1) THEN ' Outside of menu closes menu.
menu.var = 0 ' Close.
EXIT DO
END IF
END IF
'''' oldmy = my
''''''''''CALL MyWindow_keypress(b$)
IF b$ = CHR$(27) THEN EXIT DO
CASE ELSE ' Open menu.
menu.var = -1
PCOPY 0, 1
PALETTE 5, 63
PALETTE 1, 8
PALETTE 3, 56
COLOR 0, 5
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 5
PRINT CHR$(179); SPACE$(mwidth - 2) + CHR$(179);
COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1)): COLOR 1, 5
NEXT
COLOR 0, 5
PRINT CHR$(192) + STRING$(mwidth - 2, 196) + CHR$(217);
COLOR 5, 3: PRINT CHR$(SCREEN(CSRLIN, POS(0))) + CHR$(SCREEN(CSRLIN, POS(0) + 1))
LOCATE , MenuL + 2
FOR i = 1 TO mwidth
PRINT CHR$(SCREEN(CSRLIN, POS(0)));
NEXT
COLOR 0, 5
LOCATE MenuT + 2, MenuL + 2
FOR i = 0 TO WinCon.noi - 1
LOCATE MenuT + 1 + i * 2, 3
PRINT menu$(i + 1)
LOCATE , MenuL
IF i + 1 < WinCon.noi THEN PRINT "Ã" + STRING$(mwidth - 2, CHR$(196)) + "´";
NEXT
DO: _LIMIT 10: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1) = 0 ' Wait for button release to avoid continuous toggle event.
END SELECT
LOOP
PCOPY 1, 0
LOCATE y, x
_KEYCLEAR
DO: _LIMIT 10: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1) = 0
END SUBPete