Move words from right to left on a label. I don't have the Timer control

gorkac · #1 08-29-2021, 03:11 PM

This code works fine but it is vb 6. Do you know how to adapt it for Vba?

Code:

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Const speed As Byte = 1
Dim wid%
Dim hei%
Dim dc&
Const text = "       HELLO WORLD!!!       "
Private Sub Form_load()

dc = Picture1.hDC

  Picture1.CurrentX = 0
  Picture1.CurrentY = 0
  Picture1.Print text
  Picture1.ScaleMode = vbPixels
  wid = Picture1.TextWidth(text)
  hei = Picture1.TextHeight(text)
  Picture1.Width = wid * Screen.TwipsPerPixelX
  Picture1.Height = hei * Screen.TwipsPerPixelY
End Sub


Private Sub Timer1_Timer()
Dim i%


  For i = 0 To speed

    BitBlt dc, wid + 1, hei + 1, 1, hei, dc, 0, 0, &HCC0020 ' &hcc0020 is equvilent to vbSrcCopy
    BitBlt dc, 0, 0, wid, hei, dc, 1, 0, &HCC0020
    BitBlt dc, wid, 0, 1, hei, dc, wid + 1, hei + 1, &HCC0020

  Next i
    Picture1.Refresh


End Sub

Guessed · #2 08-29-2021, 09:10 PM

I'm not sure what you mean by label. This code looks like it is displaying a form containing picture on the screen and either moving the picture within that form or the entire form.

If it is a vba userform that you want to move across the screen, something like this works

Code:

#If VBA7 And Win64 Then    ' For 64bit version of Excel
    Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
#Else    ' For 32bit version of Excel
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Private Sub UserForm_Activate()
  Dim iLastPos As Long, iMove As Long
  
  With Me
    iLastPos = Application.Left + Application.Width - .Width
    iMove = 10
    .Left = Application.Left
    Do While .Left < iLastPos
      Sleep 50
      .Left = .Left + iMove
    Loop
  End With
  Me.Hide
End Sub

Private Sub UserForm_Initialize()
  With Me
    .Top = Application.Top + 0.5 * (Application.Height - .Height)
  End With
End Sub

gorkac · #3 08-30-2021, 02:21 AM

Hi Andrew, thanks for answering.
In Spanish, the word "etiqueta" means label.

VB6 :

VBA 7.1:

gorkac · #4 08-30-2021, 02:35 AM

Hi Andrew, thanks for answering.
In Spanish, the word "etiqueta" is label in english.

VB6 :

VBA 7.1:

Well, the code

Code:

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
                                             ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Const speed As Byte = 1
Dim wid%
Dim hei%
Dim dc&
Const text = "       HELLO WORLD!!!       "
Private Sub Form_load()

dc = Picture1.hDC

  Picture1.CurrentX = 0
  Picture1.CurrentY = 0
  Picture1.Print text
  Picture1.ScaleMode = vbPixels
  wid = Picture1.TextWidth(text)
  hei = Picture1.TextHeight(text)
  Picture1.Width = wid * Screen.TwipsPerPixelX
  Picture1.Height = hei * Screen.TwipsPerPixelY
End Sub


Private Sub Timer1_Timer()
Dim i%


  For i = 0 To speed

    BitBlt dc, wid + 1, hei + 1, 1, hei, dc, 0, 0, &HCC0020 ' &hcc0020 is equvilent to vbSrcCopy
    BitBlt dc, 0, 0, wid, hei, dc, 1, 0, &HCC0020
    BitBlt dc, wid, 0, 1, hei, dc, wid + 1, hei + 1, &HCC0020

  Next i
    Picture1.Refresh


End Sub

run this:
Animation.gif

I NEED THIS !!!!!!!
The problem is that it is in vb6 code, which uses the Timer and I do not have it in vba 7.1.
It would be necessary to replace the timer Timer by another.

gorkac · #5 08-30-2021, 04:08 AM

I would just need to replace Private Sub Timer1_Timer () with this timer, I think:

