用VB6.0实现几种图文特效的演示程序

'对全局变量和API函数的通用声明(API函数Sleep, BitBlt及其常参数SRCCOPY的声明从略，可从API浏览器中复制、粘贴):
Dim 1(4) As Boolean, i as Long, s As String, zt As Integer
'实现图片渐现渐隐的通用过程:
Private Sub PicCpy(Optional strip As Integer=10, Optional delay As Integer=20)
　 Dim plw As Integer, plh As Integer,p2 As Integer
　 If 1(3)=True Then
　　 Picture1 = LoadPicture("c:\win98\安装程序.bmp")
　 Else
　　 Picture1=LoadPicture("")
　 End If
　 plw = Picturel.Width
　 plh=Picturel.Height
　 p2=0
　 Do While p2<= plw
　　 BitBlt Picture2.hDC,p2,0, strip, plh, Picture1.hDC,p2,0,SRCCOPY
　　 p2=p2 + strip
　　 Sleep delay
　　 DoEvents
　 Loop'由于图片宽度不一定是strip的整数倍，故下面再全图复制一遍图片:
　 BitBlt Picture2.hDC,0,0,plw,plh,Picture1.hDC,0,0,SRCCOPY
End Sub

Private Sub Form_load()
　 Label1.Font.Name="黑体"
　 Image1.Top=0
　 Image1.Left=0
　 Picture2.Top=0
　 Picture2.Left=Screen.Width - Picthne2.Width
　 s="产生缩放和隐现效果的文字"
　 zt=5'zt为字体大小控制变量
　 i=0 'i为显示文字时截取文字的字数变量
End Sub

Private Sub Cmd_Click (Index As Integer)
　 If 1(Index)=True Then
　　 1(Index)=False
　 Else
　　 1(Idex) = True
　 End If
　 Select Case Index
　　 Case 0 '激活timer1的timer过程
　　　 Timer1.Enabled=True
　　　 Timer1.Interval=50
　　　 ...... 'Case1, 2与上述类似，分别激活timer2, timer3的timer过程
　　 Case 3 '调用图片复制过程Piccpy
　　　 PiCpy 10, 50
　　 Case 4'结束程序运行
　　　 Unload Me
　　　 End
　 End Select
End Sub

Private Sub Timer1_Timer() '实现文字缩放的过程
　 If 1(0)=Trun Then
　　 zt=zt<+5
　 Else
　　 Zt=Zt-5
　 Else If
　　 If zt>50 or zt<=5 Then
　　　 Timer1.Enabled=False
　　 End If
　　 With Label1
　　　 .Font.Size=zt
　　　 .Left=(Form1.Width - Lable1.Width) /2
　　　 .Top=(Form1.Height - Label1.Height)/2
　　 End With
　　 Label1.Caption=s
End Sub

Private Sub Timer2_Timer() '实现图片缩放的过程
　 If 1(1)=True Then '使图片放大
　　 Image1.Width=Image1.Width+Form1.Width/10
　　 Image1.Height=Image1.Height+Form1.Height/10
　 Else '使图片缩小
　　 Image1.Width=Image1.Width - Form1.Width/10
　　 Image1.Height=Image1.Height - Form1.Height/10
　 End If
　 If (Image1.Width >=Form1.Width/2) or(Image1.Width <=Form1.Width/10) Then
　　 Timer2.Enabled=False
　 End If
　 Image1=LoadPicture("c:\win98\安装程序.bmp")
End Sub

Private Sub Timer3.Timer()
　 Label1.Font.Size = 30
　 If 1(2)=True Then
　　 i=i+l
　 Else
　　 i=i一1
　 End If
　 If i >=Len(s) on i<1 Then
　　 Timer3.Enabled=False
　 End If
　 If i >=0 Then
　　 Label1.Caption=Left$(s,i)
　 End If
End Sub
　　 以上程序在VB6.0和Windows98/2000环境下调试通过。

VB中使用DDE技术为应用程序增辉：【上一篇】
在VB中通过相对路径引用标准DLL：【下一篇】