Author Topic: Hey gang, fun little scrollbar demo routine... (Read 2793 times)

Pete · « **on:** October 30, 2020, 07:42:27 pm »

Code: QB64: [Select]

DIM scrn AS my_scrn
DIM page AS my_page
DIM margin AS my_margin
DIM scrb AS my_scrb
DIM cursor AS my_cursor
DIM mb AS my_mb
 
DIM noe AS INTEGER
DIM row AS INTEGER
DIM scr AS INTEGER
 
TYPE my_scrn
    w AS INTEGER
    h AS INTEGER
END TYPE
 
TYPE my_page
    w AS INTEGER
    h AS INTEGER
    c AS INTEGER
END TYPE
 
TYPE my_margin
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    r AS INTEGER
END TYPE
 
TYPE my_scrb
    t AS INTEGER
    b AS INTEGER
    l AS INTEGER
    x AS INTEGER
    i AS INTEGER
    d AS INTEGER
    h AS INTEGER
    s AS INTEGER
    opt AS INTEGER
    adjust AS INTEGER
END TYPE
 
TYPE my_cursor
    find AS INTEGER
    scbrrow AS INTEGER ' row + scr
    scbrcol AS INTEGER ' POS(0)
    holdscr AS INTEGER ' Holds scr
    holdrow AS INTEGER ' Holds row
    holdscrbx AS INTEGER ' Holds scrb.x
END TYPE
 
TYPE my_mb
    l AS INTEGER
    r AS INTEGER
    m AS INTEGER
    drag AS INTEGER
    dragon AS INTEGER
END TYPE
 
' DEMO -----------------------------------------------------------------
CLS
DIM SHARED debug%
DO: PRINT "Input screen width: 60 - 140, blank for default or -1 for debug mode: ";: INPUT screen_width%
    IF screen_width% = -1 THEN debug% = -1: margin.t = 1: margin.b = 1: margin.l = 127: margin.r = 5: screen_width% = 150: noe = 99: GOTO make_fake_text ' Debug mode.
    IF screen_width% = 0 THEN margin.t = 1: margin.b = 1: margin.l = 10: margin.r = 12: screen_width% = 80: noe = 40: GOTO make_fake_text ' Use defaults for demo.
    IF screen_width% >= 60 AND screen_width% <= 140 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input number of text entries 10 - 99: ";: INPUT noe
    IF noe >= 10 AND noe <= 99 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin top 0 to 10: ";: INPUT margin.t
    IF margin.t >= 0 AND margin.t <= 10 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin bottom 0 to 10: ";: INPUT margin.b
    IF margin.b >= 0 AND margin.b <= 10 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin left 0 to 20: ";: INPUT margin.l
    IF margin.l >= 0 AND margin.l <= 20 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input margin right 2 to 20: ";: INPUT margin.r
    IF margin.r >= 2 AND margin.r <= 20 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
DO: PRINT "Input scrollbar indicator type 1 single 0 Expands per elements: ";: INPUT scrb.opt
    IF scrb.opt >= 0 AND scrb.opt <= 1 THEN EXIT DO ELSE PRINT: PRINT "Redo...": PRINT
LOOP
 
make_fake_text:
CLS: REDIM x$(noe)
FOR i% = 1 TO noe
    FOR j% = 1 TO screen_width% - (margin.l + margin.r) - 3
        k% = (RND * 24) + 97 + 8
        IF k% > 122 THEN
            IF RIGHT$(x$(i%), 1) <> " " AND LEN(x$(i%)) THEN a$ = " " ELSE a$ = CHR$((RND * 24) + 97)
        ELSE
            a$ = CHR$(k%)
        END IF
        x$(i%) = x$(i%) + a$
    NEXT j%
    x$(i%) = STRING$(2 - LEN(LTRIM$(STR$(i%))), "0") + LTRIM$(STR$(i%)) + " " + x$(i%)
NEXT i%
 
WIDTH screen_width%, 25
IF screen_width% > 90 THEN _SCREENMOVE 0, 0
CLS
' End Demo ------------------------------------------------------------------
 
GOSUB getvar_setscrn
 
DO
    IF debug% THEN GOSUB debugger ' Debug only.
 
    GOSUB displayscrn
 
    GOSUB makescrb
 
    GOSUB getkey
