没办法 我就爱一步登天

Dim i, j As Integer Dim x, y As Integer strBUF = "" For i = 1 To 9 If i <= 5 Then x = i y = 1 Else x = i - 5 y = 2 End If Me.CurrentY = (y - 1) * (Me.ScaleHeight / 3) * 1.2 Me.Print For j = 1 To 9 Me.CurrentX = (x - 1) * (Me.ScaleWidth / 5) Me.Print i & " * " & j & " = " & i * j Next Me.Print Next i 打印九九乘法表

Dim News_n, Point_N As Integer Public Function GetCount() Open App.Path + "\news\news.ini" For Input As
#2 Input #
2, n Close #2 GetCount = n End Function Private Sub Comlast_Click() Point_N = Point_N - 1 If Point_N = News_n Then Comnext.Enabled = False Else: Comnext.Enabled = True End If If Point_N = 1 Then Comlast.Enabled = False Else: Comlast.Enabled = True End If Open App.Path + "\news\news.txt" For Input As #1 For n = 1 To Point_N Input #1, newstitle, newsDate, newscontain Next Close #1 TexTitle.Text = newstitle TexContain.Text = newscontain Label3.Caption = "这是第" + Str(Point_N) + "条新闻" ComSelect.Text = newstitle + " " + Str(newsDate) End Sub Private Sub Comnext_Click() Point_N = Point_N + 1 If Point_N = News_n Then Comnext.Enabled = False Else: Comnext.Enabled = True End If If Point_N = 1 Then Comlast.Enabled = False Else: Comlast.Enabled = True End If Open App.Path + "\news\news.txt" For Input As #1 For n = 1 To Point_N Input #1, newstitle, newsDate, newscontain Next Close #1 TexTitle.Text = newstitle TexContain.Text = newscontain Label3.Caption = "这是第" + Str(Point_N) + "条新闻" ComSelect.Text = newstitle + " " + Str(newsDate) End Sub Private Sub Comsave_Click() News_n = GetCount() Open App.Path + "\news\news.txt" For Append As #1 Write
#1, TexTitle.Text Write #
1, Date Write #1, TexContain.Text News_n = News_n + 1 Close #1 Open App.Path + "\news\news.ini" For Output As
#1 Write #
1, News_n Close #1 Comsave.Enabled = False Point_N = Point_N + 1 If Point_N = News_n Then Comnext.Enabled = False Else: Comnext.Enabled = True End If If Point_N = 1 Then Comlast.Enabled = False Else: Comlast.Enabled = True End If ComSelect.AddItem TexTitle.Text + " " + Str(Date) ComSelect.Text = TexTitle.Text + " " + Str(Date) End Sub Private Sub ComSelect_Click() Open App.Path + "\news\news.txt" For Input As #1 For n = 0 To ComSelect.ListIndex Input #1, newstitle, newsDate, newscontain Next Close #1 TexTitle.Text = newstitle TexContain.Text = newscontain Point_N = n If Point_N = News_n Then Comnext.Enabled = False Else: Comnext.Enabled = True End If If Point_N = 1 Then Comlast.Enabled = False Else: Comlast.Enabled = True End If Label3.Caption = "这是第" + Str(Point_N) + "条新闻" End Sub Private Sub Form_Load() News_n = GetCount Open App.Path + "\news\news.txt" For Input As
#1 For n = 1 To News_n Input #
1, newstitle, newsDate, newscontain ComSelect.AddItem newstitle + " " + Str(newsDate) Next Close #1 TexContain.Text = newscontain TexTitle.Text = newstitle Point_N = News_n Label3.Caption = "这是第" + Str(Point_N) + "条新闻" End Sub Private Sub TexTitle_Change() Comsave.Enabled = True End Sub 没看懂 叫一个新闻MANAGER 也不知道单词打错了没有

