第一楼给摆渡

把代码复制到空窗体中按F5运行即可。 Option Explicit Private WithEvents Timer1 As Timer Private WithEvents Label1 As Label Dim GFangXiang As Boolean Dim HWB As Single Dim She() As ShenTi Dim X As Long, Y As Long Dim ZhuangTai(23, 23) As Long Private Type ShenTi F As Long X As Long Y As Long End Type Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim C As Long If KeyCode = 27 Then End If KeyCode = 32 Then If Timer1.Enabled = True Then Timer1.Enabled = False Label1.Visible = True Else Timer1.Enabled = True Label1.Visible = False End If End If C = UBound(She) If GFangXiang = True Then Exit Sub Select Case KeyCode Case 37 If She(C).F = 2 Then Exit Sub She(C).F = 0 GFangXiang = True Case 38 If She(C).F = 3 Then Exit Sub She(C).F = 1 GFangXiang = True Case 39 If She(C).F = 0 Then Exit Sub She(C).F = 2 GFangXiang = True Case 40 If She(C).F = 1 Then Exit Sub She(C).F = 3 GFangXiang = True End Select End Sub Private Sub Form_Load() Me.AutoRedraw = True Me.BackColor = &HC000& Me.FillColor = 255 Me.FillStyle = 0 Me.ScaleWidth = 24 Me.ScaleHeight = 24 Me.WindowState = 2 Set Timer1 = Controls.Add("VB.Timer", "Timer1") Set Label1 = Controls.Add("VB.Label", "Label1") Label1.AutoSize = True Label1.BackStyle = 0 Label1 = "暂停" Label1.ForeColor = RGB(255, 255, 0) Label1.FontSize = 50 ChuShiHua End Sub Private Sub Form_Resize() On Error GoTo 1: With Me If .WindowState <> 1 Then .Cls .ScaleMode = 3 HWB = .ScaleHeight / .ScaleWidth .ScaleWidth = 24 .ScaleHeight = 24 Label1.Move (Me.ScaleWidth - Label1.Width) / 2, (Me.ScaleHeight - Label1.Height) / 2 HuaTu Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF End If End With 1: End Sub Private Sub Timer1_Timer() Dim C As Long, I As Long On Error GoTo 2: QingChu C = UBound(She) Select Case She(C).F Case 0 If ZhuangTai(She(C).X - 1, She(C).Y) = 2 Then C = C + 1 ReDim Preserve She(C) She(C).F = She(C - 1).F She(C).X = She(C - 1).X - 1 She(C).Y = She(C - 1).Y ChanShengShiWu GoTo 1: ElseIf ZhuangTai(She(C).X - 1, She(C).Y) = 1 Then GoTo 2: End If Case 1 If ZhuangTai(She(C).X, She(C).Y - 1) = 2 Then C = C + 1 ReDim Preserve She(C) She(C).F = She(C - 1).F She(C).X = She(C - 1).X She(C).Y = She(C - 1).Y - 1 ChanShengShiWu GoTo 1: ElseIf ZhuangTai(She(C).X, She(C).Y - 1) = 1 Then GoTo 2: End If Case 2 If ZhuangTai(She(C).X + 1, She(C).Y) = 2 Then C = C + 1 ReDim Preserve She(C) She(C).F = She(C - 1).F She(C).X = She(C - 1).X + 1 She(C).Y = She(C - 1).Y ChanShengShiWu GoTo 1: ElseIf ZhuangTai(She(C).X + 1, She(C).Y) = 1 Then GoTo 2: End If Case 3 If ZhuangTai(She(C).X, She(C).Y + 1) = 2 Then C = C + 1 ReDim Preserve She(C) She(C).F = She(C - 1).F She(C).X = She(C - 1).X She(C).Y = She(C - 1).Y + 1 ChanShengShiWu GoTo 1: ElseIf ZhuangTai(She(C).X, She(C).Y + 1) = 1 Then GoTo 2: End If End Select ZhuangTai(She(0).X, She(0).Y) = 0 For I = 0 To C Select Case She(I).F Case 0 She(I).X = She(I).X - 1 Case 1 She(I).Y = She(I).Y - 1 Case 2 She(I).X = She(I).X + 1 Case 3 She(I).Y = She(I).Y + 1 End Select Next TiaoZheng 1: GFangXiang = False ZhuangTai(She(C).X, She(C).Y) = 1 HuaTu Exit Sub 2: If MsgBox("游戏结束，点“是”重新开始游戏，点“否”", vbYesNo, "贪吃蛇") = vbYes Then ChuShiHua Else End End If End Sub Private Sub ChuShiHua() Me.Cls Timer1.Enabled = True Timer1.Interval = 200 Erase ZhuangTai ReDim She(2) She(0).F = 2 She(0).X = 9 She(0).Y = 11 ZhuangTai(9, 11) = 1 She(1).F = 2 She(1).X = 10 She(1).Y = 11 ZhuangTai(10, 11) = 1 She(2).F = 2 She(2).X = 11 She(2).Y = 11 ZhuangTai(11, 11) = 1 HuaTu ChanShengShiWu End Sub Private Sub QingChu() Dim I As Long For I = 0 To UBound(She) Me.Line (She(I).X, She(I).Y)-(She(I).X + 1, She(I).Y + 1), Me.BackColor, BF Next End Sub Private Sub HuaTu() Dim I As Long For I = 0 To UBound(She) Me.Circle (She(I).X + 0.5, She(I).Y + 0.5), 0.49, RGB(255, 255, 0), , , HWB Next End Sub Private Sub TiaoZheng() Dim I As Long For I = 0 To UBound(She) - 1 She(I).F = She(I + 1).F Next End Sub Private Sub ChanShengShiWu() Randomize Timer 1: X = Int(Rnd * 24) Y = Int(Rnd * 24) If ZhuangTai(X, Y) > 0 Then GoTo 1: ZhuangTai(X, Y) = 2 Me.Line (X, Y)-(X + 1, Y + 1), RGB(255, 255, 0), BF End Sub

