LOFTER-网易轻博

充满活力的字符串任意变形动画特技

　　如果你使用 Flash MX 制作过动画，那么你一定不会忘记"任意变形"和"动作补间"这两个特技。"任意变形"可以将图形或字符串任意旋转、翻滚、缩放等等；"动作补间"则只要你设置图形移动的起始点和结束点的诸参数，中间的动作过程由系统自动完成。
　　在 VB6 中我们也可以编写代码来实现字符串的"任意变形"和"动作补间"的部分特技。下面就是笔者的经验之谈。注意一点：winXP与win7的字体名称不相同，如XP字体：楷体_GB2312，win7没有“_GB2312”，请根据自己的操作系统更改。

 

一、汉字串的任意旋转
　　这里所说的旋转是指汉字串在二维平面上的旋转。网上曾有"旋转字体"的代码，但要达到笔者的要求，则还必须加以根本性的改进，主要有3点：
　　1.原代码是字符串围绕着字符串左上角的坐标点旋转，而笔者则要求字符串围绕着它的中点（即字符串长度的1/2处）旋转，这个问题可以用三角函数式来解决。
　　2.原代码旋转结束后，所有的字符串都显示在屏幕上，而笔者则要求旋转结束时只显示最后出现的字符串，这就要在旋转的过程中及时消除前次显示的字符串。
　　3.原代码的字符串在旋转时，其起点坐标基本不变，字形大小始终不变，而笔者则要求字符串一边旋转一边在屏幕移动（例如从屏幕右下角移动到屏幕左上角），且字形大小也要在移动中逐渐增加（由小到大，当然你也可以改为由大到小）。
　　本来可以将字符串直接打印在窗体，但字符串在旋转时要清屏，闪动得厉害，所以采用了类似于"双缓冲技术"的办法：即先将字符串打印到图片框（清屏也在图片框上进行），再将处理好的图片框上的字符串用 BitBlt 函数复制到窗体。
　　这个特技用到了7个API函数：

　　lstrlen：返回以字节为单位的字符串长度。它只有1个参数，即需要获得其长度的字符串。
　　CreateFontIndirect：使用LOGFONT结构创建一种逻辑字体并返回其句柄。它也只有1个参数，即声明为该结构类型的变量名。
　　SelectObject：将指定对象选入给定的设备描述表。它有2个参数，在本代码中，第1个参数是窗体的句柄；第2个参数是逻辑字体的句柄。
　　DeleteObject：删除对象。该函数只有1个参数，即对象的句柄。
　　GetStockObject：获取窗体系统字体的 ID。该函数只有 1 个参数，在本代码中是常数 System_Font（值为13）。它的作用是预先保存系统字体，待字符串旋转结束时，根据这个ID恢复系统原字体。
　　BitBlt：按照指定的操作方式，将图像从源设备场景传输到目标设备场景。有9个参数：
　　第1个参数：目标设备场景的句柄。
　　第2、3个参数：目标设备场景中目标矩形左上角的横、纵坐标。
　　第4、5个参数：传输图像的宽度和高度。
　　第6个参数：源设备场景的句柄。
　　第7、8个参数：源设备场景中源矩形左上角的横、纵坐标。
　　第9个参数：操作方式，用常数表示。
　　Sleep：该函数是可选的，可用别的方法取代。其作用是延时，只有1个参数，即延时的毫秒数。

　　新建一个工程，其部分属性设置为：
　　BackColor＝黑色
　　ScaleMode＝3
　　WindowState＝2
　　再在窗体上添加一个图片框控件，其部分属性设置为：
　　BackColor＝黑色
　　ScaleMode＝3
　　Visible＝False
　　AutoRedraw＝True
　　说明：笔者下面介绍的各种字符串显示特技，其窗体或图片框的设置与此相同）。
　　用菜单编辑器建立一个"字串旋转"菜单项（标题与名称相同。
　　源代码：

Option Explicit

Private Type LOGFONT
  FonH As Long 'lfHeight字体高度，以逻辑单位标定
  FonW As Long 'lfWidth字体宽度，平均宽度
  FonJ As Long 'lfEscapement输出方向与当前坐标系X轴之间的字体旋转的角度，以1/10度为单位
  Fon1 As Integer'lfOrientation每个字符与当前坐标系X轴之间的角度，以1/10度为单位
  Fon2 As Integer
  Fon3 As String 'lfWeight是否粗体  
  Fon4 As Byte 'lfItalic是否为斜体
  Fon5 As Byte 'lfUnderline是否有下划线
  Fon6 As Byte 'lfStrikeOut是否有中划线