俄罗斯方块游戏！！ Option Explicit Public vbMoveLeft As Integer Public vbMoveRight As Integer Public vbMoveDown As Integer Public vbStepDown As Integer Public vbRevert As Integer Public Const SW_SHOWNORMAL = 1 Public Row10 As Integer '''''''''''''''''''''''' Public LastRow As Integer Public LastCol As Integer Public Col20 As Integer '''''''''''''''''''''''' Public MyScore As Long Public MyLevel As Integer Public StartLevel As Integer Public UpgradeFrequence As Integer Public NextBlockType As Integer Public ThisBlockType As Integer Public NextBlockColor As Integer Public NextBlockOffset As Integer Public iCount As Integer Public BlockColor(0 To 7) As Long Public BlockData() As Integer '''0表示没有，other表示color Public MovingBlock(1 To 4) As Integer '''''''''表示移动Block的Index Public NextMovingBlock(1 To 4) As Integer '''''下次显示的Block的Index Public sndupGrade As String Public sndDown As String Public sndKillLine As String Public AppFilePath As String Public sndDie As String Public sndtransform As String Public sndReadyGo As String Public sndback1 As String Public sndcontrol As Integer Public sndcontrol1 As Integer Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Function CloseMe(RoundBlock As Integer, StartBlock As Integer, _ EndBlock As Integer) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '围绕roundblock,从startblock到endblock是否已经有block '''''''''''''''''''''''''''''''''''''判断Movingblock(1)周围的block '''''''''''''''''''''''''''''''''''''是否有了 Dim i As Integer, offset As Integer offset = StartBlock - RoundBlock CloseMe = True Select Case offset '''''''''''''同行或同列''''''''''''''''''''''斜对位置 Case -Row10, -Row10 - 1 If IsThisDataInArray(StartBlock + 1) = False Then If BlockData(StartBlock + 1) = 0 Then CloseMe = False Else CloseMe = False End If Case Row10, Row10 + 1 If IsThisDataInArray(StartBlock - 1) = False Then If BlockData(StartBlock - 1) = 0 Then CloseMe = False Else CloseMe = False End If Case -1, Row10 - 1 If IsThisDataInArray(StartBlock - Row10) = False Then If BlockData(StartBlock - Row10) = 0 Then CloseMe = False Else CloseMe = False End If Case 1, 1 - Row10 If IsThisDataInArray(StartBlock + Row10) = False Then If BlockData(StartBlock + Row10) = 0 Then CloseMe = False Else CloseMe = False End If ''''''''''''''''''''''''''''''''相差两个 Case -2 * Row10 '''''''''''''''''''''''''''''''''''''''' If BlockData(RoundBlock - Row10 + 2) = 0 And _ BlockData(RoundBlock - Row10 + 1) = 0 And _ BlockData(RoundBlock - 2 * Row10 + 2) = 0 And _

BlockData(RoundBlock - 2 * Row10 + 1) = 0 Then CloseMe = False Case -2 '''''''''''''''''''''''''''''''''''''''''''''''''' If BlockData(RoundBlock - Row10 - 2) = 0 And _ BlockData(RoundBlock - Row10 - 1) = 0 And _ BlockData(RoundBlock - 2 * Row10 - 2) = 0 And _ BlockData(RoundBlock - 2 * Row10 - 1) = 0 Then CloseMe = False Case 2 If BlockData(RoundBlock + Row10 + 2) = 0 And _ BlockData(RoundBlock + Row10 + 1) = 0 And _ BlockData(RoundBlock + 2 * Row10 + 2) = 0 And _ BlockData(RoundBlock + 2 * Row10 + 1) = 0 Then CloseMe = False Case 2 * Row10 If BlockData(RoundBlock + Row10 - 2) = 0 And _ BlockData(RoundBlock + Row10 - 1) = 0 And _ BlockData(RoundBlock + 2 * Row10 - 2) = 0 And _ BlockData(RoundBlock + 2 * Row10 - 1) = 0 Then CloseMe = False End Select End Function Public Sub EMAIL_ME() ShellExecute Form1.hwnd, vbNullString, "Mailto:[email protected]", vbNullString, "c:\", SW_SHOWNORMAL End Sub Public Function CheckAvailable() As Boolean Dim tmp(0 To 3) As Integer, i As Integer, j As Integer For i = 0 To 3 tmp(i) = Form2.combosetting(i).ListIndex Next '''''''''''''''''''''''''''''''''''''''''''''' For i = 0 To 3 For j = i + 1 To 3 If tmp(j) = tmp(i) Then Exit Function End If Next Next CheckAvailable = True End Function Public Function CheckMovable(ByVal MoveType As Integer) As Boolean Dim rtn As Boolean, i As Integer, j As Integer, k As Integer, tmp As Integer Dim tempArray(1 To 4) As Integer, tempArray1(1 To 4) As Integer rtn = False For i = 1 To 4 tempArray1(i) = 30 ''''''''''''''''''''???????????? Next ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''在最顶端不能变形！！！！！！'''''''''''''' Dim BlockTop As Integer BlockTop = Row10 * 5 ''''''''''''''''''''''''''在最顶端不能变形！！！！！！'''''''''''''' Select Case MoveType '''''''''''''''''''''''''''''''''''''''''''''''''左移 Case vbMoveLeft For i = 1 To 4 If (MovingBlock(i) Mod Row10 = 0) Or MovingBlock(i) < BlockTop Then Exit For '''''''''''是否达到最左边 Next If i = 5 Then For i = 1 To 4 tempArray(i) = MovingBlock(i) - 1 Next For i = 1 To 4 If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗 If BlockData(tempArray(i)) <> 0 Then Exit For ''''''''''''''''已经有了 End If Next If i = 5 Then rtn = True End If Case vbMoveRight ''''''''''''''''''''''''''''''''''''''''''''''''''右移 For i = 1 To 4 If (MovingBlock(i) Mod Row10 = Row10 - 1) Or MovingBlock(i) < BlockTop Then Exit For '''''''''''是否达到最最边 Next If i = 5 Then For i = 1 To 4 tempArray(i) = MovingBlock(i) + 1 Next For i = 1 To 4 If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗 If BlockData(tempArray(i)) <> 0 Then Exit For ''''''''''''''''已经有了 End If Next If i = 5 Then rtn = True End If Case vbMoveDown ''''''''''''''''''''''''''''''''''''''''''''''''''下移 For i = 1 To 4 If (MovingBlock(i) \ Row10 = Col20 - 1) Then Exit For '''''''''''是否达到最下面 Next If i = 5 Then For i = 1 To 4 tempArray(i) = MovingBlock(i) + Row10

Next For i = 1 To 4 If Not IsThisDataInArray(tempArray(i)) Then '''''''''''''是在正在移动的吗 If BlockData(tempArray(i)) <> 0 Then Exit For ''''''''''''''''已经有了 End If Next If i = 5 Then rtn = True End If Case vbRevert ''''''''''''''''''''''''''''''''''''''''''''''''''''旋转 ''''''''''''''''''''''''''''''''''''''''''''''''''''旋转 ''''''''''''''''''''''''''''''''''''''' If (ThisBlockType = 1) Then Exit Function ''''''''''''''''''''''''''''方块不变 '''''''''''''''''''''''''''' 顶端不变形'' For i = 1 To 4 If MovingBlock(i) < BlockTop Then Exit For Next i '''''''''''''''''''''''''''''''''''' If i <> 5 Then Exit Function '''''''''''''''''''''''''''''''''''''' For i = 2 To 4 tmp = MovingBlock(i) - MovingBlock(1) If tmp > -4 And tmp < 4 Then '''''''''''''''''''''''''''在同一行，变成同一列 tempArray(i) = MovingBlock(i) + tmp * (Row10 - 1) ''''改for X*Y ''''''''''''''''''''''可能在最顶端或最底端 If tempArray(i) < 0 Or tempArray(i) > (Col20 * Row10 - 1) Then Exit For If IsThisDataInArray(tempArray(i)) = False Then If (tempArray(i) Mod Row10 <> MovingBlock(1) Mod Row10) Or (BlockData(tempArray(i)) <> 0) Then Exit For ''''''''''''''''''''''''''''''''''是否在同一列？ End If ElseIf Abs(tmp) = (Row10 - 1) Or Abs(tmp) = (Row10 + 1) Then '''''''''''''''''在斜对位置 '?????????????????????????????????????????????? ''''temparray(i)=???????????????????? Select Case tmp Case -Row10 - 1 tempArray(i) = MovingBlock(1) - Row10 + 1 Case 1 - Row10 tempArray(i) = MovingBlock(1) + Row10 + 1 Case Row10 - 1 tempArray(i) = MovingBlock(1) - Row10 - 1 Case Row10 + 1 tempArray(i) = MovingBlock(1) + Row10 - 1 End Select '?????????????????????????????????????????????? If tempArray(i) < 0 Or tempArray(i) > (Row10 * Col20 - 1) Then Exit For If IsThisDataInArray(tempArray(i)) = False Then Dim temp As Integer temp = Abs((tempArray(i) Mod Row10) - (MovingBlock(1) Mod Row10)) + Abs((tempArray(i) \ Row10) - (MovingBlock(1) \ Row10)) If (temp > 4) Or (BlockData(tempArray(i)) <> 0) Then Exit For '''''''''''''''??????????????????????? End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''在斜对位置 Else '''''''''''''''''''''''''''在同一列，变成同一行 tempArray(i) = MovingBlock(i) - tmp \ Row10 - tmp '''''''''''''''''''''''''''''''''''''''''''''''''''可能在最顶端或最底端 If tempArray(i) < 0 Or tempArray(i) > (Row10 * Col20 - 1) Then Exit For If IsThisDataInArray(tempArray(i)) = False Then If (tempArray(i) \ Row10 <> MovingBlock(1) \ Row10) Or BlockData(tempArray(i)) <> 0 Then Exit For End If End If If CloseMe(MovingBlock(1), MovingBlock(i), tempArray(i)) = True Or tempArray(i) \ Row10 < 5 Then Exit Function ''''若周围有，则不能转动 Next If i = 5 Then rtn = True '''''''''''''''''''''''''''''''''小于5不能旋转 End Select CheckMovable = rtn End Function Public Sub CreatNextBlock(BlockType As Integer) Dim offset As Integer offset = (5 * Row10) \ 2 - 1 ''''''''''''''''''''''''''''''''? ''''''''''''''''''''''''''''''''row10+1+row10\2-2 Select Case NextBlockType '''''''''''''''''''''''''''''''求出NextMovingBlock(i)

