扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
'对全局变量和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 |
如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。
现场直击|2021世界人工智能大会
直击5G创新地带,就在2021MWC上海
5G已至 转型当时——服务提供商如何把握转型的绝佳时机
寻找自己的Flag
华为开发者大会2020(Cloud)- 科技行者