Code:

Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerId As Long, Var As Long

But this code will not be adapted to do the same as Timer

Guessed · #6 08-30-2021, 06:15 PM

You are right, they are called labels in English versions of Office too. OK, try this code where the text is in a label called labelTicker

Code:

#If VBA7 And Win64 Then    ' For 64bit versions
    Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
#Else    ' For 32bit versions
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If

Private Sub UserForm_Activate()
  Dim iWidth As Integer, iFormWidth As Integer, iStep As Integer
  
  iStep = 1
  iFormWidth = Me.Width - 20
  With Me.labelTicker
    .Left = iFormWidth
    Do
      Sleep 20
      DoEvents
      If .Left > -1 * .Width Then
        .Left = .Left - iStep
      Else
        .Left = iFormWidth
      End If
    Loop
  End With
End Sub

Private Sub UserForm_Initialize()
  With Me
    .Top = Application.Top + 0.5 * (Application.Height - .Height)
    .Left = Application.Left + 0.5 * (Application.Width - .Width)
  End With
End Sub

gorkac · #7 08-31-2021, 02:10 AM

Wow, its run. Thank you very much, Mr. Andrew.

gorkac · #8 08-31-2021, 04:47 PM

Mr. Andrew. Two questions.
1.- If I want to add another message in the same form?
2.- Can I control the speed of the text?

Thanks in advance.

Guessed · #9 08-31-2021, 05:04 PM

1. Yes, you can add a second scrolling message but it is really just a circus trick and just adds clutter to the screen - why would you want two of these running to distract the users?

2. You can control the speed in two ways, alter the size of the Step or alter the delay between each step. The relevant lines are
iStep = 1
Sleep 20

For example:
If the step = 2, it will move in bigger steps and therefore be faster
If Sleep is changed to 40 it will move slower (or change it to 10 to make it faster)

gorkac · #10 08-31-2021, 08:53 PM

1.-It would not be the same message. In the same form, a new labelticker (labelticker2) with other information.
Please, Tell me how to add another message.

Guessed · #11 08-31-2021, 09:02 PM

Add the red lines to move a second same-sized label called labelTicker2

Code:

Private Sub UserForm_Activate()
  Dim iWidth As Integer, iFormWidth As Integer, iStep As Integer
  
  iStep = 1
  iFormWidth = Me.Width - 20
  With Me.labelTicker
    .Left = iFormWidth
    Me.labelTicker2.Left = .Left
    Do
      Sleep 20
      DoEvents
      If .Left > -1 * .Width Then
        .Left = .Left - iStep
      Else
        .Left = iFormWidth
      End If
      Me.labelTicker2.Left = .Left
    Loop
  End With
End Sub

gorkac · #12 08-31-2021, 09:09 PM

Thank you very much.

gorkac · #13 09-04-2021, 04:51 AM

Hi guessed, By putting the second one, the movement is no longer so fluid. How can I solve it?

Guessed · #14 09-06-2021, 03:17 PM

There is a reason that I called this a circus trick - it doesn't really add to the form's useability in any way and it is added complexity that might cause problems.

You have a few choices to make the performance hit less noticeable.
1. Increase the size of the step AND the sleep time
2. Use one text label to contain both lines of text (or put them into the same container and move that one container.
3. Buy a faster computer

gorkac · #15 09-07-2021, 02:18 AM

Guessed, I have a Zephyrus G14 AMD Ryzen 9 4900HS with Radeon Graphics 3.. GHz. 16 GB RAM. I think there is plenty of fast.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to edit columns and move the right column more to the left?	bchinjy	Word	3	07-29-2019 05:23 AM
move the milestone label to left of column	wilster31	Project	0	07-31-2017 07:58 AM
How to move page numbers left and right in header	enginist	Word	4	08-03-2014 09:29 PM
How to either move document display to right or left; or reduce size of find/replace window.	pmstock	Word	2	08-02-2014 08:34 PM
i want to place labels on to the left of the page anchored to words within	soooty	Word	0	07-07-2010 09:18 AM