Эффект анимации "бегущая строка"

Источник: Accessoft

В этой статье рассмотрим пример реализации эффекта анимации «бегущая строка». Применять его можно, например, как своеобразную «напоминалку», побуждающую пользователя зарегистрировать программу, или просто выводить название и версию программы (для эффекта), или, наконец, как анимированную ленту новостей программы. Конечно, здесь нужно знать меру, чтобы понапрасну не раздражать пользователя такой анимированной рекламой, иначе может получиться обратный результат.

Идея взята у Андрея Митина. Для начала определимся, что же мы будем выводить в строке анимации. Как вариант - название и версия программы и напоминание о необходимости регистрации. Строки лучше объявить как глобальные константы и переменные в общем модуле. В этом случае, если Вы решите применить эффект бегущей строки в нескольких формах, то для изменения текста строки достаточно будет изменить значения констант.

lab.ForeColor =16711680 ‘ синий цвет

Для реализации эффекта анимации напишем функцию с двумя параметрами

Public Function StrAnime(Str As String, lbStr As Label)

Str - строка, которую выводим
lbStr - элемент (Label) на форме, в котором выводится строка анимации

Public Function StrAnime(Str As String, lbStr As Label)
On Error GoTo Err_
Const iTrim As Long = 100   ' максимальная ширина строки (число знаков, включая пробелы)
Dim sIntStr As String
Dim i As Long, j As Long
     bStr.TextAlign = 1     ' выравниваем строку
     sIntStr = Str
     Do While Len(sIntStr) < iTrim   ' заполняем пробелами начало строки - до макс числа знаков <= 100
          sIntStr = " " & sIntStr
     Loop
     For i = Len(sIntStr) To 1 Step -1
          lbStr.Caption = Mid(sIntStr, i)     ' здесь собственно и происходит анимация - "выдвижение" строки - показываем строку, начиная с последнего символа
          DoEvents    ' передаем управление системе
          j = 1
          Do While j < 1500000    ' а здесь просто мотыляем счетчик - вариант временной задержки процесса
               j = j + 1
          Loop
     Next i
     For i = 1 To Len(sIntStr)   ' строка выползла, теперь ее таким же образом надо убрать
          lbStr.Caption = String(i, " ") & Mid(sIntStr, 1, Len(sIntStr) - i) ' убираем строку - отсекаем символы
          DoEvents    ' передаем управление системе
          j = 1
          Do While j < 1500000    ' мотыляем счетчик
               j = j + 1
          Loop
     Next i
Exit_:
     Exit Function
Err_:
     Resume Exit_
End Function

Функцию анимации сделали, теперь ее надо запустить. Используем свойство формы - Таймер. Интервал таймера поставим например 500. И вставим процедуру:

Private Sub Form_Timer()
On Error GoTo Err_
     lab.ForeColor = 0
     StrAnime NomWers, Me.lab
     lab.ForeColor = 255
     StrAnime StrEnabled, Me.lab
Err_:
     Exit Sub
End Sub

Если Вы решите применять рассмотренный эффект анимации, то учтите, что он в какой то мере загружает систему во время «временной задержки» - ведь приходится гонять циклы накрутки. Так же и скорость движения строки зависит от производительности системы: если машина считает быстро, то и строка будет так же летать.

Пример, как это все работает, Вы можете скачать ниже.

Ссылки по теме

Файлы для загрузки

Пример программы