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

'Для проверки выполнения кода вам надо добавить на форму элементы
'RichTextBox, 'Picture и CommandButton Не забудьте указать правильную
'ссылку на файл mydoc.rtf

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 - "Автоскролинг текста в RichTextBox", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

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