spritetutor.frm

采用VB6编制的小小程序

PicSprite.left = 0
PicSprite.top = 0
PicSprite.Width = 150
PicSprite.Height = 128
PicSprite.hdc = CreateMemHdc(Picback.hdc, PicSprite.Width, PicSprite.Height)
Call LoadBmpToHdc(PicSprite.hdc, "ladybug.bmp")

'Mem Hdc to hold Masks
PicMask.hdc = 0
PicMask.left = 0
PicMask.top = 0
PicMask.Width = 150
PicMask.Height = 128
PicMask.hdc = CreateMemHdc(Picback.hdc, PicMask.Width, PicMask.Height)
Call LoadBmpToHdc(PicMask.hdc, "ladybug.bmp")

'Make masks out of the sprites
Call Mask_Make(PicMask, PicSprite)  'make the masks

'Mem Hdc for work area
PicWork.hdc = 0
PicWork.left = 0
PicWork.top = 0
PicWork.Width = ScreenWidth
PicWork.Height = ScreenHeight
PicWork.hdc = CreateMemHdc(Picback.hdc, PicWork.Width, PicWork.Height)
Retcode = SelectPalette(PicWork.hdc, Picback.Picture.hPal, False)
Retcode = RealizePalette(PicWork.hdc)
'Unload pic
Picback.Cls
'To allow fast key strokes
Me.KeyPreview = True  'look for keystrokes
End Sub


Private Sub LadyB_Init()
'begin init LadyBsprite
'for such a small sample all this data will not be used but for a larger game it will
LadyB.Active = True     'sprite active
LadyB.ident = 0         '0 = LadyBsprite can be 0,1,2
LadyB.left = 127    'left coord
LadyB.top = 118       'top coord
LadyB.Width = TileSize    'width of sprite
LadyB.Height = 32   'height of sprite
LadyB.Sprx = 0            'frame offset x
LadyB.Spry = 0            'frame offset y
LadyB.mapx = 0          'board index loc x
LadyB.mapy = 0           'boad index loc x
LadyB.doing = 0   'index to what it is doing 0 = standing
LadyB.XSpeed = 0  'x speed in pixels
LadyB.YSpeed = 0  'y speed in pixels
LadyB.XDir = 0    '+1 or -1 dir
LadyB.Ydir = 0    '+1 or -1 dir
'source area for LadyBbitmap
LadyB.src.hdc = PicSprite.hdc
LadyB.src.left = PicSprite.left
LadyB.src.top = PicSprite.top
LadyB.src.Width = PicSprite.Width
LadyB.src.Height = PicSprite.Height
'mask area for LadyBmask bitmap
LadyB.mask.hdc = PicMask.hdc
LadyB.mask.left = PicMask.left
LadyB.mask.top = PicMask.top
LadyB.mask.Width = PicMask.Width
LadyB.mask.Height = PicMask.Height
'default background ususally a work or save area to paint to
LadyB.bkg.hdc = PicWork.hdc
LadyB.bkg.left = PicWork.left
LadyB.bkg.top = PicWork.top
LadyB.bkg.Width = PicWork.Width
LadyB.bkg.Height = PicWork.Height
'end of init LadyB
End Sub


Private Sub Mask_Make(dest As tArea, src As tArea)
'subroutine for making masks out of a picturebox bitmap
'dest = a picturebox where the mask will go
'src = a picturebox where the the sprite bitmap is
'!!Warning!! make sure all forms and objects have pixel as their scalemode
'Declarations
Dim x As Integer   'x pixel pos
Dim y As Integer    'y pixel pos
Dim color As Long   'current color of pixel
Dim Retcode As Long  'dummy return code needed for blit
Dim transparentcolor As Long  'color to be transparent
Dim FG As Long      'foreground mask color
Dim BG As Long         'background mask color
'initializations
'foreground and backgroung settings
FG = &HFFFFFF            'foreground is white
BG = &H0&                   'background is black

'I use black but can really use any color you want to be invisible
transparentcolor = BG


'construct the mask pixel by pixel
For y = 0 To src.Height - 1    'do until max y
    For x = 0 To src.Width - 1    'do until max x
        color = GetPixel(src.hdc, x, y)  'what color is that pixel
        If color = transparentcolor Then  'if it is x-parent then set it to foregroung
            Retcode = SetPixel(dest.hdc, x, y, FG)
        Else
            Retcode = SetPixel(dest.hdc, x, y, BG) 'if not set it to background
        End If
    Next x
Next y
End Sub
Private Sub board_refresh()
Dim Retcode As Long 'dummy variable needed for blt
Dim Xoffset As Long

'Update the Org Background

Retcode = BitBlt(PicWork.hdc, 0, 0, PicWork.Width, PicWork.Height, PicOrgBack.hdc, LadyB.mapx, LadyB.mapy, SRCCOPY)
Call PaintSprite(LadyB)
Call CheckBullet

'Update the main viewport
Retcode = BitBlt(Picback.hdc, 0, 0, ScreenWidth, ScreenHeight, PicWork.hdc, 0, 0, SRCCOPY)

End Sub
Private Sub PaintSprite(Sprite As tSprite)
Dim Retcode As Long

'Update the sprite
Retcode = BitBlt(Sprite.bkg.hdc, Sprite.left, Sprite.top, Sprite.Width, Sprite.Height, Sprite.mask.hdc, Sprite.Sprx, Sprite.Spry, SRCAND)
Retcode = BitBlt(Sprite.bkg.hdc, Sprite.left, Sprite.top, Sprite.Width, Sprite.Height, Sprite.src.hdc, Sprite.Sprx, Sprite.Spry, SRCINVERT)

End Sub

