A 2013 scrolling marquee

Dick7Access

Dick7Access

Dick S
Local time
Today, 18:46
Joined
Jun 9, 2009
Messages
4,321
I copied and paste a nice little snippet to make a scrolling marquee, but it 0nly scrolls so far then it starts to delete letters what do I have to do to have it continue for as long as it form is open?


Code: 
  Option Compare Database
   
  Dim textStr As String
   
  Dim padstr As String
   
  Dim txtScroll As String
   
  Dim txtLength As Integer
   
  Dim iLength As Integer
   
  Dim iPos As Integer
   
  Dim iView As Integer
   
  Dim iRem As Integer
   
  ' Read more: How to Add a Scrolling Marquee Text Box to Microsoft Access | eHow http://www.ehow.com/how_10064042_add-scrolling-marquee-text-box-microsoft-access.html#ixzz2TJf3dBnj
   
  Private Sub Form_Load()
  txtMarqee.SetFocus
   
  txtMarqee.Text = ""
   
  textStr = " Why does this stop scrolling after so many words and then starts to delete words. I want it to scroll continutally."
   
  padstr = " "
   
  txtScroll = textStr & padstr
   
  txtLength = Len(txtScroll)
   
  iLength = Len(padstr)
   
  Me.TimerInterval = 500
   
  iPos = 1
   
  iView = 1
  End Sub
   
  Private Sub Form_Timer()
  moveText
  End Sub
 
Why not ask the author of the code :confused:

Also are you sure you have all the code there?
 
and........ what happens in the MoveText routine?


thanks
 
NigelShaw said:
and........ what happens in the MoveText routine?


thanks
Click to expand...

It starts to scroll but when it gets half way across it starts to delete the first letters.
I tried to upload the whole db with just the (compressed) scrolling form but it keeps giving me some kind of error message "security token" is missing. (what ever that means). Here is the link to the original code, if you are interested.
http://www.ehow.com/how_10064042_add-scrolling-marquee-text-box-microsoft-access.html.

Also to answer big John's question. I could be wrong but I believe the author wants compensation to answer questions.
 
Hey

Can you copy your MoveText routine to here? As it is responsible for calling and by the looks of it, makes the scrolling work, i suspect the error is happening there

Thanks
 
NigelShaw said:
Hey

Can you copy your MoveText routine to here? As it is responsible for calling and by the looks of it, makes the scrolling work, i suspect the error is happening there

Thanks
Click to expand...
It look like Big John was right. I just discovered there was some code missing from my original post.

Code: 
Option Compare Database

Dim textStr As String

Dim padstr As String

Dim txtScroll As String

Dim txtLength As Integer

Dim iLength As Integer

Dim iPos As Integer

Dim iView As Integer

Dim iRem As Integer

' Read more: How to Add a Scrolling Marquee Text Box to Microsoft Access | eHow http://www.ehow.com/how_10064042_add-scrolling-marquee-text-box-microsoft-access.html#ixzz2TJf3dBnj

Private Sub Form_Load()
txtMarqee.SetFocus

txtMarqee.Text = ""

textStr = " Why does this stop scrolling after so many words and then starts to delete words. I want it to scroll continutally."

padstr = " "

txtScroll = textStr & padstr

txtLength = Len(txtScroll)

iLength = Len(padstr)

Me.TimerInterval = 500

iPos = 1

iView = 1



End Sub

Private Sub Form_Timer()
moveText
End Sub


Private Sub moveText()

txtMarqee.SetFocus

txtMarqee.Text = Mid(txtScroll, iPos, iView)

iRem = txtLength - (iPos + iView - 1)

If (iPos - 1) < (txtLength - iLength) Then

If iView < 20 And iView < iRem Then

iView = iView + 1

End If

If iPos < txtLength And iView >= 20 Then

iPos = iPos + 1

End If

Else

txtMarqee.Text = ""

iPos = 1

iView = 1

End If

End Sub
 
I went to the URL of the original code, and found that it would not work. It would scroll to a certain point, then stop scrolling. This version at least works:

Code: 
Option Compare Database
Option Explicit

Dim strText As String
Dim strPad As String
Dim strTxtScroll As String
Dim intTxtLength As Integer
Dim intLength As Integer
Dim intPos As Integer
Dim intView As Integer
Dim intMaxView As Integer

