main.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Main 
   Caption         =   "不闪烁的动画"
   ClientHeight    =   3015
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4485
   LinkTopic       =   "Form1"
   Picture         =   "Main.frx":0000
   ScaleHeight     =   3015
   ScaleWidth      =   4485
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   120
      Top             =   3240
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim pic As Picture
Dim picNum As Integer
Dim picWidth As Integer
Dim picHeight As Integer

Dim hDCSave As Long, hBmpSave As Long
Dim hDCPaint As Long, hBmpPaint As Long
Const Xoffset = 2
Const Yoffset = 2

Dim X As Integer, Y As Integer


Sub Form_Load()
    Dim bm As BITMAP
    ScaleMode = vbPixels
    picNum = 4
    Set pic = LoadPicture(App.Path & "\" & "Anim.bmp")
    GetObject pic.Handle, LenB(bm), bm
    picWidth = bm.bmWidth / 2
    picHeight = bm.bmHeight / picNum
    hDCPaint = CreateCompatibleDC(Me.hDC)
    hBmpPaint = CreateCompatibleBitmap(Me.hDC, _
        picWidth + Abs(Xoffset), picHeight + Abs(Yoffset))
    SelectObject hDCPaint, hBmpPaint
    X = 0: Y = (Me.ScaleHeight - picHeight) / 2
End Sub

Private Sub Form_Paint()
   Dim hOldBmp As Long
   Cls
   hDCSave = CreateCompatibleDC(Me.hDC)
   hBmpSave = CreateCompatibleBitmap(Me.hDC, Me.ScaleWidth, _
       Me.ScaleHeight)
   hOldBmp = SelectObject(hDCSave, hBmpSave)
   If hOldBmp <> 0 Then DeleteObject hOldBmp
   BitBlt hDCSave, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Me.hDC, _
       0, 0, vbSrcCopy

End Sub

Private Sub Form_Unload(Cancel As Integer)
    DeleteDC hDCSave
    DeleteDC hDCPaint
    DeleteObject hBmpSave
    DeleteObject hBmpPaint
End Sub

Private Sub Timer1_Timer()
    Static Idx As Integer
    Dim hMemDC As Long

    BitBlt hDCPaint, 0, 0, picWidth + Abs(Xoffset), _
        picHeight + Abs(Yoffset), _
        hDCSave, X, Y, vbSrcCopy

    hMemDC = CreateCompatibleDC(Me.hDC)
    SelectObject hMemDC, pic.Handle

    BitBlt hDCPaint, Xoffset, Yoffset, picWidth, picHeight, hMemDC, _
           picWidth, picHeight * Idx, vbSrcAnd
    BitBlt hDCPaint, Xoffset, Yoffset, picWidth, picHeight, hMemDC, _
           0, picHeight * Idx, vbSrcPaint

    Idx = Idx + 1
    If Idx = picNum Then Idx = 0

    DeleteDC hMemDC
    
    BitBlt Me.hDC, X, Y, picWidth + Abs(Xoffset), _
        picHeight + Abs(Yoffset), hDCPaint, _
        0, 0, vbSrcCopy
    
    X = X + Xoffset
    Y = Y + Yoffset
    If X > Me.ScaleWidth Then X = 0
    If X + picWidth < 0 Then X = Me.ScaleWidth
    If Y > Me.ScaleHeight Then Y = 0
    If Y + picHeight < 0 Then Y = Me.ScaleHeight

End Sub