anmation.bas

一个屏幕 动 画的演示程序(例子 )

Attribute VB_Name = "Animation"
'This Animation module will be the basis for the
'animation engine created during the tutorial.
'all general animation functions, declares and
'constants will be put here.

Option Explicit
 
Rem CreateCompatibleDC creates the memory dc, or staging areas for the graphics.
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Any) As Long

Rem CreateCompatibleBitmap makes a temporary (bogus) bitmap.
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Rem DeleteDC frees the memory used by a memory dc after you are finished with it
Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long

Rem SelectObject Selects a bitmap into the specified dc
Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Rem BitBlt (Bit Block Transfer) copies a graphics area to another graphics area
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


Rem Type declarations for reading bitmap information
Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type

Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type

Rem Constants used for the dwRop parameter in BitBlt.
Rem These are different Raster Operations or ROP's
Public Const MERGEPAINT = &HBB0226
Public Const SRCAND = &H8800C6
Public Const SRCCOPY = &HCC0020
Public Const SRCINVERT = &H660046

Rem Constants used for the Sprite objects' Status property
Public Const Animated = 1
Public Const Moving = 2
Sub GameScreen(GameForm As Form, Optional BGColor As Variant, Optional Pic As Variant)
'This procedure will set up the specified form as a game screen
    With GameForm
        'Check for a specified background color. Use black
        'if it's not specified.
        If IsMissing(BGColor) Then
            .BackColor = vbBlack
        Else
            .BackColor = BGColor
        End If
        'Get rid of the form's caption.
        .Caption = ""
        'If a picture is specified, set it in the form.
        If Not IsMissing(Pic) Then .Picture = Pic
        'Set the ScaleMode of the form to Pixels
        .ScaleMode = vbPixels
        'Make the form full-screen
        .WindowState = vbMaximized
    End With
End Sub

Function NewDC(hdcScreen As Long, HorRes As Long, VerRes As Long) As Long
'This function sets up memory device contexts
'used to store graphics.
Dim hdcCompatible As Long
    Dim hbmScreen As Long
    hdcCompatible = CreateCompatibleDC(hdcScreen)                   'Create the DC
    hbmScreen = CreateCompatibleBitmap(hdcScreen, HorRes, VerRes)   'Temporary bitmap
    If SelectObject(hdcCompatible, hbmScreen) = vbNull Then         'If the function fails
        NewDC = vbNull                                              ' return null
    Else                                                            'If it succeeds
        NewDC = hdcCompatible                                       ' return the DC
    End If
End Function

Sub ScalePic(Pic As PictureBox, PicWidth As Long, PicHeight As Long, Optional PicLeft As Variant, Optional PicTop As Variant)
'This procedure is used to scale the specified PictureBox.
'It compensates for the width of the border of the PictureBox.
    Pic.Move Pic.Left, Pic.Top, Pic.Width - Pic.ScaleWidth + PicWidth, Pic.Height - Pic.ScaleHeight + PicHeight
End Sub