【CBM666 的不闪卡通片】

【CBM666 的不闪动画】
'添加Timer1 Picture1
'保存下面两张图片到你的程序相同路径下(App.Path)
'大张的图片名称是 Girls.bmp  小秤台文件名是 BchScale.jpg

Option Explicit
Private Declare Function GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color 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
Dim PicName$, PicNo%, AppDisk$, W&, H&, TransColor$, X1%, Y1%
Dim N%, L%, C$, UD As Boolean
Const Captions As String = "CBM666 的不闪动画"
Private Sub Form_Load()
   AppDisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   Me.AutoRedraw = True: Me.ScaleMode = 3: Me.Width = 7000: Me.Height = 5160
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   If Dir(AppDisk & "bchscale.jpg") <> "" Then Me.Picture = LoadPicture(AppDisk & "bchscale.jpg")
   Picture1.AutoSize = True: Picture1.AutoRedraw = True
   Picture1.BorderStyle = 0: Picture1.Move Screen.Width
   PicName = AppDisk & "girls.bmp"
   If Dir(PicName) = "" Then MsgBox "您缺少了 " & PicName & " 图片": Unload Me: Exit Sub
   Picture1.Picture = LoadPicture(PicName)
   W = Picture1.Width: H = Picture1.Height \ 6
   Timer1.Interval = 100: Timer1.Enabled = True
   TransColor = RGB(99, 0, 255)
   PicNo = 1: X1 = 58: Y1 = 33
End Sub

Private Sub Timer1_Timer()
   Me.Cls
   GdiTransparentBlt Me.hDC, X1, Y1, W, H, Picture1.hDC, 0, 120 * (PicNo - 1), W, H, TransColor
   PicNo = IIf(PicNo + 1 > 6, 1, PicNo + 1)
   Y1 = IIf(UD, Y1 + 2, Y1 - 2)
   UD = IIf(Y1 >= 66 Or Y1 <= 0, Not UD, UD)
   '*********** 滚动标题栏
   L = Int(Me.Width / 110)
   C = String(L, " ") & Captions & String(L, " ")
   N = N + 1
   If N > Len(C) - L Then N = 1
   Me.Caption = Mid(C, N, L)
End Sub


效果图:




保存到 App.Path 程序路径下 BchScale.jpg



保存到 App.Path 程序路径下 Girls.bmp  

------解决方案--------------------
阿弥陀佛!
善哉善哉!

------解决方案--------------------
两个又干上了？、
------解决方案--------------------
   学习。。
 另：  再这样干 估计又要像360和QQ一样了。  
------解决方案--------------------

引用:

学习并接分。

+1
------解决方案--------------------
一个幽灵api
------解决方案--------------------
感谢分享
------解决方案--------------------

------解决方案--------------------
这个小孩看到太多次了。

CMB66,一个建议，
Dim PicName$, PicNo%, AppDisk$, W&, H&, TransColor$, X1%, Y1%
这种定义变量的方式虽然是可以的，但是不推荐。

绘图闪不闪与是否使用 API没有直接关系，vb中的 autoredraw的主要作用还是为了减轻用户在设计是的代码量，如果是为了绘图，还是自己的双缓冲效率最高。VB中的autoredraw=TRUE时，你调用任何VB自带的绘图函数都会调用refresh方法的。
------解决方案--------------------
老大
 你们技术高我们承认
 但你们也必要把论坛搞混
 论坛是个清静地
 是用来修炼地.......
------解决方案--------------------
又开始了，额的神啊
------解决方案--------------------
呵呵，有意思