呵呵~~LZ好孩子

于 你终于做了件大好事~~~~顶!

Private Sub Form_Load() Me.DrawWidth = 2 Timer1.Interval = 200 End Sub Private Sub Timer1_Timer() Static c If c = 0 Then Me.Cls Line (800, ScaleHeight / 2 - 300)-(1500, ScaleHeight / 2 - 150), , B Me.Circle (1000, ScaleHeight / 2 - 100), 50 Me.Circle (1300, ScaleHeight / 2 - 100), 50 Line (0, ScaleHeight / 2 + 500)-(ScaleWidth, ScaleHeight / 2 + 500) Line (0, ScaleHeight / 2 - 500)-(ScaleWidth, ScaleHeight / 2 - 500) For i = 1 To 10 Step 2 Line (ScaleWidth * (i - 1) / 10, ScaleHeight / 2 - 50)-(ScaleWidth * i / 10, ScaleHeight / 2 + 50), vbRed, BF Line (ScaleWidth * i / 10, ScaleHeight / 2 - 50)-(ScaleWidth * (i + 1) / 10, ScaleHeight / 2 + 50), vbBlue, BF Next Else Me.Cls Line (800, ScaleHeight / 2 - 300)-(1500, ScaleHeight / 2 - 150), , B Me.Circle (1000, ScaleHeight / 2 - 100), 50 Me.Circle (1300, ScaleHeight / 2 - 100), 50 Line (0, ScaleHeight / 2 + 500)-(ScaleWidth, ScaleHeight / 2 + 500) Line (0, ScaleHeight / 2 - 500)-(ScaleWidth, ScaleHeight / 2 - 500) For i = 1 To 10 Step 2 Line (ScaleWidth * (i - 1) / 10, ScaleHeight / 2 - 50)-(ScaleWidth * i / 10, ScaleHeight / 2 + 50), vbBlue, BF Line (ScaleWidth * i / 10, ScaleHeight / 2 - 50)-(ScaleWidth * (i + 1) / 10, ScaleHeight / 2 + 50), vbRed, BF Next End If c = 1 - c End Sub

Private Type POINTAPI x As Long y As Long End Type Const Srccopy = &HCC0020 Const Swp_nomove = &H2 Const Swp_nosize = &H1 Const Flags = Swp_nomove Or Swp_nosize Const hwnd_topmost = -1 Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Dim pos As POINTAPI Dim sx As Integer Dim sy As Integer Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" (ByVal hwnd As Long, _ ByVal lpString As String, ByVal cch As Long) As Long Dim CurrentHwnd As Long Dim ForegroundWindowHwnd As Long Dim sText As String * 255 Dim N, M Private Sub Command1_Click() N = N + 1 Me.Caption = N End Sub Private Sub Command3_Click() N = N - 1 Me.Caption = N End Sub Private Sub Command2_Click() End Sub Private Sub Form_Load() SetWindowPos hwnd, hwnd_topmost, 0, 0, 0, 0, Flags GetCursorPos pos End Sub Private Sub start() GetCursorPos pos Dim aaa As Long aaa = GetDC(CurrentHwnd) StretchBlt hdc, 0, 0, Form1.Width / 3000 * 200, Form1.Height / 3000 * 200 / 2, aaa, 6, 0, 250 + 12, 199, Srccopy StretchBlt hdc, 0, Form1.Height / 3000 * 200 / 2, Form1.Width / 3000 * 200, Form1.Height / 3000 * 200 / 2, aaa, 6, 250 - 42, 250 + 12, 237, Srccopy Call ReleaseDC(0, aaa) End Sub Private Sub Timer1_Timer() ForegroundWindowHwnd = GetForegroundWindow CurrentHwnd = ForegroundWindowHwnd start End Sub Option Explicit Private Type POINTAPI x As Long y As Long End Type Const Srccopy = &HCC0020 Const Swp_nomove = &H2 Const Swp_nosize = &H1 Const Flags = Swp_nomove Or Swp_nosize Const hwnd_topmost = -1 Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Dim pos As POINTAPI Dim sx As Integer Dim sy As Integer Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" (ByVal hwnd As Long, _ ByVal lpString As String, ByVal cch As Long) As Long Dim CurrentHwnd As Long Dim ForegroundWindowHwnd As Long Dim sText As String * 255 Dim N, M Private Sub Command1_Click() N = N + 1 Me.Caption = N End Sub Private Sub Command3_Click() N = N - 1 Me.Caption = N End Sub Private Sub Command2_Click() End Sub Private Sub Form_Load() SetWindowPos hwnd, hwnd_topmost, 0, 0, 0, 0, Flags GetCursorPos pos End Sub Private Sub start() GetCursorPos pos Dim aaa As Long aaa = GetDC(CurrentHwnd) StretchBlt hdc, 0, 0, Form1.Width / 3000 * 200, Form1.Height / 3000 * 200 / 2, aaa, 6, 0, 250 + 12, 199, Srccopy StretchBlt hdc, 0, Form1.Height / 3000 * 200 / 2, Form1.Width / 3000 * 200, Form1.Height / 3000 * 200 / 2, aaa, 6, 250 - 42, 250 + 12, 237, Srccopy Call ReleaseDC(0, aaa) End Sub Private Sub Timer1_Timer() ForegroundWindowHwnd = GetForegroundWindow CurrentHwnd = ForegroundWindowHwnd start End Sub

编译错误- -

额是伐三个都不行啊

我就试了第一个……

可以的啊~~~我试过了~~~第一个