End Type

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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub 字串旋转_Click()
Dim Font As LOGFONT
Dim Fhdc As Long, Mhdc As Long, J As Long, k As Long
Dim x As Long, y As Long, X1 As Long, Y1 As Long
Dim ST As String, JD As Integer
Const P = 3.14159265 / 180
Picture1.Width = Me.ScaleWidth: Picture1.Height = Me.ScaleHeight
Mhdc = SelectObject(Me.hdc, GetStockObject(13)) '获取系统原字体句柄
Randomize
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST = "汉字串任意旋转": k = lstrlen(ST): Font.Fon3 = 1
JD = 720 '旋转角度
X1 = ScaleWidth: Y1 = ScaleHeight '字串矩形上边的中心坐标
Cls
For J = 0 To JD Step 5
  Font.FonJ = J * 10
  Font.FonW = 1 + J \ 15
  Font.FonH = Font.FonW * 2
  x = X1 - Cos(J * P) * k * Font.FonW \ 2
  y = Y1 + Sin(J * P) * k * Font.FonW \ 2
  Fhdc = CreateFontIndirect(Font) '创建字体
  SelectObject Picture1.hdc, Fhdc '选择旋转字体
  Picture1.CurrentX = x: Picture1.CurrentY = y: Picture1.Print ST '在图片框打印旋转字体
  DeleteObject Fhdc '删除创建的字体
  BitBlt Me.hdc, 0, 0, ScaleWidth, ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
  Sleep 5
  DoEvents
  If J < JD Then Picture1.Cls
  If X1 > ScaleWidth \ 2 Then X1 = X1 - 5
  If Y1 > 100 Then Y1 = Y1 - 5
Next
SelectObject Me.hdc, Mhdc '恢复系统原字体
End Sub

　　关于汉字串任意旋转的说明：对这段代码稍加改动，就可以实现多个字符串同时旋转，显示效果更加精彩眩目！下面的代码作为 3个字符串同时旋转的范例，供诸位参考（声明节与单个字符串旋转相同），其显示效果是汉字串1 从屏幕右下角旋转至屏幕上方中央，汉字串2 从屏幕左上角旋转至屏幕中部,汉字串3 从屏幕右上角旋转至屏幕下方中央。

Private Sub 字串旋转_Click()
Dim Font As LOGFONT

Dim Fhdc As Long, Mhdc As Long, JD As Integer, i As Integer, FontLeft As Long
Dim J(2) As Long, LenST(2) As Long, R(2) As Long, X1(2) As Long, Y1(2) As Long
Dim ST(2) As String, A(2) As Integer, B(2) As Integer
Const P = 3.14159265 / 180
Picture1.Width = Me.ScaleWidth: Picture1.Height = Me.ScaleHeight: FontLeft = ScaleWidth \ 2
Mhdc = SelectObject(Me.hdc, GetStockObject(13))
Randomize
R(0) = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
R(1) = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
R(2) = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST(0) = "多字串同时旋转": ST(1) = "一江秋水编程": ST(2) = "wangzhichao_812@msn.com"
LenST(0) = lstrlen(ST(0)) '各字符串的长度
LenST(1) = lstrlen(ST(1))
LenST(2) = lstrlen(ST(2))
X1(0) = ScaleWidth: X1(1) = 0: X1(2) = ScaleWidth '各字符串的初始X坐标
Y1(0) = ScaleHeight: Y1(1) = 0: Y1(2) = 0 '各字符串的初始Y坐标
J(0) = 45: J(1) = 0: J(2) = 25 '各字符串的当前角度
JD = 1080
A(0) = 20: A(1) = 30: A(2) = 50
B(0) = 3: B(1) = 2: B(2) = 2
Font.Fon3 = 1
Cls
Do
  For i = 0 To 2
      If J(i) < JD Then J(i) = J(i) + 5
      Picture1.ForeColor = R(i)
      Select Case i
        Case 0
          If X1(i) > FontLeft Then X1(i) = X1(i) - 5
          If Y1(i) > 60 Then Y1(i) = Y1(i) - 5
        Case 1
          If X1(i) < FontLeft Then X1(i) = X1(i) + 5
          If Y1(i) < 300 Then Y1(i) = Y1(i) + 5
        Case 2
          If X1(i) > FontLeft Then X1(i) = X1(i) - 5
          If Y1(i) < 450 Then Y1(i) = Y1(i) + 5
      End Select
      Font.FonJ = J(i) * 10
    Font.FonW = J(i) \ A(i)
    Font.FonH = Font.FonW * B(i)
    Fhdc = CreateFontIndirect(Font)
    SelectObject Picture1.hdc, Fhdc
    Picture1.CurrentX = X1(i) - Cos(J(i) * P) * LenST(i) * Font.FonW \ 2
    Picture1.CurrentY = Y1(i) + Sin(J(i) * P) * LenST(i) * Font.FonW \ 2
    Picture1.Print ST(i)
    DeleteObject Fhdc
    BitBlt Me.hdc, 0, 0, ScaleWidth, ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
  Next
  DoEvents
  Picture1.Cls
