Flappy Birds i EXCEL.Af Nørd GrillBiller | 19-06-2024 13:47 | 965 visninger | 5 svar, hop til senesteÅben Excel, Tryk ALT F11
insæt en model.
Phase denne kode ind.
Option Explicit
Dim birdRow As Integer
Dim birdCol As Integer
Dim birdDirection As Integer
Dim birdHeight As Integer
Dim gameRunning As Boolean
Dim score As Integer
Dim obstacleCols() As Integer
Sub InitializeGame()
Dim i As Integer
' Ensure Sheet2 exists and has correct headers
If Not SheetExists("Sheet2") Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Sheet2"
End If
With Sheets("Sheet2")
.Cells(1, 1).Value = "Windows Username"
.Cells(1, 2).Value = "Score"
.Cells(1, 3).Value = "Time and Date"
End With
birdRow = 10
birdCol = 5
birdHeight = 10
birdDirection = 0
gameRunning = True
score = 0
' Initialize obstacles
ReDim obstacleCols(1 To 3)
For i = 1 To 3
obstacleCols(i) = 25 + (i - 1) * 10
Next i
' Set up the game board
Range("A1:Z20").Interior.ColorIndex = 0
MainGameLoop
End Sub
Sub MainGameLoop()
Dim i As Integer
Dim obstacle As Integer
Dim obstacleHeight As Integer
Do While gameRunning
' Clear the board
Range("A1:Z20").Interior.ColorIndex = 0
' Move obstacles
For i = 1 To UBound(obstacleCols)
obstacleCols(i) = obstacleCols(i) - 1
If obstacleCols(i) < 1 Then
obstacleCols(i) = 25
score = score + 1
End If
Next i
' Draw obstacles
For i = 1 To UBound(obstacleCols)
obstacle = obstacleCols(i)
obstacleHeight = WorksheetFunction.RandBetween(1, 15)
Range(Cells(1, obstacle), Cells(obstacleHeight, obstacle)).Interior.ColorIndex = 3
Range(Cells(obstacleHeight + 5, obstacle), Cells(20, obstacle)).Interior.ColorIndex = 3
Next i
' Apply gravity to bird
birdHeight = birdHeight + birdDirection
If birdDirection < 1 Then birdDirection = birdDirection + 1
' Check for collisions
If birdHeight < 1 Or birdHeight > 20 Then
GameOver
Exit Do
End If
For i = 1 To UBound(obstacleCols)
If obstacleCols(i) = birdCol Then
If birdHeight <= obstacleHeight Or birdHeight >= obstacleHeight + 5 Then
GameOver
Exit Do
End If
End If
Next i
' Draw bird
Cells(birdHeight, birdCol).Interior.ColorIndex = 6
' Update the screen
DoEvents
Delay (0.2)
Loop
End Sub
Sub FlapBird()
birdDirection = -2
End Sub
Sub GameOver()
gameRunning = False
' Get the username and current time
Dim userName As String
Dim currentTime As String
userName = Environ("Username")
currentTime = Now()
' Find the next empty row in Sheet2
Dim nextRow As Long
nextRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
' Write the score to Sheet2
With Sheets("Sheet2")
.Cells(nextRow, 1).Value = userName
.Cells(nextRow, 2).Value = score
.Cells(nextRow, 3).Value = currentTime
End With
MsgBox "Game Over! Your score is: " & score
End Sub
Sub Delay(seconds As Single)
Dim start As Single
start = Timer
Do While Timer < start + seconds
DoEvents
Loop
End Sub
Function SheetExists(sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
SheetExists = Not ws Is Nothing
On Error GoTo 0
End Function
lav en knap der hedder "Flip" og en "Start"
og match Flip med modulet: sub FlapBird
og Start med modulet: SUB InitializeGame
--
"Signatur fjernet af moderator i samarbejde med Dalai Lama, Anders Fogh, Bill Gates, Marilyn Manson og Michael Moore"
En Excel-licens koster mere end spillet... just saying :)
--
"ORK SATME!" Det er alligevel ret cool. Gad vide om doom bliver det næste ??
--
#1 I og med at spillet er gratis så ja men 0.26euro for en Excel licens... just saying
https://www.allkeyshop.com[...]
--
Retur til moderation efter personlige præferencer - I love it also! ->#2
Hver så god...
' Create a new Module and paste the following code' Constants for the grid size
Const GRID_WIDTH As Integer = 10
Const GRID_HEIGHT As Integer = 10
' Define the map as a 2D array (1 = wall, 0 = empty space)
Dim map(GRID_WIDTH, GRID_HEIGHT) As Integer
' Player's starting position and direction
Dim playerX As Double
Dim playerY As Double
Dim playerDir As Double
Sub InitializeGame()
' Initialize the map
Dim x As Integer, y As Integer
For x = 0 To GRID_WIDTH
For y = 0 To GRID_HEIGHT
If x = 0 Or y = 0 Or x = GRID_WIDTH Or y = GRID_HEIGHT Then
map(x, y) = 1 ' Create border walls
Else
map(x, y) = 0 ' Empty space
End If
Next y
Next x
' Set player's start position and direction
playerX = 1.5
playerY = 1.5
playerDir = 0 ' Facing right (0 degrees)
' Draw the initial view
DrawView
End Sub
' Subroutine to draw the player's view
Sub DrawView()
' Clear previous drawing
Worksheets("Sheet1").Cells.Clear
Dim x As Integer, y As Integer
For x = 1 To GRID_WIDTH
For y = 1 To GRID_HEIGHT
If map(x, y) = 1 Then
Worksheets("Sheet1").Cells(y, x).Interior.Color = RGB(0, 0, 0) ' Black for walls
Else
Worksheets("Sheet1").Cells(y, x).Interior.Color = RGB(255, 255, 255) ' White for empty space
End If
Next y
Next x
' Draw the player
Worksheets("Sheet1").Cells(Int(playerY), Int(playerX)).Interior.Color = RGB(255, 0, 0) ' Red for player
End Sub
' Subroutine to handle key presses
Sub KeyPressHandler(KeyCode As Integer)
Select Case KeyCode
Case vbKeyUp
MovePlayer 0.1
Case vbKeyDown
MovePlayer -0.1
Case vbKeyLeft
playerDir = (playerDir - 15) Mod 360
Case vbKeyRight
playerDir = (playerDir + 15) Mod 360
End Select
DrawView
End Sub
' Function to move the player
Sub MovePlayer(distance As Double)
Dim newX As Double, newY As Double
newX = playerX + distance * Cos(playerDir * Application.WorksheetFunction.Pi() / 180)
newY = playerY + distance * Sin(playerDir * Application.WorksheetFunction.Pi() / 180)
If map(Int(newX), Int(newY)) = 0 Then ' Check for collision with walls
playerX = newX
playerY = newY
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' Capture arrow key movements
If Not Intersect(Target, Me.Cells(1, 1)) Is Nothing Then
KeyPressHandler Target.Application.Selection.Value
End If
End Sub
indsæt denne i Denne Ark:
Private Sub Workbook_Open() InitializeGame
End Sub
Profit :D
--
"Signatur fjernet af moderator i samarbejde med Dalai Lama, Anders Fogh, Bill Gates, Marilyn Manson og Michael Moore" #3 - det er måske ikke helt fair at sammenligne priser med organiseret kriminalitet.
Jeg kunne jo også gå ned i en dyrehandler, stjæle nogle papegøjer, og begynde at kyle rundt med dem :)
--
"ORK SATME!"
Grundet øget spam aktivitet fra gæstebrugere, er det desværre ikke længere muligt, at oprette svar som gæst.
Hvis du ønsker at deltage i debatten, skal du oprette en brugerprofil.
Opret bruger | Login
|
Du skal være logget ind for at tilmelde dig nyhedsbrev.
Hvilken udbyder har du til internet? 380 personer har stemt - Mit energiselskab (Ewii f.eks) 12%
|