【CBM666 的不闪动画】

Question

'添加Timer1 Picture1
'保存下面两张图片到你的程序相同路径下(App.Path)
'大张的图片名称是 Girls.bmp  小秤台文件名是 BchScale.jpgOption 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 SubPrivate 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  

Answer 1

说白了就2个API，连三个都没有，还贴到laviewpbt的帖子里，真是班门弄斧

Answer 2

呵呵 CSDN 里有哪一个帖子 问问题 有说 指导与纠正的？我发帖 碍着你了吗？你尽管可路过 可飘过.....

Answer 3

折不折腾不是你说了算 有问题与不完美的地方 其他人以给我纠正, 需要的人 可以利用它2F 正在写一些心得与要求思路的指导时, 还没发帖, 你速度快啊，我也没必要再贴了希望你也同样的多关注别人与关注我一样 帮别人解决问题 CSDN 幸甚

Answer 4

这个小孩看到太多次了。CMB66,一个建议，
Dim PicName$, PicNo%, AppDisk$, W&, H&, TransColor$, X1%, Y1%
这种定义变量的方式虽然是可以的，但是不推荐。绘图闪不闪与是否使用 API没有直接关系，vb中的 autoredraw的主要作用还是为了减轻用户在设计是的代码量，如果是为了绘图，还是自己的双缓冲效率最高。VB中的autoredraw=TRUE时，你调用任何VB自带的绘图函数都会调用refresh方法的。

Answer 5

Dim PicName$, PicNo%, AppDisk$, W&, H&, TransColor$, X1%, Y1%
这种定义变量的方式是VB5的,可读性极差
“绘图闪不闪与是否使用 API没有直接关系”
等于抽了楼主一大嘴巴

Answer 6

我说怎么老看到这种呢，我反正有借鉴别人代码的全改成 As String等等等了，今天终于找到出处了！