vb label的Caption的文字实现上下滚动

Question

就想电影屏幕上面那样能从下面往上面滚动这样循环一直没想出来是不是用label.height呢谢谢 希望能给出实例

Answer 1

picture控件+Timer控件+label控件=平滑移动

Answer 2

'在窗体Form1上面放上一个Picture1，picture1上面放上一个Label1，在窗体上再放上一个计时器Timer1
Option ExplicitPrivate Sub Form_Load()
        Label1.Caption = "2008年奥运会即将来临"
        Timer1.Enabled = True
        Timer1.Interval = 10 '调整这个值可控制标签label1的移动速度
         Picture1.ScaleMode = 3
        Me.ScaleMode = 3
        Picture1.Picture = LoadPicture("D:\bliss.jpg")
End SubPrivate Sub Timer1_Timer()
        If Label1.Top <= 0 Then Label1.Top = Picture1.ScaleHeight
        Label1.Top = Label1.Top - 1
End Sub

Answer 3

楼上的代码在LABEL的TOP=0时就会从底部重新开始移动有种跳跃的感觉Private Sub Timer1_Timer()
        If Label1.Top <= 0-Label1.Top Then Label1.Top = Picture1.ScaleHeight
        Label1.Top = Label1.Top - 1
End Sub改了一下。HOO~

Answer 4

'添加Timer1 Label1 Label2 Image1(0) Image1(1)
'Image1(0)与image1(1)是两张同样大小画面稍不同并叠在一起的图片, 用来做退出的小图片.
'Me.picture自己加一张背景图片Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
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
'*****************************************移动窗体
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
'****************************************圆矩窗体
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
'*************************************************************
Dim xx1%, yy1%, xx2%, yy2%, rtn&, aa$, lw&, lh&
Private Sub Form_Load()
   With Me
      .AutoRedraw = True
      .BorderStyle = 0
      .Caption = ""
      .Width = 9090
      .Height = 7125
      .Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   End With
   With Label1
      .BackStyle = 0
      .AutoSize = True
      .Font = "楷体_GB2312"
      .FontSize = 24
      .ForeColor = QBColor(10)
      .Caption = "欢迎观赏 CBM666 的标签不闪滚动测试"
      .Left = Me.Width
      .Top = Me.Height - Label1.Height - 200
   End With
   aa = " CBM666的电影卷幕" & Chr(10) & vbCrLf
   aa = aa & "不闪的标签要如何作?" & Chr(10) & vbCrLf
   aa = aa & "  要代码的留下邮箱"
   With Label2
      .BackStyle = 0
      .AutoSize = True
      .Font = "楷体_GB2312"
      .FontSize = 24
      .ForeColor = QBColor(11)
      .Caption = aa
      .Left = (Me.Width - Label2.Width) \ 2
      .Top = Me.Height
   End With
   xx1 = Label1.Left: yy1 = Label1.Top
   xx2 = Label2.Left: yy2 = Label2.Top
   Image1(0).Move Me.Width - Image1(0).Width - 200, Me.Height - Image1(0).Height - 600
   Image1(1).Move Image1(0).Left, Image1(0).Top
   Image1(0).ZOrder 0
   rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
   rtn = rtn Or WS_EX_LAYERED
   SetWindowLong hwnd, GWL_EXSTYLE, rtn
   SetLayeredWindowAttributes hwnd, 0, 255, LWA_COLORKEY And LWA_ALPHA
   lw = Me.Width \ Screen.TwipsPerPixelX
   lh = Me.Height \ Screen.TwipsPerPixelY
   SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, lw, lh, 36, 36), True
   Timer1.Enabled = True
   Timer1.Interval = 20
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Image1(0).Visible = True
   If Button = 1 Then
      MousePointer = 5
      Call ReleaseCapture
      lngReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
      MousePointer = 0
   End If
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   rtn = MsgBox("确认要退出程序吗？", vbYesNo, "退出确认")
   If rtn = vbNo Then
      Cancel = -1
   Else
      End
   End If
End SubPrivate Sub Image1_Click(Index As Integer)
   Unload Me
End SubPrivate Sub image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
   Image1(0).Visible = False
End SubPrivate Sub Timer1_Timer()
   xx1 = IIf(xx1 <= -Label1.Width, Me.Width, xx1 - 60)
   yy2 = IIf(yy2 <= -Label2.Height, Me.Height, yy2 - 40)
   Label1.Move xx1, yy1
   Label2.Move xx2, yy2
End Sub
效果图:
http://p.blog.csdn.net/images/p_blog_csdn_net/cbm666/366646/o_JZT.gif

Answer 5

很 厉害 呵呵我有一点不  明白的是   为什么在每个人的回复中一定要加个PICTURE呢？不加图片不可以么？
我自己写好了 就没加图片

Answer 6

当然，可以不加！
加picture的好处是：移动时，上、下都有一段空间，让人可以接受，这是艺术！我们平时写字都要求上下都留点空白吧！不要从地上一冒出来，就捅到天上去，这样不好！