home *** CD-ROM | disk | FTP | other *** search
VERSION 2.00 Begin Form Form1 BackColor = &H00C0C0C0& Caption = "BitBlt and Sprite Example" ClientHeight = 6045 ClientLeft = 390 ClientTop = 645 ClientWidth = 5550 Height = 6450 Left = 330 LinkTopic = "Form1" ScaleHeight = 6045 ScaleWidth = 5550 Top = 300 Width = 5670 Begin CommandButton btnSprites Caption = " &Animated Sprites" Height = 375 Left = 3720 TabIndex = 19 Top = 120 Width = 1665 End Begin PictureBox picEarthMask AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 480 Left = 5670 Picture = BITDEMO1.FRX:0000 ScaleHeight = 32 ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 18 Top = 360 Width = 480 End Begin PictureBox picEarthSprites AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 480 Left = 5670 Picture = BITDEMO1.FRX:027A ScaleHeight = 32 ScaleMode = 3 'Pixel ScaleWidth = 256 TabIndex = 17 Top = 960 Width = 3840 End Begin CheckBox chkFlickerless BackColor = &H00C0C0C0& Caption = "Flickerless" Height = 255 Left = 3930 TabIndex = 12 Top = 5220 Value = 1 'Checked Width = 1395 End Begin CheckBox chkAutoRedraw BackColor = &H00C0C0C0& Caption = "AutoRedraw" Height = 255 Left = 3930 TabIndex = 11 Top = 4950 Value = 1 'Checked Width = 1395 End Begin PictureBox picWork AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 675 Left = 2700 ScaleHeight = 45 ScaleMode = 3 'Pixel ScaleWidth = 45 TabIndex = 10 Top = 5100 Visible = 0 'False Width = 675 End Begin HScrollBar HScroll1 Height = 255 LargeChange = 12 Left = 180 TabIndex = 9 Top = 4440 Width = 4965 End Begin VScrollBar VScroll1 Height = 3675 LargeChange = 12 Left = 5130 TabIndex = 8 Top = 780 Width = 255 End Begin PictureBox picBMP AutoRedraw = -1 'True AutoSize = -1 'True Height = 9030 Left = 5670 Picture = BITDEMO1.FRX:12F4 ScaleHeight = 600 ScaleMode = 3 'Pixel ScaleWidth = 800 TabIndex = 7 Top = 1560 Width = 12030 End Begin CommandButton btnStep Caption = "Single &Step" Height = 375 Left = 1950 TabIndex = 5 Top = 120 Width = 1665 End Begin CommandButton btnGo Caption = "&S&imple Sprites" Height = 375 Left = 180 TabIndex = 4 Top = 120 Width = 1665 End Begin PictureBox picSave AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 750 Left = 1860 ScaleHeight = 50 ScaleMode = 3 'Pixel ScaleWidth = 50 TabIndex = 3 Top = 5100 Visible = 0 'False Width = 750 End Begin Timer Timer1 Enabled = 0 'False Interval = 55 Left = 6300 Top = 60 End Begin PictureBox PicImage AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 750 Left = 1020 Picture = BITDEMO1.FRX:76A2E ScaleHeight = 50 ScaleMode = 3 'Pixel ScaleWidth = 50 TabIndex = 2 Top = 5100 Width = 750 End Begin PictureBox picMask AutoRedraw = -1 'True AutoSize = -1 'True BorderStyle = 0 'None Height = 750 Left = 180 Picture = BITDEMO1.FRX:77020 ScaleHeight = 50 ScaleMode = 3 'Pixel ScaleWidth = 50 TabIndex = 1 Top = 5100 Width = 750 End Begin PictureBox picBackground BackColor = &H00FFFFFF& Height = 3675 Left = 180 ScaleHeight = 243 ScaleMode = 3 'Pixel ScaleWidth = 329 TabIndex = 0 Top = 780 Width = 4965 End Begin Timer Timer2 Enabled = 0 'False Interval = 55 Left = 6840 Top = 60 End Begin Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "Work" ForeColor = &H000000C0& Height = 195 Index = 3 Left = 2670 TabIndex = 16 Top = 4860 Width = 735 End Begin Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "Saved" ForeColor = &H000000C0& Height = 195 Index = 2 Left = 1860 TabIndex = 15 Top = 4860 Width = 735 End Begin Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "Sprite" ForeColor = &H000000C0& Height = 195 Index = 1 Left = 1020 TabIndex = 14 Top = 4860 Width = 735 End Begin Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "Mask" ForeColor = &H000000C0& Height = 195 Index = 0 Left = 150 TabIndex = 13 Top = 4860 Width = 735 End Begin Label lblStep Alignment = 2 'Center BackStyle = 0 'Transparent Height = 195 Left = 1560 TabIndex = 6 Top = 540 Width = 2535 End Option Explicit '----------------------------------------------------- ' BITDEMO1.FRM ' This program demonstrates some of the methods used ' to display bitmaps and sprites. '----------------------------------------------------- ' The number of pixels to offset the sprite ' each time it is moved. Const INCREMENT = 3 ' Constants for Raster Operations used by BitBlt function. Const SRCAND = &H8800C6 ' dest = source AND dest Const SRCCOPY = &HCC0020 ' dest = source Const SRCPAINT = &HEE0086 ' dest = source OR dest ' The BitBlt Windows API call. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer ' The x and y coordinates for the Sprite Dim SpriteX As Integer Dim SpriteY As Integer ' The x and y coordinates for the upper left corner ' of the large bitmap (picBMP). Dim BackgroundX As Integer Dim BackgroundY As Integer ' The width and height of the work area bitmap (picWork). Dim WorkWidth As Integer Dim WorkHeight As Integer Sub AnimatedSpriteMove () '----------------------------------------------------- ' Move the animated sprite to its next position. '----------------------------------------------------- Dim rc As Integer Static SpriteNum As Integer ' Calculate the next position for the sprite, and any ' necessary direction changes. GetNextPos picEarthMask.ScaleWidth, picEarthMask.ScaleHeight ' Copy a section of the large bitmap into the work area. rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBMP.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY) ' Draw the sprite mask into the work area. rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picEarthMask.ScaleWidth, picEarthMask.ScaleHeight, picEarthMask.hDC, 0, 0, SRCAND) ' The picEarthSprites bitmap contains 8 "frames". Each frame ' is displayed in sequence to animate the object. rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picEarthMask.ScaleWidth, picEarthMask.ScaleHeight, picEarthSprites.hDC, (SpriteNum \ 2) * 32, 0, SRCPAINT) ' Increment the Sprite Frame number. SpriteNum = (SpriteNum + 1) Mod 16 ' Copy the work area onto the background. rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY) DoEvents End Sub Sub btnGo_Click () '----------------------------------------------------- ' Start the simple sprite demonstration when this ' button is pushed. '----------------------------------------------------- Dim rc As Integer ' We're running. If Timer1.Enabled Then Timer1.Enabled = False ' Restore BG If chkFlickerless = 0 Then rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY) Else VScroll1_Change End If ' We're stopped. Else ' Save BG If chkFlickerless = 0 Then rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY) Timer1.Enabled = True End If End Sub Sub btnSprites_Click () '----------------------------------------------------- ' Start the animated sprite demonstration. '----------------------------------------------------- ' We're running. If Timer2.Enabled Then Timer2.Enabled = False ' This makes sure the background is refreshed. VScroll1_Change ' We're stopped. Else Timer2.Enabled = True End If End Sub Sub btnStep_Click () '----------------------------------------------------- ' Run the next step of the Single Step demonstration ' when this button is pushed. '----------------------------------------------------- SingleStep End Sub Sub chkAutoRedraw_Click () '----------------------------------------------------- ' Show the effects of the AutoRedraw property on ' the sprite work and save areas. '----------------------------------------------------- picSave.AutoRedraw = (chkAutoRedraw = 1) If picSave.AutoRedraw Then picSave.Cls picWork.AutoRedraw = (chkAutoRedraw = 1) If picWork.AutoRedraw Then picWork.Cls picSave.Refresh picWork.Refresh End Sub Sub FlickerlessSpriteMove () '----------------------------------------------------- ' Moving a sprite without flicker requires the use ' of an off-screen work area into which we copy a ' section of the background and sprite. '----------------------------------------------------- Dim rc As Integer ' Calculate the next position for the sprite, and any ' necessary direction changes. GetNextPos picImage.ScaleWidth, picImage.ScaleHeight ' Copy a section of the large bitmap into the work area. rc = BitBlt(picWork.hDC, 0, 0, WorkWidth, WorkHeight, picBMP.hDC, (BackgroundX + SpriteX) - INCREMENT, (BackgroundY + SpriteY) - INCREMENT, SRCCOPY) ' Draw the mask and sprite bitmaps into the work area. rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND) rc = BitBlt(picWork.hDC, INCREMENT, INCREMENT, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT) ' Copy the work area onto the background. rc = BitBlt(picBackground.hDC, SpriteX - INCREMENT, SpriteY - INCREMENT, WorkWidth, WorkHeight, picWork.hDC, 0, 0, SRCCOPY) DoEvents End Sub Sub Form_Load () '----------------------------------------------------- '----------------------------------------------------- Dim rc As Integer Me.Show chkAutoRedraw.Value = 1 ' Set the limits of the scroll bars. HScroll1.Max = picBMP.ScaleWidth - picBackground.ScaleWidth VScroll1.Max = picBMP.ScaleHeight - picBackground.ScaleHeight ' Only enable the scrollers if picBMP is larger than ' the picBackground bitmap. If picBMP.ScaleWidth <= picBackground.ScaleWidth Then HScroll1.Enabled = False If picBMP.ScaleHeight <= picBackground.ScaleHeight Then VScroll1.Enabled = False ' Save this initial section of the background. It may be ' needed for the flickering sprite demo. rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, picBMP.hDC, HScroll1, VScroll1, SRCCOPY) ' Set the dimensions of the work bitmap. WorkWidth = (picImage.Width / 15) + (INCREMENT * 2) WorkHeight = (picImage.Height / 15) + (INCREMENT * 2) picWork.Width = WorkWidth * 15 picWork.Height = WorkHeight * 15 Me.Refresh End Sub Sub GetNextPos (ByVal AWidth As Integer, ByVal AHeight As Integer) '----------------------------------------------------- ' Calculate the next position for the sprite, and ' make any necessary direction changes. '----------------------------------------------------- Static xdir As Integer Static ydir As Integer ' If this is the first time into the routine, ' then initialize the x and y direction indicators. If xdir = 0 Then xdir = 1 ydir = 1 End If ' Calculate the new position for the sprite. SpriteX = SpriteX + (INCREMENT * xdir) SpriteY = SpriteY + (INCREMENT * ydir) ' Change direction of the sprite if it reaches the edge ' of the background bitmap. If (SpriteX + AWidth) >= picBackground.ScaleWidth Then xdir = -1 End If If SpriteX <= 0 Then xdir = 1 End If If (SpriteY + AHeight) >= picBackground.ScaleHeight Then ydir = -1 End If If SpriteY <= 0 Then ydir = 1 End If End Sub Sub HScroll1_Change () '----------------------------------------------------- ' Move the background horizontally under scroller ' control. '----------------------------------------------------- Dim rc As Integer BackgroundX = HScroll1 rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, picBMP.hDC, BackgroundX, BackgroundY, SRCCOPY) End Sub Sub SingleStep () '----------------------------------------------------- ' Single step through the process of displaying a ' sprite. '----------------------------------------------------- Dim rc As Integer Static cstep As Integer ' Perform the current step. Select Case cstep Case 0: lblStep = "1: Copy BG to Save Area" rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY) btnGo.Enabled = False Case 1: lblStep = "2: Bitwise AND Mask to BG" rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND) Case 2: lblStep = "3: Bitwise OR Sprite to BG" rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT) Case 3: lblStep = "4: Copy Save Area to BG" rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY) btnGo.Enabled = True cstep = -1 GetNextPos picImage.ScaleWidth, picImage.ScaleHeight End Select ' Get ready for the next step. cstep = cstep + 1 End Sub Sub SpriteMove () '----------------------------------------------------- ' A simple method for displaying a sprite. '----------------------------------------------------- Dim rc As Integer ' Replace the background saved when sprite was ' last displayed. rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picSave.ScaleWidth, picSave.ScaleHeight, picSave.hDC, 0, 0, SRCCOPY) ' Calculate the next position for the sprite, and any ' necessary direction changes. GetNextPos picImage.ScaleWidth, picImage.ScaleHeight ' Save the area of the background where the sprite is ' about to be drawn. This saved area will be used to ' "erase" the sprite before it is displayed at a new ' position. rc = BitBlt(picSave.hDC, 0, 0, picSave.ScaleWidth, picSave.ScaleHeight, picBackground.hDC, SpriteX, SpriteY, SRCCOPY) ' Draw the sprite mask directly onto the background. rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picMask.ScaleWidth, picMask.ScaleHeight, picMask.hDC, 0, 0, SRCAND) ' Draw the sprite over top of the mask. rc = BitBlt(picBackground.hDC, SpriteX, SpriteY, picImage.ScaleWidth, picImage.ScaleHeight, picImage.hDC, 0, 0, SRCPAINT) DoEvents End Sub Sub Timer1_Timer () '----------------------------------------------------- ' Depending on the value of the Flickerless check ' box, run one of the simple sprite move subroutines. '----------------------------------------------------- If chkFlickerless = 1 Then FlickerlessSpriteMove Else SpriteMove End If End Sub Sub Timer2_Timer () '----------------------------------------------------- ' Move the animated sprite to its next position. '----------------------------------------------------- AnimatedSpriteMove End Sub Sub VScroll1_Change () '----------------------------------------------------- ' Move the background vertically under scroller ' control. '----------------------------------------------------- Dim rc As Integer BackgroundY = VScroll1 rc = BitBlt(picBackground.hDC, 0, 0, picBackground.ScaleWidth, picBackground.ScaleHeight, picBMP.hDC, BackgroundX, BackgroundY, SRCCOPY) End Sub 
(.txt)