Loop Until J(1) >= JD
SelectObject Me.hdc, Mhdc
End Sub

二、汉字的横向移动
　　这是一种动感非常强的显示特技。一串字符一个接一个地快速地从屏幕右外方移到屏幕内指定的坐标处，定将为你的应用程序增色不少。
　　要实现这一特技，需要定义一个用户自定义数据类型 PECT，供有关的 API 函数使用。PECT的作用是在屏幕上定义一个矩形，字符串文本就打印在这个矩形中。另外还要用到 6个API 函数，它们是：

　　CreateSolidBrush：用指定颜色创建一个刷子，返回其句柄。该函数只有一个参数，就是指定的颜色。
　　FillRect：用指定颜色的刷子填充矩形。该函数有3个参数：
　　第1个参数：设备场景（即矩形所在对象）的句柄；
　　第2个参数：填充区域，即定义好的矩形；
　　第3个参数：刷子的句柄。
　　SetTextCharacterExtra：在字符串的各个字符间插入指定数量的空格。该函数有2个参数，
　　第1个参数：设备场景的句柄；
　　第2个参数：要插入空格的数量。
　　DrawText：将字符串文本描绘到矩形中。该函数有5个参数：
　　第1个参数：设备场景的句柄；
　　第2个参数：欲描绘的字符串；
　　第3个参数：欲描绘的字符个数；
　　第4个参数：描绘区域，即定义好的矩形；
　　第5个参数：描绘方式，用常数来表示。

　　另外2个API函数 DeleteObject 和 Sleep，前面已有介绍，不赘述。
　　汉字横向移动的原理：在欲显示的字符串的各字符间插入一定数量的空格，将这个插入了空格的字符串显示在屏幕上指定的矩形中，由于屏幕的宽度有限，只能看到左边的字符，然后减少空格的数量，再显示，看起来字符串就向屏幕左侧移动了，再减少空格的数量，再显示……直至字符间没有空格了，这时整个字符串就移动完毕并全部显示在屏幕上了。
　　新建一个工程，用菜单编辑器建立一个"横向移动"菜单项（标题与名称相同）。
　　下面就是实现汉字横向移动特技的源代码
　　
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetTextCharacterExtra Lib "gdi32" (ByVal hdc As Long, ByVal nCharExtra As Long) As Long
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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

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

Private Sub 横向移动_Click()
Dim ST As String '欲显示的字符串
Dim kg As Integer '要在字符间插入的空格数量
Dim hdc1 As Long, hdc2 As Long
Dim tR As RECT
Me.AutoRedraw = True
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF '清屏
hdc2 = CreateSolidBrush(0) '用黑色创建一个刷子，返回其句柄
hdc1 = Me.hdc
Me.Font.Size = 72: Me.FontName = "黑体"
ST = " 汉字的显示特技" '注意字符串前面有一个英文空格
tR.Left = (ScaleWidth - TextWidth(ST)) / 2 - 24
tR.Top = 120: kg = 240
GoSub 100
Me.Font.Size = 36
Me.FontName = "楷体_GB2312" 'win7要去掉“_GB2312，下同”

ST = " 一江秋水编程"
tR.Left = (ScaleWidth - TextWidth(ST)) / 2 - 12
tR.Top = 300: kg = 128
GoSub 100
Me.Font.Size = 26: Me.FontName = "仿宋_GB2312"
ST = " wangzhichao_812@msn.com"
tR.Left = (ScaleWidth - TextWidth(ST)) / 2 - 9
tR.Top = 450: kg = 128
GoSub 100
Me.AutoRedraw = False
DeleteObject hdc2  '删除颜色刷子
Exit Sub
100
Me.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256) '产生随机颜色
Do While kg > -1
  FillRect hdc1, tR, hdc2 '用指定颜色的刷子填充矩形，目的是覆盖旧文本
  SetTextCharacterExtra hdc1, kg  '在每2个字符间插入Kg个空格
  DrawText hdc1, ST, -1, tR, &H400 '&H400常数表示延展矩形的右侧，不描绘文字
  DrawText hdc1, ST, -1, tR, 0 '将文本描绘到矩形。-1：描绘所有文字，0：左对齐
  Me.Refresh '更新窗体内容
  kg = kg - 1
  Sleep 5 '延时5毫秒
  DoEvents
Loop
Return
End Sub

 