LOOP
END
 
getvar_setscrn:
scrn.w = _WIDTH
scrn.h = _HEIGHT
scrb.x = 0 ' Relative position of the scrollbar cursor from top of scrb.h. 0 Off / 1 to
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.t = margin.t + 1
scrb.b = margin.t + page.h
scrb.l = margin.l + page.w + 2
page.w = scrn.w - (margin.l + margin.r)
page.h = scrn.h - (margin.t + margin.b)
scrb.d = scrb.b - scrb.t + 1
scrb.h = scrb.b - scrb.t - 1 ' Max. vertical scroll. Bar minus the top and bottom arrow symbols.
IF scrb.opt = 0 THEN
    scrb.s = (scrb.h + 1) * 2 - noe: IF scrb.s <= 0 THEN scrb.s = 1
ELSE
    scrb.s = 1
END IF
 
IF row = 0 THEN row = 1
IF page.c = 0 THEN page.c = 7 ' Cursor apearance as underline.
LOCATE margin.t + row, margin.l + 1, 1, 7, page.c
GOSUB getcurrow: cursor.find = -1
RETURN
 
displayscrn:
yy% = CSRLIN: xx% = POS(0)
LOCATE , , 0: ' Cursor hide.
j% = 0
DO ' page.h determines how mnay rows of text are displayed.
    j% = j% + 1
    LOCATE margin.t + j%, margin.l + 1
    PRINT x$(scr + j%);
    IF j% = page.h OR j% = noe THEN EXIT DO
LOOP
LOCATE yy%, xx%
IF cursor.find THEN
    cursor.find = 0
    IF cursor.scbrrow > scr AND cursor.scbrrow <= scr + page.h THEN
        LOCATE margin.t + cursor.scbrrow - scr, cursor.scbrcol, 1 ' Cursor show.
    END IF
ELSE
    LOCATE , , 1 ' Show cursor.
END IF
RETURN
 
makescrb:
yy% = CSRLIN: xx% = POS(0)
LOCATE scrb.t, scrb.l
COLOR 0, 7
PRINT CHR$(24);
COLOR 7, 0
FOR i% = 1 TO scrb.h
    LOCATE scrb.t + i%, scrb.l
    PRINT CHR$(177);
NEXT i%
LOCATE scrb.b, scrb.l
COLOR 0, 7
PRINT CHR$(25);
COLOR 7, 0
 
IF noe > scrb.h + 2 THEN
    FOR i% = 1 TO scrb.s
        LOCATE scrb.t + scrb.x + i%, scrb.l
        COLOR 1, 0
        PRINT CHR$(176); ' Scrollbar index cursor.
    NEXT
    COLOR 7, 0
END IF
LOCATE yy%, xx%
RETURN
 
getkey:
row = CSRLIN - margin.t
DO
    _LIMIT 60
    b$ = INKEY$
    IF LEN(b$) THEN
        SELECT CASE b$
            CASE CHR$(0) + "R"
                IF page.c = 7 THEN page.c = 30 ELSE page.c = 7
                LOCATE , , 1, 7, page.c
            CASE CHR$(0) + "H"
                GOSUB backtocursor
                IF row + scr > 0 THEN
                    IF row = 1 THEN
                        IF scr > 0 THEN
                            scr = scr - 1
                            GOSUB displayscrn
                        END IF
                    ELSE
                        row = row - 1
                    END IF
                    LOCATE row + margin.t, margin.l + 1
                    GOSUB getcurrow
                END IF
            CASE CHR$(0) + "P"
                GOSUB backtocursor
                IF row + scr < noe THEN
                    IF row = page.h THEN
                        scr = scr + 1
                        GOSUB displayscrn
                    ELSE
                        row = row + 1
                    END IF
                    LOCATE row + margin.t, margin.l + 1
                    GOSUB getcurrow
                END IF
            CASE CHR$(9)
                RUN
            CASE CHR$(27)
                SYSTEM
        END SELECT
 
        ' Reverse algorithm. Not needed for this routine. scrb.x = scrb.i / ((noe - scrb.d) / (scrb.h - scrb.s))
 
        IF row + scr >= INT((scrb.x + 1) * ((noe - scrb.d) / (scrb.h - scrb.s))) + page.h THEN
            scrb.x = scrb.x + 1
 
            GOSUB makescrb
 
            scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
        ELSEIF row + scr <= scrb.i THEN
            scrb.x = scrb.x - 1
 
            GOSUB makescrb
 
            scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
        END IF
    END IF
 
    IF delay.on! THEN ' Scrollbar delay.
        _DELAY delay.on!
        delay.on! = 0 ' Toggle off.
    END IF
 
    mb.m = 0
    WHILE _MOUSEINPUT
        mb.l = _MOUSEBUTTON(1)
        mb.m = mb.m + _MOUSEWHEEL
    WEND
 
    IF mb.l OR mb.m THEN
        mx% = _MOUSEX ' Mouse column.
        my% = _MOUSEY ' Mouse row.
 
        IF mx% = scrb.l AND scrb.s AND my% >= scrb.t AND my% <= scrb.b OR scrbardrag% AND my% > scrb.t AND my% < scrb.b OR mb.m > 0 AND scrb.x + scrb.s < scrb.h OR mb.m < 0 AND scrb.x <> 0 THEN ' Mouse on scrollbar or doing a bar cursor drag or using the scroll wheel.
            IF my% = scrb.t AND scrb.x > 0 OR my% = scrb.b AND scrb.x + scrb.s < scrb.h OR mb.m THEN ' Mouse on a scrollbar arrow.
                IF my% = scrb.t OR mb.m < 0 THEN scrb.x = scrb.x - 1 ELSE scrb.x = scrb.x + 1 ' Top or bottom arrow.
                IF mb.m = 0 THEN delay.on! = .15
                scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
                scr = scrb.i
                cursor.find = -1
                EXIT DO
            ELSEIF my% - (scrb.t + 1) >= scrb.x AND my% - (scrb.t + 1) <= scrb.x + scrb.s - 1 AND scrbardrag% = 0 THEN ' Mouse on scrollbar cursor.
                scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
            ELSEIF my% > scrb.t AND my% < scrb.b THEN ' Mouse on scrollbar between scrollbar arrow and cursor.
                IF my% - (scrb.t + 1) - scrb.adjust >= 0 AND my% - (scrb.t + 1) + scrb.s - scrb.adjust <= scrb.h OR scrbardrag% = 0 THEN
                    IF scrbardrag% = 0 THEN ' NO drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position.
                        IF my% - (scrb.t + 1) > scrb.x THEN
                            scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1
                        ELSE
                            scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1
                        END IF
                    END IF
                    scrb.x = my% - (scrb.t + 1) - scrb.adjust
                    scrb.i = INT(scrb.x * ((noe - scrb.d) / (scrb.h - scrb.s)))
                    scr = scrb.i
                    cursor.find = -1
                    EXIT DO
                ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust.
                    IF mx% = scrb.l THEN scrbardrag% = 0: scrb.adjust = 0
                END IF
            END IF
        ELSEIF my% >= margin.t + 1 AND my% <= margin.t + page.h THEN
            IF mx% >= margin.l + 1 AND mx% <= scrn.w - margin.r THEN
                LOCATE my%, mx%, 1 ' Locate by left mouse click and show cursor.
                GOSUB getcurrow
            END IF
        END IF
    ELSE
        scrbardrag% = 0: scrb.adjust = 0
    END IF
LOOP
RETURN
 
getcurrow:
row = CSRLIN - margin.t
cursor.scbrrow = row + scr
cursor.scbrcol = POS(0)
cursor.holdscr = scr
cursor.holdrow = row
cursor.holdscrbx = scrb.x
RETURN
 
backtocursor:
IF cursor.scbrrow > scr AND cursor.scbrrow <= scr + page.h THEN
    ' Display region does not contain cursor. Do nothing.
ELSE ' Display region contains the cursor.
    scr = cursor.holdscr
    row = cursor.holdrow
    scrb.x = cursor.holdscrbx
    scrb.i = scr
    GOSUB makescrb
    GOSUB displayscrn
END IF
RETURN
 
