如何在产生字体滚动的效果？

Question

类似于PPT里面的飞来飞去或者其它动画效果的。
虽然通过字体坐标的变化来刷新窗体是可以实现的，但总觉得应该还有更好的方法

Answer 1

把字写在label里面，然后move label飞来飞去咯

Answer 2

用timer控件，把在窗体上建立坐标系x y 你可以用函数sin cos 去实现
这个我做过的可以实现

Answer 3

Option ExplicitPrivate Declare Function BitBlt Lib "gdi32" ( _
   ByVal hdcDest As Long, ByVal XDest As Long, _
   ByVal YDest As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hDCSrc As Long, _
   ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) _
   As LongPrivate Const SRCCOPY = &HCC0020
Dim filename As String
Dim Tempstring(1 To 3000) As Variant
Dim ipicHeight As Integer
Dim ipicWidth As Integer
Dim lYOffset As Integer
Dim iColorCur As Single
Dim iColorStep As Single
Dim NumLines As Integer
Dim lX As Long
Dim lY As Long
Dim strRead As StringPrivate Sub Form_Load()
 
  With frmAbout
    .Caption = "关于本人"
    .Left = (Screen.Width - .Width) / 2
    .Top = (Screen.Height - .Height) / 2
  End With
 'Call makeOnTop(True)   '窗口在最上
Dim iLine As Integer
    
    NumLines = 1
    
    frmAbout.ScaleMode = vbPixels
    
    picBuffer.ScaleMode = vbPixels
    
    picBuffer.ForeColor = vbWhite
    picBuffer.BackColor = vbBlack
    picBuffer.AutoRedraw = True
    
    picBuffer.Visible = False
    
    filename = App.Path & "\" & "aboutMe.txt"
    Open filename For Input As #1
    
    Do Until EOF(1)
        Line Input #1, Tempstring(NumLines)
        NumLines = NumLines + 1
    Loop
    Close #1
    
    NumLines = NumLines - 1
    
    lX = picBuffer.ScaleLeft
    lY = picBuffer.ScaleHeight
    
    GradiantBackground picBackBuffer
    
    ReDrawTimer.Interval = 40
    ReDrawTimer.Enabled = True
    unload me
End Sub
Private Function GradiantBackground(picBox As PictureBox)
    ipicWidth = picBox.ScaleWidth
    ipicHeight = picBox.ScaleHeight
    
    iColorCur = 255
    iColorStep = 5 * (0 - 255) / ipicHeight    For lYOffset = 0 To ipicHeight Step 5
        picBox.Line (-1, lYOffset - 1)-(ipicWidth, lYOffset + 5), RGB(0, 0, iColorCur), BF
        iColorCur = iColorCur + iColorStep
    Next lYOffset
End FunctionPrivate Sub picBackBuffer_Click()
  Unload Me
End SubPrivate Sub picOut_Click()
  Unload Me
End SubPrivate Sub RedrawTimer_Timer()
  Dim l As Long
  Dim j As LongOn Error Resume Next
   l = BitBlt(picBuffer.hDC, 0, picBuffer.ScaleTop, picBuffer.ScaleWidth, picBuffer.ScaleHeight, picBackBuffer.hDC, 0, 0, SRCCOPY)
    
    
    For j = 1 To NumLines Step 1
        
        picBuffer.CurrentY = lY + (j * picBuffer.FontSize + (6 * j))
        picBuffer.CurrentX = (picBuffer.ScaleWidth / 2) - (picBuffer.TextWidth(Tempstring(j)) / 2)
        picBuffer.ForeColor = vbWhite
        If picBuffer.CurrentY < 245 Then
            
           
            If picBuffer.CurrentY > 15 Then
                
                picBuffer.ForeColor = RGB((((255 / 235) * picBuffer.CurrentY)), (((255 / 235) * picBuffer.CurrentY)), (((255 / 25) * picBuffer.CurrentY)))
            Else
                picBuffer.ForeColor = vbBlack
                If j = NumLines And picBuffer.CurrentY < -25 Then
                  ReDrawTimer.Enabled = False
                  Unload Me
                End If
            End If
        End If
        
       
        picBuffer.Print Tempstring(j)
        
    Next
    l = BitBlt(picOut.hDC, 0, picOut.ScaleTop, picOut.ScaleWidth, picOut.ScaleHeight, picBuffer.hDC, 0, 0, SRCCOPY)
    picOut.Refresh
    lY = lY - 1End Sub