三、汉字的纵向移动
　　我们看电影或VCD影碟时，常见到字幕从屏幕下面缓缓向上移动，直至完全移出屏幕上方。在VB6中
也可以实现这样的特技，而且至少有二种方法：
　　①先将文字打印到图片框（用标签替代图片框也可），再改变图片框的 Top值来实现纵向移动；
　　②先将文字打印在图片框，再循环利用 BitBlt 函数将文本图像从图片框传输到窗体，只要设置好每次传输的坐标以及宽度和高度，就可以达到汉字由下向上移动的目的。
　　下面介绍的是第二种方法。
　　这个特技需要用到2个API函数：Sleep 和 BitBlt。

　　新建一个工程，用菜单编辑器建立一个"纵向移动"菜单项（标题与名称相同），再在窗体上添加一个图片框控件。
　　下面是实现汉字纵向移动特技的源代码

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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 Sub 纵向移动_Click()
Dim ST As String '欲打印的字符串
Dim X As Integer, Y As Integer, X1 As Integer, Y1 As Integer
Dim i As Integer
Picture1.Width = ScaleWidth: Picture1.Height = 500
Picture1.Line (0, 0)-(Picture1.Width, Picture1.Height),0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF '清屏
Picture1.Font.Size = 72: Picture1.FontName = "黑体"
Picture1.ForeColor = QBColor(12)
ST = "汉字的显示特技": Y = 10: X1 = -4: Y1 = -4: i = 4
GoSub 100
Picture1.Font.Size = 48: Picture1.FontName = "楷体_GB2312"
Picture1.ForeColor = QBColor(7)
ST = "一江秋水编程"
Y = 220: X1 = 2: Y1 = 3: i = 6
GoSub 100
Picture1.Font.Size = 28: Picture1.FontName = "黑体"
Picture1.ForeColor = QBColor(15)
ST = "wangzhichao_812@msn.com"
Y = 380: X1 = 2: Y1 = -1: i = 1
GoSub 100
For i = -ScaleHeight To 420
  Sleep 8
  BitBlt Me.hdc, 0, 0, ScaleWidth, Scaleheight, Picture1.hdc, 0, i, vbSrcCopy
  DoEvents
Next
Exit Sub
100 '将字符串打印到图片框
X = (Picture1.Width - Picture1.TextWidth(ST)) \ 2
Picture1.CurrentX = X: Picture1.CurrentY = Y
Picture1.Print ST
Picture1.CurrentX = X + X1: Picture1.CurrentY = Y + Y1
Picture1.ForeColor = QBColor(i)
Picture1.Print ST
Return
End Sub

　　关于汉字纵向移动的说明：大家可能注意到每个字符串在图片框上都进行了两次打印，第 1次打印是普通的显示效果，第 2次打印实际上是运用了另外 3种汉字显示特技，即立体字（第 1个字符串）、浮雕字（第 2个字符串）、雕刻字（第 3个字符串）。

 

四、汉字的动态放大
　　这里所说的汉字动态放大，是指汉字在短时间内迅速地由小变大，直至屏幕可容纳的大小，看起来就象从屏幕深处快速推出了一个字，这将使你的应用程序显得非常酷。
　　这个特技使用了 2 个 API 函数，除了 Sleep 还用到了 StretchBlt，它的作用是将一幅位图从源设备场景传输到目标设备场景，看起来它似乎与 BitBlt 函数的作用相同，但是 StretchBlt 在传输位图时能将图像放大或缩小，而 BitBlt 则不能。
　　StretchBlt函数有11个参数：
　　第1个参数：目标设备场景的句柄。
　　第2、3个参数：目标设备场景中目标矩形左上角的横、纵坐标。
　　第4、5个参数：目标矩形的宽度和高度。
　　第6个参数：源设备场景的句柄。
　　第7、8个参数：源设备场景中源矩形左上角的横、纵坐标。
　　第9、10个参数：源矩形的宽度和高度。
　　第11个参数：操作方式，用常数表示。

