Posts: 2,119
Threads: 212
Joined: Apr 2022
Reputation:
97
Fake News + Phony Politicians = Real Problems
Posts: 2,648
Threads: 313
Joined: Apr 2022
Reputation:
208
(12-21-2022, 10:10 PM)Kernelpanic Wrote: (12-21-2022, 08:22 PM)Pete Wrote: Anyone know where I can find a cute librarian?
Pete
Of coures! 
Sounds like you're asking for my services. All those libraries you're talking about, I already have. 
Unfortunately, I don't think you can afford my services, and I don't think your HR Department would allow it. You'd never get any work done, as they'd never get you out of their office for all the harassment you always send my pretty little way. 
Posts: 2,119
Threads: 212
Joined: Apr 2022
Reputation:
97
My problem is I live in California, and all our libraries have restricted magazines.
Pete
Posts: 170
Threads: 12
Joined: Apr 2022
Reputation:
5
Pete. Did you ever find that cute Librarian?
May your journey be free of incident. Live long and prosper.
Posts: 2,119
Threads: 212
Joined: Apr 2022
Reputation:
97
Yes I did, but I won't be seeing her anytime soon, because her schedule is completely booked.
Pete
Fake News + Phony Politicians = Real Problems
Posts: 2,119
Threads: 212
Joined: Apr 2022
Reputation:
97
12-22-2022, 03:48 PM
(This post was last modified: 12-22-2022, 03:49 PM by Pete.)
Okay, okay, okay, bad puns aside, here's what the Rock's got cooking....
Code: (Select All) REDIM SHARED menu$(1)
DO
my_mse_kbd lb, rb, my, mx, dblclk, drag, b$
IF rb THEN MyWindow_Menu menu$(), menu.var, b$
LOOP
SUB MyWindow_Menu (menu$(), menu.var, b$) ' 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
DO
_LIMIT 30
'''''''z = GetCursorPos(WinMse)
IF rt_menu <> 2 THEN CALL my_mse_kbd(lb, rb, my, mx, dblclk, drag, b$)
IF rb = 0 AND rt_menu = -1 THEN rt_menu = -2
IF rb AND rt_menu = -2 THEN rt_menu = 2: EXIT DO ' Move to a new position.
SELECT CASE menu.var
CASE -1
IF my > MenuT AND my < MenuB AND mx > MenuL AND mx < MenuR THEN
IF (my - MenuT) \ 2 <> (my - MenuT) / 2 AND my <> oldmy THEN ' Works for odd or even number top margins.
IF MenuHL THEN ' Remove highlighting from previous hover.
atmp = SPACE$(mwidth - 2)
MID$(atmp, 2, LEN(menu$((MenuHL - MenuT) \ 2 + 1))) = menu$((MenuHL - MenuT) \ 2 + 1)
LOCATE MenuHL, MenuL + 2 - 1
COLOR 0, 5: PRINT atmp;
END IF
atmp = SPACE$(mwidth - 2)
MID$(atmp, 2, LEN(menu$((my - MenuT) \ 2 + 1))) = menu$((my - MenuT) \ 2 + 1)
LOCATE my, MenuL + 2 - 1
COLOR 5, 0
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
IF b$ = CHR$(27) THEN b$ = "": EXIT DO ' Simply close popup.
IF LEN(b$) THEN
'-----------------------------------------------------------------------------------------------------------
' Valid menu shortcut key list here.
SELECT CASE b$
CASE CHR$(0) + "S", CHR$(22), CHR$(24), CHR$(1), CHR$(3): EXIT DO
END SELECT
END IF
CASE ELSE ' Open menu.
menu_variety = 1 '''''''''''''''
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.
SELECT CASE menu_variety
CASE 0 ' Fixed menu to left.
MenuT = 3: MenuL = 1: MenuR = MenuL + mwidth: MenuB = MenuT + mheight
CASE 1 ' Movable menu.
WHILE _MOUSEINPUT: WEND
MenuT = _MOUSEY
MenuL = _MOUSEX
IF MenuT + mheight >= _HEIGHT THEN MenuT = _HEIGHT - mheight - 1 ' -1 for shadow.
IF MenuL + mwidth >= _WIDTH THEN MenuL = _WIDTH - mwidth - 1 ' -1 for shadow.
MenuR = MenuL + mwidth: MenuB = MenuT + mheight
END SELECT
menu.var = -1
PCOPY 0, 1
COLOR 0, 5
LOCATE MenuT, MenuL
PRINT CHR$(218) + STRING$(mwidth - 2, 196) + CHR$(191)
FOR i = 1 TO mheight - 2
COLOR 0, 5: LOCATE , MenuL
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: LOCATE , MenuL
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, MenuL + 2
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 SUB
SUB my_mse_kbd (lb, rb, my, mx, dblclk, drag, b$)
STATIC oldmy, oldmx, z1
DO
WHILE _MOUSEINPUT: WEND
my = _MOUSEY
mx = _MOUSEX
LOOP UNTIL my
IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN shift% = -1 ELSE IF shift% THEN shift% = 0
b$ = INKEY$
IF _MOUSEBUTTON(1) THEN
IF lb = 0 THEN
lb = 1
IF ABS(TIMER - z1) < .3 THEN dblclk = -1 ELSE dblclk = 0: z1 = TIMER
END IF
IF oldmy AND oldmx <> mx OR oldmy AND oldmy <> my THEN
IF mx <> oldmx THEN drag = SGN(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
END IF
ELSE
IF lb THEN lb = 0: drag = 0
END IF
IF _MOUSEBUTTON(2) AND rb = 0 THEN
rb = 1
ELSE
IF _MOUSEBUTTON(2) = 0 AND rb THEN rb = 0
END IF
oldmy = my: oldmx = mx
END SUB
So When making this popup menu into a library, I have the option to either keep the mouse/keyboard sub as is, and keep the names of all subs in the library consistent, so they are always identifiable in a list when combined with other subs in other apps using this library, or I could eliminate the sub and just insert it where it is called in the "MyWindowMenu" sub.
I also have the option of letting the program flow through this library, or keep it locked up inside the library until a library action is taken.
So many pros and cons on both sides. Oh what to do? This is like falling in love with two women. Oh wait, that's easy, just download FreeBASIC and use the _POLYGAMY switch.
Kidding aside, I see the mouse/keyboard being used in most of these libs, so I might just go with having each library $INCLUDE that library.
And all this time Steve is thinking. I could show Pete what I do, but that wouldn't keep the little ******* busy, and frankly, my HR team really, really needs their x-mas break!
Pete
|
