天天寫報表工具,感覺Excel越用越煩,看着Sheet裏的格子,我突然想到了以前他們說用VBA做遊戲的想法。
Excel工作表裏的格子,天生就適合用來做俄羅斯方塊、貪喫蛇這樣的小遊戲啊,想到了就做,於是有了以下。
先說一下實現方式。
蛇的運動通過user32.dll的SetTimer實現,蛇的組成即一個一維數組,數組存放自定義類型,包含橫縱座標。
蛇、食物通過填充Excel單元格實現。
下面貼VBA的源碼。
模塊:
Public Direction As Integer '蛇的方向 1左2上3右4下
Public SnakeBody(1 To 676) As PosSnake
Public SnakeBodyCount As Integer
Public PosX '橫座標集合
Public lTimerID As Long
Public Food As PosSnake
#If VBA7 And Win64 Then
Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#Else
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Sub Drawing(pos As String, bl As Boolean)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
If bl Then
ranges.Interior.Color = 65535
Else
ranges.Interior.Color = 5287936
End If
End Sub
Sub DrawingFood(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 14951936
End Sub
Sub NotDrawing(pos As String)
Dim ranges As range
pos = KillSpace(pos)
Set ranges = range(pos)
ranges.Interior.Color = 16777215
End Sub
Sub button1_Click()
On Error Resume Next
If Not Direction = 4 Then
Direction = 2
End If
End Sub
Sub button2_Click()
On Error Resume Next
If Not Direction = 3 Then
Direction = 1
End If
End Sub
Sub button3_Click()
On Error Resume Next
If Not Direction = 1 Then
Direction = 3
End If
End Sub
Sub button4_Click()
On Error Resume Next
If Not Direction = 2 Then
Direction = 4
End If
End Sub
Sub button5_Click()
PosX = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For i = 0 To 25
For j = 1 To 26
NotDrawing (PosX(i) + Str(j))
Next
Next
SnakeBodyCount = 1
Dim pos As New PosSnake
Direction = 3
pos.X = 0
pos.Y = 12
Set SnakeBody(1) = pos
createFood
StartTimer (200) '蛇開始運動
End Sub
'啓動定時器,IDuration是定時器觸發的時間,單位爲毫秒
Sub StartTimer(lDuration As Long)
If Not lTimerID = 0 Then
lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
Else
Call StopTimer
lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
End If
End Sub
'停止定時器的函數
Sub StopTimer()
KillTimer 0&, lTimerID
End Sub
'OnTime函數
Sub OnTime()
Dim spot As New PosSnake
On Error GoTo BeforeExit
NotDrawing (PosX(SnakeBody(SnakeBodyCount).X) + Str(SnakeBody(SnakeBodyCount).Y)) '擦除最後一格
For i = 1 To 767
If i = 1 Then
spot.X = SnakeBody(i).X '蛇頭
spot.Y = SnakeBody(i).Y
If spot.X > 25 Or spot.Y > 26 Then
Return
End If
If Direction = 1 Then
spot.X = spot.X - 1
End If
If Direction = 2 Then
spot.Y = spot.Y - 1
End If
If Direction = 3 Then
spot.X = spot.X + 1
End If
If Direction = 4 Then
spot.Y = spot.Y + 1
End If
If Food.X = spot.X And Food.Y = spot.Y Then '判斷是否喫到了食物
Set SnakeBody(SnakeBodyCount + 1) = New PosSnake
'SnakeBody(SnakeBodyCount + 1).X = SnakeBody(SnakeBodyCount).X
'SnakeBody(SnakeBodyCount + 1).Y = SnakeBody(SnakeBodyCount).Y
SnakeBodyCount = SnakeBodyCount + 1
createFood
End If
Else
SnakeBody(SnakeBodyCount - i + 2).X = SnakeBody(SnakeBodyCount - i + 1).X
SnakeBody(SnakeBodyCount - i + 2).Y = SnakeBody(SnakeBodyCount - i + 1).Y
End If
If i >= SnakeBodyCount Then
Exit For
End If
Next
SnakeBody(1).X = spot.X
SnakeBody(1).Y = spot.Y
If spot.X > 25 Or spot.X < 0 Or spot.Y > 26 Or spot.Y < 0 Then '判斷是否撞到牆了
Call StopTimer
MsgBox ("GG")
End If
For i = 2 To SnakeBodyCount '判斷是否咬到了自己
If spot.X = SnakeBody(i).X And spot.Y = SnakeBody(i).Y Then
Call StopTimer
MsgBox ("GG")
End If
Next
For i = 1 To SnakeBodyCount
Dim pos As String
pos = PosX(SnakeBody(i).X) + Str(SnakeBody(i).Y)
If i = 1 Then '蛇頭畫不一樣的顏色
Drawing pos, True
Else
Drawing pos, False
End If
Next
BeforeExit:
End Sub
Sub createFood()
Set Food = New PosSnake
Dim Y As Integer
Dim X As Integer
Y = Int((26 * Rnd) + 1)
X = Int((25 * Rnd) + 0)
Food.X = X
Food.Y = Y
DrawingFood (PosX(Food.X) + Str(Food.Y))
End Sub
Function KillSpace(Expression)
Dim tmpS
For i = 1 To Len(Expression)
tmpT = Mid(Expression, i, 1)
If tmpT <> " " Then tmpS = tmpS & tmpT
Next i
KillSpace = tmpS
End Function
類 PosSnake:
Private ix As Integer
Private iy As Integer
Property Let X(i As Integer)
ix = i
End Property
Property Let Y(i As Integer)
iy = i
End Property
Property Get X() As Integer
X = ix
End Property
Property Get Y() As Integer
Y = iy
End Property
規矩轉載。