　　汉字动态放大的原理是：先将汉字打印到图片框控件上，然后在循环语句中利用 StretchBlt 将汉字传输到窗体，只要设置好每次传输时源矩形及目标矩形的宽度和高度，就可将汉字放大显示。
　　有一个问题要引起注意，即打印汉字时的字号问题。如果打印字号小，那么放大后的汉字笔划将出现严重的锯齿边，很不美观。所以打印时要选用最大号的字体，放大后虽然仍有锯齿边，但很轻微，不影响效果。
　　新建一个工程，用菜单编辑器建立一个"字体放大"菜单项（标题与名称相同），再在窗体上添加一个图片框控件。
　　下面是实现汉字动态放大特技的源代码：

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Sub 字体放大_Click()
Dim ST As String, k As Single
Dim Tw As Integer, Th As Integer, x As Integer, y As Integer
Picture1.Font.Size = 72
Picture1.FontName = "楷体_GB2312"
Tw = 96:Th = 96 '96是72号常规宋体字的宽度和高度
Picture1.Width = Tw: Picture1.Height = Th
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST = "汉": GoSub 100
ST = "字": GoSub 100
ST = "放": GoSub 100
ST = "大": GoSub 100
Exit Sub
100
Picture1.Line (0, 0)-(Tw, Th), 0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Picture1.CurrentX = 0: Picture1.CurrentY = 0
Picture1.Print ST
For k = 0.1 To 6 Step 0.1
  x = (ScaleWidth - k * Tw) \ 2: y = (ScaleHeight - k * Th) \ 2
  StretchBlt Me.hdc, x, y, Tw * k, Th * k, Picture1.hdc,0,0,Tw, Th,vbSrcCopy
  Sleep 5
  DoEvents
Next
Sleep 100
Return
End Sub
　　
　　关于汉字动态放大的说明：只要稍加修改，就能实现2个字以上的汉字串的放大。

 

五、汉字的动态缩小
　　汉字的动态缩小是指字体一出现就已经是放大到了屏幕可容纳的大小，然后迅速缩小，直至看不见，看起来就象面前的字符快速地隐入了屏幕深处。汉字的动态缩小是动态放大的逆过程，只要更改"字体放大_Click"事件过程中 i循环的初值、终值和步长值即可。但有一个必须解决的问题，就是字体缩小的过程中，有的笔划会在屏幕留下痕迹，影响显示效果，所以还要加上清除笔划痕迹的语句（不能用Cls 清屏语句,那将造成画面闪动）。
　　新建一个工程，在窗体中添加一个图片框控件，再用菜单编辑器建立一个"字体缩小"菜单项（标题与名称相同）。
　　汉字动态缩小特技的源代码如下（声明节与"汉字的动态放大"相同）：

Private Sub 字体缩小_Click()
Dim ST As String, k As Single
Dim Tw As Integer, Th As Integer
Dim x As Integer, y As Integer
Th = 96: Picture1.Height = Th
Tw = 96: Picture1.Width = Tw
Picture1.Font.Size = 72
Picture1.FontName = "楷体_GB2312"
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST = "汉": GoSub 100
ST = "字": GoSub 100
ST = "缩": GoSub 100
ST = "小": GoSub 100
Cls
Exit Sub
100
Picture1.Line (0, 0)-(Tw, Th), 0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Picture1.CurrentX = 0: Picture1.CurrentY = 0
Picture1.Print ST
For k = 6 To 0.1 Step -0.1
  x = (ScaleWidth - k * Tw) \ 2: y = (ScaleHeight - k * Th) \ 2
  StretchBlt Me.hdc, x, y, Tw * k, Th * k, Picture1.hdc,0,0,Tw, Th, vbSrcCopy
  Line (0, 0)-(x, ScaleHeight), 0, BF '清除字符左侧区域
  Line (ScaleWidth - x, 0)-(ScaleWidth, ScaleHeight), 0, BF '清除字符右侧区域
  Line (x, y + Th * k)-(ScaleWidth - x, ScaleHeight), 0, BF '清除字符下方区域
  Sleep 5
  DoEvents
Next
Sleep 50
Return

End Sub

　　关于汉字动态缩小的说明：程序中没有清除字上方区域的语句，这是因为根据笔者的实验，上方不会出现笔划痕迹，如果你在应用时上方区域出现了笔划痕迹，请自行添加一个清除语句。
　　提示：将字体放大与字体缩小结合起来，即每个汉字放大后紧接着又缩小，显示效果更加动人心弦，如果放大→缩小→放大→缩小这么来几次，呵呵，简直酷毙了！

 

六、汉字串的垂直绕轴翻滚
　　我们可以将打印了字符串的图片框想像为一个平面框，并在左右边框的中部装上一根轴，用手指轻拨框的上边或下边，框就会绕轴旋转，框中的图像也一会儿正立一会儿倒立，这种仿三维动画效果绝对震撼眼球！当然，在程序中是用几行代码来代替手指的功能。赶快试试吧。
　　这个特技也使用了 API 函数 StretchBlt，当字串平面向后倒或自前翻转上来时，需要缩小或放大字体（高度变化宽度不变）。
　　打印在图片框上的汉字串要使用斜体，这样看起来才有逼真的翻滚旋转的效果，如果用正楷，那么看起来就是画面向后倒又从后弹上来，没有旋转的感觉。
　　新建一个工程，在窗体中添加一个图片框控件，它们的属性设置均与"汉字的动态放大"相同，用菜单编辑器建立一个"垂直翻滚"菜单项（标题与名称相同）。
　　下面是实现汉字串垂直绕轴翻滚特技的源代码（声明节与"汉字的动态放大"相同）：