Case 0 NextMovingBlock(1) = offset NextMovingBlock(2) = offset - 2 NextMovingBlock(3) = offset - 1 NextMovingBlock(4) = offset + 1 Case 1 '''''''''''''''''''''''''''''''''''''''''''方块不变形 NextMovingBlock(1) = offset NextMovingBlock(2) = offset + 1 NextMovingBlock(3) = offset + Row10 NextMovingBlock(4) = offset + Row10 + 1 Case 2 NextMovingBlock(1) = offset + Row10 NextMovingBlock(2) = offset + Row10 - 1 NextMovingBlock(3) = offset + Row10 + 1 NextMovingBlock(4) = offset + 2 * Row10 Case 3 NextMovingBlock(1) = offset NextMovingBlock(2) = offset - 2 NextMovingBlock(3) = offset - 1 NextMovingBlock(4) = offset + Row10 Case 4 NextMovingBlock(1) = offset NextMovingBlock(2) = offset + 1 NextMovingBlock(3) = offset + 2 NextMovingBlock(4) = offset + Row10 Case 5 NextMovingBlock(1) = offset + Row10 NextMovingBlock(2) = offset + Row10 - 1 NextMovingBlock(3) = offset + 2 * Row10 NextMovingBlock(4) = offset + 2 * Row10 + 1 Case 6 NextMovingBlock(1) = offset + Row10 NextMovingBlock(2) = offset + Row10 + 1 NextMovingBlock(3) = offset + 2 * Row10 NextMovingBlock(4) = offset + 2 * Row10 - 1 '''''''''''''''''''''''''''''''求出NextMovingBlock(i) End Select End Sub Public Sub GeneralNewGame(LastRow As Integer, LastCol As Integer) Dim i As Integer, offset As Integer ReDim BlockData(0 To Row10 * Col20 - 1) ''''''''''''''''''''''''''''''''''''''''''''''''''设置各个控件位置 With Form1 offset = 240 * Row10 + 80 - .Picture1.Width .Picture1.Width = 240 * Row10 + 80 .Picture1.Height = 240 * (Col20 - 5) + 75 .Width = .Picture1.Width + 2155 .Height = .Picture1.Height + 720 .CmdDown.Left = .CmdDown.Left + offset .CmdLeft.Left = .CmdLeft.Left + offset .CmdRight.Left = .CmdRight.Left + offset .CmdRevert.Left = .CmdRevert.Left + offset .LabNext.Left = .LabNext.Left + offset .Label3.Left = .Label3.Left + offset .Label4.Left = .Label4.Left + offset .LabelLevel.Left = .LabelLevel.Left + offset .LabelScore.Left = .LabelScore.Left + offset .Labelpass.Left = .Labelpass.Left + offset .Labeltime.Left = .Labeltime.Left + offset '.AniGif1.Left = .AniGif1.Left + offset '.AniGif2.Left = .AniGif2.Left + offset .Picture2.Left = .Picture2.Left + offset End With ''''''''''''''''''''''''''''''''''''''''''''''''''设置各个控件位置 If (LastRow = Row10) And (LastCol = Col20) Then For i = 1 To Row10 * Col20 - 1 Form1.Block(i).Visible = False Next i Else If LastRow <> 0 Then For i = 1 To LastRow * LastCol - 1 Unload Form1.Block(i) Next i End If For i = 1 To Row10 * 5 - 1 Load Form1.Block(i) Form1.Block(i).Top = -1000 Form1.Block(i).Left = -1000 Next i For i = Row10 * 5 To Row10 * Col20 - 1 Load Form1.Block(i) With Form1.Block(i) .Left = ((i - Row10 * 5) Mod Row10) * 240 .Top = ((i - Row10 * 5) \ Row10) * 240 .Visible = False .Enabled = False End With Next i End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' MyScore = 0 MyLevel = StartLevel iCount = 0 ''''''''' With Form1 .CmdLeft.Enabled = True .CmdRight.Enabled = True .CmdRevert.Enabled = True

