| |
Данный пример покажет, как можно организовать
автоскролинг элемента 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
|
|