Private Sub 垂直翻滚_Click()
Dim k As Single, J As Single, t1 As Single, t2 As Single, t3 As Single
Dim Tw As Integer, Th As Integer, X As Integer, Y As Integer, i As Integer
Dim ST As String, BJ1 As Boolean, BJ2 As Boolean
Picture1.Font.Size = 72: Picture1.FontName = "楷体_GB2312"
Picture1.FontItalic = True
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST = "汉字串垂直翻滚"
Tw = Picture1.TextWidth(ST) + 10: Picture1.Width = Tw
Th = Picture1.TextHeight(ST): Picture1.Height = Th
Picture1.Line (0, 0)-(Tw, Th), 0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Picture1.CurrentX = 0: Picture1.CurrentY = 0
Picture1.Print ST
X = (ScaleWidth - 1.2 * Tw) \ 2
For J = 5 To 1 Step -0.2
  If Not BJ1 Then t1 = 0.1: t2 = J: t3 = 0.1: i = i + 1
  If BJ1 Then t1 = J: t2 = 0.1: t3 = -0.1: i = i + 1
  GoSub 100
  BJ1 = Not BJ1: If i = 2 Then i = 0: BJ2 = Not BJ2
Next
Exit Sub
100
For k = t1 To t2 Step t3
  Y = (ScaleHeight - Th * k) \ 2
  If BJ1 Then
    Line (X, 0)-(ScaleWidth, Y), 0, BF
    Line (X, ScaleHeight - Y)-(ScaleWidth, ScaleHeight), 0, BF
  End If
  If Not BJ2 Then
    StretchBlt Me.hdc,X,Y, Tw * 1.2, Th * k, Picture1.hdc,0,0,Tw,Th,vbSrcCopy
  End If
  If BJ2 Then
    StretchBlt Me.hdc, X, ScaleHeight - Y, Tw * 1.2, -Th * k, Picture1.hdc, _
0, 0, Tw, Th, vbSrcCopy
  End If
  Sleep 5
  DoEvents
Next
Return
End Sub

　　关于汉字串垂直绕轴翻滚的说明：
　　　1.本实例的效果是字符串每翻滚一周其高度就缩小一些，最后高度由 480 像素缩为96 像素。第一个 For 循环中的循环初值决定了目标字符串的最大高度，5表示高度为源字串的 5倍；循环终值决定翻滚结束时的目标字符高度，1 表示高度与源字串相同；步长决定翻滚的次数和每次翻滚时字符高度的缩减值。当然，你可以改变这些数值来满足你的要求，例如：循环初值与循环终值互换，步长改为正值（这样字符串每翻滚一周其高度就增加一些）；t1或 t2不等于变量J，而等于另一个固定值（这样的话高度就不会变化），等等。
　　下面是字串高度不变化的有关代码，用它去替换原代码：

x = (ScaleWidth - Tw) \ 2
For J = 1 To 5
  If BJ1 Then
    t1 = 1: t2 = 0.1: t3 = -0.1: i = i + 1
  Else
    t1 = 0.1: t2 = 1: t3 = 0.1: i = i + 1
  End If
  GoSub 100
  BJ1 = Not BJ1: If i = 2 Then i = 0: BJ2 = Not BJ2
Next

　　　2. StretchBlt 函数的第 5个参数（目标矩形的高度）如果为负值，会产生垂直镜像效果（图像的上下颠倒）。
　　　3.代码中用 Line 语句擦除字体缩小后留在屏幕上的笔划痕迹

 

七、汉字串的水平绕轴翻滚
　　这个特技只要将"汉字串的垂直绕轴翻滚"的代码稍加改动即可，也是仿三维动画显示效果。我们仍可以将打印了字符串的图片框想像为一个平面框，并在上下边框的中部装上一根轴，用手指轻拨框的左边或右边，平面框就会绕轴旋转。想像"轴"位于字串宽度的二分之一处（即字串的水平中心）。代码中，当字串水平旋转 90 度到 270 度时，StretchBlt函数的第 4 个参数（目标矩形的宽度）为负值，产生水平镜像效果（图像的左右颠倒）。如果第 4个参数和第 5个参数均为负值，那会产生什么效果？呵呵，诸君若有兴趣，不妨自己动手试一试！
　　新建一个工程，在窗体中添加一个图片框控件，用菜单编辑器建立一个"水平翻滚"菜单项（标题与名称相同）。
　　下面是实现汉字串水平绕轴翻滚特技的源代码（声明节中只要声明StretchBlt函数）：

