急,文字平滑移动问题求助!
我编写了一个文字滚动程序,我是用以下方法编写的:
dim T as long
Do
T = timeGetTime
'T = GetTickCount
Display
Do While timeGetTime - T < CC
Add
DoEvents
Loop
Loop
其中CC是一个常量,display函数用于在picturebox上显示文本,add函数用于进行文字载入和文字移动处理(文字左移一个像素点)。然后这个程序界面会通过设备显示到视频屏(1280*32,约八米长,刷新率:60HZ)上。
但是问题出现了,文字在移动过程中总会定时出现跳动,严重影响了移动的平滑性,这在视频屏上十分明显。
我调整过CC的值,但是没用用,哪个值都会有跳动,只是间隔不同。为此我非常着急。
请教高手这个问题如何解决?
[解决办法]
Const strSamp = "滚动文本演示 "
Dim bShow As Boolean
Dim iScroll As Integer
Private Sub Timer1_Timer()
If bShow Then
bShow = False
Picture1.Visible = False
Picture2.Visible = True
Picture1.Cls
Picture1.CurrentX = iScroll
Picture1.CurrentY = 30
Picture1.Print strSamp
Else
bShow = True
Picture1.Visible = True
Picture2.Visible = False
Picture2.Cls
Picture2.CurrentX = iScroll
Picture2.CurrentY = 30
Picture2.Print strSamp
End If
iScroll = iScroll + 30
If iScroll > 1800 Then
Timer1.Enabled = False
End If
End Sub
[解决办法]
"定时出现跳动 "是什么意思?
我认为你的Add和Display函数的效率对此也会产生影响.而且这种循环定时CPU占用率很高.
[解决办法]
Option Explicit
Dim pm_tsOld As String
Dim LTxt As Integer
Private Sub Form_Load()
pm_tsOld = "其中CC是一个常量,display函数用于在picturebox上显示文本,add函数用于进行文字载入和文字移动处理(文字左移一个像素点)。然后这个程序界面会通过设备显示到视频屏(1280*32,约八米长,刷新率:60HZ)上。 "
Timer1.Interval = 500
End Sub
Private Sub Timer1_Timer()
Text1 = pm_tsOld
LTxt = Len(pm_tsOld)
'Text1.Left = 7680 - 30 * LTxt
'Text1.Width = 60 * LTxt
If LTxt > 0 Then
pm_tsOld = Mid(pm_tsOld, 2, LTxt - 1) & Mid(pm_tsOld, 1, 1)
End If
End Sub
[解决办法]
利用双缓冲,先写到内存在一次显示出来,可能可以解决.
[解决办法]
双缓冲。
[解决办法]
模仿DirectX
[解决办法]
如果你是做工程,建议你别太费力了,用现成的吧,这个控件包中有一个字幕控件,看是否符合你的要求:
http://www.vb99.com/product/acControl/register.asp
它可以实现垂直滚动、水平滚动、逐行滚动、淡入淡出、打字机效果。若修改一些属性值,还可以实现不同的效果。支持背景和前景文字纹理贴图,非常的不错。
[解决办法]
直接用DIRECTX
工程引用DX7
Option Explicit
Dim DX As New DirectX7
Dim DD As DirectDraw7
Dim DDSPrimary As DirectDrawSurface7
Dim ddsd As DDSURFACEDESC2
Private Sub Form_Load()
Set DD = DX.DirectDrawCreate( " ")
DD.SetCooperativeLevel Me.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
DD.SetDisplayMode 1024, 768, 16, 0, 0 'DDSDM_DEFAULT
ddsd.lFlags = DDSD_CAPS
ddsd.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
ddsd.lWidth = 100
ddsd.lHeight = 100
Set DDSPrimary = DD.CreateSurface(ddsd)
DDSPrimary.SetFontBackColor RGB(255, 255, 255)
End Sub
sub DrawTextStr()
DDSPrimary.SetForeColor VBRED
DDSPrimary.DrawText 500, 300, "Hello World ", True
End Sub
[解决办法]
60HZ 的显示器建议用 Timer 控制在每秒刷新 30 次。
如果绘图的频率高于显示器刷新频率,那么每帧都不能显示完整画面。
还有知道播放电影用的是多少频率吗?24帧/秒,在每帧图都不一样的情况下,刷新太快肉眼反而反映不过来,会觉得眼花。
[解决办法]
TO 楼上
其实电影也好动画也好,都是利用了人眼的错觉,在很短的时间内显示不同的画面,从而形成运动感.
但是相邻的图片如果相差太大,就会发生眼花缭乱的感觉.
因此,只要能控制相邻的图片之间的差异大小,就可以得到比较满意的动画效果了.
[解决办法]
其实还有一些更加深入的原理,并且很多时候大家在做动态画面的时候并没有注意到,推荐大家看看这篇文章,希望对大家有所帮助:
http://blog.yesky.com/141/wallescai/1675141.shtml