Seneste forumindlæg
Køb / Salg
 * Uofficiel Black/White liste V3
Login / opret bruger

Forum \ Programmering og webdesign \ Programmering

Flappy Birds i EXCEL.

Af Nørd GrillBiller | 19-06-2024 13:47 | 1230 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"
#1
the688
Guru
19-06-2024 16:36

Rapporter til Admin
En Excel-licens koster mere end spillet... just saying :)
--
"ORK SATME!"
#2
SteffE
Semi Nørd
19-06-2024 18:16

Rapporter til Admin
Det er alligevel ret cool. Gad vide om doom bliver det næste ??
--
#3
Frøsnapperen
Ny på siden
19-06-2024 19:17

Rapporter til Admin
#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!
#4
GrillBiller
Nørd
20-06-2024 08:02

Rapporter til Admin
->#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"
#5
the688
Guru
20-06-2024 08:33

Rapporter til Admin
#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!"

Opret svar til indlægget: Flappy Birds i EXCEL.

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
NYHEDSBREV
Afstemning