Private Sub 水平翻滚_Click()
Dim k As Single, J As Single, t1 As Single, t2 As Single, t3 As Single
Dim Tw As Integer, Th As Integer, X As Integer, Y As Integer, i As Integer
Dim ST As String, BJ1 As Boolean, BJ2 As Boolean
Picture1.Font.Size = 72: Picture1.FontName = "楷体_GB2312"
Picture1.FontItalic = True
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
ST = "汉字串水平翻滚"
Tw = Picture1.TextWidth(ST): Picture1.Width = Tw
Th = Picture1.TextHeight(ST): Picture1.Height = Th
Picture1.Line (0, 0)-(Tw, Th), 0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Picture1.CurrentX = 0: Picture1.CurrentY = 0
Picture1.Print ST
Y = (ScaleHeight - Th) \ 2
For J = 1 To 5
  If Not BJ1 Then t1 = 0.01: t2 = 1.01: t3 = 0.02: i = i + 1
  If BJ1 Then t1 = 1.01: t2 = 0.01: t3 = -0.02: i = i + 1
  GoSub 100
  BJ1 = Not BJ1: If i = 2 Then i = 0: BJ2 = Not BJ2
Next
Exit Sub
100
For k = t1 To t2 Step t3
  X = (ScaleWidth - Tw * k) \ 2
  If BJ1 Then
    Line (0, Y)-(X, Y + Th), 0, BF
    Line (ScaleWidth - X, Y)-(ScaleWidth, Y + Th), 0, BF
  End If
  If Not BJ2 Then
    StretchBlt Me.hdc, X, Y, Tw * k, Th, Picture1.hdc,0,0, Tw, Th, vbSrcCopy
  End If
  If BJ2 Then
    StretchBlt Me.hdc, ScaleWidth - X, Y, -Tw * k, Th, Picture1.hdc, 0, 0, Tw, Th, vbSrcCopy
  End If
  DoEvents
Next
Return
End Sub

 

八、汉字串的拖尾放大
　　这种放大的方法有点类似于前面介绍的字体动态放大，不同的是，它在动态放大的过程中，颜色不断变化，并且留下一个三角形的"尾巴"，又具有立体效果，所以看起来非常绚丽多彩。
　　拖尾放大的原理是：在屏幕上由最小号的字开始打印，直至最大号的字，每打印一种字号更换一种颜色，同时调整 X、Y 坐标，这样就在字的后面留下了彩色的"尾巴"。
　　新建一个工程，用菜单编辑器建立一个"拖尾放大"菜单项（标题与名称相同）。
　　下面是实现汉字拖尾放大特技的源代码：

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub 拖尾放大_Click()
Dim ST As String, i As Integer
ST = "汉字放大"
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Font.Name = "黑体"
For i = 1 To 120
  Font.Size = i: ForeColor = RGB(i * 3, 60, 0)'修改这里的颜色值以显示不同色彩
  CurrentX = (ScaleWidth - TextWidth(ST)) \ 2: CurrentY = i * 2 + 100
  Print ST
  Sleep 1
Next
End Sub

　　关于汉字串拖尾放大的说明：也可以这样：添加一个图片框控件，把文字先打印在图片框，再使用 API函数 StretchBlt 将字符图形放大拷贝到窗体。这样处理后速度稍慢一些，没有直接打印在窗体上的那种迅速推出的"爽"的感觉，但完成后的"气势"要强烈一些。
　　下面是这种放大方式的源代码，供各位参考选用（别忘了声明 StretchBlt 函数）。

Sub 拖尾放大_Click()
Dim ST As String
Dim Tw As Integer, Th As Integer, w As Integer, h As Integer, i As Integer
ST = "汉字放大"
Tw = 192 * Len(ST): Picture1.Width = Tw
Th = 240: Picture1.Height = Th
w = Tw * 2: h = Th * 3
Picture1.Line (0, 0)-(Tw, Th), 0, BF
Line (0, 0)-(ScaleWidth, ScaleHeight), 0, BF
Picture1.FontBold = True: Font.Name = "黑体"
For i = 1 To 120
  Picture1.Font.Size = i
  Picture1.ForeColor = RGB(i * 3, 100, 50)
  Picture1.CurrentX = (Tw - Picture1.TextWidth(ST)) \ 2
  Picture1.CurrentY = i
  Picture1.Print ST
  StretchBlt Me.hdc, (ScaleWidth - w) \ 2, 0, w, h, Picture1.hdc, 0, 0, Tw, Th, vbSrcCopy
Next
End Sub

 

