VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cSprite_Background" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cSprite_Background Module ' ------------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : January 27, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : modBitmap.bas (Bitmap processing module written by Kevin Wilson) ' ' Description : This module is designed to be used with the "cSprite_Bitmap" class module as an easy ' implementation of a technology or technique called "Sprites". Sprites is a word to ' describe a picture that is drawn with transparency onto a background picture repeatedly ' in different locations. This effect gives the appearance of animation and is used in ' some games. This module handles the background for an animation while the ' "cSprite_Bitmap" class module handles the image(s) to be drawn transparently onto ' the background. ' ' Example Use : ' ' Option Explicit ' Private cBG As cSprite_Background ' Private cImage(10) As cSprite_Bitmap ' ' Private Sub Form_Load() ' Dim MyCounter As Integer ' Dim PicBG As StdPicture ' Dim PicImg As StdPicture ' Dim TheHeight As Long ' Dim TheWidth As Long ' Set PicBG = LoadPicture("C:\Background.bmp") ' Set PicImg = LoadPicture("C:\Image.bmp") ' ' Convert the measurements of the pictures form their standard measurement (HiMetric) to the Win32 API standard measurement (Pixels). ' Convert_HM_PX PicBG.Height, PicBG.Width, TheHeight, TheWidth, True ' ' Set the form to automatically redraw itself so the images aren't lost ' With Me ' .AutoRedraw = True ' .ScaleMode = vbPixels ' .Left = 0 ' .Top = 0 ' .ScaleHeight = TheHeight ' .ScaleWidth = TheWidth ' .Caption = "Sprite Animation Demo" ' .Show ' End With ' ' Set the picture for the background ' Set cBG = New cSprite_Background ' cBG.hPicture = PicBG.Handle ' cBG.Render Me.hDC ' RefreshHWND Me.hWnd ' ' Set the picture for the sprite and specify the transparency color ' For MyCounter = 0 To 10 ' Set cImage(MyCounter) = New cSprite_Bitmap ' cImage(MyCounter).TransparentColor = CLng("&H00FF00") ' cImage(MyCounter).hPicture = PicImg.Handle ' cImage(MyCounter).Render Me.hDC ' RefreshHWND Me.hWnd ' ' Specify the velocity of the image ' Randomize ' cImage(MyCounter).VelocityX = CLng((10 * Rnd) + 0) ' Randomize ' cImage(MyCounter).VelocityY = CLng((10 * Rnd) + 0) ' If cImage(MyCounter).VelocityX = 0 And cImage(MyCounter).VelocityY = 0 Then ' cImage(MyCounter).VelocityX = 1 ' End If ' Next ' ' Start the loop that draws the sprite animation ' Timer1.Interval = 15 ' Timer1.Enabled = True ' ' Delete the StdPicture objects ' Set PicBG = Nothing ' Set PicImg = Nothing ' End Sub ' ' Private Sub Form_Unload(Cancel As Integer) ' Dim MyCounter As Integer ' Set cBG = Nothing ' For MyCounter = 0 To 10 ' Set cImage(MyCounter) = Nothing ' Next ' End Sub ' ' Private Sub Timer1_Timer() ' Dim MyCounter As Integer ' Dim TempDC As Long ' Dim TempBMP As Long ' Dim PrevBMP As Long ' Dim hScreenDC As Long ' ' Create a buffer to draw to, then paint to the destination... this eliminates flicker and sprite overlap mis-drawing. ' TempDC = MemoryDC_Create ' hScreenDC = GetDC(GetDesktopWindow) ' TempBMP = CreateCompatibleBitmap(hScreenDC, cBG.Width, cBG.Height) ' ReleaseDC GetDesktopWindow, hScreenDC ' LoadPictureToDC TempDC, TempBMP, PrevBMP ' ' Draw the background onto the buffer ' cBG.Render TempDC ' ' Draw the sprites to the buffer ' For MyCounter = 0 To 10 ' With cImage(MyCounter) ' ' Increment the image's location ' .CurrentX = .CurrentX + .VelocityX ' .CurrentY = .CurrentY + .VelocityY ' ' Keep the image within the viewable area ' If .CurrentX > cBG.Width Then .CurrentX = -1 * .Width ' If .CurrentY > cBG.Height Then .CurrentY = -1 * .Height ' ' Draw the image in the new place ' .Render TempDC, .CurrentX, .CurrentY, , , , False ' End With ' Next ' ' Draw the buffer to the destination ' BitBlt Form1.hDC, 0, 0, cBG.Width, cBG.Height, TempDC, 0, 0, SRCCOPY ' RefreshHWND Me.hWnd ' ' Clean up the memory used ' MemoryDC_Delete TempDC, PrevBMP ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= '============================================================================================================= ' CLASS PROPERTY VARIABLES '============================================================================================================= Private c_ColorDepth As Integer 'Read Private c_hDC As Long 'Read Private c_Height As Long 'Read Private c_hPicture As Long 'Read/W Private c_PrevBitmap As Long 'Internal Use Private c_Width As Long 'Read '============================================================================================================= ' CLASS EVENTS '============================================================================================================= Private Sub Class_Terminate() Me.Clear End Sub '============================================================================================================= ' CLASS PROPERTIES '============================================================================================================= ' Color depths are as follows: ' 1 = Black & White ' 4 = 16 Colors ' 8 = 256 Colors ' 16 = 16bit Color (True Color) ' 24 = 24bit Color (True Color) ' 32 = 32bit Color (True Color) Public Property Get ColorDepth() As Integer ColorDepth = c_ColorDepth End Property Public Property Get hDC() As Long hDC = c_hDC End Property Public Property Get Height() As Long Height = c_Height End Property Public Property Get hPicture() As Long hPicture = c_hPicture End Property Public Property Let hPicture(ByVal NewValue As Long) Dim hTempBMP As Long Dim hTempBMP1 As Long Dim TempHeight As Long Dim TempWidth As Long Dim TempClrDpth As Integer ' Clear out the old data Me.Clear ' Create 2 copies of the specified picture... one to be the picture, one to be selected into the DC. ' This is designed this way to make sure that the original picture passed to this class isn't destroyed ' causing problems elsewhere when a picture that is expected to be there has been deleted. If CopyPicture(NewValue, hTempBMP) = False Then Exit Property If CopyPicture(NewValue, hTempBMP1) = False Then Exit Property ' Get the picture's dimentions If GetBitmapInfo(NewValue, TempHeight, TempWidth, TempClrDpth) = False Then Exit Property ' Save the specified picture info c_hPicture = hTempBMP c_Height = TempHeight c_Width = TempWidth c_ColorDepth = TempClrDpth ' Create a memory DC to hold the picture c_hDC = MemoryDC_Create ' Put the picture into the newly created DC c_PrevBitmap = SelectObject(c_hDC, hTempBMP1) End Property Public Property Get Width() As Long Width = c_Width End Property '============================================================================================================= ' CLASS METHODS '============================================================================================================= Public Sub Clear() ' Delete the memory Device Contexts (DC) and their associated pictures If c_hDC <> 0 Then MemoryDC_Delete c_hDC, c_PrevBitmap If c_hPicture <> 0 Then DeleteObject c_hPicture ' Reset the property variables to the defaults c_hPicture = 0 c_hDC = 0 c_PrevBitmap = 0 c_Height = 0 c_Width = 0 c_ColorDepth = 0 End Sub Public Function Render(ByVal Dest_hDC As Long, _ Optional ByVal X As Long, _ Optional ByVal Y As Long, _ Optional ByVal Stretch As Boolean = False, _ Optional ByVal StretchHeight As Long, _ Optional ByVal StretchWidth As Long, _ Optional ByVal RasterOperation As RasterOperations = SRCCOPY) As Boolean ' Make sure there's currently a background picture loaded to be used If c_hPicture = 0 Then Exit Function ' Render the currently loaded picture Render = RenderBitmapEx(Dest_hDC, c_hDC, c_hPicture, X, Y, 0, 0, c_Height, c_Width, RasterOperation, Stretch, StretchHeight, StretchWidth) End Function