Last time we implemented a Huadiang Typeful game under Excel, using small partial properties and features in Excel, less than 100 lines of statements were completed. This time we have to move the greed to the Excel, it is not so easy.
First resolve the problem of the game display. For us, the best platform for small games is Excel's workspace. Due to the adjustable cell, the color-filled cell operates, we can use them as a pixel. So our greedy snake game has a display method in the form of cell-based pixel.
This is followed by the control method of the game. Here I spend a long time, where I walked, I didn't say, my last conclusion is that the way to implement button events in Excel is to introduce the form, then in response to KeyDown and KeyPress events in the form. In this case, it can be modified according to the situation based on the case.
Finally, the timing problem of the game. All the games are actually a program that receives an input information update status in a time large cycle, and our small games are no exception. Honestly, I wrote most of this game to think about how to achieve the game. Excel's VBA is related to the Timer function, without other related functions, the ONTime function can realize an event to occur at the specified time, but can only be minimized in seconds, do tens of dozens of dozens in one second The small game of the information is not suitable, we can only find a way. People who have used VB know that there is a timed control in the VB control, use it to achieve game timing is the best, but in Excel, don't I put the timing control in VB to VBA? This is also a topic worth studying, but I think of another method. VB's programmers know that if you want VB programs to play a big role, you must not drive the API of the system, so I check the help of the system-related API, discovering the SETTIMER and KILLTIMER functions of the system API, specific definitions, and usage Everyone can refer to the help, but from the literal everyone can know that they are what we are looking for. Then now the problem is how to call the system API in the VBA environment. I think Microsoft said VBA is VB in Office, then calling system APIs in VBA should also be the same as in VB. One trial, huh, really, this Microsoft is really not covered (after the MSDN found MS Office VBA from the 2000 version to support the calling system API, everyone can expand Office App).
In this way, the game input, output, logical timing is solved, and our snake game only has the logical part of the algorithm. Our game logic is, after the game is initialized, start the timer. In each timing cycle, the program implements the snake head movement and the snake tail, respectively. The first is to move the snake head, the game judges whether the position of the snake head is spaced in the moving direction, if so, fill in the color of this position (snake head movement), the snake tail movement sign is true; if the next position of the snake is not space ( That is, it is food), then fills the space of this position into the color (snake head moves), set the snake tail moving sign as a fake. Then go to the snake tail moving part, if the snake tail movement is true, filled the cells in the snake tail (snake movement), and updates the snake tail position; if the snake movement sign is fake, then nothing (snake does not move the snake head The snake is long.). For the entire game, the bottleneck of efficiency is in the pixel operation (frequently filling the cells). However, from the above algorithm, it is only necessary to handle the cells and snakes in each cycle; if you eat snakes to eat food, just need to update the snake head cell. There are fewer data processing in each time cycle to realize the fast game faster response speed, and the enthusiasts have actual significance in EXCEL.
The game is also implemented in the form of a macro. Let's create a new macro and enter the following code.
'Familiar with VB programmers know first is a statement calling the system API of Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer LIB "User32" (Byval Hwnd As Long) As Long
'Define Data Structure Type Pos_ Row As Long Col as Longend Type
Public Timerset As long 'settimer function returns to mark the existing Timer, KillTimer destroys the marked Timerpublic Gaming as Booleanpublic pulsed as booleanpublic Pulsed as Boolean
Public head_movement as long 'snake head new mobile direction sign, 1, 2, 3, 4 Represents the upper right upper left PUBLIC TAIL_MOVEMENT AS long' snake tail moving direction sign, meaning the same PUBLIC OLDHEAD_MOVEMENT AS Long 'snake head Old There is a moving direction sign Dim Tailmove as boolean' snake tail Mobile logo
Dim Origin_Size As long 'greedy snake original size
Public Score As Longdim Steps as Longdim Clean as Boolean
DIM STH AS POS_
Dim Headrow As Long 'Snake Location DIM Headcol As Long' Snake Location DIM TAILROW AS LONG 'Snake Location Location DIM TAILCOL As Long' Snake Location Dim StartPOS AS POS_ 'Greedy Snake Start Position DIM Color AS Long
Const left as long = 5 'Game area left border const right as long = 30' Game area Right boundary const top as long = 3 'game area on the border const Bottom as long = 25' game area Border boundaries
Function main () 'main function gaming = False If Worksheets.Count <2 Then ActiveWorkbook.Sheets.Add after: = Worksheets (Worksheets.Count) ElseIf (MsgBox ( "Do you want to run it in a new blank worksheet?", vbOKCancel, "?????") = vbOK) Then ActiveWorkbook.Sheets.Add after: = Worksheets (Worksheets.Count) Else Worksheets (Worksheets.Count) .Select End IfLoad UserForm1 'incorporated form UserForm1.ShowEnd Function
Function game_initial () Game initialization function 'initialization game interface color = 5 if not gaming then cells.columnwidth = 1 cells.RowHeight = 10 Range (Cells (Top, LEFT), Cells (Top, Right)). Interior.colorIndex = 1 Range (Cells (TOP 1, Left), Cells (Bottom - 1, Left)). Interior.ColorIndex = 1 Range (Bottom, Right). Interior.ColorIndex = 1 Range (Cells (TOP 1, Right), Cells (Bottom - 1, Right)). Interior.ColorIndex = 1 Range (Cells (TOP 1, Left 1), Cells (Bottom - 1, Right - 1)). Font.ColorIndex = color End If 'Snake initialization origin_size = 5 tail_movement = 1 head_movement = 1 oldhead_movement = head_movement startpos.row = (top bottom) / 2' initialized as 16 startpos.col = (left right) / 2 'initailized as 20 pulsed = False tailmove = True headrow = startpos.row headcol = startpos.col tailrow = startpos.row tailcol = startpos.col - origin_size 1 clean = True steps = 0 score = 0 For i = 0 To or IGIN_SIZE - 1 Cells (StartPos.Row, StartPos.col - i) .interior.ColorIndex = Color Next I Gaming = true 'game initialization end End Function
SUB SNAKE_MOVE () IF GAMING THEN DIM NEXTCOL AS Long Dim Next Steps = Steps 1 'greedy snake food generation, here the food generation process is simple, and the snake generation will generate a piece of food if Steps> = 6 THEN Steps = 0 randomize sth.row = int (Bottom - TOP) * RND) TOP 1 Randomize sth.col = int (Right - Left) * RND) Left 1 do while st.row> = bottom sth.row = sth.row - (bottom - top) 1 loop do while sth.col> = right sth.col = sth.col - (Right - Left) 1 Loop Cells (sth.row, Sth. col) = "*" clean = False End If End If '' '' '' snake head movable portion tailmove = True If oldhead_movement <> head_movement Then If Abs (oldhead_movement - head_movement) <> 2 Then oldhead_movement = head_movement Cells (headrow, headcol ) = head_movement 'When the direction changes, the front direction of the snake head is in the direction, and the tail runs to the tail to move forward in the correct direction. I should use a number of array, but I am too lazy to ponder. End If End If Select Case oldhead_movement Case 1 'right nextrow = headrow nextcol = headcol 1 Case 2' up nextcol = headcol nextrow = headrow - 1 Case 3 'left nextrow = headrow nextcol = headcol - 1 Case 4' down nextcol = headcol Nextrow = Headrow 1 End Select 'See if it exceeds the game area.
If nextcol = left Then nextcol = right - 1 ElseIf nextcol = right Then nextcol = left 1 End If If nextrow = top Then nextrow = bottom - 1 ElseIf nextrow = bottom Then nextrow = top 1 End If If Cells (nextrow, nextcol ). Interior.Colorindex = color the 'snake head touched the snake body, the game ends Call game_over: exit sub * = "*" THEN CALL SCORE_ Cells (next, nextcol) .clearContents Endiffs (nextrow, nextcol) .Interior.ColorIndex = color headrow = nextrow headcol = nextcol '' '' '' tail portion moving If tailmove Then Select Case tail_movement Case 1 'right nextrow = tailrow nextcol = tailcol 1 Case 2' up nextrow = Tailrow - 1 nextcol = tailcol case 3 'Left next = tailrow nextcol = tailcol - 1 case 4' down nextcol = tailco l nextrow = tailrow 1 End Select If nextcol = left Then nextcol = right - 1 ElseIf nextcol = right Then nextcol = left 1 End If If nextrow = top Then nextrow = bottom - 1 ElseIf nextrow = bottom Then nextrow = top 1 Endiffness (Next, Nextcol) <> 0 THEN IF (ASC (Cells (NEXTROW, NextCOL) <> 42) TAIL_MOVEMENT =
Cells (nextrow, nextcol) Cells (nextrow, nextcol) .ClearContents End If End If Cells (tailrow, tailcol) .Interior.ColorIndex = 0 tailrow = nextrow tailcol = nextcol End If End IfEnd SubFunction game_over () If timerset <> 0 Then Timerset = Killtimer (0, Timerset) pulsed = false end if imp ("Game over ... Temporarily. Try Again?", VBOKCANCEL, "?????") = Vbok Then Range (Cells (TOP 1, Left 1), Cells (Bottom - 1, Right - 1)). Interior.ColorIndex = 0 Range (Cells (TOP 1, Left 1), Cells (Bottom - 1, Right - 1)). ClearContents Call Game_Initial Else Cells.clearContents Cells.interior.COLORINDEX = 0 Gaming = false sendKeys "% {f4}" this sentence is critical. When introducing the form, you must use the ALT F4 end ifnd function to exit the form in the program.
Function score_ () clean = true score = score 50 tailmove = false userform1.label2.caption = "now you have the score of" str (score) End Function
The upper side is the main program (macro) section, the following is the form code section. Introducing User Forms in Engineering, named Userform1, dragged into two Label controls named Label1, 2, and then adjust the location of the form in Excel in the Form Properties window. After completing, type the following code in the Form Code window:
Private Sub UserForm_Initialize () 'form initialization event Call game_initial If gaming Then UserForm1.Label1.Caption = "NO PLAY, NO GAME" UserForm1.Label2.Caption = "Arrow keys to move. P key to pause the game E key to end The game "else userform1.label1.caption =" Something happened! "end if End Sub
Private Sub UserForm_KeyDown (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'in response to the form KeyDown event If gaming Then If Not pulsed Then pulsed = True timerset = SetTimer (0, 0, 150, AddressOf snake_move)' starts a timer, The time interval here is 150 milliseconds, you can join some code to achieve increasing game speed userform1.label2.caption = "arrow keys to move. P Key to Pause the game e key to end the game" end if SELECT Case KeyCode Case vbKeyUp head_movement = 2 Case vbKeyDown head_movement = 4 Case vbKeyLeft head_movement = 3 Case vbKeyRight head_movement = 1 Case vbKeyP 'here is achieved by destroying the game pauses timer If timerset <> 0 Then timerset = KillTimer (0, timerset) pulsed = False end if userform1.label2.caption = "game paused. Any key to resume." Case VBKEYE Call game_over End Select End IFEnd Subprivate Sub Userform_Terminate () 'Form Destroying Event, here is an Alt F4 button event to trigger if Timerset <> 0 Timerset = KillTimer (0, Timerset) Pulsed = False End If Msgbox ( "You Have Finished The Game with THE SCI" STR (SCORE)) End Sub
But I haven't finished, we have to find a place to start the entire program. Looking into a button in the worksheet sheet1 to use the total switch, named CommandButton1, double-click to enter the code to write status, type
Private submmandbutton1_click () Call MAINEND SUB
Save everything after everything. Click CommandButton1, the game is inquiry to start the game in a new worksheet, the choice is, the wild boar is pulling.