九、单个汉字的旋转
　　这里所说的旋转与第一例所说的旋转是不同的。
　　本特技的显示效果：汉字从窗体的左上角（或右上角）出来向中心移动，同时一边旋转一边放大，到达预定位置时，静止一秒钟，然后一边旋转一边缩小，并向窗体左上角（或右上角）返回，直至看不见。这个特技需要用到三个 API 函数：StretchBlt、Sleep 和 PlgBlt。前两个函数已作了介绍，下面介绍 PlgBlt 函数。它的作用是对图形进行旋转处理，共有10个参数，简述如下：
　　第1个参数：目标设备场景
　　第2个参数：POINTAPI结构，在本代码中的作用是确定目标区域左上、右上和左下角的坐标
　　第3个参数：源设备场景
　　第4、5个参数：源图形左上角的x、y坐标
　　第6、7个参数：源图形宽高
　　第8、9、10个参数：未用

　　本例要使用两个图片框：图片框一打印 72 号汉字，再使用 StretchBlt 函数将图片框一的汉字经过放大或缩小，复制到图片框二（最终将 72 号字放大 4 倍)，最后通过 PlgBlt 函数将图片框二上的汉字显示到窗体。
　　新建一个工程，用菜单编辑器建立一个"单字旋转"菜单项（标题与名称相同），在窗体上添加两个图片框，属性设置为：
　　BackColor＝0　　（窗体和图片框）
　　ScaleMode＝3　　（同上）　
　　Visible＝False　（图片框）
　　AutoRedraw＝True（同上）
　　下面就是实现单个汉字旋转特技的源代码

Private Declare Function PlgBlt Lib "gdi32" Alias "PlgBlt" (ByVal hdcDest As Long, lpPoint As POINTAPI, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Sub 单字旋转_Click()
Dim S As Single, C As Single, Jw As Single, Jh As Single, zW As Single, zH As Single
Dim Mew As Integer, Meh As Integer, Tw As Integer, Th As Integer
Dim k As Integer, i As Integer, x As Integer, y As Integer
Dim Pt(2) As POINTAPI, dPt(2) As POINTAPI
Const PI = 3.14159265238 / 180
AutoRedraw = True
Mew = ScaleWidth: Meh = ScaleHeight: Tw = 96 * 4: Th = 96 * 4
Picture1.Width = Tw: Picture1.Height = Tw: Picture2.Width = Tw: Picture2.Height = Th
Picture1.FontSize = 72: Picture1.FontName = "楷体_GB2312": Picture1.FontBold = True
Randomize
Picture1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256): Picture1.Cls
Picture1.Print "转"
StretchBlt Picture2.hdc, 0, 0, Tw, Th, Picture1.hdc, 0, 0, 96, 96, vbSrcCopy
Picture1.Cls
k = 5 '旋转角度的增量
Jw = Tw * k / 1080: Jh = Th * k / 1080 '汉字图形大小的增量
zW = Jw: zH = Jh
Cls
For i = 0 To 1080 Step k: x = i \ 2: y = i \ 3: GoSub 100: Next
Sleep 1000
Jw = -Jw: Jh = -Jh
For i = 1080 To 0 Step -k: x = i \ 2: y = i \ 3: GoSub 100: Next
Cls
AutoRedraw = False
Exit Sub

100
StretchBlt Picture1.hdc, 0, 0, zW, zH, Picture2.hdc, 0, 0, Tw, Th, vbSrcCopy
Pt(0).x = -zW * 0.5: Pt(0).y = -zH * 0.5
Pt(1).x = Pt(0).x + zW: Pt(1).y = Pt(0).y
Pt(2).x = Pt(0).x: Pt(2).y = Pt(0).y + zH
S = Sin(i * PI): C = Cos(i * PI)
dPt(0).x = Pt(0).x * C - Pt(0).y * S + x
dPt(0).y = Pt(0).x * S + Pt(0).y * C + y
dPt(1).x = Pt(1).x * C - Pt(1).y * S + x
dPt(1).y = Pt(1).x * S + Pt(1).y * C + y
dPt(2).x = Pt(2).x * C - Pt(2).y * S + x
dPt(2).y = Pt(2).x * S + Pt(2).y * C + y
Cls
PlgBlt Me.hdc, dPt(0), Picture1.hdc, 0, 0, zW, zH, 0, 0, 0
zW = zW + Jw: zH = zH + Jh
DoEvents
Return
End Sub

关于单个汉字旋转特技的说明：
　　1.本例是字符从屏幕左上角出入，如果要从右上角出入，那么X的计算式要改为：x = Abs(i - 2160) \ 2
　　　如果要从下方出入，那么y的计算式要改为：y = Abs(i - Meh)
　　2.x、y的值都是在1024*768的屏幕分辨率下计算的，如果是别的分辨率，则需要修改。