Without further ado. Now I offer the code of the Russian square implemented in the Excel environment in the Excel environment, regarding a summary of expanding the Office app. Since the program is written in last year, it seems that the idea is a bit not remembered, and the statement is not too efficient. But I am too lazy to modify, after all, this is the correct operation. Let's refer to my other two related articles, try to do it.
Still create a new macro, type the following code.
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As LongPublic Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long 'first is the declaration of the API function call.
TYPE POS_ ROW AS long col AsLONGEND TYPE
Type Obj POS AS POS_SAT AS Long Typ As Long Color As LONGEND TYPE 'Definition of Basic Object Data Structure
Public Cur_Obj As Objpublic Prv_obj As Objpublic Nex_obj As Objpublic Objs_Array (27, 3) AS POS_
DIM STARTPOS AS POS_DIM NextPOS AS POS_
Global Score As Long 'Public Score_level AS Long Dim Level As Long
Public Gaming as Boolean Public Pulse As Boolean
Public Interval As Long 'Timer Time Diagrams PUBLIC TIMERSET AS Long' Timer
Public Top as long 'The highest layer of record block stacked
Public const Mosttop as long = 5 'The top of the game area, when the block is stacked here, the game ends public const left as long = 5' game area left border public const right as long = 22 'game area left boundary public const middle as long = (Left Right) / 2 'Game Area Middle Line to locate public const s long = 25' game area
Sub main () gaming = false
IF Worksheets.count <2 Then ActiveWorkbook.sheets.add after: = Worksheets (Worksheets.count) Else Worksheets (Worksheets.count) .select end if load userform1 userform1.show end sub
Function game_initial () game initialization function startpos.row = MostTop StartPos.col = middle nextpos.row = MostTop nextpos.col = Right 8 TOP = Bottom - 1 score = 0 Range (Cells (Mosttop 1, Left), Cells (Bottom - 1, Left)). Interior.ColorIndex = 1 Range (Cells (Mosttop 1, Right), Cells (Bottom - 1, Right)). Interior.ColorIndex = 1 Range (Cells (Bottom, Left), Cells (Bottom, Right)). Interior.ColorIndex = 1 Range (Bottom, LEFT), Cells (Bottom, Right)) = "" IF not gaming the celens.columnwidth = 1 Cells.RowHeight = 10 'Initializing the shape Square, I forgot which type of Objs_Array (0, 0) .row = -1 objs_Array (0, 0) .col = -1 Objs_Array (0, 1) .row = 0 objs_Array (0, 1) .col = -1 Objs_Array (0, 2) .ROW = 0 objs_Array (0, 2) .col = 0 objs_Array (0, 3) .row = 1 objs_Array (0, 3) .col = 0 Objs_Array (1, 0 ).Row = 0 objs_Array (1, 0) .col = 0 objs_Array (1, 1) .ROW = 0 objs_Array (1, 1) .col = 1 objs_Array (1, 2) .row = 1 Objs_Array (1, 2 ) .col = 0 Objs_Array (1 , 3 ).Row = 1 objs_Array (1, 3) .col = -1 objs_Array (2, 0) .ROW = -1 Objs_Array (2, 0) .col = -1 Objs_Array (2, 1) .row = 0 Objs_Array (2, 1) .col = -1 Objs_Array (2, 2) .ROW = 0 objs_Array (2, 2) .col = 0 objs_Array (2, 3) .row = 1 objs_Array (2, 3) .col = 0 Objs_Array (3, 0) .Row = 0 objs_Array (3, 0) .col = 0 objs_Array (3, 1) .ROW = 0 objs_Array (3, 1) .col = 1 Objs_Array (3, 2) .row = 1 Objs_Array (3, 2) .col = 0 objs_Array (3, 3) .row = 1 Objs_Array (3, 3) .col = -1 ''
Type 2 objs_Array (4, 0) .ROW = -1 Objs_Array (4, 0) .col = 0 objs_Array (4, 1) .row = 0 Objs_Array (4, 1) .col = 0 Objs_Array (4, 2). Row = 0 objs_Array (4, 2) .col = -1 Objs_Array (4, 3) .row = 1 objs_Array (4, 3) .col = -1 Objs_Array (5, 0) .row = 0 objs_Array (5, 0 ) .col = -1 Objs_Array (5, 1 ).ROW = 0 objs_Array (5, 1) .col = 0 objs_Array (5, 2) .row = 1 objs_Array (5, 2) .col = 0 objs_Array (5, 3) .row = 1 objs_Array (5, 3) .col = 1 objs_Array (6, 0) .ROW = -1 Objs_Array (6, 0) .col = 0 objs_Array (6, 1) .row = 0 Objs_Array (6 , 1) .col = 0 objs_Array (6, 2 ).ROW = 0 objs_Array (6, 2) .col = -1 Objs_Array (6, 3) .row = 1 Objs_Array (6, 3) .col = -1 Objs_Array (7, 0) .ROW = 0 objs_Array (7, 0) .col = -1 Objs_Array (7, 1) .ROW = 0 objs_Array (7, 1) .col = 0 objs_Array (7, 2) .row = 1 Objs_Array (7, 2) .col = 0 objs_Array (7, 3) .row = 1 objs_Array (7, 3) .col = 1 '' Type 3 Objs_Array (8, 0) .row = -1 Objs_Array (8, 0 ) .col = 0 o BJS_Array (8, 1) .row = 0 objs_Array (8, 1) .col = 0 objs_Array (8, 2) .row = 0 objs_Array (8, 2) .col = 1 Objs_Array (8, 3) .row = 1 Objs_Array (8, 3) .col = 0 objs_Array (9, 0) .ROW = -1 Objs_Array (9, 0) .col = 0 objs_Array (9, 1) .row = 0 Objs_Array (9, 1) .col = 0 Objs_Array (9, 2) .row = 0 objs_Array (9, 2) .col = -1 Objs_Array (9, 3) .row = 0 objs_Array (9, 3) .col = 1 Objs_Array (10, 0) .ROW = -1 Objs_Array (10, 0) .col = 0 Objs_Array (10, 1) .ROW = 0 objs_Array (10, 1) .col =
0 Objs_Array (10, 2 ).Row = 0 objs_Array (10, 2) .col = -1 Objs_Array (10, 3) .ROW = 1 Objs_Array (10, 3) .col = 0 objs_Array (11, 0) .row = 0 objs_Array (11, 0) .col = -1 Objs_Array (11, 1) .ROW = 0 objs_Array (11, 1) .col = 0 objs_Array (11, 2) .row = 0 Objs_Array (11, 2). Col = 1 objs_Array (11, 3) .row = 1 objs_Array (11, 3) .col = 0 '' Type 4 Objs_Array (12, 0) .row = 0 Objs_Array (12, 0) .col = 0 Objs_Array (12 , 1 ).ROW = 1 objs_Array (12, 1) .col = 0 objs_Array (12, 2) .row = 2 objs_Array (12, 2) .col = 0 objs_Array (12, 3) .row = 3 objs_Array (12 , 3) .col = 0 objs_Array (13, 0) .row = 0 objs_Array (13, 0) .col = 0 objs_Array (13, 1) .ROW = 0 objs_Array (13, 1) .col = 1 Objs_Array (13 , 2 ).ROW = 0 objs_Array (13, 2) .col = 2 objs_Array (13, 3) .ROW = 0 objs_Array (13, 3) .col = 3 objs_Array (14, 0) .row = 0 objs_Array (14 , 0) .col = 0 objs_Array (14, 1) .row = 1 objs_Array (14, 1) .col = 0 objs_Array (14, 2) .row = 2 Objs_arr AY (14, 2) .col = 0 Objs_Array (14, 3) .ROW = 3 objs_Array (14, 3) .col = 0 objs_Array (15, 0) .row = 0 objs_Array (15, 0) .col = 0 Objs_Array (15, 1) .row = 0 objs_Array (15, 1) .col = 1 objs_Array (15, 2 ).Row = 0 objs_Array (15, 2) .col = 2 objs_Array (15, 3) .row = 0 Objs_Array (15, 3) .col = 3 '' Type 5 Objs_Array (16, 0) .ROW = 0 objs_Array (16, 0) .col = 0 objs_Array (16, 1) .row = 0 objs_Array (16, 1) .col = 1 objs_Array (16, 2 ).ROW = 1 objs_Array (16, 2) .col = 0 objs_Array (16, 3) .ROW =
1 Objs_Array (16, 3) .col = 1 objs_Array (17, 0) .ROW = 0 objs_Array (17, 0) .col = 0 objs_Array (17, 1) .ROW = 0 Objs_Array (17, 1) .col = 1 Objs_Array (17, 2) .row = 1 objs_Array (17, 2) .col = 0 objs_Array (17, 3) .ROW = 1 Objs_Array (17, 3) .col = 1 objs_Array (18, 0) .row = 0 Objs_Array (18, 0) .col = 0 objs_Array (18, 1) .ROW = 0 objs_Array (18, 1) .col = 1 objs_Array (18, 2) .row = 1 Objs_Array (18, 2) .col = 0 Objs_Array (18, 3) .row = 1 objs_Array (18, 3) .col = 1 objs_Array (19, 0) .ROW = 0 objs_Array (19, 0) .col = 0 objs_Array (19, 1) .row = 0 Objs_Array (19, 1) .col = 1 Objs_Array (19, 2 ).ROW = 1 Objs_Array (19, 2) .col = 0 objs_Array (19, 3) .row = 1 Objs_Array (19, 3) .col = 1 '' Type 6 Objs_Array (20, 0) .ROW = -2 Objs_Array (20, 0) .col = 0 Objs_Array (20, 1) .ROW = -1 Objs_Array (20, 1) .col = 0 Objs_Array (20 , 2 ).ROW = 0 objs_Array (20, 2) .col = 0 objs_Array (20, 3) .row = 0 objs_Array (20, 3) .col = 1 Objs _Array (21, 0) .ROW = -1 Objs_Array (21, 0) .col = 0 objs_Array (21, 1) .ROW = 0 objs_Array (21, 1) .col = 0 objs_Array (21, 2) .ROW = 0 Objs_Array (21, 2) .col = -1 Objs_Array (21, 3) .ROW = 0 Objs_Array (21, 3) .col = -2 Objs_Array (22, 0) .Row = 0 Objs_Array (22, 0). COL = -1 Objs_Array (22, 1) .ROW = 0 objs_Array (22, 1) .col = 0 objs_Array (22, 2) .ROW = 1 Objs_Array (22, 2) .col = 0 Objs_Array (22, 3) .row = 2 objs_Array (22, 3) .col = 0 objs_Array (23, 0) .ROW = 0 objs_Array (23, 0) .col =
0 Objs_Array (23, 1) .row = 0 objs_Array (23, 1) .col = 1 Objs_Array (23, 2) .ROW = 0 objs_Array (23, 2) .col = 2 Objs_Array (23, 3) .row = 1 Objs_Array (23, 3) .col = 0 '' Type 7 Objs_Array (24, 0) .ROW = -2 Objs_Array (24, 0) .col = 0 Objs_Array (24, 1) .row = -1 Objs_Array (24 , 1) .col = 0 objs_Array (24, 2 ).ROW = 0 objs_Array (24, 2) .col = 0 objs_Array (24, 3) .ROW = 0 objs_Array (24, 3) .col = -1 Objs_Array ( 25, 0) .ROW = 0 objs_Array (25, 0) .col = -2 Objs_Array (25, 1) .ROW = 0 objs_Array (25, 1) .col = -1 Objs_Array (25, 2) .row = 0 Objs_Array (25, 2) .col = 0 objs_Array (25, 3) .ROW = 1 Objs_Array (25, 3) .col = 0 objs_Array (26, 0) .ROW = 0 Objs_Array (26, 0) .col = 0 Objs_Array (26, 1) .row = 0 objs_Array (26, 1) .col = 1 objs_Array (26, 2) .row = 1 objs_Array (26, 2) .col = 0 objs_Array (26, 3) .row = 2 Objs_Array (26, 3) .col = 0 objs_Array (27, 0) .ROW = -1 Objs_Array (27, 0) .col = 0 Objs_Array (27, 1) .row = 0 Objs _Array (27, 1) .col = 0 objs_Array (27, 2) .ROW = 0 objs_Array (27, 2) .col = 1 objs_Array (27, 3) .row = 0 objs_Array (27, 3) .col = 2 END IF
Randomize nex_obj.typ = Int (7 * Rnd) nex_obj.stat = Int (4 * Rnd) nex_obj.color = Int (8 * Rnd) 3 nex_obj.pos = nextpos cur_obj = nex_obj prv_obj = cur_obj Call obj_draw Randomize cur_obj.typ = INT (7 * rND) CUR_OBJ.STAT = INT (4 * rND) CUR_OBJ.COLOR = INT (8 * RND) 3 cur_obj.pos = startpos pr_obj = cur_obj call obj_draw level = 1000 pulse = false interval = 800 gaming = TrueEnd FunctionPublic Function obj_left () 'game object moves to the left, beyond the left margin required is determined whether Dim i As Long Dim ii As Long Dim nextcol As Long Dim collide As Boolean collide = False nextcol = cur_obj.pos.col - 1 ii = cur_obj .TYP * 4 CUR_OBJ.STAT for i = 0 to 3 IF ((NEXTCOL OBJS_ARRAY (II, I) .col <= left) or cells (cur_obj.pos.row objs_array (II, i) .row, Nextcol OBJS_ARRAY (II, I) .col) = "") THEN COLLIDE = TRUE: EXIT for Next I if (Not Collide) THEN PRV_OBJ = CUR_OBJ CUR_OBJ.POS.COL = NEXTCOL CALL OBJ_DRAW END IFEND FUNCTION
Public Function Obj_right () 'Game object moves to the right, you need to judge whether it exceeds the right border DIM I as long Dim II as Long Dim nextcol as long number nextcol = cur_obj.pos.col 1 II = CUR_OBJ. TYP * 4 CUR_OBJ.STAT for i = 1 to 3 IF ((NEXTCOL OBJS_ARRAY (II, I) .col> = Right) or Cells (CUR_OBJ.POS.ROW OBJS_ARRAY (II, I) .row, NextCol Objs_Array (II, I) .col) = "") THEN COLLIDE = TRUE: EXIT for next i if (not collide) THEN PR_OBJ = CUR_OBJ CUR_OBJ.POS.COL = NEXTCOL CALL OBJ_DRAW End IFEND Function
Public Function obj_change () changes Dim 'aspect of the game object falling i As Long Dim ii As Long Dim iii As Long Dim iiii As Long Dim nextstat As Long Dim nextcol As Long Dim collide As Boolean collide = False nextstat = cur_obj.stat 1 IF (NextStat> = 4) Then nextstat = nextstat mod 4 end if Ii = cur_obj.typ * 4 nextstat nextcol = cur_obj.pos.col if cur_obj.pos.col <= left 3 Then for i = 0 To 3 iii = left 1 - cur_obj.pos.col - objs_array (ii, i) .col if (iii> = 0 and III> iiii) THEN III = III Next I nextcol = nextcol iiii for i = 0 to 3 if Cells Cur_obj.pos.row objs_array (ii, i) .row, Nextcol Objs_Array (II, I) .col) = "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" For i = 0 to 3 III = cur_obj.pos.col objs_array (ii, i) .col - Right 1 IF (iii> = 0 and Iii> IIII) THEN III = III Next I Nextcol = NextCOL - IIII for i = 0 to 3 if cells (cur_obj.pos.row objs_array (ii, i) .row, Nextcol Objs_Array (II, i) .col) = "" "" "" "" "" " I else for i = 0 to 3 if cells (cur_obj.pos.row objs_array (ii, i) .row, Nextcol Objs_Array (ii, i) .col) = "" "" "" "" "" IF if not collide life pr_obj = cur_obj cur_obj.stat = nextstat cur_obj.pos.col = nextcol call obj_draw end ifend function
Function obj_fall () 'game objects falling Dim i As Long Dim ii As Long Dim collide As Boolean Dim j As Long Dim k As Long Dim nextrow As Long collide = False ii = cur_obj.typ * 4 cur_obj.stat nextrow = cur_obj. POS.ROW 1 'Judging whether it falls to the bottom for i = 0 to 3 if (nextrow objs_array (ii, i) .row, cur_obj.pos.col objs_array (ii, i) .col) = "" OR nextrow objs_array (ii, i) .row> = bottom) Then collide = True: Exit For Next i If Not collide Then prv_obj = cur_obj cur_obj.pos.row = nextrow Call obj_draw Else score = score 10 score_level = 0 ii = CUR_OBJ.TYP * 4 CUR_OBJ.STAT for i = 0 to 3 cells (cur_obj.pos.row objs_array (ii, i) .row, cur_obj.pos.col objs_array (ii, i) .col) = "" Next i if cur_obj.pos.row objs_Array (II, 0 ).ROW
IF score_level> 0 THEN DIM L As Long L = Objs_Array (II, 3 ).Row - Objs_Array (II, 0) .row Dim Tmp_Array (3) As long for i = 0 to 3 TMP_Array (i) = 0 Next I ' Move J = CUR_OBJ.POS.ROW OBJS_ARRAY (II, 3 ).Row K = 0 for i = 0 to l if cells (j - I, LEFT 1) = "" "" "THEN RANGE (Cells (J - I, LEFT 1), Cells (J - I, Right - 1)). ClearContents Range (Cells (J - I, Left 1), Cells (J - I, Right - 1)). Interior.Colorindex = 0 else Range (Cells (J - I, Left 1), Cells (J - I, Right - 1)). Cut Destination: = Range (Cells (J - K, Left 1), Cells (J - K, Right - 1)) K = K 1 end if next i l = cur_obj.pos.row objs_Array (II, 0) .row if top
Level kil = interval 800 interval = interval - 150 if interval <50 Ten Interval = 50 End if if Timerset <> 0 Timerset = KillTimer (0, TIMERSET) end if pulse = false end if 'judgment blocks to top, If the next block is not generated, otherwise the game ends if top reinitial: exit function else: Call game_over: exit function end if end ifend functionfunction obj_draw () DIM I as long Dim II as long ii = prV_obj.typ * 4 prV_obj.stat for i = 0 to 3 cells (prV_obj.pos.row objs_array (ii, i) .row, prV_obj.pos.col objs_array (ii, i) .col) .Interior.colorindex = 0 Next I ii = cur_obj.typ * 4 cur_obj.stat for i = 0 to 3 cells (cur_obj.pos.row objs_array (ii, i) .row, cur_obj.pos.col objs_Array (ii, i) .col) .Interior.colorindex = CUR_OBJ.COLOR Next IEND FUNCTION
Function reinitial () If gaming Then prv_obj = nex_obj Randomize nex_obj.typ = Int (7 * Rnd) nex_obj.stat = Int (4 * Rnd) nex_obj.color = Int (8 * Rnd) 3 nex_obj.pos = nextpos cur_obj = NEX_OBJ CALL OBJ_DRAW CUR_OBJ = PrV_OBJ CUR_OBJ.POS = StartPOS PRV_OBJ = CUR_OBJ CALL OBJ_DRAW End IFEND FUNCTION
Function game_over () If timerset <> 0 Then timerset = KillTimer (0, timerset) End If If MsgBox ( "Try it again?", VbOKCancel, "Game over temporarily") = vbOK Then Cells.ClearContents Cells.Interior.ColorIndex = 0 call game_initial else cells.clearcontents cells.interior.COLORINDEX = 0 gaming = false sendkeys "% {f4}" end = {f4} "end =}" End IFEND FUNCTIONPUBLIC SUB PULSE_ () if Gaming The Call Obj_fall End IFEND SUB
The above is the code of the macro section, and the following code is introduced below the form.
Private Sub UserForm_Initialize () Label1.Caption = "NO PLAY, NO GAME" Call game_initial If (gaming) Then Label2.Caption = "Move and change by ARROW keys. Pause the game by P and end it by E" Else Label2.Caption = "Something happened. It Needs to do something" call game_over end ifend sub
Private Sub UserForm_KeyDown (ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If gaming Then If Not pulse Then pulse = True timerset = SetTimer (0, 0, interval, AddressOf pulse_) Label2.Caption = "Move and change by ARROW keys . pause the game by P and end it by E "End If Select Case KeyCode Case vbKeyLeft Call obj_left Case vbKeyRight Call obj_right Case vbKeyUp Call obj_change Case vbKeyDown Call obj_fall Case vbKeyP 'destruction timer, pause the game If timerset <> 0 Then timerset = KillTimer (0, Timerset) pulse = false end if label2.caption = "Game paused.you can result by any key" case vbkeye call game_over end select end if End su Bprivate Sub Userform_Terminate () MSGBox ("You Have Complete The Game with The Score Of" Str (Score)) Worksheets (1) .SelectensEnd Sub is issued again, I forgot to have seven seven eight eight.
