home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / New_Snake_2084179212007.psc / Form1.frm < prev    next >
Text File  |  2007-09-21  |  22KB  |  708 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Snake"
  7.    ClientHeight    =   8070
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   10425
  11.    Icon            =   "Form1.frx":0000
  12.    KeyPreview      =   -1  'True
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   538
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   695
  18.    StartUpPosition =   2  'CenterScreen
  19.    Begin VB.PictureBox picBG 
  20.       AutoRedraw      =   -1  'True
  21.       AutoSize        =   -1  'True
  22.       BackColor       =   &H00000000&
  23.       BorderStyle     =   0  'None
  24.       Height          =   255
  25.       Left            =   420
  26.       ScaleHeight     =   17
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   17
  29.       TabIndex        =   1
  30.       Top             =   1980
  31.       Visible         =   0   'False
  32.       Width           =   255
  33.    End
  34.    Begin VB.Timer Timer4 
  35.       Enabled         =   0   'False
  36.       Interval        =   100
  37.       Left            =   5460
  38.       Top             =   60
  39.    End
  40.    Begin VB.Timer Timer3 
  41.       Enabled         =   0   'False
  42.       Interval        =   1000
  43.       Left            =   5040
  44.       Top             =   60
  45.    End
  46.    Begin VB.Timer Timer2 
  47.       Enabled         =   0   'False
  48.       Interval        =   100
  49.       Left            =   4620
  50.       Top             =   60
  51.    End
  52.    Begin VB.Timer Timer1 
  53.       Enabled         =   0   'False
  54.       Interval        =   40
  55.       Left            =   4200
  56.       Top             =   60
  57.    End
  58.    Begin VB.PictureBox picScene 
  59.       AutoRedraw      =   -1  'True
  60.       AutoSize        =   -1  'True
  61.       BackColor       =   &H00000000&
  62.       BorderStyle     =   0  'None
  63.       FillStyle       =   0  'Solid
  64.       Height          =   4200
  65.       Left            =   60
  66.       Picture         =   "Form1.frx":0E42
  67.       ScaleHeight     =   280
  68.       ScaleMode       =   3  'Pixel
  69.       ScaleWidth      =   300
  70.       TabIndex        =   0
  71.       Top             =   600
  72.       Visible         =   0   'False
  73.       Width           =   4500
  74.    End
  75.    Begin VB.Image imgEgg 
  76.       Height          =   360
  77.       Left            =   120
  78.       Picture         =   "Form1.frx":3E6E4
  79.       Top             =   120
  80.       Visible         =   0   'False
  81.       Width           =   360
  82.    End
  83.    Begin VB.Image imgMushroom 
  84.       Height          =   360
  85.       Left            =   600
  86.       Picture         =   "Form1.frx":3EDCE
  87.       Top             =   120
  88.       Visible         =   0   'False
  89.       Width           =   360
  90.    End
  91.    Begin VB.Image imgSpiderLeft 
  92.       Height          =   480
  93.       Index           =   1
  94.       Left            =   3600
  95.       Picture         =   "Form1.frx":3F4B8
  96.       Top             =   60
  97.       Visible         =   0   'False
  98.       Width           =   480
  99.    End
  100.    Begin VB.Image imgSpiderLeft 
  101.       Height          =   480
  102.       Index           =   0
  103.       Left            =   3120
  104.       Picture         =   "Form1.frx":3FD82
  105.       Top             =   60
  106.       Visible         =   0   'False
  107.       Width           =   480
  108.    End
  109.    Begin VB.Image imgBG 
  110.       Height          =   480
  111.       Left            =   540
  112.       Picture         =   "Form1.frx":4064C
  113.       Top             =   60
  114.       Visible         =   0   'False
  115.       Width           =   480
  116.    End
  117.    Begin VB.Image imgFrog 
  118.       Height          =   480
  119.       Index           =   1
  120.       Left            =   1020
  121.       Picture         =   "Form1.frx":40E8E
  122.       Top             =   60
  123.       Visible         =   0   'False
  124.       Width           =   480
  125.    End
  126.    Begin VB.Image imgFrog 
  127.       Height          =   480
  128.       Index           =   0
  129.       Left            =   1500
  130.       Picture         =   "Form1.frx":41758
  131.       Top             =   60
  132.       Visible         =   0   'False
  133.       Width           =   480
  134.    End
  135.    Begin VB.Image imgSpiderUp 
  136.       Height          =   480
  137.       Index           =   1
  138.       Left            =   2040
  139.       Picture         =   "Form1.frx":42022
  140.       Top             =   60
  141.       Visible         =   0   'False
  142.       Width           =   480
  143.    End
  144.    Begin VB.Image imgSpiderUp 
  145.       Height          =   480
  146.       Index           =   0
  147.       Left            =   2580
  148.       Picture         =   "Form1.frx":428EC
  149.       Top             =   60
  150.       Visible         =   0   'False
  151.       Width           =   480
  152.    End
  153. End
  154. Attribute VB_Name = "Form1"
  155. Attribute VB_GlobalNameSpace = False
  156. Attribute VB_Creatable = False
  157. Attribute VB_PredeclaredId = True
  158. Attribute VB_Exposed = False
  159. '***************************************************
  160. '   writen by yidie
  161. '   http://hi.baidu.com/yi_die
  162. '   xiaocaiyd@sohu.com
  163. '   2007-8-30
  164. '***************************************************
  165.  
  166. Option Explicit
  167.  
  168. Private Type RECT
  169.     Left As Long
  170.     Top As Long
  171.     Right As Long
  172.     Bottom As Long
  173. End Type
  174.  
  175. Private Declare Function PtInRect Lib "user32" _
  176.     (lpRect As RECT, _
  177.     ByVal x As Long, _
  178.     ByVal y As Long) As Long
  179.  
  180. Private Declare Function timeGetTime Lib "winmm.dll" _
  181.     () As Long
  182.  
  183. Private Declare Function sndPlaySound Lib "winmm.dll" _
  184.     Alias "sndPlaySoundA" _
  185.     (ByVal lpszSoundName As String, _
  186.     ByVal uFlags As Long) As Long
  187.  
  188. Private Const A_DEGREE As Double = 3.14159265 / 180
  189.  
  190. Dim x(220) As Integer, y(220) As Integer                            'data for snake
  191. Dim rectFrog As RECT, rectSpider(1 To 100) As RECT                  '
  192. Dim intSnakeLength As Integer, s As Integer, r As Double            'length of snake,direction,move step
  193. Dim intSpider As Integer, intTime As Integer                        'num of spider,delay time
  194. Dim score As Long, hightScore As Long                               'score,hight score
  195. Dim blnIsPause As Boolean, blnIsLast As Boolean
  196. Dim intDelay As Integer, intDelayF As Integer, intIndexF As Integer '
  197. Dim StrSoundsPath As String                                         '
  198.  
  199. Dim rectMushroom As RECT, intTimeMushroom As Integer                '
  200. Dim blnIsEatMushroom As Boolean                                     '
  201.  
  202. Dim lngDelaySpider As Long                                          '╩╣╓⌐╓δ╤╙│┘│÷╧╓
  203. Dim lngDelayMushroom As Long                                        '│╘╡╜─ó╣╜╤╙│┘
  204.  
  205. Private Sub Form_Unload(Cancel As Integer)
  206.     Call SaveSetting(App.Title, Me.Name, "hight", hightScore)       '▒ú┤µ╫ε╕▀╖╓
  207.     Timer1.Enabled = False
  208.     Timer2.Enabled = False
  209.     Timer3.Enabled = False
  210.     Timer4.Enabled = False
  211.     End
  212. End Sub
  213.  
  214. Private Sub Form_Load()
  215.     
  216.     Dim i As Integer, j As Integer
  217.     
  218.     If Right(App.Path, 1) <> "\" Then
  219.         StrSoundsPath = App.Path & "\Sounds\"
  220.     Else
  221.         StrSoundsPath = App.Path & "Sounds\"
  222.     End If
  223.  
  224.     hightScore = GetSetting(App.Title, Form1.Name, "hight", 0)         'get hight score
  225.     
  226.     Form1.PaintPicture picScene.Picture, Form1.ScaleWidth / 2 - 150, Form1.ScaleHeight / 2 - 140
  227.     
  228.     picBG.Move 0, 0, Form1.ScaleWidth, Form1.ScaleHeight
  229.     
  230.     'draw background
  231.     For i = 0 To Form1.ScaleWidth Step imgBG.Width
  232.         For j = 0 To Form1.ScaleHeight Step imgBG.Height
  233.             picBG.PaintPicture imgBG.Picture, i, j
  234.         Next
  235.     Next
  236.     
  237.     picScene.FontBold = True
  238.     PlaySound "music.wav"
  239. End Sub
  240.  
  241. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  242.     If KeyCode = vbKeyLeft Then s = s - 5             'move counterclockwise
  243.     If KeyCode = vbKeyRight Then s = s + 5            'move clockwise
  244. End Sub
  245.  
  246. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  247.     If Timer2.Enabled Then Exit Sub
  248.     Select Case KeyCode
  249.         Case vbKeyPause, vbKeyDown          'pause
  250.             If Timer1.Enabled = True Then
  251.                 blnIsPause = True
  252.                 Timer1.Enabled = False
  253.                 Timer3.Enabled = False
  254.                 Timer4.Enabled = True
  255.             End If
  256.         Case vbKeyEscape                    'exit
  257.             Unload Me
  258.         Case vbKeyReturn, vbKeyUp           'start\continue
  259.             If blnIsPause Then
  260.                 Timer4.Enabled = False
  261.                 Timer1.Enabled = True
  262.                 Timer3.Enabled = True
  263.                 blnIsPause = False
  264.             ElseIf Timer1.Enabled = False And Timer2.Enabled = False Then
  265.                 Timer1.Enabled = True
  266.                 Timer3.Enabled = True
  267.                 InitGame
  268.             End If
  269.     End Select
  270. End Sub
  271.  
  272. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  273.     If Timer2.Enabled Then Exit Sub
  274.     If Button = vbRightButton Then                      'pause\continue
  275.         If Timer1.Enabled = True Then
  276.             blnIsPause = True
  277.             Timer1.Enabled = False
  278.             Timer3.Enabled = False
  279.             Timer4.Enabled = True
  280.         ElseIf Timer4.Enabled = False Then
  281.             Timer1.Enabled = True
  282.             Timer3.Enabled = True
  283.             InitGame
  284.         Else
  285.             blnIsPause = False
  286.             Timer1.Enabled = True
  287.             Timer3.Enabled = True
  288.             Timer4.Enabled = False
  289.         End If
  290.     End If
  291. End Sub
  292.  
  293. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, iX As Single, iY As Single)
  294.     
  295.     If Button <> vbLeftButton Then Exit Sub
  296.     
  297.     Dim detaX As Double, detaY As Double
  298.     
  299.     detaX = iX - x(0): detaY = iY - y(0)
  300.     
  301.     If detaX = 0 Then
  302.         If detaY < 0 Then s = 0 Else s = 180
  303.     ElseIf detaY = 0 Then
  304.         If detaX < 0 Then s = 270 Else s = 90
  305.     Else
  306.         s = IIf(detaX < 0, 270, 90) + Atn(detaY / detaX) / A_DEGREE
  307.     End If
  308. End Sub
  309.  
  310. 'draw a single frame
  311. Private Sub Timer1_Timer()
  312.     Dim i As Integer, j As Integer, t As Double
  313.     Dim newX As Single, newY As Single
  314.     Dim detaX As Double, detaY As Double
  315.     
  316.     picScene.Cls
  317.     
  318.     If x(0) < 0 Then x(0) = Me.ScaleWidth
  319.     If y(0) < 0 Then y(0) = Me.ScaleHeight
  320.     If x(0) > Me.ScaleWidth Then x(0) = 0
  321.     If y(0) > Me.ScaleHeight Then y(0) = 0
  322.     
  323.     'draw spider
  324.     For i = 1 To intSpider
  325.         If i = intSpider Then
  326.             If blnIsLast Then
  327.                 'delay 1500 ms
  328.                 If timeGetTime - lngDelaySpider >= 1500 Then
  329.                     blnIsLast = False
  330.                     DrawSpider i, 0
  331.                 Else
  332.                     picScene.PaintPicture imgEgg.Picture, rectSpider(i).Left + 4, rectSpider(i).Top + 4
  333.                 End If
  334.             Else
  335.                 DrawSpider i, 4
  336.             End If
  337.         Else
  338.             DrawSpider i
  339.         End If
  340.     Next
  341.     
  342.     
  343.     
  344.     DrawSnake
  345.  
  346.     t = s * A_DEGREE
  347.     
  348.     detaX = Sin(t)
  349.     detaY = Cos(t)
  350.             
  351.     'eat spider
  352.     For i = 1 To intSpider - 1
  353.         If i = intSpider - 1 And blnIsLast Then Exit For
  354.         newX = x(0): newY = y(0)
  355.         For j = 1 To 15
  356.             newX = newX + detaX: newY = newY - detaY
  357.             If PtInRect(rectSpider(i), newX, newY) Then
  358.                 PlaySound "die.wav"
  359.                 Timer2.Enabled = True
  360.                 Timer1.Enabled = False
  361.                 Timer3.Enabled = False
  362.                 Exit Sub
  363.             End If
  364.         Next
  365.     Next
  366.         
  367.     'eat frog
  368.     If PtInRect(rectFrog, x(0) + detaX * 15, y(0) - detaY * 15) Then
  369.         PlaySound
  370.         intDelayF = 0
  371.         intSnakeLength = intSnakeLength + 2
  372.         intSpider = intSpider + 1
  373.         x(intSnakeLength) = x(intSnakeLength - 1)
  374.         y(intSnakeLength) = y(intSnakeLength - 1)
  375.         score = score + intTime * 10& + intSpider * 100&
  376.         intTime = 110 - (intSpider \ 5) * 5
  377.         If hightScore < score Then hightScore = score
  378.         Me.Caption = "╠░╩│╔▀  ╝╟┬╝ú║" & hightScore & "  ─·╡─╡├╖╓ú║" & score
  379.         blnIsLast = True
  380.         
  381.         'finish
  382.         If intSnakeLength >= 220 Then
  383.             Timer1.Enabled = False
  384.             Congration
  385.             Exit Sub
  386.         End If
  387.         
  388.         lngDelaySpider = timeGetTime
  389.         
  390.         If intSpider Mod 10 = 0 Then
  391.         'draw mushroom
  392.             With rectMushroom
  393.                 .Left = Int(Rnd * (Me.ScaleWidth - 40)) + 20
  394.                 .Top = Int(Rnd * (Me.ScaleHeight - 40)) + 20
  395.                 .Right = .Left + 20
  396.                 .Bottom = .Top + 20
  397.             End With
  398.             intTimeMushroom = 5
  399.         End If
  400.                
  401.         With rectFrog
  402.             'set spider's location
  403.             rectSpider(intSpider).Left = .Left
  404.             rectSpider(intSpider).Top = .Top
  405.             rectSpider(intSpider).Right = .Right
  406.             rectSpider(intSpider).Bottom = .Bottom
  407.             
  408.             'next frog's location
  409.             .Left = Fix(Rnd * (Me.ScaleWidth - 40)) + 20
  410.             .Top = Fix(Rnd * (Me.ScaleHeight - 40)) + 20
  411.             .Right = .Left + 32
  412.             .Bottom = .Top + 32
  413.         End With
  414.     End If
  415.     
  416.     'eat mushroom
  417.     If PtInRect(rectMushroom, x(0) + detaX * 15, y(0) - detaY * 15) Then
  418.         PlaySound "fun.wav"
  419.         blnIsEatMushroom = True
  420.         intTimeMushroom = 0
  421.         lngDelayMushroom = timeGetTime
  422.         'move mushroom out
  423.         rectMushroom.Left = -100
  424.         rectMushroom.Top = -100
  425.         rectMushroom.Right = -100
  426.         rectMushroom.Bottom = -100
  427.         
  428.         score = score + 10000&
  429.         If hightScore < score Then hightScore = score
  430.         Me.Caption = "Snake  hight scoreú║" & hightScore & "  your scoreú║" & score
  431.         
  432.     End If
  433.     
  434.     'draw mushroom
  435.     If intTimeMushroom > 0 Then
  436.         With rectMushroom
  437.             picScene.PaintPicture imgMushroom.Picture, .Left, .Top
  438.             picScene.FontSize = 10
  439.             picScene.ForeColor = vbYellow
  440.             picScene.CurrentX = .Left + 4
  441.             picScene.CurrentY = .Top - picScene.TextHeight("A")
  442.             picScene.Print intTimeMushroom
  443.         End With
  444.     End If
  445.         
  446.     DrawFrog
  447.         
  448.     'trun a frame
  449.     Me.Picture = picScene.Image
  450. End Sub
  451.  
  452. 'over
  453. Private Sub Timer2_Timer()
  454.     Delay 500
  455.     PlaySound "bom.wav"
  456.     Dim i As Integer, j As Integer, t As Double
  457.     For i = 25 To 1 Step -2
  458.         picScene.Cls
  459.         For j = 0 To 360 Step 30
  460.             t = j * A_DEGREE
  461.             picScene.Line (x(0) + Sin(t) * i, y(0) - Cos(t) * i)-(x(0) + Sin(t) * (i + 5), y(0) - Cos(t) * (i + 5)), vbRed
  462.         Next
  463.         Me.Picture = picScene.Image
  464.         Delay 100
  465.     Next
  466.     picScene.Cls
  467.     picScene.FontSize = 120
  468.     picScene.ForeColor = vbRed
  469.     picScene.CurrentX = (Me.ScaleWidth - picScene.TextWidth("you lose")) / 2
  470.     picScene.CurrentY = (Me.ScaleHeight - picScene.TextHeight("you lose")) / 2
  471.     picScene.Print "you lose"
  472.     
  473.     Me.Picture = picScene.Image
  474.         
  475.     Delay 1000
  476.     
  477.     If MsgBox("scoreú║" & score & vbCrLf & "play againú┐", vbYesNo + vbInformation, "snake") = vbYes Then
  478.         Timer1.Enabled = True
  479.         Timer3.Enabled = True
  480.         InitGame
  481.     Else
  482.         Unload Me
  483.     End If
  484.     
  485.     Timer2.Enabled = False
  486.  
  487. End Sub
  488.  
  489. 'begin to count down
  490. Private Sub Timer3_Timer()
  491.     intTime = intTime - 1
  492.     If intTime = 0 Then
  493.         Timer2.Enabled = True
  494.         Timer1.Enabled = False
  495.         Timer3.Enabled = False
  496.     End If
  497.     If intTimeMushroom <> 0 Then
  498.         intTimeMushroom = intTimeMushroom - 1
  499.         If intTimeMushroom = 0 Then
  500.             blnIsEatMushroom = False
  501.         End If
  502.     End If
  503. End Sub
  504.  
  505. 'if pause
  506. Private Sub Timer4_Timer()
  507.     score = score - 10
  508.     Me.Caption = "Snake  hight scoreú║" & hightScore & "  your scoreú║" & score
  509. End Sub
  510.  
  511. Private Sub InitGame()
  512.     
  513.     Dim i As Integer
  514.     
  515.     picScene.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
  516.     
  517.     picScene.Picture = picBG.Image
  518.     picScene.Cls
  519.     picScene.FontName = "MS Sans Serif"
  520.     intSnakeLength = 20
  521.     'data for snake
  522.     For i = 0 To intSnakeLength
  523.         x(i) = Me.ScaleWidth \ 2
  524.         y(i) = Me.ScaleHeight \ 2
  525.     Next
  526.     
  527.     r = 7
  528.     s = 0
  529.     
  530.     Randomize Timer
  531.     'frog
  532.     With rectFrog
  533.         .Left = Int(Rnd * (Me.ScaleWidth - 40)) + 20
  534.         .Top = Int(Rnd * (Me.ScaleHeight - 40)) + 20
  535.         .Right = .Left + 32
  536.         .Bottom = .Top + 32
  537.     End With
  538.     
  539.     intSpider = 0
  540.     intTime = 110 - (intSpider \ 5) * 5
  541.     
  542.     intTimeMushroom = 0
  543.     blnIsEatMushroom = False
  544.     
  545.     score = 0
  546.     Me.Caption = "Snake  hight scoreú║" & hightScore & "  your scoreú║" & score
  547. End Sub
  548.  
  549. 'success
  550. Private Sub Congration()
  551.     PlaySound "win.wav"
  552.  
  553.     picScene.FontSize = 120
  554.     picScene.ForeColor = vbRed
  555.     picScene.CurrentX = (Me.ScaleWidth - picScene.TextWidth("Congration")) / 2
  556.     picScene.CurrentY = (Me.ScaleHeight - picScene.TextHeight("Congration")) / 2
  557.     picScene.Print "Congration"
  558.     
  559.     Me.Picture = picScene.Image
  560.     
  561.     Delay 10000
  562.     
  563.     If MsgBox("scoreú║" & score & vbCrLf & "play againú┐", vbYesNo + vbInformation, "snake") = vbYes Then
  564.         Timer1.Enabled = True
  565.         Timer3.Enabled = True
  566.         InitGame
  567.     Else
  568.         Unload Me
  569.     End If
  570. End Sub
  571.  
  572.  
  573. Private Sub PlaySound(Optional ByVal fileName As String = "ching.wav")
  574.     sndPlaySound StrSoundsPath & fileName, 3&
  575. End Sub
  576.  
  577.  
  578. Private Sub DrawSpider(ByVal i As Integer, Optional ByVal step As Integer = 6)
  579.     
  580.     If blnIsEatMushroom Then
  581.         'spider stop move ,delay 4 seconds
  582.         If timeGetTime - lngDelayMushroom >= 4000 Then blnIsEatMushroom = False
  583.         step = 0
  584.     End If
  585.     
  586.     With rectSpider(i)
  587.         Select Case (i And 3)
  588.             Case 0  'move up
  589.                 .Top = .Top - Fix(Rnd * step)
  590.                 If .Top < -32 Then .Top = Form1.ScaleHeight
  591.                 .Bottom = .Top + 32
  592.                 picScene.PaintPicture imgSpiderUp(Fix(2 * Rnd)).Picture, .Left, .Top
  593.             Case 1  'move down
  594.                 .Top = .Top + Fix(Rnd * step)
  595.                 If .Top > Form1.ScaleHeight Then .Top = -32
  596.                 .Bottom = .Top + 32
  597.                 picScene.PaintPicture imgSpiderUp(Fix(2 * Rnd)).Picture, .Left, .Top, 32, 32, 0, 31, 32, -32
  598.             Case 2  'move left
  599.                 .Left = .Left - Fix(Rnd * step)
  600.                 If .Left < -32 Then .Left = Form1.ScaleWidth
  601.                 .Right = .Left + 32
  602.                 picScene.PaintPicture imgSpiderLeft(Fix(2 * Rnd)).Picture, .Left, .Top
  603.             Case 3  'move right
  604.                 .Left = .Left + Fix(Rnd * step)
  605.                 If .Left > Form1.ScaleWidth Then .Left = -32
  606.                 .Right = .Left + 32
  607.                 picScene.PaintPicture imgSpiderLeft(Fix(2 * Rnd)).Picture, .Left, .Top, 32, 32, 31, 0, -32, 32
  608.         End Select
  609.     End With
  610. End Sub
  611.  
  612. Private Sub DrawFrog(Optional ByVal step As Integer = 100)
  613.     
  614.     If blnIsEatMushroom Then step = 0 'stop move
  615.     
  616.     With rectFrog
  617.         picScene.FillColor = RGB(0, 255, 0)
  618.         intDelayF = (intDelayF + 1) And 31
  619.         If intDelayF = 31 Then  'move to new place
  620.             intIndexF = 1 - intIndexF
  621.             .Left = .Left + Fix(step * (0.5 - Rnd))
  622.             .Top = .Top + Fix(step * (0.5 - Rnd))
  623.             If .Left < -16 Then .Left = Form1.ScaleWidth - 16
  624.             If .Left > Form1.ScaleWidth Then .Left = -16
  625.             If .Top < -16 Then .Top = Form1.ScaleHeight - 16
  626.             If .Top > Form1.ScaleHeight Then .Top = -16
  627.             .Bottom = .Top + 32
  628.             .Right = .Left + 32
  629.             
  630.             If step <> 0 Then PlaySound "pop.wav"
  631.         End If
  632.         'draw frog
  633.         picScene.PaintPicture imgFrog(intIndexF).Picture, .Left, .Top
  634.         picScene.FontSize = 10
  635.         picScene.ForeColor = vbWhite
  636.         picScene.CurrentX = .Left
  637.         picScene.CurrentY = .Top - picScene.TextHeight("A")
  638.         picScene.Print intTime
  639.     End With
  640.  
  641. End Sub
  642.  
  643. '╗¡╔▀
  644. Private Sub DrawSnake()
  645.     Dim i As Integer
  646.     Dim t As Double, t2 As Double, detaX As Double, detaY As Double
  647.     
  648.     'snake
  649.     For i = intSnakeLength To 1 Step -1
  650.         x(i) = x(i - 1)
  651.         y(i) = y(i - 1)
  652.         
  653.         picScene.DrawWidth = Int((intSnakeLength - i) / intSnakeLength * 11 + 2)
  654.         
  655.         If i <> intSnakeLength Then
  656.            If Abs(x(i) - x(i + 1)) > 10 Or Abs(y(i) - y(i + 1)) > 10 Then
  657.            Else
  658.                picScene.Line (x(i), y(i))-(x(i + 1), y(i + 1)), IIf((i And 1), RGB(&H0, &H55, &H0), RGB(&HFF, &HCC, 0))
  659.            End If
  660.         End If
  661.     Next
  662.  
  663.     t = s * A_DEGREE
  664.     t2 = 45 * A_DEGREE
  665.     
  666.     detaX = Sin(t)
  667.     detaY = Cos(t)
  668.  
  669.     x(0) = x(0) + detaX * r
  670.     y(0) = y(0) - detaY * r
  671.     
  672.     If Abs(x(0) - x(1)) > 10 Or Abs(y(0) - y(1)) > 10 Then
  673.     Else
  674.         picScene.Line (x(0), y(0))-(x(1), y(1)), RGB(&HFF, &HCC, 0)
  675.     End If
  676.     
  677.     'head
  678.     picScene.DrawWidth = 1
  679.     picScene.FillColor = RGB(&H0, &H55, &H0)
  680.     picScene.Circle (x(0), y(0)), 8, RGB(&H0, &H55, &H0)
  681.     picScene.Circle (x(0) + detaX * 7, y(0) - detaY * 7), 4, RGB(&H0, &H55, &H0)
  682.     'eyes
  683.     picScene.FillColor = vbRed
  684.     picScene.Circle (x(0) + Sin(t + t2) * 8, y(0) - Cos(t + t2) * 8), 1, vbRed
  685.     picScene.Circle (x(0) + Sin(t - t2) * 8, y(0) - Cos(t - t2) * 8), 1, vbRed
  686.     
  687.     If Int(Rnd * 3) = 0 Then
  688.       'tongue
  689.       t2 = 5 * A_DEGREE
  690.       
  691.       picScene.Line (x(0) + detaX * 11, y(0) - detaY * 11)-(x(0) + detaX * 15, y(0) - detaY * 15), vbRed
  692.       picScene.Line (x(0) + Sin(t + t2) * 22, y(0) - Cos(t + t2) * 22)-(x(0) + detaX * 15, y(0) - detaY * 15), vbRed
  693.       picScene.Line (x(0) + Sin(t - t2) * 22, y(0) - Cos(t - t2) * 22)-(x(0) + detaX * 15, y(0) - detaY * 15), vbRed
  694.     
  695.     End If
  696.  
  697. End Sub
  698.  
  699. 'delay,ms
  700. Private Sub Delay(ByVal n As Long)
  701.     Dim lngT As Long
  702.     lngT = timeGetTime
  703.     While (timeGetTime - lngT < n)
  704.         DoEvents
  705.     Wend
  706. End Sub
  707.  
  708.