.CmdDown.Enabled = True .CmdPause.Enabled = True .CmdPause.Caption = "暂停(&P)" .LabelLevel.Caption = MyLevel .LabelScore.Caption = 0 .Timer1.Interval = 25 For i = 0 To 24 .BlockPreview(i).Visible = False Next i End With LastRow = Row10 LastCol = Col20 ''''''''''''''''''''''''''''''''''''''''''''''''''''''' NextBlockType = Int(Rnd * 7) NextBlockColor = Int(Rnd * 7) NextBlockOffset = Int(Rnd * 4) CreatNextBlock NextBlockType For i = 1 To NextBlockOffset ''''''''''''''''''''''旋转 RevertIt ''''''''''''''''''''''旋转NextMovingBlock(i) Next GeneralANewBlock ''''''''''''''''''''''''''''''''''''''''''''''''' End Sub Public Function GeneralANewBlock() As Boolean ''''''''不能创建则失败 Dim BlockType As Long, rndBlockColor As Integer, tmp As Integer Dim BlockToCreat(1 To 4) As Integer, i As Integer, j As Integer Dim DispX As Integer ''''''''''''''''''''''''''''''''''''' If NextBlockType = -1 Then Exit Function ThisBlockType = NextBlockType For i = 1 To 4 MovingBlock(i) = NextMovingBlock(i) BlockData(MovingBlock(i)) = NextBlockColor Form1.Block(MovingBlock(i)).Visible = True Form1.Block(MovingBlock(i)).BackColor = BlockColor(NextBlockColor) Next tmp = Row10 * 5 ''''''''''''''''''''''''' For i = tmp To tmp + Row10 - 1 If BlockData(i) <> 0 Then NextBlockType = -1 Exit Function End If Next GeneralANewBlock = True NextBlockType = Int(Rnd * 7) NextBlockOffset = Int(Rnd * 4) NextBlockColor = Int(Rnd * 7) ''''''''''''''''''''''''''''''''''''''''''''''''''' CreatNextBlock NextBlockType '''''''''''''''''''''''''''''''''''''''''''''''''' For i = 1 To NextBlockOffset RevertIt ''''''''''''''''''''''旋转NextMovingBlock(i) Next ShowPreview End Function Public Sub GOHOMEPAGE() ShellExecute Form1.hwnd, vbNullString, "http://www.ihavenohomepage.com", vbNullString, "c:\", SW_SHOWNORMAL End Sub Public Function IsThisDataInArray(Source As Integer) As Boolean Dim rtn As Boolean, i As Integer For i = 1 To 4 If Source = MovingBlock(i) Then rtn = True Next IsThisDataInArray = rtn End Function Public Sub KillALine() Dim i As Integer, j As Integer, k As Integer, Flag As Boolean Dim LineFeed As Integer '''''''''''''''''''''删除的行数 Dim tmpLevel As Integer, tmpScore As Long tmpLevel = MyLevel tmpScore = MyScore Dim ToBeKilled(0 To 4) As Integer, Line As Integer, istep As Integer ''''''''''''''''''''''''''''''''''''''' For i = 1 To 4 ToBeKilled(i) = 1000 ''''''''''''''''''''使之足够大 Next i '''''''''''''''''''''''''''''''''''''' Dim LineStart As Integer, LineEnd As Integer For i = 1 To 4 Line = MovingBlock(i) \ Row10 ''''''''''''''''''测试的行 LineStart = Line * Row10 LineEnd = LineStart + Row10 - 1 For j = LineStart To LineEnd If BlockData(j) = 0 Then Exit For Next j If j = LineEnd + 1 Then '''''''''''''''''''''''''''''''''''插入排序 '''''''''''''''''''''''''''行数放在ToBeKilled(0 to 4) ''''''若Line不在tobekilled（）里则加入 Flag = False istep = 1 While Flag = False And istep < 4 If ToBeKilled(istep) > Line Then Dim ii As Integer For ii = 3 To istep Step -1

ToBeKilled(ii + 1) = ToBeKilled(ii) Next ii ToBeKilled(istep) = Line ToBeKilled(0) = ToBeKilled(0) + 1 Flag = True ElseIf ToBeKilled(istep) = Line Then GoTo EndWhile End If istep = istep + 1 Wend EndWhile: '''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''插入排序 '''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''ToBeKilled(0)为总行数 '''''''''''''''''''''''''''''''''''''''''''''''''''''' End If Next i If ToBeKilled(0) = 0 Then ''''''''''''''''''不能消行 PlaysndDown MyScore = MyScore + 5 Form1.LabelScore.Caption = MyScore GoTo CaculateMyscore: End If '''''''''''''''''''''''''''''''''''KillTheseLines For i = 1 To ToBeKilled(0) For j = ToBeKilled(i) To 5 Step -1 LineStart = j * Row10 LineEnd = LineStart + Row10 - 1 For k = LineStart To LineEnd Form1.Block(k).Visible = Form1.Block(k - Row10).Visible Form1.Block(k).BackColor = Form1.Block(k - Row10).BackColor BlockData(k) = BlockData(k - Row10) Next k Next j Next i '''''''''''''''''''''''''''''''''''KillThisLine '''''''''''''''''''''''''''''''''''删除最顶 For k = Row10 * 4 To Row10 * 5 - 1 'Row10 - 1 Form1.Block(k).Visible = False BlockData(k) = 0 Next '''''''''''''''''''''''''''''''''''''''''''''''' LineFeed = ToBeKilled(0) '''''''''''''''''''''''''''''''''''''''''''''''得分算法 Select Case LineFeed Case 1 MyScore = MyScore + 100 Case 2 MyScore = MyScore + 210 Case 3 MyScore = MyScore + 350 Case 4 MyScore = MyScore + 500 Case Else Exit Sub End Select ''''''''''''''''''''''''''''显示我的得分 CaculateMyscore: If MyScore \ UpgradeFrequence <> tmpScore \ UpgradeFrequence Then PlaysndUpGrade MyLevel = MyLevel + 1 If MyLevel > 9 Then Form1.LabelLevel.Caption = "高手" MyLevel = 9 Else Form1.LabelLevel.Caption = MyLevel End If ElseIf MyScore - tmpScore > 10 Then PlaysndKillLine End If Form1.LabelScore.Caption = MyScore End Sub Public Sub PlaysndKillLine() On Error Resume Next sndPlaySound sndKillLine, 3 End Sub Public Function RevertIt() As Boolean Dim tmp As Integer, i As Integer, tempArray(2 To 4) As Integer For i = 2 To 4 tmp = NextMovingBlock(i) - NextMovingBlock(1) If tmp > -4 And tmp < 4 Then ''''''''''''''''''''''''''''''''''在同一行，变成同一列 tempArray(i) = NextMovingBlock(i) + tmp * (Row10 - 1) ElseIf Abs(tmp) = (Row10 - 1) Or Abs(tmp) = (Row10 + 1) Then ''''''''''''''''''''''''''''''''''''''''''''''''''在斜对位置 Select Case tmp Case -Row10 - 1 tempArray(i) = NextMovingBlock(1) - Row10 + 1 Case 1 - Row10 tempArray(i) = NextMovingBlock(1) + Row10 + 1 Case Row10 - 1 tempArray(i) = NextMovingBlock(1) - Row10 - 1 Case Row10 + 1 tempArray(i) = NextMovingBlock(1) + Row10 - 1 End Select Else ''''''''''''''''''''''''''''''''''''''''''''在同一列，变成同一行 tempArray(i) = NextMovingBlock(i) - tmp \ Row10 - tmp End If Next For i = 2 To 4 NextMovingBlock(i) = tempArray(i) Next End Function Public Function SetKey(Index As Integer) As Integer Dim tmp As Integer tmp = Form2.combosetting(Index).ListIndex If tmp < 36 Then If tmp < 26 Then