Private Sub Form_Load()

  Me.txtMarqee.Value = vbNullString
  strText = "This is a way cool test! And some more text..."
  strPad = Chr(32)
  strTxtScroll = strText & strPad
  intTxtLength = Len(strTxtScroll)
  Me.TimerInterval = 500
  intPos = 1
  intView = 1
  If intTxtLength < 20 Then
    intMaxView = intTxtLength
  Else
    intMaxView = 20
  End If

End Sub

Private Sub Form_Timer()

  Call Me.MoveText

  'Keep UI responsive
  DoEvents

End Sub

Public Sub MoveText()

  Dim strMarqeeValue As String
  
  'Compute the portion of the string to show at this cycle
  strMarqeeValue = Mid(strTxtScroll, intPos, intView)
  'Compute its length
  intLength = Len(strMarqeeValue)
  'Check if the cursor pos is less than the MaxView alottment
  If intPos < intMaxView Then
    'Check if the portion of the string is less than the MaxView alottment
    If intLength < intMaxView Then
      'Jah, needs to be space padded out...
      strMarqeeValue = Space(intMaxView - intLength) & strMarqeeValue
    End If
  End If

  'Update the form control with the current portion to be shown at this cycle
  Me.txtMarqee.Value = strMarqeeValue

  'See if we have reached our Max of Viewable Characters
  If (intView < intMaxView) Then
    'Nope, then add one
    intView = intView + 1
  Else
    'See if we are at the end of the Marqee string
    If Not (intPos = intTxtLength) Then
      'Nope, then add one
      intPos = intPos + 1
    Else
      'Jah, then reset variables
      intPos = 1
      intView = 1
    End If
  End If

End Sub
The one annoyance I see is that unless I have the VBA window open and it has focus, the Marqee text gets all selected and turns "selected text" background color.

Updated to add white space padding at the beginning of the cycle so that the text comes out of the right side of the control and goes into the left side of the control! :cool:
 
Last edited:
mdlueck said:
I went to the URL of the original code, and found that it would not work. It would scroll to a certain point, then stop scrolling. This version at least works:

I am not getting this to work. VBA is not my strong suit. Please correct me if I am wrong. Name of form is irrelevant. Name of the text box needs to be txtMarqee.
Click to expand...
 
Dick7Access said:
Name of form is irrelevant. Name of the text box needs to be txtMarqee.
Click to expand...

Both points correct.

Did you snag a copy of my updated code which right pads the string so that the text appears to come out of the right side of the text control and disappear to the left side of the control?
 
mdlueck said:
Both points correct.

Did you snag a copy of my updated code which right pads the string so that the text appears to come out of the right side of the text control and disappear to the left side of the control?
Click to expand...

I copied and paste all your code from post #7. Now it looks like your update is a link (Since it's blue)
PHP: 
Updated to add white space padding at the beginning of the cycle so that the text comes out of the right side of the control and goes into the left side of the control! [IMG]file:///C:\Users\Sonier\AppData\Local\Temp\msohtmlclip1\01\clip_image001.gif[/IMG]
but it doesn’t open anything. Is there anything else I need to add to the form besides a text box.
 
Dick7Access said:
but it doesn’t open anything. Is there anything else I need to add to the form besides a text box.
Click to expand...

rrrrr???? :confused:

attachment.php


Perhaps place a watch on each Subroutine and see if Timer events actually fire.
 

Attachments

  • Marqee.png
    Marqee.png
    6.8 KB · Views: 1,566
OK, I polished up this code a bit more, and think it is ready to be placed in my application's "About" form to highlight the name of the application. ;)

1) I have made both a text label animated as well as the field control.
2) I have added a button and always set the button to have focus each time the timer event fires. That way all of the text in the text field does not get selected.
3) I noticed some problems with the timer firing and being able to switch the code back to Design mode. So in the Exit button I right away turn off the timer. The Exit button appears to work consistently.

attachment.php