debugger:
ss% = CSRLIN: tt% = POS(0)
LOCATE 2, 1
PRINT " initiate_scrb% ="; initiate_scrb%
PRINT " scrn.w ="; scrn.w; " scrn.h ="; scrn.h; scrb.s; "     "
PRINT " margin.t ="; margin.t; " margin.b ="; margin.b; " margin.l ="; margin.l; " margin.r ="; margin.r; scrb.s; "     "
PRINT " scrb.t ="; scrb.t; " scrb.b ="; scrb.b; " scrb.l ="; scrb.l; " scrb.d ="; scrb.d; " scrb.x = "; scrb.x; " scrb.i ="; scrb.i; " scrb.h ="; scrb.h; " scrb.s ="; scrb.s; "     "
PRINT " cursor.find ="; cursor.find; " cursor.scbrrow ="; cursor.scbrrow; " cursor.scbrcol = "; cursor.scbrcol; scrb.s; "     "
PRINT " cursor.holdscr ="; cursor.holdscr; " cursor.holdrow ="; cursor.holdrow; " cursor.holdscrbx ="; cursor.holdscrbx
PRINT " page.h% ="; page.h%; " noe% = "; noe%; " delay_on! ="; delay_on!; " row% = "; row%; " scr% ="; scr%; " mx% ="; mx%; " my% ="; my%; " mb.l ="; mb.l; " mb.dragon ="; mb.dragon; " mb.drag ="; mb.drag; "   "
LOCATE ss%, tt%
_DELAY .05
RETURN

Now I have a library version, but I'm skeptical of being able to use it. Between the need for a display and key input, you just cannot easily make this routine into a separate drag and drop library. I'll probably just marry it to an editor routine, anyway.

I now need to go through the code and start renaming variables, refining, etc. For instance, apparently the little square in the scrollbar is called a "box" or "thumb" and I have to change that in some remarks. Any other comments as to better names, etc. are welcome.

I'm done with all the algorithms. I refined those from the library ones I posted a couple of days ago in a different thread, and I have to say they are pretty tight.

Try it for fun, and make use of it if you need to put a scrollbar routine in any of your SCREEN ZERO programs.

Note: The demo may not be 100% goof proof, but I don't care. It's only included so folks can fiddle with different set ups.

Pete

Edited to include mouse wheel scrolling.

bplus · « **Reply #1 on:** October 31, 2020, 02:44:25 am »

@Pete, sorry I have to say, all those lines of code and you can't scroll with mouse wheel? I was kind of surprised.

Scrollbar looks and works fine though, I guess with screen 0 you have to put up with those narrow bars with the funny dots ;-))

Pete · « **Reply #2 on:** October 31, 2020, 04:37:26 am »

You can drag it, even if you move off the bar, but keepthe mouse button down (drag) or you can click off the box in the bar, but no, I didn't add a wheel function... well, not yet. That's an easy add though. What's not so easy is incorporating this into an editor, which is why I punted on it as a library. I've got the arrow keys working in an editor, but I have to fiddle a little more to get the mouse routine working properly. After I fix that, I'll add a mouse wheel.

Narrow? Who in the hell wants a big fat scroll bar? They are a drain on our health care system, and look awful in a speedo. I bet those dots don't look so bad after saying that!

Pete

Unseen Machine · « **Reply #3 on:** October 31, 2020, 06:15:09 am »

@Pete

Quote

SCREEN ZERO programs.

I make sure i use it in all of mine pete i promise! :)

Unseen

Petr · « **Reply #4 on:** October 31, 2020, 06:29:11 am »

Nicely done, Pete.

Pete · « **Reply #5 on:** October 31, 2020, 06:34:55 am »

Quote from: Unseen Machine on October 31, 2020, 06:15:09 am

@Pete

I make sure i use it in all of mine pete i promise! :)

Unseen

Are you saying you have NO SCREEN ZERO programs? You are DEAD to me... Oh wait, you think FB sucks. Consider yourself resurrected, and officially off my non-screen zero smite list. Sorry for being a smite ASCII.

@ Petr, thanks! :)

Pete

News:

Author Topic: Hey gang, fun little scrollbar demo routine... (Read 2793 times)

Pete

Hey gang, fun little scrollbar demo routine...

bplus

Re: Hey gang, fun little scrollbar demo routine...

Pete

Re: Hey gang, fun little scrollbar demo routine...

Unseen Machine

Re: Hey gang, fun little scrollbar demo routine...

Petr

Re: Hey gang, fun little scrollbar demo routine...

Pete

Re: Hey gang, fun little scrollbar demo routine...