Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Scroll bars and resizable programs
#1
Code: (Select All)
DIM SHARED WorkScreen AS LONG, DisplayScreen AS LONG
$RESIZE:ON

WorkScreen = _NEWIMAGE(3600, 2400, 32) ' a nice large screen so we can scroll like crazy
DisplayScreen = _NEWIMAGE(640, 480, 32) 'a nice small display screen

SCREEN DisplayScreen
_DEST WorkScreen
PRINT "Let's print all sorts of stuff on our workscreen, and make certain that it's more than long enough so that it'll scroll quite a ways across from the normal screen."
PRINT
PRINT
LINE (400, 400)-(3000, 1200), &HFFFFFF00, BF
FOR i = 1 TO 145
    COLOR _RGB32(RND * 256, RND * 256, RND * 256), 0 'various colors for each line
    PRINT "LINE #"; i; ".  This is just a bunch of junk for testing purposes only.  As you can see, if you want to read all the text from this line, you're going to have to scroll to see it all."
NEXT





StartX = 0: StartY = 0: W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
_DEST DisplayScreen
DO
    IF _RESIZE THEN
        temp = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
        SCREEN temp
        _FREEIMAGE DisplayScreen
        DisplayScreen = temp
        W = _WIDTH(DisplayScreen): H = _HEIGHT(DisplayScreen)
        _DELAY .25
        junk = _RESIZE 'clear the resize flag after manually setting the screen to the size we specified.
    END IF
    _LIMIT 30
    CLS
    ScrollBar StartX, 2
    ScrollBar StartY, 1

    k = _KEYHIT
    SELECT CASE k
        CASE ASC("A"), ASC("a"), 19200: StartX = StartX - 10: IF StartX < 0 THEN StartX = 0
        CASE ASC("S"), ASC("s"), 20480: StartY = StartY + 10: IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
        CASE ASC("D"), ASC("d"), 19712: StartX = StartX + 10: IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
        CASE ASC("W"), ASC("w"), 18432: StartY = StartY - 10: IF StartY < 0 THEN StartY = 0
    END SELECT
    WHILE _MOUSEINPUT: WEND
    IF _MOUSEBUTTON(1) THEN
        IF _MOUSEX > W - 21 AND _MOUSEY < H - 20 THEN 'We're on a up/down scroll bar
            StartY = _MOUSEY / _HEIGHT(DisplayScreen) * _HEIGHT(WorkScreen)
            IF StartY > _HEIGHT(WorkScreen) - H THEN StartY = _HEIGHT(WorkScreen) - H
        END IF
        IF _MOUSEY > H - 21 AND _MOUSEX < W - 20 THEN 'we're on the left/right scroll bar
            StartX = _MOUSEX / _WIDTH(DisplayScreen) * _WIDTH(WorkScreen)
            IF StartX > _WIDTH(WorkScreen) - W THEN StartX = _WIDTH(WorkScreen) - W
        END IF
    END IF

    _PUTIMAGE (0, 0)-(W - 20, H - 20), WorkScreen, DisplayScreen, (StartX, StartY)-STEP(W, H)
    _DISPLAY
LOOP





SUB ScrollBar (Start, Direction)
    D = _DEST: _DEST DisplayScreen 'our scrollbars show on the display
    Min = 0
    MaxH = _HEIGHT(DisplayScreen)
    MaxW = _WIDTH(DisplayScreen)
    H = _HEIGHT(WorkScreen)
    W = _WIDTH(WorkScreen)
    IF Direction = 1 THEN 'up/down bar
        Box MaxW - 20, 0, 20, MaxH - 20, &HFF777777, &HFFFFFFFF
        Box MaxW - 19, Start / H * MaxH, 18, MaxH / H * MaxH - 20, &HFFFF0000, 0 'Red with transparent
    ELSE 'left/right bar
        Box Min, MaxH - 20, MaxW - 20, 20, &HFF777777, &HFFFFFFFF 'Gray with white border
        Box Start / W * MaxW, MaxH - 19, MaxW / W * MaxW - 20, 18, &HFFFF0000, 0 'Red with transparent
    END IF
    _DEST D
END SUB


SUB Box (x, y, wide, high, kolor AS _UNSIGNED LONG, border AS _UNSIGNED LONG)
    LINE (x, y)-STEP(wide, high), kolor, BF
    LINE (x, y)-STEP(wide, high), border, B
END SUB


Use arrows (or WASD) to scroll the screen, or press the mousebutton down over the scroll bar and see it in action.  Then grab the corner of the screen and resize it, and watch how the scroll bars automatically resize to fit the new dimensions and continue to work as you'd expect them to.

Resizeable program -- Check!
Scroll bars for it -- Check!

As the title says, "Scroll bars and resizable programs".  We do both things in this little demo.  (And now we also do arrow keys and mouse support!)
Reply


Messages In This Thread
Scroll bars and resizable programs - by SMcNeill - 04-23-2022, 05:25 PM



Users browsing this thread: 1 Guest(s)