Бегущие титры по окну - VB

Формулировка задачи:

Всем привет! У гогото есть есть плавная реализация бегущих титров по экрану. То что есть (реализация через Picture) как-то дергается..

Option Explicit
Dim intPosY                   As Integer
Dim strWtnNews                As String
 
Private Sub Form_Load()
        Dim strString    As String
        Dim fNum         As Integer
        
        If Dir(App.Path & "\Files\Logo.jpg") <> "" Then
            picLogo = LoadPicture(App.Path & "\Files\Logo.jpg")
        End If
 
        If Dir(App.Path & "\Files\verInfo.txt") <> "" Then
            fNum = FreeFile
            Open App.Path & "\Files\verInfo.txt" For Input As #fNum
                    While EOF(fNum) = False
                        Line Input #fNum, strString
                        strWtnNews = strWtnNews & " " & strString & vbCrLf
                    Wend
            Close #fNum
        End If
End Sub
 
Private Sub picLogo_Click()
        Unload frmWhatNews
End Sub
 
Private Sub Timer1_Timer()
        picLogo.Cls
        intPosY = intPosY + 1
        picLogo.CurrentY = picLogo.ScaleHeight - intPosY
        picLogo.Print strWtnNews
End Sub

Решение задачи: «Бегущие титры по окну»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
    Const LB_SETHORIZONTALEXTENT = &H194
    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2
    Const HWND_TOPMOST = -1
    Const SWP_NOMOVE = &H2
    Const SWP_NOSIZE = &H1
 
Dim Shadow                    As clsShadow
Dim intPosY                   As Integer
Dim intTotHeight              As Integer
Dim strWtnNews                As String
 
Private Sub cmbExit_Click()
        Unload frmWhatNews
        End
End Sub
 
Private Sub Form_Load()
  
        Dim strTempLoadString         As String
        Dim fNum                      As Integer
        
                            picUp.Top = 0
                            picUp.Left = 0
                            picMain.Top = 530
                            picMain.Left = 0
                            picDown.Top = 6450
                            picDown.Left = 0
                            frmWhatNews.Width = 10970
                            frmWhatNews.Height = 6980
                            strWtnNews = ""
                            intPosY = 0
                            PutWindowOnTop Me
        
        
        If Dir(App.Path & "\Files\WhatNewsUp.pic") <> "" Then
            picUp = LoadPicture(App.Path & "\Files\WhatNewsUp.pic")
            picMain = LoadPicture(App.Path & "\Files\WhatNewsCentre.pic")
            picDown = LoadPicture(App.Path & "\Files\WhatNewsDown.pic")
        End If
                            
                            Set Shadow = New clsShadow
                            Call Shadow.Shadow(Me)
                            Shadow.Depth = 14
                            Shadow.Transparency = 110
 
        If Dir(App.Path & "\Files\verInfo.txt") <> "" Then
            fNum = FreeFile
            Open App.Path & "\Files\verInfo.txt" For Input As #fNum
                While EOF(fNum) = False
                      Line Input #fNum, strTempLoadString
                      strTempLoadString = " " & strTempLoadString
                      strWtnNews = strWtnNews & strTempLoadString & Chr(10)
                Wend
                intTotHeight = picMain.TextHeight(strWtnNews)
            Close #fNum
        Else
                            strTempLoadString = "  Файл " & App.Path & "\ParsingSystem\verInfo.txt" & " не найден"
                            strWtnNews = strWtnNews & strTempLoadString
                            intTotHeight = picMain.TextHeight(strWtnNews)
        End If
      
      
        Me.Show
      
                             Do
                               picMain.Cls
                               intPosY = intPosY + 1
                                   If intPosY > 450 Then
                                       lbl1.Enabled = False
                                       lbl2.Enabled = False
                                   End If
                               
                               picMain.CurrentY = picMain.ScaleHeight - intPosY
                               picMain.CurrentX = 0
                               picMain.Print strWtnNews
                               DoEvents
                               Sleep (7)
                            Loop Until intPosY > 1500
      
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        Set Shadow = Nothing
End Sub
 
Private Sub picMain_DblClick()
        Call cmbExit_Click
End Sub
 
Private Sub picMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        ReleaseCapture
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub
 
 
Public Function PutWindowOnTop(pFrm As Form)
        Dim lngWindowPosition As Long
        lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function
                        