Scroll Bars

[SMcNeill]

Always needed.  And I never can find them when I needs them.  

Here they is once again, simple Scroll Bars.

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

[Pete]

Stop coding at the bars, especially after your 5th round!

Pete

[Pete]

Okay, now that I'm done crying over the 49ers MASSACRE, I had a chance to run the code. Not bad for something out not made in SCREEN 0. Actually, it is interesting to imagine using a screen image copy instead of creating additional code to determine and place text to the screen as it is being scrolled. I would think that concept would collapse for large documents, unless you kept updating the image in the background, which in itself would be as much or more code than just adding the text to the screen. To be honest, I've never tried horizontal scrolling with text.

Hmm...

Code: (Select All)

Width 120, 42

w = _Width

ReDim a$(145)

For i = 1 To 145

    a$ = "LINE #" + Str$(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."

    a$(i) = a$

Next

GoSub dsp

Do

    _Limit 30

    b$ = InKey$

    Select Case b$

        Case Chr$(0) + "K"

            If hscr > 0 Then hscr = hscr - 1

        Case Chr$(0) + "M"

            hscr = hscr + 1

        Case Chr$(27): System

    End Select

    If hscr <> oldhscr Then GoSub dsp

    oldhscr = hscr

Loop



dsp:

Locate 1, 1

Screen 0, 0, 1, 0

For i = 1 To _Height

    a$ = Space$(w)

    Mid$(a$, 1) = Mid$(a$(i), hscr + 1, w + hscr)

    Locate i, 1: Print a$;

Next

PCopy 1, 0

Screen 0, 0, 0, 0

Return

Anyway, I'd suppose I'd do it something like that. For posterity, I threw in the PCOPY/SCREEN stuff. QB664 is fast enough it hardly makes a flicker's bit of difference theses days, but in the QuickBASIC Period, it was HUGE!

Question, what method did Rob use in the IDE? Oh, and if not arrays, I could see the same thing done in a single string with CHR$(13) + CHR$(10) added to indicate end of line.

Pete