Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

SCROLLING TEXT IN A FORM - PART II 3

Status
Not open for further replies.

PPJOSEPH

IS-IT--Management
Apr 2, 2003
82
US
thanks for the link, but I'm getting stuck on the line below:
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)


The code from the link is:
'start paste
Private Static Function Scrolltext(strfield As String) As String
'call from on timer event
Dim astr As Integer
Dim TextLen As Integer

astr = astr + 1
TextLen = Len(strfield)
If astr >= TextLen Then astr = 1
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)
Me!Text81.Text = Scrolltext("Hello World") 'Refer to the unbound text box
End Function


Private Static Function SpellOut(strMessage As String) As String

Dim iCount As Integer
Dim iLen As Integer

iLen = Len(strMessage)
If iCount >= iLen Then iCount = 1

SpellOut = Left(strMessage, iCount)
iCount = iCount + 1

End Function
 
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Thanks PHV, I was able to take that bug out but still it is not working.

Can someone lend a helping hand!!

The revised code for a scrolling marquee text in a text box looks like this:

Option Compare Database
Option Explicit

Private Static Function Scrolltext(Strfield As String) As String
Dim astr As Integer
Dim TextLen As Integer

astr = astr + 1
TextLen = Len(Strfield)
If astr >= TextLen Then astr = 1

Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)
Me!Text0.Text = "Hello World"
End Function
Private Static Function SpellOut(strMessage As String) As String

Dim iCount As Integer
Dim iLen As Integer

iLen = Len(strMessage)
If iCount >= iLen Then iCount = 1

SpellOut = Left(strMessage, iCount)
iCount = iCount + 1

End Function
 
but still it is not working
What happens ? Computer crash ? Error message ? Unexpected behaviour ? ...

Anyway, you may replace this:
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)
with this:
Scrolltext = Mid(Strfield, astr) & " " & Left(Strfield, astr)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Very funny, PHV.
I was hoping to see the words scroll thru inside the text box in the form, but the text box is blank.

I edited the code as you recommended but still the text box is blank.

Is it the code or something else that I'm doing wrong. What I did was that i created a blank text box on a form to call out the scrolling marquee.

Thanks PH.
 
What is the code of the form's Timer event procedure ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
I do not have any code in the Timer event procedure. I changed the TIMER INTERVAL TO 100.

 
Your code seems coming from faq181-86, so reread it carefully.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
PHV, You are correct, I missed one step of inserting the code on the timer.

This is how it looks now. At least I can now see the words and its shaky but not moving.

Option Compare Database
Option Explicit

Private Static Function Scrolltext(Strfield As String) As String

Dim astr As Integer
Dim TextLen As Integer

astr = astr + 1
TextLen = Len(Strfield)
If astr >= TextLen Then astr = 1
Scrolltext = Mid(Strfield, astr) & " " & Left(Strfield, astr)
End Function


Private Static Function SpellOut(strMessage As String) As String

Dim iCount As Integer
Dim iLen As Integer

iLen = Len(strMessage)
If iCount >= iLen Then iCount = 1

SpellOut = Left(strMessage, iCount)
iCount = iCount + 1

End Function


Private Sub Form_Timer()
Me!Text0.Text = "Hello World"
End Sub
 
Replace this:
Me!Text0.Text = "Hello World"
with this:
Me!Text0.Value = Scrolltext("Hello World")

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Thank you so much for your time. It worked good. I wish I could give you two stars. Great job!!
 
Or try this.
acknowledgement if used please.

Code:
Option Compare Database
Private TickMessage As String
Private TickLen As Long
Private TickPointer As Integer
Private LabelWidth As Long
Private Speed As Long


Private Sub Form_Load()
  Speed = 200
  LabelWidth = 41

  Me.TimerInterval = Speed

  ' In this example the message is coded directly into VBA. You could change it so it looked up the message
  ' from an admin table using tickmessage = dlookup ("[fieldname]","tablename",[optional criteria]) function
  ' By doing this you could alter the message in access without going into VBA.
  ' Remember to add a space at the end of the message
  ' otherwise the beginning letter will butt up to the end letter.
  TickMessage = "Created By Ian Mayor - Put your message in here " & _
                "and here if its too long "

  'Makes sure the message length is at least the width of the displaybox. Adds extra spaces if not.
  If Len(TickMessage) < LabelWidth Then
    TickMessage = TickMessage & Space(LabelWidth + Len(TickMessage))
  End If

  TickMessage = TickMessage & Left(TickMessage, LabelWidth)
  TickLen = Len(TickMessage)
  TickPointer = TickLen - 1
End Sub

Private Sub Form_Timer()
Dim TickMess As String
  Debug.Print TickMessage
  Debug.Print TickPointer
  TickMess = Mid(TickMessage, (TickLen - TickPointer), LabelWidth - 1)
  Me.Label1.Caption = TickMess
  Debug.Print TickMess

  If TickPointer > LabelWidth Then
    TickPointer = TickPointer - 1
  Else
    TickPointer = TickLen - 1
  End If

End Sub

Ian Mayor (UK)
Program Error
Programming is 1% coding, 50% error checking and 49% sweat as your application bombs out in front of the client.
 
Here is how to remove that it shows whatever is in the first position, in the last position at the same time:

Replace:
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr)
With:
Scrolltext = Mid([Strfield], astr, Len([Strfield])) & " " & Left([Strfield], astr - 1)

Basically, add the " - 1" for taking the left part of message.

To fix the odd quirk of SpellOut, where it doesn't seem to show the last letter, replace:
iLen = Len(strMessage)
With:
iLen = Len(strMessage) + 1

Hope these help ya out.
Enjoy.



~
Give a man some fire, he will be warm for a day, Set a man on fire, he will be warm for the rest of his life.
 
Thanks Ian, you deserve a star for just sharing the code. I like your idea of creating a table for the message so that we need not access the vba coding. However, I'm lost at OPTIONAL CRITERIA --- I'm clueless

tickmessage = dlookup ("[fieldname]","tablename",[optional criteria])

Thanks
 
Just use

tickmessage = dlookup ("[fieldname]","tablename")

and this will find the first record in the table (substitute the names accordingly). The optional criteria is used if you want to find the first occurance of a particular criteria in a table. For example, If you were looking for record number 1000 and this was in a field called ProgNo you would use


tickmessage = dlookup ("[fieldname]","tablename", "[ProgNo = 1000"

I used an admin tbale consisting of only one record with several fileds to store variable which I want to save when the application is close. Then use the first dlookup statement here to get that variable. For example you may want to save the record number the user was last looking at so a form opens on that record when Access is reloaded.

Hope that helps.



Ian Mayor (UK)
Program Error
Programming is 1% coding, 50% error checking and 49% sweat as your application bombs out in front of the client.
 
P.S.

PHV seems to be the connoisseur of the Dlookup method. Take a look at some of the threads he's replied to. I find them very useful.

Ian Mayor (UK)
Program Error
Programming is 1% coding, 50% error checking and 49% sweat as your application bombs out in front of the client.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top