And yes, it's in SCREEN 0, which of course means it looks way better than anything made in graphics! 
Works with mouse and keyboard. You can resize the window using a mouse drag on the edges or the corners.
Pete
Code: (Select All)
_Title "Pete's Scroll Bar Demo"
$Resize:On
Type TextVar
mt As Integer
mr As Integer
mb As Integer
ml As Integer
bsTop As Integer
bsRight As Integer
bsBottom As Integer
bsLeft As Integer
noe As Integer
nol As Integer
scr As Integer
wide As Integer
tall As Integer
fw As Integer
fh As Integer
ScrnResizeW As Integer
ScrnResizeH As Integer
End Type
Dim t As TextVar
Type MouseVar
x As Integer
y As Integer
lb As Integer
rb As Integer
mb As Integer
mw As Integer
clkcnt As Integer
prevx As Integer
prevy As Integer
drag As Integer
sbar As Integer
sbRow As Integer
End Type
Dim m As MouseVar
t.noe = 24
For i = 1 To t.noe
cntr$ = "000"
x$ = LTrim$(Str$(i))
Select Case Len(x$)
Case 1: Mid$(cntr$, 3, 1) = x$
Case 2: Mid$(cntr$, 2, 2) = x$
Case 3: Mid$(cntr$, 1, 3) = x$
End Select
ReDim _Preserve Text$(i): Text$(i) = cntr$
Next
Do
_Limit 30
GUI Text$(), m, t
Loop
Sub GUI (Text$(), m As MouseVar, t As TextVar)
Static setup, initiate, oldscr, oldsbRow, TDelay, b$, olddragmov, dragmov, ThumbTop, ThumbSize
If setup = 0 Then
setup = 1
GoSub skin
GoSub ScrollBar
GoSub disply
End If
If TDelay Then If Abs(Timer - TDelay) > .1 Then TDelay = 0
oldscr = t.scr: oldsbRow = m.sbRow
MseKbd m, b$
If m.mw Then
m.mw = m.mw \ Abs(m.mw)
If m.mw < 0 And t.scr + m.mw > -1 Or m.mw > 0 And t.scr + t.nol < t.noe Then
t.scr = t.scr + m.mw
End If
End If
If m.drag = 0 Then ' Non-drag mouse related scroll bar events with clicks in scroll bar track and not on scroll bar thumb.
Select Case m.lb
Case -1 ' Left click.
If m.y = t.mt - t.bsTop And m.x >= t.mr + t.bsRight + 1 Then
If m.sbRow > t.mt Then m.sbRow = m.sbRow - 1
ElseIf m.y = t.mb + t.bsBottom And m.x >= t.mr + t.bsRight + 1 Then
If m.sbRow + ThumbSize < t.mb Then m.sbRow = m.sbRow + 1
ElseIf m.y >= t.mt And m.y <= t.mb And m.x >= t.mr + t.bsRight + 1 Then
If Screen(m.y, m.x, 0) <> 219 Then
If m.y > m.sbRow Then m.sbRow = m.y - ThumbSize Else m.sbRow = m.y
End If
End If
If m.sbRow <> oldsbRow Then TDelay = Timer
Case 1 ' Left button down. Auto scroll.
If TDelay = 0 Then
If m.y = t.mt - t.bsTop And m.x >= t.mr + t.bsRight + 1 Then
If m.sbRow > t.mt Then m.sbRow = m.sbRow - 1
ElseIf m.y = t.mb + t.bsBottom And m.x >= t.mr + t.bsRight + 1 Then
If m.sbRow + ThumbSize < t.mb Then m.sbRow = m.sbRow + 1
End If
End If
End Select
End If
If m.y Then ' Click on scroll bar thumb and drag.
If Screen(m.y, m.x, 0) = 219 Or m.drag Then
If m.lb = -1 Then
m.drag = -1
ThumbTop = m.y - m.sbRow
Else
If m.drag Then
If m.y <> m.prevy Then
If m.y > m.sbRow And m.y < t.mb + t.bsBottom Or m.y < m.sbRow And m.y > t.mt - t.bsTop Then
olddragmov = dragmov: If m.y < m.prevy Then dragmov = -1 Else dragmov = 1
If m.y - ThumbTop + ThumbSize <= t.mb And m.y - ThumbTop >= t.mt Then m.sbRow = m.y - ThumbTop
If m.y - ThumbTop + ThumbSize < 0 Then m.sbRow = t.mt
If m.y - ThumbTop + ThumbSize > t.mb Then m.sbRow = t.mb - ThumbSize
End If
If olddragmov And dragmov <> olddragmov Then ThumbTop = m.y - m.sbRow
End If
End If
End If
End If
End If
If _Resize Then
j = _ResizeHeight: k = _ResizeWidth
If j <> _Height * _FontHeight Or k <> _Width * _FontWidth Then
t.ScrnResizeW = k \ _FontWidth: t.ScrnResizeH = j \ _FontHeight
GoSub skin: GoSub ScrollBar: GoSub disply
End If
End If
Select Case b$
Case Chr$(27)
System
Case Chr$(0) + "H"
If t.scr > 0 Then t.scr = t.scr - 1
Case Chr$(0) + "P"
If t.scr + t.nol < t.noe Then t.scr = t.scr + 1
Case Chr$(0) + "I"
If t.scr - (t.nol - 1) > 0 Then t.scr = t.scr - (t.nol - 1) Else t.scr = 0
Case Chr$(0) + "Q"
If t.scr + (t.nol - 1) + t.nol < t.noe Then t.scr = t.scr + (t.nol - 1) Else t.scr = t.noe - t.nol
Case Chr$(0) + "w"
t.scr = 0
Case Chr$(0) + "u"
t.scr = t.noe - t.nol
End Select
If oldscr <> t.scr Or oldsbRow <> m.sbRow Then
GoSub ScrollBar
GoSub disply
End If
m.prevy = m.y
Exit Sub '--------------------------------------------------------->
skin:
If initiate = 0 Or t.ScrnResizeW Then
initiate = 1
If t.ScrnResizeW Then
Width t.ScrnResizeW, t.ScrnResizeH: _Font 16
Palette 5, 63: Palette 6, 56: Color 0, 5
t.ScrnResizeW = 0: t.ScrnResizeH = 0
Else
Width 80, 25: _Font 16: _ScreenMove 0, 0
Palette 5, 63: Palette 6, 56: Color 0, 5: Cls
End If
t.wide = _Width: t.tall = _Height
t.mt = 2: t.mr = t.wide - 4: t.mb = t.tall - 1: t.ml = 3
t.bsTop = 1: t.bsRight = 2: t.bsBottom = 1: t.bsLeft = 2 ' Border spacing.
t.nol = t.mb - (t.mt - 1)
End If
View Print t.mt - t.bsTop To t.mb + t.bsBottom: Cls 2: View Print
Locate t.mt - t.bsTop, t.ml - t.bsLeft + 1: Print String$(t.mr - t.ml + t.bsRight + t.bsLeft - 1, Chr$(196));
Locate t.mb + t.bsBottom, t.ml - t.bsLeft + 1: Print String$(t.mr - t.ml + t.bsRight + t.bsLeft - 1, Chr$(196));
For i = 0 To t.mb - t.mt + t.bsTop + t.bsBottom - 2
Locate t.mt - t.bsTop + 1 + i, t.ml - t.bsLeft: Print Chr$(179);
Locate , t.mr + t.bsRight: Print Chr$(179);
Next
Locate t.mt - t.bsTop, t.ml - t.bsLeft: Print Chr$(218);: Locate t.mt - t.bsTop, t.mr + t.bsRight: Print Chr$(191);
Locate t.mb + t.bsBottom, t.ml - t.bsLeft: Print Chr$(192);: Locate t.mb + t.bsBottom, t.mr + t.bsRight: Print Chr$(217);
Return
ScrollBar:
If t.noe > t.mb - (t.mt - 1) Then ' Scroll Bar
ThumbSize = (t.mb - t.mt) - (t.noe - t.nol): If ThumbSize < 0 Then ThumbSize = 0
Color 8, 7: Locate t.mt - t.bsTop, t.mr + t.bsRight + 1: Print Chr$(24); Chr$(24);
Color 0, 7
For i = 1 To t.mb + t.bsBottom - t.mt
Locate t.mt - t.bsTop + i, t.mr + t.bsRight + 1: Print Chr$(255); Chr$(255);
Next
If m.sbRow = 0 Then m.sbRow = t.mt
If oldsbRow And oldsbRow <> m.sbRow Then
t.scr = Int((m.sbRow - t.mt) * (t.noe - t.nol) / (t.mb - (t.mt + ThumbSize)))
If t.scr + ThumbSize > t.noe Then t.scr = t.noe - t.nol
End If
If ThumbSize Then
If m.drag = 0 And m.lb = 0 Then m.sbRow = t.scr + t.mt
Else
If m.lb = 0 Then m.sbRow = Int(t.scr / (((t.noe - t.nol) / (t.mb - t.mt)))) + t.mt
End If
If t.scr + t.nol >= t.noe Then m.sbRow = t.mb - ThumbSize
Color 6, 5
For i = 0 To ThumbSize
Locate m.sbRow + i, t.mr + t.bsRight + 1: Print Chr$(219); Chr$(219);
Next
Color 8, 7: Locate t.mb + t.bsBottom, t.mr + t.bsRight + 1: Print Chr$(25); Chr$(25);
Color 0, 5
End If
Return
disply:
j = t.noe - t.scr: If j > t.mb - (t.mt - 1) Then j = t.mb - (t.mt - 1)
For i = 1 To j
Locate t.mt - 1 + i, t.ml: Print Text$(i + t.scr);
Next
Return
End Sub
Sub MseKbd (m As MouseVar, b$)
Static z1
b$ = InKey$
If m.mw Then m.mw = 0
While _MouseInput
m.mw = m.mw + _MouseWheel: If m.mw Then m.mw = m.mw \ Abs(m.mw) ' Limit to 1 or -1 for up or down.
Wend
m.x = _MouseX
m.y = _MouseY
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: m.clkcnt = 0
Select Case m.lb
Case 2: m.lb = 0 ' Click cycle completed.
Case 1: If _MouseButton(1) = 0 Then m.lb = 2: m.drag = 0 ' Button released.
Case -1: m.lb = 1 ' Button held down.
Case 0: m.lb = _MouseButton(1)
End Select
Select Case m.rb
Case 2: m.rb = 0 ' Click cycle completed.
Case 1: If _MouseButton(2) = 0 Then m.rb = 2 ' Button released.
Case -1: m.rb = 1 ' Button held down.
Case 0: m.rb = _MouseButton(2)
End Select
Select Case m.mb
Case 2: m.mb = 0 ' Click cycle completed.
Case 1: If _MouseButton(3) = 0 Then m.mb = 2 ' Button released.
Case -1: m.mb = 1 ' Button held down.
Case 0: m.mb = _MouseButton(3)
End Select
If m.lb = -1 Then z1 = Timer: m.clkcnt = m.clkcnt + 1
End SubWorks with mouse and keyboard. You can resize the window using a mouse drag on the edges or the corners.
Pete
