请教文字滚动

[2934046]

本人要实现文字（400字左右）由屏幕的各个方向平滑移动到中心，该如果处理，不能用label的移动，也不能用picture.print 因为有闪动.最好有完整的代码。收到后，马上给分！

[射天狼]

什么都不能用!!
干脆不用程序实现吧~~~

[muniu]

太高难度了，支持一下。

[海牛]

加点分吧！
我会给你一个控件！

[2934046]

好，只要能实现，我给100分

[海牛]

明天行吗？
我现在在公司，现在没有！

[海牛]

EMail：[e-mail]

[海牛]

具体要求能说明白点吗？

[yoki]

'窗体命名为frmAbout,在窗体上加两个command,一个picture,一个timer
Option Explicit
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Const DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'the actual text to scroll. This could also be loaded in from a text file

Const ScrollText As String = "My Application Title" & vbCrLf & _
vbCrLf & vbCrLf & _
"Producer: Myself" & vbCrLf & _
"Executive Producer: Myself" & _
vbCrLf & "Main programmer: Myself" & _
vbCrLf & "Main graphic artist: Myself" & _
vbCrLf & vbCrLf & _
"Sample from:" & _
vbCrLf & _
"HTTP://WWW.VBEXPLORER.COM"
Dim EndingFlag As Boolean

Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
EndingFlag = False
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
EndingFlag = True
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
picScroll.ForeColor = vbYellow
picScroll.FontSize = 14
End Sub

Private Sub RunMain()
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long

'show the form
frmAbout.Refresh

'Get the size of the drawing rectangle by suppying the DT_CALCRECT constant
rt = DrawText(picScroll.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)

If rt = 0 Then 'err
MsgBox "Error scrolling text", vbExclamation
EndingFlag = True
Else
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Left = 0
DrawingRect.Right = picScroll.ScaleWidth
'Store the height of The rect
RectHeight = DrawingRect.Bottom
DrawingRect.Bottom = DrawingRect.Bottom + picScroll.ScaleHeight
End If

Do While Timer1.Enabled 'EndingFlag
If GetTickCount() - LastFrameTime > IntervalTime Then
picScroll.Cls
DrawText picScroll.hdc, ScrollText, -1, DrawingRect, DT_CENTER Or DT_WORDBREAK
'update the coordinates of the rectangle
DrawingRect.Top = DrawingRect.Top - 1
DrawingRect.Bottom = DrawingRect.Bottom - 1

'control the scolling and reset if it goes out of bounds
If DrawingRect.Top < -(RectHeight) Then 'time to reset
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Bottom = RectHeight + picScroll.ScaleHeight
End If

picScroll.Refresh
LastFrameTime = GetTickCount()
End If
DoEvents
Loop
End Sub


Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
EndingFlag = True
Beep
End Sub

Private Sub Timer1_Timer()
RunMain
End Sub

[yoki]

这是从一个方向的
你加多几个定时器分别控制不同方向的，类似以上的稍微改一下就可以

[海牛]

小马哥，要考虑400字啊，执行速度！！！

[2934046]

yoki(小马哥) 我测试了你的程序，怎么什么东西都没有！
Rick110AAA(海牛猪猪) ，快发给我吧，我再加100分
邮件：[e-mail]