标题:非常平滑的水平字幕滚动 不能滚动中文问题?
只看楼主
xzqsml
Rank: 2
等 级:论坛游民
帖 子:41
专家分:47
注 册:2008-6-15
结帖率:90.91%
 问题点数:0 回复次数:7 
非常平滑的水平字幕滚动 不能滚动中文问题?
问题,只能滚动"VB";不能滚动"VB论坛";中文不行
问题好像在
Private Sub Scroll()

End Sub
中....

代码如下 :
Option Explicit

Private TextLine  As String  '文字信息
Private Index     As Long    '字符索引

Private Scrolling As Boolean '滚动标志
Private t         As Long    '帧延时

Private RText     As RECT
Private RClip     As RECT
Private RUpdate   As RECT

Private Sub Form_Load()
    TextLine = "VB论坛"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Scrolling = 0 '!
End Sub

Private Sub cmdScroll_Click()
    '-- 开始滚动
    Scrolling = -1
    Index = 1
    Scroll
End Sub

Private Sub Scroll()

  Dim Char As String
  
    With iScroll
         SetRect RClip, 1, 2, .ScaleWidth, .ScaleHeight
         SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Left$(TextLine, 1)), .ScaleHeight
    End With

    Char = Left$(TextLine, 1)

    With iScroll

        Do
            If (timeGetTime - t >= 30) Then

                t = timeGetTime

                If (RText.Right <= .ScaleWidth) Then

                    Index = Index + 1
                    Char = Mid$(TextLine, Index, 1)
                    SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Mid$(TextLine, Index, 1)), .ScaleHeight
                End If

                DrawText .hdc, Char, 1, RText, &H0

                OffsetRect RText, -1, 0

                ScrollDC .hdc, -1, 0, RClip, RClip, 0, RUpdate
                iScroll.Line (.ScaleWidth - 1, 0)-(.ScaleWidth - 1, .ScaleHeight - 1), .BackColor
            End If

            If (Index > Len(TextLine)) Then Index = 0
            DoEvents
            
        Loop Until Scrolling = 0
    End With
End Sub

非常平滑的字幕滚动.rar (7.09 KB)
←已上传附件. 请指教...

[ 本帖最后由 xzqsml 于 2009-11-24 11:07 编辑 ]
搜索更多相关主题的帖子: 滚动 水平 中文 字幕 
2009-11-24 10:30
suxin868
Rank: 4
等 级:业余侠客
威 望:1
帖 子:145
专家分:203
注 册:2008-12-31
得分:0 
找不到毛病

--------------当你无力改变这个世界的时候,就让这个世界改变你-------------------
2009-11-24 11:56
xzqsml
Rank: 2
等 级:论坛游民
帖 子:41
专家分:47
注 册:2008-6-15
得分:0 
TextLine = "VB论坛"
TextLine 里面的中文不能滚动啊???
2009-11-24 11:58
suxin868
Rank: 4
等 级:业余侠客
威 望:1
帖 子:145
专家分:203
注 册:2008-12-31
得分:0 
回复 3楼 xzqsml
是啊,不知道是什么原因

