by Paul Wheeler (1 Submission)
Category: Graphics
Compatability: Visual Basic 3.0
Difficulty: Beginner
Date Added: Wed 3rd February 2021
Rating: 
(3 Votes)
This is a simple function which smoothly scrolls text in a picturebox. Unlike other entries it only needs one picturebox. Each time the function is called it adds the text to the bottom (or top) of the picturebox and scrolls the rest of the box (without moving the box itself). Used with a timer control it creates a very versatile scrolling routine. It can easily be modified to scroll anything that has an HDC. The font property on the picturebox controls the look of the text. BitBlt api based on code submitted by MO. I used this code for a phone tracking program than needed to constantly scroll incoming call data in a picturebox.
Inputs
a PictureBox control, some text and the direction
Assumes
Simply add a picturebox called picture1 and a timer called timer1 to a form and paste the code into the form's code module. The timer.interval changes the speed of the scrolling (of course).
API DeclarationsPrivate Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
VBcodersOption Explicit
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = 100
End Sub
Sub Timer1_Timer()
Static i As Integer
i = i + 1
If i < 10 Then
ScrollText Picture1, "Just a simple test #" & i, True
Else
ScrollText Picture1, "", True
End If
End Sub
Sub ScrollText(pic As PictureBox, txt As String, up As Boolean)
Dim ret As Long, vHeight As Long
If pic.ScaleMode <> 3 Then pic.ScaleMode = 3
vHeight = pic.TextHeight(txt)
If up Then
ret = BitBlt(pic.hDC, 0, -vHeight, pic.ScaleWidth, pic.ScaleHeight, pic.hDC, 0, 0, &HCC0020)
pic.Line (0, pic.ScaleHeight - vHeight)-(pic.ScaleWidth, pic.ScaleHeight), pic.BackColor, BF
pic.CurrentY = pic.ScaleHeight - vHeight
Else 'down
ret = BitBlt(pic.hDC, 0, vHeight, pic.ScaleWidth, pic.ScaleHeight, pic.hDC, 0, 0, &HCC0020)
pic.Line (0, 0)-(pic.ScaleWidth, vHeight), pic.BackColor, BF
pic.CurrentY = 0
End If
pic.CurrentX = (pic.ScaleWidth - pic.TextWidth(txt)) / 2 'centers text
pic.Print txt
End Sub