Programming Tool Box

home *** CD-ROM | disk | FTP | other *** search

/ Programming Tool Box / SIMS_2.iso / tool / grafik / canimate / game.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-02-27 | 14.6 KB | 449 lines

VERSION 2.00 Begin Form Form1 Caption = "CANIMATE.VBX Sample Program" ClientHeight = 3465 ClientLeft = 2685 ClientTop = 1575 ClientWidth = 6810 ForeColor = &H00000000& Height = 3990 Left = 2625 LinkTopic = "Form1" ScaleHeight = 3465 ScaleWidth = 6810 Top = 1110 Width = 6930 Begin Stage Stage1 BackColor = &H00404040& Height = 3525 Interval = 50 Left = -15 MaxDepth = 0 Picture = GAME.FRX:0000 Playback = 0 'False PlaybackBufferSize= 0 Record = 0 'False Top = 0 Width = 6855 Begin CSPlayer BackTree CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 0 Height = 1740 Interval = 0 Left = 4365 Moving = 0 'False NormalDepth = 0 Picture = GAME.FRX:CF1A TargetEvents = 0 'False TargetX = 0 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 1575 TransparentColor= &H00FFFFFF& Width = 1155 XFrames = 0 XMoveAmount = 0 YFrames = 0 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 2 End Begin CSPlayer FrontTree CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 0 Height = 1740 Interval = 0 Left = 1620 Moving = 0 'False NormalDepth = 0 Picture = GAME.FRX:E074 TargetEvents = 0 'False TargetX = 0 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 1725 TransparentColor= &H00FFFFFF& Width = 1095 XFrames = 0 XMoveAmount = 0 YFrames = 0 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 0 End Begin CSPlayer cloud CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 0 Height = 540 Index = 0 Interval = 3 Left = 2280 Moving = -1 'True NormalDepth = 0 Picture = GAME.FRX:F1CE TargetEvents = -1 'True TargetX = 7000 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 120 TransparentColor= &H00FF0000& Width = 1200 XFrames = 0 XMoveAmount = 50 YFrames = 3 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 1 End Begin CSPlayer Fire CollideEvents = 0 'False CollideID = 1 CycleEvents = 0 'False Cycling = -1 'True Frame = 0 FrameRow = 0 Height = 360 Interval = 2 Left = 3120 Moving = 0 'False NormalDepth = 0 Picture = GAME.FRX:111C8 TargetEvents = 0 'False TargetX = 0 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 2970 TransparentColor= &H00FF0000& Width = 630 XFrames = 2 XMoveAmount = 0 YFrames = 0 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 0 End Begin CSPlayer Player1 CollideEvents = -1 'True CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 0 Height = 1455 Interval = 0 Left = 210 Moving = 0 'False NormalDepth = 0 Picture = GAME.FRX:11482 TargetEvents = -1 'True TargetX = 6800 TargetY = 1845 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 1845 TransparentColor= &H0000FF00& Width = 690 XFrames = 2 XMoveAmount = 0 YFrames = 4 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 1 End Begin CSPlayer Bird CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = -1 'True Frame = 0 FrameRow = 0 Height = 345 Interval = 0 Left = 465 Moving = -1 'True NormalDepth = 0 Picture = GAME.FRX:15E7C TargetEvents = -1 'True TargetX = 4000 TargetY = 50 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 900 TransparentColor= &H00FFFFFF& Width = 540 XFrames = 3 XMoveAmount = 0 YFrames = 2 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 0 End End Begin CSPlayer cloud CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 2 Height = 540 Index = 2 Interval = 3 Left = 0 Moving = -1 'True NormalDepth = 0 Picture = GAME.FRX:166D6 TargetEvents = -1 'True TargetX = 7000 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 100 TransparentColor= &H00FF0000& Width = 1200 XFrames = 0 XMoveAmount = 50 YFrames = 3 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 1 End Begin CSPlayer cloud CollideEvents = 0 'False CollideID = 0 CycleEvents = 0 'False Cycling = 0 'False Frame = 0 FrameRow = 1 Height = 540 Index = 1 Interval = 3 Left = 5000 Moving = -1 'True NormalDepth = 0 Picture = GAME.FRX:186D0 TargetEvents = -1 'True TargetX = 7000 TargetY = 0 TargetZ = 0 Text = "" TextColor = &H00000000& Top = 80 TransparentColor= &H00FF0000& Width = 1200 XFrames = 0 XMoveAmount = 50 YFrames = 3 YMoveAmount = 0 ZMoveAmount = 0 ZPosition = 1 End Dim LastKey As Integer ' What was the last key processed? Dim LastDir As Integer ' Which direction (also a key) Dim KeyLeft As Integer ' Is the left key down Dim KeyRight As Integer ' Is the right key down Dim KeyUp As Integer ' Is the Up key down Sub Bird_AtTarget () Dim NewX As Integer Dim NewY As Integer 'We just pick a random location within limits and head ' there next NewX = Int(7000 * Rnd) NewY = Int(1000 * Rnd) 'See if our new location is to the left or right and use ' the appropriate row of animation If Bird.TargetX > NewX Then Bird.FrameRow = 1 Bird.FrameRow = 0 End If Bird.TargetX = NewX Bird.TargetY = NewY Bird.Moving = True End Sub Sub cloud_AtTarget (Index As Integer) 'The target was set at design time to be just off the right ' edge of the screen. So evertime a cloud arrives there, ' Move it back to left of stage and start it moving again 'This is an example of beginning and ending movement off ' stage for smoothe entries and exits Cloud(Index).Move 0 - Cloud(Index).Width, 0 Cloud(Index).Moving = True End Sub Sub Form_Load () 'Save Interval and pause game on any message box! SaveI = Stage1.Interval Stage1.Interval = 0 MsgBox "Use Left/Right/Up Arrows to Move, Esc to Pause" Stage1.Interval = SaveI End Sub Sub Player1_AtTarget () 'If a key is still down, act on it; we may just be at ' the bottom or top of a jump If KeyLeft = True Then Stage1_KeyDown (37) End If If KeyRight = True Then Stage1_KeyDown (39) End If 'If neither left or right is down, select the standing ' still bitmap and quit cycling If KeyLeft = False And KeyRight = False Then Player1.FrameRow = 0 Player1.Cycling = False End If 'This checks for the up key to enable "hopping". We can't ' jump again at the top, only the bottom If KeyUp = True And Player1.Top = 1845 Then Stage1_KeyDown (38) End If 'If we are at the top of a jump we descend back down If Player1.Top <> 1845 Then Player1.TargetY = 1845 Player1.Moving = True End If End Sub Sub Player1_Collide (ID As Integer) 'The only collision is fire - start the "OUCH" sequence ' and set cycle events on so we will return to normal ' play after going through the sequence Player1.FrameRow = 3 Player1.CycleEvents = True End Sub Sub Player1_Cycle () 'The only time we get this event is after stepping in the ' fire and playing the "OUCH" bitmaps 'Turn the event off Player1.CycleEvents = False 'See which sequence to do next If KeyRight = True Then Player1.FrameRow = 1 If KeyLeft = True Then Player1.FrameRow = 2 'If we are still, we also stop cycling. NOTE - we know it ' is on or we never would have gotten this event. That's ' why we turn it off here and don't bother turning it on ' for left or right If KeyLeft = False And KeyRight = False Then Player1.FrameRow = 0 Player1.Cycling = False End If End Sub Sub Stage1_KeyChar (WP As Integer) 'Save Interval to pause game on Esc If (WP <> 27) Then Exit Sub SaveI = Stage1.Interval Stage1.Interval = 0 MsgBox "Game Paused; OK to continue" Stage1.Interval = SaveI 'Reset all key states KeyLeft = False KeyRight = False KeyUp = False End Sub Sub Stage1_KeyDown (WP As Integer) 'IMPORTANT: KeyDown does not repeat - otherwise we ' would get flooded with events. So we use state ' logic to track which keys are down, and aim at the ' far edge of the stage for left and right 'KeyUp will stop the player if needed, and AtTarget (player ' event) will keep it moving after jumps 'We check the key stroke, but through a series of ' If statements in case we want to change it so ' that multiple things happen (especially for up ' arrow - we want to keep moving in the same ' direction we have been) ' <- = 37 ' -> = 39 ' ^ = 38 'Let's eliminate keys we don't care about If WP < 37 Or WP > 39 Then Exit Sub 'First, let's check for an up arrow hit If WP = 38 Then KeyUp = True ' "Normal" TargetY is 1845, which places the guy on ' the grass. Not a magic number, just where it ' happens to be. Player1.TargetY = 1845 - (Player1.Height / 2) ' Now we want to jump in the direction we are moving WP = LastKey ' If not jumping, aim at normal level Player1.TargetY = 1845 End If 'On left and right we aim for the far end of the stage ' unless the up arrow is down, in which we aim nearby ' so that the slope will be right 'Next, let's check for right If WP = 39 Then KeyRight = True Player1.FrameRow = 1 Player1.TargetX = (Stage1.Width - Player1.Width) If KeyUp = True Then Player1.TargetX = Player1.Left + Player1.Width End If End If 'Last, we check for left If WP = 37 Then KeyLeft = True Player1.FrameRow = 2 Player1.TargetX = 0 If KeyUp = True Then Player1.TargetX = Player1.Left - Player1.Width End If End If ' Save key (direction actually) for next time LastKey = WP ' Make sure we are moving Player1.Moving = True ' If going left or right, use cell animation If Player1.FrameRow <> 0 Then Player1.Cycling = True End Sub Sub Stage1_KeyUp (WP As Integer) 'See KeyDown for key# explanation and some overall logic ' explanation 'Let's elimate keys we don't care about If WP < 37 Or WP > 39 Then Exit Sub 'We need to update key state variables and stop motion ' by setting Targets to current location. NOTE: Setting ' target will allow player's AtTarget logic to work. If ' you wanted to prevent that, you would set Moving False ' for the player. We want the logic to run. 'First, let's check for an up arrow released If WP = 38 Then KeyUp = False Player1.TargetY = 1845 End If 'Next, let's check for right If WP = 39 Then KeyRight = False Player1.FrameRow = 0 Player1.TargetX = Player1.Left End If 'Last, we check for left If WP = 37 Then KeyLeft = False Player1.FrameRow = 0 Player1.TargetX = Player1.Left End If End Sub