Da code...
Code: 
Rem /************************************************************************************/
Rem /* FILENAME       :  Form_Marqee                                                    */
Rem /* TYPE           :  VBA Form                                                       */
Rem /* DESCRIPTION    :  VBA code attached to the projects form                         */
Rem /*                                                                                  */
Rem /* AUTHOR         :  Michael D Lueck                                                */
Rem /*                   mlueck@lueckdatasystems.com                                    */
Rem /*                                                                                  */
Rem /* NEEDS          :                                                                 */
Rem /*                                                                                  */
Rem /* USAGE          :                                                                 */
Rem /*                                                                                  */
Rem /* REVISION HISTORY                                                                 */
Rem /*                                                                                  */
Rem /* DATE       REVISED BY DESCRIPTION OF CHANGE                                      */
Rem /* ---------- ---------- -------------------------------------------------------    */
Rem /* 05/16/2013 MDL        Initial Creation                                           */
Rem /* 05/17/2013 MDL        Added txtMarqee and btnExit controls                       */
Rem /************************************************************************************/

Option Compare Database
Option Explicit

Dim strText As String
Dim strPad As String
Dim strTxtScroll As String
Dim intTxtLength As Integer
Dim intLength As Integer
Dim intPos As Integer
Dim intView As Integer
Dim intMaxView As Integer

Private Sub Form_Load()

  Me.fldMarqee.Value = vbNullString
  Me.txtMarqee.Caption = vbNullString
  strText = "This is a way cool test! And some more text..."
  strPad = Chr(32)
  strTxtScroll = strText & strPad
  intTxtLength = Len(strTxtScroll)
  Me.TimerInterval = 500
  intPos = 1
  intView = 1
  If intTxtLength < 20 Then
    intMaxView = intTxtLength
  Else
    intMaxView = 20
  End If

End Sub

Private Sub Form_Timer()

  Call Me.MoveText

  'Shift focus elsewhere than the fldMarqee text field control
  Me.btnExit.SetFocus

  'Keep UI responsive
  DoEvents

End Sub

Public Sub MoveText()

  Dim strMarqeeValue As String
  
  'Compute the portion of the string to show at this cycle
  strMarqeeValue = Mid(strTxtScroll, intPos, intView)
  'Compute its length
  intLength = Len(strMarqeeValue)
  'Check if the cursor pos is less than the MaxView alottment
  If intPos < intMaxView Then
    'Check if the portion of the string is less than the MaxView alottment
    If intLength < intMaxView Then
      'Jah, needs to be space padded out...
      strMarqeeValue = Space(intMaxView - intLength) & strMarqeeValue
    End If
  End If

  'Update the form controls with the current portion to be shown at this cycle
  Me.fldMarqee.Value = strMarqeeValue
  Me.txtMarqee.Caption = strMarqeeValue

  'See if we have reached our Max of Viewable Characters
  If (intView < intMaxView) Then
    'Nope, then add one
    intView = intView + 1
  Else
    'See if we are at the end of the Marqee string
    If Not (intPos = intTxtLength) Then
      'Nope, then add one
      intPos = intPos + 1
    Else
      'Jah, then reset variables
      intPos = 1
      intView = 1
    End If
  End If

End Sub

Private Sub btnExit_Click()

  'Done with the timer, so turn it off
  Me.TimerInterval = 0

  'Flush keystrokes out of the buffer so that close via Esc does not generate an error msg
  DoEvents
  DoEvents
  DoEvents

  'Close window "self"
  DoCmd.Close ObjectType:=acForm, _
              ObjectName:=Me.Name

End Sub
 

Attachments

  • Marqee_2.png
    Marqee_2.png
    6.2 KB · Views: 1,538
mdlueck said:
I went to the URL of the original code, and found that it would not work. It would scroll to a certain point, then stop scrolling. This version at least works:

Michael, thanks. I haven't had a chance to get back to you before this. I do have it working. I will change the text and copy and paste into my db. Thanks again
Dick S.
Click to expand...
 
Dick7Access said:
I do have it working.
Click to expand...

Woo hoo! Glad to be of assistance.

I kicked the marquee script up a bit and tossed it in my main application's "About" screen. I ran into some snag that the Marquee was unable to correctly handle a wider width than the text, or portion of the text. So, FYI if you make the text control's width wider than the available scroll text, there will be further issues.
 
You must log in or register to reply here.

Similar threads

I
Find TextBoxes in a Workbook and change background colour
Replies
10
Views
1,338
Darrell
Darrell
M
Marquee with Public & private ending
Replies
1
Views
356
sneuberg
S
R
Creating a scrolling marquee
Replies
3
Views
2,640
rikklaney1
R
Isskint
clsScrollText - Scrolling text (marquee) controller
Replies
0
Views
3,344
Isskint
Isskint
R
Updating a text box to scroll
Replies
1
Views
742
aleb
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom