Library help

[Pete]

Pete

[SMcNeill]

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. 

[Pete]

My problem is I live in California, and all our libraries have restricted magazines.

Pete

[johnno56]

Pete. Did you ever find that cute Librarian?

[Pete]

Yes I did, but I won't be seeing her anytime soon, because her schedule is completely booked.

Pete

[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