|
В этой статье рассмотрим пример реализации эффекта «бегущая строка». Применять его можно, например, как своеобразную «напоминалку», побуждающую пользователя зарегистрировать программу, или просто выводить название и версию программы (для эффекта), или, наконец, как ленту новостей программы. Конечно, здесь нужно знать меру, чтобы понапрасну не раздражать пользователя такой «рекламой», иначе может получиться обратный результат.
Идея взята у Андрея Митина. Для начала определимся, что же мы будем выводить в строке. Как вариант – название и версия программы и напоминание о необходимости регистрации. Строки лучше объявить как глобальные константы и переменные в общем модуле. В этом случае, если Вы решите применить эффект бегущей строки в нескольких формах, то для изменения текста строки достаточно будет изменить значения констант.
Пример реализации интерфейса регистрации программы уже рассматривался ранее. Добавлю лишь, что если Вы будете включать в строку напоминание о необходимости регистрации программы, то после ее проведения нужно будет либо убрать строку, либо сменить ее цвет с красного, например на синий.
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_
Do While True
lab.ForeColor = 0
StrAnime NomWers, Me.lab
lab.ForeColor = 255
StrAnime StrEnabled, Me.lab
Loop
Err_:
Exit Sub
End Sub
Если Вы решите применять рассмотренный эффект, то учтите, что он в какой то мере загружает систему во время «временной задержки» - ведь приходится гонять циклы накрутки. Так же и скорость движения строки зависит от производительности системы: если машина считает быстро, то и строка будет так же летать.
|