clsScrollText - Scrolling text (marquee) controller

Isskint

Slowly Developing
Local time
Today, 13:53
Joined
Apr 25, 2012
Messages
1,302
Ok so after I provided a solution to a post recently about scrolling text within a textbox (or label) on a form, I got to thinking about a ‘cleaner’ way to achieve this. The answer I thought would be to create a class module to do the hard work and have the Forms Timer Event use this class to provide the required text.
This is what I came up with.
Class Module clsScrollText
Option Compare Database
Option Explicit

Public ScrollLength As Integer ’Maximum number of characters that can be displayed in the textbox (or label)
Public ScrollSource As String ’The name of the table (or query) to get the data from OR the string you want to scroll
Public isScrollTextSupplied As Boolean ’ If ScrollSource is a table (or query)name then FALSE otherwise TRUE
Public LeadingSpaces As Long ‘This is the number of spaces you want between data items
Public ScrollField As String ‘the name of the field to get the scroll data from if you have supplied a table (or query) name


Public Function ScrollText() As String

Dim rs As DAO.Recordset
Dim sQry As String
Dim HoldScroll As String
Dim HoldLen As Integer
Dim HoldDiff As Long

If isScrollTextSupplied Then
HoldScroll = Space(LeadingSpaces) & ScrollSource
ScrollPoint = ScrollPoint + 1
If ScrollPoint > Len(ScrollSource) + LeadingSpaces Then ScrollPoint = 1
ScrollText = Mid(HoldScroll, ScrollPoint, ScrollLength)
Else
sQry = "SELECT [" & ScrollField & "] FROM " & ScrollSource & ";"
Set rs = CurrentDb().OpenRecordset(sQry, dbOpenSnapshot)
With rs
If .RecordCount = 0 Then
ScrollText = "Error in reading table:" & ScrollSource
Else
.MoveLast
.MoveFirst
.Move ScrollItem - 1

If .BOF Or .EOF Then
.MoveFirst
ScrollItem = 1
End If

HoldScroll = .Fields(ScrollField)
ScrollPoint = ScrollPoint + 1

HoldLen = Len(HoldScroll) - (ScrollPoint - 1)
If HoldLen < 0 Then HoldLen = 0

Select Case HoldLen
Case Is >= ScrollLength 'scrolltext all comes from current record
ScrollText = Mid(HoldScroll, ScrollPoint, ScrollLength)
Case Else 'needs padding
ScrollText = Right(HoldScroll, HoldLen)
HoldDiff = ScrollLength - HoldLen
Select Case HoldDiff
Case Is > LeadingSpaces 'needs padding and next scroll item
ScrollText = ScrollText & Space(LeadingSpaces)
.MoveNext
If .EOF Then
.MoveFirst
End If
HoldScroll = .Fields(ScrollField)
ScrollText = ScrollText & Left(HoldScroll, ScrollLength - Len(ScrollText))
Case Else
ScrollText = ScrollText & Space(HoldDiff)
End Select
If Left(ScrollText, LeadingSpaces) = Space(LeadingSpaces) Then
ScrollPoint = 0
ScrollItem = ScrollItem + 1
End If
End Select
End If
End With
End If
[FONT=&quot]End Function[/FONT]
In a normal module you would need to declare 2 global public variables
Option Compare Database
Option Explicit

Public ScrollPoint As Integer
Public ScrollItem As Long
In the Form_Open event of the form you would need the following
Option Explicit
Option Compare Database

Private Sub Form_Open(Cancel As Integer)
ScrollPoint = 0
ScrollItem = 1
End Sub
In the Form_Timer event of the form you would need to provide the following data and set the textbox (or label.caption) = the ScrollText method of the new class.
Private Sub Form_Timer()
'in this example I am providing a table name [Table1] so isScrollTextSupplied is FALSE and i provide'
the field name [Data] for ScrollField. I want 10 leading spaces and my maximum scroll is 50
Dim Scroller As New clsScrollText

Scroller.isScrollTextSupplied = False
Scroller.LeadingSpaces = 10
Scroller.ScrollField = "Data"
Scroller.ScrollLength = 50
Scroller.ScrollSource = "Table1"
Me.ScrollDisplay.Caption = Scroller.ScrollText

End Sub
Private Sub Form_Timer()
'in this example I am providing the exact text i want scrolled One flew over the cuckoos nest
'so the ScrollField value is not required.
Dim Scroller As New clsScrollText

Scroller.isScrollTextSupplied = True
Scroller.LeadingSpaces = 10
Scroller.ScrollLength = 50
Scroller.ScrollSource = "One flew over the cuckoos nest"
Me.ScrollDisplay.Caption = Scroller.ScrollText

End Sub
I have attached the class module

I hope this helps people out and i welcome feedback on this little undertaking.
 

Attachments

Users who are viewing this thread

Back
Top Bottom