Private Sub CheckBullet()
Dim Retcode As Long

If Bullet.Active = 1 Then
    If Bullet.left > 0 And Bullet.left < ScreenWidth And Bullet.top > 0 And Bullet.top < ScreenHeight Then
        Call PaintSprite(Bullet)
        Bullet.left = Bullet.left + (Bullet.XDir * dx)
        Bullet.top = Bullet.top + (Bullet.Ydir * dy)
    Else
        Bullet.Active = False
    End If
End If
End Sub



Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'this will check for different keystrokes and adjust the position
'you could change speed and increments also here
    Select Case KeyCode
        Case KEY_LEFT:
            LadyB.XDir = -1
            LadyB.Ydir = 0
            If LadyB.left > 0 Then
                Call CheckLeftRight(LadyB)
                If ScrollX = False Then
                    LadyB.left = LadyB.left - dx
                ElseIf ScrollX = True Then
                    LadyB.mapx = LadyB.mapx - dx
                End If
                If LastXDir = 1 Then
                    LadyB.Spry = LadyB.Height * 2
                    LadyB.Sprx = 0
                    Call board_refresh
                    Call DelayLoop(109000)
                End If
                If LadyB.Sprx < (LadyB.Width * 2) Then
                    LadyB.Sprx = LadyB.Sprx + LadyB.Width
                Else
                    LadyB.Sprx = 0
                End If
                LadyB.Spry = 0
                LastXDir = -1
            Else
            LadyB.left = 0
            End If
        Case KEY_RIGHT:
            LadyB.XDir = 1
            LadyB.Ydir = 0
            If LadyB.left < (PicWork.Width - LadyB.Width) Then
                Call CheckLeftRight(LadyB)
                If ScrollX = False Then
                    LadyB.left = LadyB.left + dx
                ElseIf ScrollX = True Then
                    LadyB.mapx = LadyB.mapx + dx
                End If
                If LastXDir = -1 Then
                    LadyB.Spry = LadyB.Height * 2
                    LadyB.Sprx = 0
                    Call board_refresh
                    Call DelayLoop(109000)
                End If
                If LadyB.Sprx < (LadyB.Width * 2) Then
                   LadyB.Sprx = LadyB.Sprx + LadyB.Width
                Else
                   LadyB.Sprx = 0
                End If
                LadyB.Spry = LadyB.Height
                LastXDir = 1
        Else
        LadyB.left = (PicWork.Width - LadyB.Width)
        
        End If
        Case KEY_UP:
            LadyB.Ydir = -1
            LadyB.XDir = 0
            If LadyB.top > 0 Then
                Call CheckUpDown(LadyB)
                If ScrollY = False Then
                    LadyB.top = LadyB.top - dy
                ElseIf ScrollY = True Then
                    LadyB.mapy = LadyB.mapy - dy
                End If
                If LadyB.Sprx < (LadyB.Width * 2) Then
                    LadyB.Sprx = LadyB.Sprx + LadyB.Width
                Else
                    LadyB.Sprx = 0
                End If
                    LadyB.Spry = LadyB.Height * 3
                    LastYDir = -1
            Else
                LadyB.top = 0
            End If
        Case KEY_DOWN:
            LadyB.Ydir = 1
            LadyB.XDir = 0
            If LadyB.top < (PicWork.Height - LadyB.Height) Then
                Call CheckUpDown(LadyB)
                If ScrollY = False Then
                    LadyB.top = LadyB.top + dy
                ElseIf ScrollY = True Then
                    LadyB.mapy = LadyB.mapy + dy
                End If
                If LadyB.Sprx < (LadyB.Width * 2) Then
                    LadyB.Sprx = LadyB.Sprx + LadyB.Width
                Else
                    LadyB.Sprx = 0
                End If
                    LadyB.Spry = LadyB.Height * 2
                    LastYDir = 1
            Else
                LadyB.top = (PicWork.Height - LadyB.Height)
            End If
        Case KEY_SPACE:
          If Bullet.Active <> 1 Then
            Bullet.Active = 1
            If LadyB.XDir = 1 Then
                Bullet.left = LadyB.left
                Bullet.top = LadyB.top
                Bullet.XDir = 1
                Bullet.Ydir = 0
                Bullet.Sprx = 25
            ElseIf LadyB.XDir = -1 Then
                Bullet.left = LadyB.left
                Bullet.top = LadyB.top
                Bullet.XDir = -1
                Bullet.Ydir = 0
                Bullet.Sprx = 25 * 2
            ElseIf LadyB.Ydir = 1 Then
                Bullet.left = LadyB.left
                Bullet.top = LadyB.top
                Bullet.XDir = 0
                Bullet.Ydir = 1
                Bullet.Sprx = 25 * 3
            ElseIf LadyB.Ydir = -1 Then
                Bullet.left = LadyB.left
                Bullet.top = LadyB.top
                Bullet.XDir = 0
                Bullet.Ydir = -1
                Bullet.Sprx = 0
            End If
          End If
    End Select
 Label1(0).Caption = Str(LadyB.left)
 Label1(1).Caption = Str(LadyB.top)
 Label1(2).Caption = Str(LadyB.mapx)
 Label1(3).Caption = Str(LadyB.mapy)
 Label1(4).Caption = Str(ScrollX)
 Label1(5).Caption = Str(ScrollY)
End Sub

Private Sub Form_Load()
Call Initializations
Call LadyB_Init 'init all game data
Call Bullet_Init
Call SetFastKeyboard
Timer1.Enabled = True  'start our timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call RestoreKeyboard
Call DestroyHdcs
End Sub

Private Sub Timer1_Timer()


Call board_refresh  'update the background and clean sprites off the save area
 
'loop back
End Sub