社区
VB
帖子详情
[求助]滚动字幕求解!帮顶有分!
oo渣渣oo
2005-06-27 05:02:48
想在程序里面做个类似网页上滚动字幕的效果,
但是偶不想用时间控件+Label的方式,
因为在某些反应迟顿的机器上,这种方式会出现字幕跳动(移动不连续)的情况.
请教:有没有什么更加科学的方法啊,源代码或做好的Dll之类均可.
主要是不想让人觉得偶滴程序一点技术含量都没有!嘿嘿嘿.....
偶只要.NET的啊,别拿个C++的给偶,那玩意太高深,不会!看不懂!
...全文
208
14
打赏
收藏
[求助]滚动字幕求解!帮顶有分!
想在程序里面做个类似网页上滚动字幕的效果, 但是偶不想用时间控件+Label的方式, 因为在某些反应迟顿的机器上,这种方式会出现字幕跳动(移动不连续)的情况. 请教:有没有什么更加科学的方法啊,源代码或做好的Dll之类均可. 主要是不想让人觉得偶滴程序一点技术含量都没有!嘿嘿嘿..... 偶只要.NET的啊,别拿个C++的给偶,那玩意太高深,不会!看不懂!
复制链接
扫一扫
分享
转发到动态
举报
写回复
配置赞助广告
用AI写文章
14 条
回复
切换为时间正序
请发表友善的回复…
发表回复
打赏红包
Snrmnm_sx
2005-06-28
打赏
举报
回复
上面的程序在中文Win98,VB6下运行通过。
Snrmnm_sx
2005-06-28
打赏
举报
回复
接上楼的!
Public Sub SelectFont(o As Object)
NewFont = CreateFontIndirect(m_LF)
OrgFont = SelectObject(o.hdc, NewFont)
End Sub
Public Sub FontOut(text$, o As Control, XX, YY)
Dim Throw As Long
Throw = TextOut(o.hdc, XX, YY, text$, Len(text$))
End Sub
Public Property Get Width() As Long
Width = m_LF.lfWidth
End Property
Public Property Let Width(ByVal W As Long)
m_LF.lfWidth = W
End Property
Public Property Get Height() As Long
Height = m_LF.lfHeight
End Property
Public Property Let Height(ByVal vNewValue As Long)
m_LF.lfHeight = vNewValue
End Property
Public Property Get Escapement() As Long
Escapement = m_LF.lfEscapement
End Property
Public Property Let Escapement(ByVal vNewValue As Long)
m_LF.lfEscapement = vNewValue
End Property
Public Property Get Weight() As Long
Weight = m_LF.lfWeight
End Property
Public Property Let Weight(ByVal vNewValue As Long)
m_LF.lfWeight = vNewValue
End Property
Public Property Get Italic() As Byte
Italic = m_LF.lfItalic
End Property
Public Property Let Italic(ByVal vNewValue As Byte)
m_LF.lfItalic = vNewValue
End Property
Public Property Get UnderLine() As Byte
UnderLine = m_LF.lfUnderline
End Property
Public Property Let UnderLine(ByVal vNewValue As Byte)
m_LF.lfUnderline = vNewValue
End Property
Public Property Get StrikeOut() As Byte
StrikeOut = m_LF.lfStrikeOut
End Property
Public Property Let StrikeOut(ByVal vNewValue As Byte)
m_LF.lfStrikeOut = vNewValue
End Property
Public Property Get FaceName() As String
FaceName = m_LF.lfFaceName
End Property
Public Property Let FaceName(ByVal vNewValue As String)
m_LF.lfFaceName = vNewValue
End Property
Private Sub Class_Initialize()
m_LF.lfHeight = 30
m_LF.lfWidth = 10
m_LF.lfEscapement = 0
m_LF.lfWeight = 400
m_LF.lfItalic = 0
m_LF.lfUnderline = 0
m_LF.lfStrikeOut = 0
m_LF.lfOutPrecision = 0
m_LF.lfClipPrecision = 0
m_LF.lfQuality = 0
m_LF.lfPitchAndFamily = 0
m_LF.lfCharSet = 0
m_LF.lfFaceName = "Arial" + Chr(0)
End Sub
在工程文件的Form1中加入一个PictureBox和一个CommandButton控件,然后在Form1的代码窗口中加入以下的代码:
Option Explicit
Dim AF As APIFont
Dim X, Y As Integer
Private Sub Command1_Click()
Dim i As Integer
Set AF = Nothing
Set AF = New APIFont
Picture2.Cls
For i = 0 To 3600 Step 360
AF.Escapement = i
AF.SelectFont Picture2
X = Picture2.ScaleWidth / 2
Y = Picture2.ScaleHeight / 2
‘在字符串后面要加入7个空格
AF.FontOut "电脑商情报第42期 ", Picture2, X, Y
AF.SelectOrg Picture2
Next i
End Sub
Private Sub Form_Load()
Picture2.ScaleMode = 3
End Sub
运行程序,点击Form上的Command1按钮,在窗口的图片框就会出现旋转的文本显示。
楼主都能旋转了,也就是能滚动!希望能帮上你的忙!
Snrmnm_sx
2005-06-28
打赏
举报
回复
在VB中建立可旋转的文本特效
在VB中利用Windows的API函数可以实现很多的VB无法实现的扩展功能,下面的程序介绍的是如何通过调用Windows中的API函数实现文本旋转显示的特级效果的。
首先建立一个工程文件,然后选菜单中的Project | Add Class Module 加入一个新的类文件,并将这个类的Name属性改变为APIFont,然后在类的代码窗口中加入以下的代码:
Option Explicit
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As _
Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As _
Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As _
Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As _
Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As _
Long) As Long
Private Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags _
As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const TA_LEFT = 0
Private Const TA_RIGHT = 2
Private Const TA_CENTER = 6
Private Const TA_TOP = 0
Private Const TA_BOTTOM = 8
Private Const TA_BASELINE = 24
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 50
End Type
Private m_LF As LOGFONT
Private NewFont As Long
Private OrgFont As Long
Public Sub CharPlace(o As Object, txt$, X, Y)
Dim Throw As Long
Dim hregion As Long
Dim R As RECT
R.Left = X
R.Right = X + o.TextWidth(txt$) * 2
R.Top = Y
R.Bottom = Y + o.TextHeight(txt$) * 2
hregion = CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom)
Throw = SelectClipRgn(o.hdc, hregion)
Throw = TextOut(o.hdc, X, Y, txt$, Len(txt$))
DeleteObject (hregion)
End Sub
Public Sub SetAlign(o As Object, Top, BaseLine, Bottom, Left, Center, Right)
Dim Vert As Long
Dim Horz As Long
If Top = True Then Vert = TA_TOP
If BaseLine = True Then Vert = TA_BASELINE
If Bottom = True Then Vert = TA_BOTTOM
If Left = True Then Horz = TA_LEFT
If Center = True Then Horz = TA_CENTER
If Right = True Then Horz = TA_RIGHT
SetTextAlign o.hdc, Vert Or Horz
End Sub
Public Sub setcolor(o As Object, CValue As Long)
Dim Throw As Long
Throw = SetTextColor(o.hdc, CValue)
End Sub
Public Sub SelectOrg(o As Object)
Dim Throw As Long
NewFont = SelectObject(o.hdc, OrgFont)
Throw = DeleteObject(NewFont)
End Sub
ccg68
2005-06-28
打赏
举报
回复
如果不用Timer控件的话,也可以用循环的方法:
While True
Thread.Sleep(100)
(字幕滚动的算法)
end while
然后用一个线程去执行,如果需要停止滚动,就终止线程。这是我的想法。
changyf
2005-06-28
打赏
举报
回复
做个Flash插上去算啦~ 嘿嘿~
oo渣渣oo
2005-06-28
打赏
举报
回复
再看看有没高手有啥高办法没有:)
smx717616
2005-06-27
打赏
举报
回复
我倒是想看看有什么别的办法!!!
fanruinet
2005-06-27
打赏
举报
回复
其实用timer没什么不好的,我也没想到不用timer的办法
pupo
2005-06-27
打赏
举报
回复
放个浏览器控件,然后加载滚动脚本
oo渣渣oo
2005-06-27
打赏
举报
回复
那就是说,偶只有用Timer这一种选择鸟?
zeusvenus
2005-06-27
打赏
举报
回复
.NET的没用过,这样的需求干吗不用JS来实现?
fanruinet
2005-06-27
打赏
举报
回复
>>在某些反应迟顿的机器上,这种方式会出现字幕跳动(移动不连续)的情况
这不是一个很恰当的理由,无论你怎么做,我用台486都会出现跳动的情况
timer加label对系统资源要求不是很高,能跑起.net的应该都没问题
tornado379
2005-06-27
打赏
举报
回复
用Timer啊
hamadou
2005-06-27
打赏
举报
回复
不用timer?呵呵,那我不知道了!
(HDUACM201403版_04)递推
求解
杭电ACM课件2014版之 (HDUACM201403版_04)递推
求解
tp5集成swoole的坑!
求解
!!!!
tp集成swoole的坑!
求解
!!!! 不胜感激!!!!!!!!!!!!!!!!!!!
计算机光盘无法格式化,怎么格式化光盘啊??
求解
!!
求解
!!问题最佳答案一般光盘是不可擦写的,只能一次性,格式化不了。可擦写的光盘贵多了,可擦写次数有限,可以格式化,推荐答案一般光盘是不可擦写的,只能一次性,格式化不了。可擦写的光盘贵多了,可擦写次数有限...
利用Z变换
求解
线性常系数差分方程
求解
线性常系数差分方程有三种方法,经典法,递推解法,Z变换法,今天我们来学习Z变换
求解
线性常系数差分方程 利用Z变换
求解
线性常系数差分方程的过程 1.对等号两边做单边或者双边Z变换,如果激励x(n)是因果信号,也...
差分方程及
求解
MATLAB实现
数字信号处理实验四 差分方程及其
求解
一、 实验目的1.学习并掌握系统的差分方程表示方法以及差分方程的相关概念。 2.熟练使用filter函数对差分方程进行数值
求解
。 3.掌握差分方程的
求解
及MATLAB实现方法。二、实验...
VB
16,554
社区成员
110,527
社区内容
发帖
与我相关
我的任务
VB
VB技术相关讨论,主要为经典vb,即VB6.0
复制链接
扫一扫
分享
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
加入社区
获取链接或二维码
近7日
近30日
至今
加载中
查看更多榜单
社区公告
暂无公告
试试用AI创作助手写篇文章吧
+ 用AI写文章