--------------当你无力改变这个世界的时候,就让这个世界改变你-------------------
2009-11-24 12:03
xzqsml
Rank: 2
等 级:论坛游民
帖 子:41
专家分:47
注 册:2008-6-15
得分:0 
Char = Mid$(TextLine, Index, 1)
是不是跟这个有关呢??
2009-11-24 12:23
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:0 
DrawText  函数功能:该函数在指定的矩形里写入格式化文本,根据指定的方法对文本格式化(扩展的制表符,字符对齐、折行等)。
  函数原型:int DrawText(HDC hdc, LPCTSTR lpString, int nCount, LPRECT lpRect, UINT uFormat);
  参数:
  hdc:设备环境句柄。
  lpString:指向将被写入的字符串的指针,如果参数nCount是-1,则字符串必须是以\0结束的。
  如果uFormat包含DT_MODIFYSTRING,则函数可为此字符串增加4个字符,存放字符串的缓冲区必须足够大,能容纳附加的字符。
  nCount:指向字符串中的字符数。如果nCount为-1,则lpString指向的字符串被认为是以\0结束的,DrawText会自动计算字符数。
  lpRect:指向结构RECT的指针,其中包含正文将被置于其中的矩形的信息(按逻辑坐标)。
  uFormat:指定格式化正文的方法。它可以下列值的任意组合,各值描述如下:
  DT_BOTTOM:将正文调整到矩形底部。此值必须和DT_SINGLELINE组合。
  DT_CALCRECT:决定矩形的宽和高。如果正文有多行,DrawText使用lpRect定义的矩形的宽度,并扩展矩形的底训以容纳正文的最后一行,如果正文只有一行,则DrawText改变矩形的右边界,以容纳下正文行的最后一个字符,上述任何一种情况,DrawText返回格式化正文的高度而不是写正文。
  DT_CENTER:使正文在矩形中水平居中。
  DT_VCENTER:使正文在矩形中垂直居中。
  DT_EDITCONTROL:复制多行编辑控制的正文显示特性,特殊地,为编辑控制的平均字符宽度是以同样的方法计算的,此函数不显示只是部分可见的最后一行。
  DT_END_ELLIPSIS或DT_PATH_ELLIPSIS:可以指定DT_END_ELLIPSIS来替换在字符串末尾的字符,或指定DT_PATH_ELLIPSIS来替换字符串中间的字符。如果字符串里含有反斜扛,DT_PATH_ELLIPSIS尽可能地保留最后一个反斜杠之后的正文。
  DT_EXPANDTABS:扩展制表符,每个制表符的缺省字符数是8。
  DT_EXTERNALLEADING:在行的高度里包含字体的外部标头,通常,外部标头不被包含在正文行的高度里。
  DT_INTERNAL:用系统字体来计算正文度量。
  DT_LEFT:正文左对齐。
  DT_MODIFYSTRING:修改给定的字符串来匹配显示的正文,此标志必须和DT_END_ELLIPSIS或DT_PATH_ELLIPSIS同时使用。
  DT_NOCLIP:无裁剪绘制当DT_NOCLIP使用时DrawText的使用会有所加快。
  DT_NOPREFIX:关闭前缀字符的处理,通常DrawText解释助记前缀字符,&为给其后的字符加下划线,解释&&为显示单个&。指定DT_NOPREFIX,这种处理被关闭。
  DT_RIGHT:正文右对齐。
  DT_RTLREADING:当选择进设备环境的字体是Hebrew或Arabicf时,为双向正文安排从右到左的阅读顺序都是从左到右的。
  DT_SINGLELINE:显示正文的同一行,回车和换行符都不能折行。
  DT_TABSTOP:设置制表,参数uFormat的15"C8位(低位字中的高位字节)指定每个制表符的字符数,每个制表符的缺省字符数是8。
  DT_TOP:正文顶端对齐(仅对单行)。DT_VCENTER:正文水平居中(仅对单行)。
  DT_WORDBREAK:断开字。当一行中的字符将会延伸到由lpRect指定的矩形的边框时,此行自动地在字之间断开。一个回车一换行也能使行折断。
  DT_WORD_ELLIPSIS:截短不符合矩形的正文,并增加椭圆。
  注意:DT_CALCRECT, DT_EXTERNALLEADING, DT_INTERNAL, DT_NOCLIP, DT_NOPREFIX值不能和DT_TABSTOP值一起使用。
  返回值:如果函数调用成功,返回值是正文的高度;如果函数调用失败,返回值是0。
  Windows NT:若想获得更多错误信息,请调用GetLastError函数。
  备注:函数DrawText用设备环境中的字体选择、正文颜色和背景颜色来写正文,除非DT_NOCLIP被使用,DrawText裁剪正文,所以它不会出现在指定矩形的外面,除DT_SINGLELINE格式化,其余的格式都认为正文有多行。
  如果选择的字体对指定的矩形而言太大,DrawText不会试图去换成一种小字体。
  Windows CE:如果为参数uFormat指定DT_CALCRECT值,必须为lpRect指向的RECT结构设置right和bottom成员。Windows CE不支持uFormat为DT_EXTERNALLEADING。
  速查:Windows NT:3.1及以上版本;Windows:95及以上版本;Windows CE:1.0及以上版本;头文件:wingdi.h;库文件:gdi32.lib;Unicode:在Windows NT环境下以Unicode和ANSI两种方式实现。



对照 API 函数说明
你调用的命令是:
                DrawText .hdc, Char, 1, RText, &H0

这行命令,对于英文字符来说, 第三个参数是1 ,正好是英文字符的长度.
但对于中文来说,第三个参数却不是 中文字符的长度,所以这个函数执行时,只取你传进去的中文的第一个字节,结果不是一个ASC码的值,就无法显示,那就空着在.

这条命令改为:
                DrawText .hdc, Char & Chr(0), -1, RText, &H0

        长度用 -1 传进去,但提供字符串时,必须以 Chr(0) 结尾,以符合C 的字符串结束.这样这个函数会自己计算长度,并正确的显示出来.


授人于鱼,不如授人于渔
早已停用QQ了
2009-11-24 16:14
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:0 
我写的,实现原理与你的不同,完全用的VB代码写的,只是使用了你里面的时间函数
我是另外放过了一个按钮,复制一份 iScroll ,名字叫: Picture1
没去测试执行效率.

Private Sub Command1_Click()

Scrolling = True

Dim i As Long           '字符的长度
With Picture1
    i = .TextWidth(TextLine)
Dim x As Long
x = .ScaleWidth             '起始X坐标

Do
If (timeGetTime - t >= 30) Then         '延时
    t = timeGetTime
   
    x = x - 1               '向左移一位
    If x < -i Then          '如果对应的一段移出去了,则去掉
        x = x + i
    End If
   
    .Cls                    '清屏
        .CurrentX = x       '初始坐标
        .CurrentY = 3       '与上边距离 3
    Do
        Picture1.Print TextLine;            '显示一节
    Loop While .CurrentX < .ScaleWidth      '如果当前坐标还没出范围,则继续显示
   
    DoEvents
End If

Loop Until Scrolling = 0

End With

End Sub

授人于鱼,不如授人于渔
早已停用QQ了
2009-11-24 16:54
Joforn
Rank: 6Rank: 6
等 级:贵宾
威 望:23
帖 子:1242
专家分:122
注 册:2007-1-2
得分:0 
DrawText .hdc, Char, LenB(StrConv(Char, vbFromUnicode)), RText, &H0

VB QQ群:47715789
2009-11-25 08:46



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-293185-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.407869 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved