Главная страницаОбратная связьКарта сайта

Автоскролинг текста

Private Type SCROLLINFO
cbSize As Long
fMask As Long

nMin As Long
nMax As Long
nPage As Long

nPos As Long
nTrackPos As Long
End Type

Private Declare Function GetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const SIF_RANGE = &H1
Const SB_VERT = 1

Dim lHeight As Long, OnePixel As Long

Dim S As SCROLLINFO

Private Sub Command1_Click()
Do
DoEvents
ScrollUp 50
Loop
End Sub

Private Sub Form_Load()
rtb1(0).LoadFile App.Path & "\mydoc.rtf", rtfRTF
Picture1.Move rtb1(0).Left, rtb1(0).Top, rtb1(0).Width, rtb1(0).Height
Set rtb1(0).Container = Picture1
OnePixel = Screen.TwipsPerPixelY
S.cbSize = Len(S)
S.fMask = SIF_RANGE

Do

Call GetScrollInfo(rtb1(0).hwnd, SB_VERT, S)
If S.nMax = 0 Then Exit Do
lHeight = S.nMax * OnePixel
rtb1(0).Height = lHeight
Loop


If lHeight = 0 Then lHeight = rtb1(0).Height
Text1 = lHeight / OnePixel
rtb1(0).Move 0, 0
Load rtb1(1)
rtb1(1).Visible = False
End Sub

Private Sub ScrollUp(delay As Long)
Sleep delay
With rtb1(0)
.Top = .Top - OnePixel
If .Top + .Height = 0 Then

.Move 0, 0
rtb1(1).Visible = False
End If
If .Top + .Height <= Picture1.Height Then
rtb1(1).Top = .Top + .Height
rtb1(1).Visible = True

End If
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
End

End Sub

Обсудить статью на форуме


Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "Автоскролинг текста", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!
   


Copyright © 2008 - 2022 Дискета.info