SetKey = tmp + 65 '''''''''''''''A-----Z Else SetKey = tmp + 22 ''''''''''0--------9 End If ElseIf tmp > 35 And tmp < 40 Then SetKey = tmp + 1 ElseIf tmp > 41 Then SetKey = vbKeyNumpad0 + tmp - 42 Else Select Case tmp Case 40 SetKey = vbKeySpace '''''''''''Space Case 41 SetKey = 13 '''''''''''''''''''''''Enter End Select End If End Function Public Function GetKey(Key As Integer) As Integer '''''''''''''''''''''''''''''''Key 是键值 ''''''''''''''''''''''''''''''SetKey的逆过程 If Key >= vbKeyA And Key <= vbKeyZ Then GetKey = Key - 65 ElseIf Key >= vbKey0 And Key <= vbKey9 Then GetKey = Key - 22 ElseIf Key >= vbKeyLeft And Key <= vbKeyDown Then GetKey = Key - 1 ElseIf Key = vbKeySpace Then GetKey = 40 ElseIf Key = 13 Then GetKey = Key Else GetKey = Key - vbKeyNumpad0 + 42 End If End Function Public Sub ShowPreview() Dim i As Integer, tmp As Integer, x As Integer, offset As Integer For i = 0 To 24 ''''''''''''''''''''''''''''''''''' Form1.BlockPreview(i).Visible = False Next ''''''''''''''''''''''''''''''''''''''''''''''' x = Row10 \ 2 - 3 For i = 1 To 4 tmp = NextMovingBlock(i) - x 'OffSet = (tmp \ Row10) * 5 + tmp Mod Row10 offset = 5 * (tmp \ Row10) + tmp Mod Row10 Form1.BlockPreview(offset).BackColor = BlockColor(NextBlockColor) Form1.BlockPreview(offset).Visible = True Next i End Sub Public Sub PlaysndUpGrade() If sndcontrol = 0 Then On Error Resume Next sndPlaySound sndupGrade, 3 End If End Sub Public Sub PlaysndDown() If sndcontrol = 0 Then On Error Resume Next sndPlaySound sndDown, 3 End If End Sub Public Sub PlaysndRedyGo() If sndcontrol = 0 Then On Error Resume Next sndPlaySound sndReadyGo, 3 End If End Sub Public Sub Playsndtransform() If sndcontrol = 0 Then On Error Resume Next sndPlaySound sndtransform, 3 End If End Sub Public Sub PlaysnBack1() Dim ReturnValue As Long If sndcontrol1 = 0 Then sndback1 = "D:\download\vbstudy\VBRAR\russia2000\Data\back1.mid" ReturnValue = mciExecute("play D:\download\vbstudy\VBRAR\russia2000\Data\back1.mid") End If End Sub

VB部分为本公司最新产品（开发中）小企业会计核算软件的系统管理部分（主界面load时的执行代码） Delphi部分为本公司刚刚开发完毕的零售产品——古钱买卖收藏管理系统（成本收益分析部分） 两套软件均出自一人之手！ ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

Private Sub Form_Load() Dim colNo As Integer Dim cUser_Id, cUser_Name As String '用户编码、用户名 Dim iLogId As Integer '日志编码 Dim cAcc_ID As String '帐套号 Dim iYear As Integer '会计年度 Dim Index As Integer Dim Acc_Row As String Dim conn1 As ADODB.Connection Dim rst1 As ADODB.Recordset Set Module1.Conn = New ADODB.Connection Set Module1.Rst = New ADODB.Recordset '获取程序路径 Module1.Program_path = App.Path If Right(Module1.Program_path, 1) <> "\" Then Module1.Program_path = Module1.Program_path + "\" End If 'end '设置Access密码 Module1.Access_pwd = "ilovexiangqian" 'end '判断程序是否打开 If App.PrevInstance Then MsgBox "", vbOKOnly + vbExclamation, "Error" End End If 'end '登录 frmLogin.Show 1 'end '获取SQL Server登录参数 Set conn1 = New ADODB.Connection conn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Module1.Program_path + "wisystem.mdb;Jet OLEDB:DataBase Password=" + Module1.Access_pwd Set rst1 = New ADODB.Recordset rst1.Open "select * from WI_Connectdb where iRowID = 1", conn1 Module1.HostName = rst1("cHostName") Module1.UserName = rst1("cUid") Module1.password = rst1("cPwd") rst1.Close Set rst1 = Nothing conn1.Close Set conn1 = Nothing 'end '连接SQL Server数据源 Module1.Conn.Open "Provider=SQLOLEDB.1;Data Source=" + Module1.HostName + ";Database=wisystem" + ";Uid=" + Module1.UserName + ";Pwd=" + Module1.password + ";Trusted_Connection=No" 'end '设置窗体 MSFlexGrid1.Width = frmMain.ScaleWidth MSFlexGrid1.Height = (frmMain.ScaleHeight - StatusBar1.Height) * 60 / 100 MSFlexGrid2.Width = frmMain.ScaleWidth MSFlexGrid2.Height = frmMain.ScaleHeight - StatusBar1.Height - MSFlexGrid1.Height MSFlexGrid1.Left = 0 MSFlexGrid1.Top = frmMain.ScaleHeight - MSFlexGrid1.Height - MSFlexGrid2.Height - StatusBar1.Height MSFlexGrid2.Left = 0 MSFlexGrid2.Top = frmMain.ScaleHeight - MSFlexGrid2.Height - StatusBar1.Height 'end

'设置状态栏 StatusBar1.Panels(1).Width = Me.ScaleWidth * 30 / 100 StatusBar1.Panels(2).Width = Me.ScaleWidth * 50 / 100 StatusBar1.Panels(3).Width = Me.ScaleWidth * 20 / 100 StatusBar1.Panels(2).Text = "『在线用户』" StatusBar1.Panels(3).Text = CStr(Now) Timer1.Enabled = True 'end '设置表格 '设置MSFlexGrid1 MSFlexGrid1.Rows = 2 MSFlexGrid1.Cols = 7 MSFlexGrid1.ColWidth(0) = 1200 MSFlexGrid1.ColWidth(1) = 1600 MSFlexGrid1.ColWidth(2) = 1200 MSFlexGrid1.ColWidth(3) = 1200 MSFlexGrid1.ColWidth(4) = 3000 MSFlexGrid1.ColWidth(5) = 1200 MSFlexGrid1.ColWidth(6) = 2000 For colNo = 0 To 6 MSFlexGrid1.ColAlignment(colNo) = 4 Next MSFlexGrid1.RowHeight(0) = 350 MSFlexGrid1.TextMatrix(0, 0) = "日志编码" MSFlexGrid1.TextMatrix(0, 1) = "操作员" MSFlexGrid1.TextMatrix(0, 2) = "帐套号" MSFlexGrid1.TextMatrix(0, 3) = "会计年度" MSFlexGrid1.TextMatrix(0, 4) = "执行功能" MSFlexGrid1.TextMatrix(0, 5) = "状态" MSFlexGrid1.TextMatrix(0, 6) = "执行时间" 'end '设置MSFlexGrid2 MSFlexGrid2.Rows = 2 MSFlexGrid2.Cols = 6 MSFlexGrid2.ColWidth(0) = 1200

MSFlexGrid2.ColWidth(1) = 2000 MSFlexGrid2.ColWidth(2) = 1600 MSFlexGrid2.ColWidth(3) = 1600 MSFlexGrid2.ColWidth(4) = 2000 MSFlexGrid2.ColWidth(5) = 1200 For colNo = 0 To 5 MSFlexGrid2.ColAlignment(colNo) = 4 Next MSFlexGrid2.RowHeight(0) = 350 MSFlexGrid2.TextMatrix(0, 0) = "帐套号" MSFlexGrid2.TextMatrix(0, 1) = "帐套名称" MSFlexGrid2.TextMatrix(0, 2) = "启用时间" MSFlexGrid2.TextMatrix(0, 3) = "会计主管" MSFlexGrid2.TextMatrix(0, 4) = "本位币" MSFlexGrid2.TextMatrix(0, 5) = "是否开帐" 'end 'end '导入数据 '导入账套 Module1.Rst.Open "select * from WI_Account", Module1.Conn Do While Not Module1.Rst.EOF MSFlexGrid2.RowHeight(MSFlexGrid2.Rows - 1) = 350 MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 0) = Module1.Rst.Fields("cAcc_ID") MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 1) = Module1.Rst.Fields("cAcc_Name") MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 2) = Module1.Rst.Fields("iYear") & "年" & Module1.Rst.Fields("iMonth") & "月" MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 3) = Module1.Rst.Fields("cAcc_Master") MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 4) = Module1.Rst.Fields("cCurCode") + Module1.Rst.Fields("cCurName") Set rst1 = New ADODB.Recordset rst1.Open "select * from WI_Account_sub where cAcc_ID = '" + Module1.Rst.Fields("cAcc_ID") + "'", Module1.Conn If rst1.Fields("bInstalled") Then MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 5) = "是" Else MSFlexGrid2.TextMatrix(MSFlexGrid2.Rows - 1, 5) = "否" End If rst1.Close Set rst1 = Nothing Module1.Rst.MoveNext If Not Module1.Rst.EOF Then MSFlexGrid2.Rows = MSFlexGrid2.Rows + 1 End If Loop Module1.Rst.Close 'end

'导入操作日志 '建立用户编号列表 Module1.Rst.Open "select * from WI_UserList", Module1.Conn If Module1.Rst.RecordCount < 0 Then StatusBar1.Panels(2).Text = StatusBar1.Panels(2).Text + "NULL" Module1.Rst.Close Exit Sub End If StatusBar1.Panels(2).Text = StatusBar1.Panels(2).Text + "「" ReDim UserList(1 To Module1.Rst.RecordCount) For Index = 1 To Module1.Rst.RecordCount UserList(Index) = Module1.Rst.Fields("cUser_Id") If Not Module1.Rst.EOF Then StatusBar1.Panels(2).Text = StatusBar1.Panels(2).Text + Module1.Rst.Fields("cUser_Id") + "，" Else StatusBar1.Panels(2).Text = StatusBar1.Panels(2).Text + Module1.Rst.Fields("cUser_Id") + "」" End If Module1.Rst.MoveNext Next Index Module1.Rst.Close 'end '导入操作日志 For Each cUser_Id In UserList '获取用户名 Module1.Rst.Open "select * from WI_User where cUser_Id = '" + cUser_Id + "'", Module1.Conn cUser_Name = Module1.Rst.Fields("cUser_Name") Module1.Rst.Close 'end '获取日志编号、帐套号、会计年度 Module1.Rst.Open "select * from WI_Log where cUser_Id = '" + cUser_Id + "'", Module1.Conn iLogId = Module1.Rst.Fields("iLogId") cAcc_ID = Module1.Rst.Fields("cAcc_ID") iYear = Module1.Rst.Fields("iYear") Module1.Rst.Close 'end '导入操作日志 Module1.Rst.Open "select * from WI_Log_sub where iLogId = '" + iLogId + "'" Do While Not Module1.Rst.EOF MSFlexGrid1.RowHeight(MSFlexGrid1.Rows - 1) = 350 MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = iLogId MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = cUser_Name MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 2) = cAcc_ID MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 3) = CStr(iYear) MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 4) = Module1.Rst.Fields("cCommand") MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 5) = Module1.Rst.Fields("cStation") MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 6) = CStr(Module1.Rst.Fields("dTime")) Module1.Rst.MoveNext If Not Module1.Rst.EOF Then MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1 End If Loop Module1.Rst.Close 'end Next 'end 'end 'end End Sub

unit cbsyfx; //成本收益分析 interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ToolWin, StdCtrls, ImgList, DB, ADODB, Grids; type Tfrmcbsyfx = class(TForm) CoolBar1: TCoolBar; ToolBar1: TToolBar; Label1: TLabel; txtdate1: TDateTimePicker; ToolButton1: TToolButton; Label2: TLabel; txtdate2: TDateTimePicker; ToolButton2: TToolButton; ToolButton3: TToolButton; ImageList1: TImageList; ADOConnection1: TADOConnection; ADODataSet1: TADODataSet; StringGrid1: TStringGrid; ADODataSet2: TADODataSet; procedure FormShow(Sender: TObject); procedure ToolButton3Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var frmcbsyfx: Tfrmcbsyfx; implementation uses publicdata; Procedure DB_Open(var ADOConnection1:TADOConnection;DB_Path:string;DB_Pwd:string); stdcall; external 'conn.dll' name 'DB_Open'; {$R *.dfm} procedure Tfrmcbsyfx.FormShow(Sender: TObject); var colNo: integer; begin txtdate1.Date := date(); txtdate2.Date := date(); DB_Open(ADOConnection1,publicdata.mainPath+'\data\info.mdb',publicData.database_PWD); stringgrid1.ColCount := 10; stringgrid1.RowCount := 2; stringgrid1.ColWidths[0] := 5; stringgrid1.RowHeights[0] := 20; stringgrid1.RowHeights[1] := 20; stringgrid1.ColWidths[1] := 64; stringgrid1.ColWidths[2] := 148; for colNo := 3 to 9 do begin stringgrid1.ColWidths[colNo] := 64; end; stringgrid1.Cells[1,0] := '出售编号'; stringgrid1.Cells[2,0] := '古钱名称'; stringgrid1.Cells[3,0] := '古钱类别'; stringgrid1.Cells[4,0] := '购买时间'; stringgrid1.Cells[5,0] := '出售时间'; stringgrid1.Cells[6,0] := '出售数量'; stringgrid1.Cells[7,0] := '成本'; stringgrid1.Cells[8,0] := '收入'; stringgrid1.Cells[9,0] := '利润'; end;

procedure Tfrmcbsyfx.ToolButton3Click(Sender: TObject); var cb,lr: real; zcb,zlr,zsr: real; colNo,rowNo: integer; begin if txtdate1.Date > txtdate2.Date then begin showmessage('开始时间不能大于结束时间！'); exit; end; for rowNo := 1 to stringgrid1.RowCount - 1 do begin for colNo := 1 to stringgrid1.ColCount - 1 do begin stringgrid1.Cells[colNo,rowNo] := ''; end; end; stringgrid1.RowCount := 2; cb := 0.00; lr := 0.00; zcb := 0.00; zlr := 0.00; zsr := 0.00; ADODataSet1.CommandText := 'select * from buy where sj between #' + formatdatetime('yyyy-m-d',txtdate1.Date) + '# and #' + formatdatetime('yyyy-m-d',txtdate2.Date) + '# and sk = "1" and fh = "1" and th = "0"'; ADODataSet1.Open; if ADODataSet1.RecordCount > 0 then begin while not ADODataSet1.Eof do begin ADODataSet2.CommandText := 'select * from gmxx where usercode = "' + ADODataSet1.fieldbyname('gm_usercode').AsString + '"'; ADODataSet2.Open; cb := ADODataSet2.fieldbyname('gmj').AsFloat + ADODataSet2.fieldbyname('qtfy').AsFloat + ADODataSet1.fieldbyname('qtfy').AsFloat; zcb := zcb + cb; lr := ADODataSet1.fieldbyname('jg').AsFloat - cb; zlr := zlr + lr; zsr := zsr + ADODataSet1.fieldbyname('jg').AsFloat; stringgrid1.Cells[1,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('usercode').AsString; stringgrid1.Cells[2,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('name').AsString; stringgrid1.Cells[3,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('lb').AsString; stringgrid1.Cells[4,stringgrid1.RowCount - 1] := ADODataSet2.fieldbyname('sj').AsString; stringgrid1.Cells[5,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('sj').AsString; stringgrid1.Cells[6,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('sl').AsString; stringgrid1.Cells[7,stringgrid1.RowCount - 1] := floattostr(cb); stringgrid1.Cells[8,stringgrid1.RowCount - 1] := ADODataSet1.fieldbyname('jg').AsString; stringgrid1.Cells[9,stringgrid1.RowCount - 1] := floattostr(lr); ADODataSet2.Close; ADODataSet1.Next; if not ADODataSet1.Eof then begin stringgrid1.RowCount := stringgrid1.RowCount + 1; stringgrid1.RowHeights[stringgrid1.RowCount - 1] := 20; end; end; stringgrid1.RowCount := stringgrid1.RowCount + 1; stringgrid1.RowHeights[stringgrid1.RowCount - 1] := 20; stringgrid1.Cells[2,stringgrid1.RowCount - 1] := '合计'; stringgrid1.Cells[7,stringgrid1.RowCount - 1] := floattostr(zcb); stringgrid1.Cells[8,stringgrid1.RowCount - 1] := floattostr(zsr); stringgrid1.Cells[9,stringgrid1.RowCount - 1] := floattostr(zlr); end else begin showmessage('您选择的时间段内没有发生出售行为！'); end; ADODataSet1.Close; end; procedure Tfrmcbsyfx.FormClose(Sender: TObject; var Action: TCloseAction); var colNo,rowNo: integer; begin ADOConnection1.Close; for rowNo := 1 to stringgrid1.RowCount - 1 do begin for colNo := 1 to stringgrid1.ColCount - 1 do begin stringgrid1.Cells[colNo,rowNo] := ''; end; end; end; end.

’1个赛车游戏↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

Dim Pic As Integer, GO As Boolean, Oil As Integer, Dis As Integer, _ Sco As Integer, R As Integer, X As Integer, F As Integer, _ Q As String, spacedone As Boolean, updone As Boolean 'µÀ·µÄleft = 800£¬ right =3200£¬ mid=1800 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If lblGo.Visible = True Then Timer1.Enabled = True Timer2.Enabled = True Timer4.Enabled = True Timer5.Enabled = True lblGo.Visible = False End If If KeyCode = vbKeyDown Then MyCar.Visible = Not (MyCar.Visible) If KeyCode = vbKeyUp Then '°´ÏÂUp¼ü GO = True '³µ×ÓÇ°½ø updone = True 'UP¼ü±»°´Ï End If If KeyCode = vbKeyLeft And MyCar.Left >= 900 And GO = True Then If spacedone = False Then MyCar.Left = MyCar.Left - 100 If spacedone = True Then MyCar.Left = MyCar.Left - 500 End If '×óת £¨ÅжÏÊÇ·ñΪ¼ÓËÙ״̬£© If KeyCode = vbKeyRight And MyCar.Left <= 3100 And GO = True Then If spacedone = False Then MyCar.Left = MyCar.Left + 100 If spacedone = True Then MyCar.Left = MyCar.Left + 500 End If 'ÓÒת £¨ÅжÏÊÇ·ñΪ¼ÓËÙ״̬£© If KeyCode = vbKeySpace Then 'Èç¹û°´Ï¿ոñ TimerBack.Interval = 5 '################# TimerPB.Interval = 50 Timer1.Interval = 6 Timer2.Interval = 9 'È«ÃæÆô¶¯¼ÓËÙ Timer3.Interval = 2 Timer4.Interval = 15 Timer5.Interval = 4 TimerRnd.Interval = 100 TimerBanana.Interval = 3 '################# GO = True '³µ×ÓÇ°½ø spacedone = True '¿Õ¸ñ±»°´Ï End If End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyUp Then 'Ç°½ø¼üËÉ¿ª If spacedone = False Then GO = False updone = False 'Í£³µ End If If KeyCode = vbKeySpace Then If updone = False Then GO = False '¿Õ¸ñ¼üËÉ¿ª TimerBack.Interval = 50 '################# TimerPB.Interval = 500 Timer1.Interval = 60 Timer2.Interval = 90 '¹Ø±Õ¼ÓËÙÆ÷ Timer3.Interval = 20 Timer4.Interval = 150 Timer5.Interval = 40 TimerRnd.Interval = 1000 TimerBanana.Interval = 30 '################# spacedone = False '¿Õ¸ñËÉ¿ªÁË End If End Sub Private Sub Form_Load() Randomize '²úÉúËæ¼¼Êõ Pic = 1 Oil = 50

End Sub Private Sub MyCar_Click() 'µ¥»÷³µ×Ó MsgBox "The Car Game is made by Bradley,Haoran,Wang. Enjoy!" End Sub Private Sub Timer1_Timer() 'µÚ1Á¾³µ If Car1.Top > 4000 And Car1.Top < 5000 And _ Car1.Left > MyCar.Left - 400 And Car1.Left < MyCar.Left + 400 Then Timer1.Enabled = False Car1.Top = -500 GO = False Q = MsgBox("Game Over.Your Score is:" & LblS.Caption, vbApplicationModal + vbExclamation) Unload Me Me.Show ElseIf Car1.Top > 8000 Then Timer1.Enabled = False Car1.Top = -500 ElseIf Car1.Top < -1000 Then Timer1.Enabled = False Car1.Top = -500 ElseIf GO = True Then Car1.Top = Car1.Top + 100 ElseIf GO = False Then Car1.Top = Car1.Top - 200 End If End Sub Private Sub Timer2_Timer() 'µÚ2Á¾³µ If Car2.Top > 4000 And Car2.Top < 5000 And _ Car2.Left > MyCar.Left - 400 And Car2.Left < MyCar.Left + 400 Then Timer2.Enabled = False Car2.Top = -500 GO = False Q = MsgBox("Game Over.Your Score is:" & LblS.Caption, vbApplicationModal + vbExclamation) Unload Me Me.Show ElseIf Car2.Top > 8000 Then Timer2.Enabled = False Car2.Top = -500 ElseIf Car2.Top < -1000 Then Timer2.Enabled = False Car2.Top = -500 ElseIf GO = True Then Car2.Top = Car2.Top + 100 ElseIf GO = False Then Car2.Top = Car2.Top - 200 End If End Sub Private Sub Timer3_Timer() 'µÚ3Á¾³µ If Car3.Top > 4000 And Car3.Top < 5000 And _ Car3.Left > MyCar.Left - 400 And Car3.Left < MyCar.Left + 400 Then Timer3.Enabled = False Car3.Top = -500 GO = False Q = MsgBox("Game Over.Your Score is:" & LblS.Caption, vbApplicationModal + vbExclamation) Unload Me Me.Show ElseIf Car3.Top > 8000 Then Timer3.Enabled = False Car3.Top = -500 ElseIf Car3.Top < -1000 Then Timer3.Enabled = False Car3.Top = -500 ElseIf GO = True Then Car3.Top = Car3.Top + 100 ElseIf GO = False Then Car3.Top = Car3.Top - 200 End If End Sub Private Sub Timer4_Timer() 'µÚ4Á¾³µ If Car4.Top > 4000 And Car4.Top < 5000 And _ Car4.Left > MyCar.Left - 400 And Car4.Left < MyCar.Left + 400 Then Timer4.Enabled = False Car4.Top = -500 GO = False Q = MsgBox("Game Over.Your Score is:" & LblS.Caption, vbApplicationModal + vbExclamation) Unload Me Me.Show ElseIf Car4.Top > 8000 Then Timer4.Enabled = False Car4.Top = -500 ElseIf Car4.Top < -1000 Then Timer4.Enabled = False Car4.Top = -500 ElseIf GO = True Then Car4.Top = Car4.Top + 100 ElseIf GO = False Then Car4.Top = Car4.Top - 200 End If End Sub Private Sub Timer5_Timer() 'µÚ5Á¾³µ If Car5.Top > 4000 And Car5.Top < 5000 And _ Car5.Left > MyCar.Left - 400 And Car5.Left < MyCar.Left + 400 Then Timer5.Enabled = False Car5.Top = -500 LblS.Caption = LblS.Caption + 200 GO = False Q = MsgBox("Game Over.Your Score is:" & LblS.Caption, vbApplicationModal + vbExclamation) Unload Me Me.Show ElseIf Car5.Top > 8000 Then