我一直在为我的游戏开发课程制作游戏，但由于大学的局限性，我们必须使用Visual Basic创建游戏而不使用插件，所以我只能使用GDI +。
我遇到了一个错误，它将耗尽内存并且游戏停止运行，错误在第312行 - “_backBufferGr.DrawImage（_backbuffer，0,0，_resWidth，_resHeight）”
我认为这可能是由于产生的图像没有被清除但我不确定，因为我只编码了大约3个月。如果有人可以提供帮助，那将非常感激。我附上了以下代码 - 这些类在我的项目中位于单独的文件中。
以下是我的错误图片：
和文字：
System.OutOfMemory: Out of memory.
at System.Drawing.Graphics.CheckErrorStatus(Int32 Status)
at System.Drawing.Graphics.DrawImage(Image image, Int32 x, Int32 y, Int32 Width, Int32 height)
at SpaceInvaders.Spaceinvaders.DrawGraphics()
Imports System.Drawing.Imaging
Imports System.IO
Public Class Spaceinvaders
'Star Generation Variables
ReadOnly _random As New Random
Private ReadOnly _r As New Random
Private ReadOnly _stars As New List(Of Point)
'Sound Variabless
Public Shared Intsound As Integer = 0
Public Shared Snd As New Sounds
'Graphics varibles
Dim _backbuffer As Bitmap
Dim _backBufferGr As Graphics
Public Shared Gr As Graphics
Shared _sourceRec As Rectangle
'View Port Variables
Dim _resWidth As Int16 = 700
Dim _resHeight As Int16 = 650
Dim _paused As Boolean = False
Dim _pauseNum As Int16 = 0
Dim _pausedText As Int16 = 40
Dim _mouseX, _mouseY As Int16
'Key Detection
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Int16) As Int16
Public Function GetKeyState(ByVal key1 As Int16) As Boolean
Dim s As Int16
s = GetAsyncKeyState(key1)
If s = 0 Then Return False
Return True
End Function
'Character Variables
Dim _bmpPlayer As Bitmap
Public Shared PlayerW, PlayerH As Int16
Public Shared XPos As Int16 = 0
Public Shared YPos As Int16 = 0
Dim _movementSpeed As Int16 = 8
Dim _moveDir As Int16 = 0
Dim _lastDir As Int16 = 0
'Fire Variables
Dim _fire As Boolean
Dim _bulletArray(100000) As Bullet
Dim _bulletNum As Int16 = 0
Dim _cooldown As Int16
Public Shared Points As Int32 = 0
Public Shared EnemiesKilled As Int16 = 0
Public Shared ExploArray(100000) As Explo
Public Shared ExploNum As Int16 = 0
'Enemy Variables
Dim _spawnNum As Int16
Public Shared EnemyArray(100000) As Enemies
Public Shared EnemyNum As Int16 = 0
Public Shared Lives As Int16 = 3
Dim SpawnSpd As Int16 = 30
'Other Variables
Dim _isRunning As Boolean = True
Public Shared CollitionDetc As New StreamWriter(Application.StartupPath() & "\" & "Detection" & ".Log")
Public Function FadeInImage(ByVal bmp As Bitmap, ByVal opacity As Single) As Bitmap
Dim bmp2 As New Bitmap(bmp.Width, bmp.Height, PixelFormat.Format32bppArgb)
opacity = Math.Max(0, Math.Min(opacity, 1.0F))
Using ia As New ImageAttributes
Dim cm As New ColorMatrix
cm.Matrix33 = opacity
ia.SetColorMatrix(cm)
Dim destpoints() As PointF = {New Point(0, 0), New Point(bmp.Width, 0), New Point(0, bmp.Height)}
Using g As Graphics = Graphics.FromImage(bmp2)
g.DrawImage(bmp, destpoints, New RectangleF(Point.Empty, bmp.Size), GraphicsUnit.Pixel, ia)
End Using
End Using
Return bmp2
End Function
'Form Events
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Show()
Focus()
'Create Stars - 300 is the Number of Stars
CreateStarField(300)
'Start Music
Intsound += 1
With Snd
.Name = "Sound" & Intsound
.PlaySound(1, True)
End With
'This creates the graphics and the backbuffer, along with drawing the player to the screen
Gr = CreateGraphics()
_backbuffer = New Bitmap(_resWidth, _resHeight)
_bmpPlayer = New Bitmap(My.Resources.Ship)
XPos = (Width / 2)
YPos = 500
Gr.DrawImage(_bmpPlayer, XPos, YPos, _sourceRec, GraphicsUnit.Pixel)
StartGameLoop()
End Sub
Private Sub Spaceinvaders_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Do Until Intsound = 0
Snd.Kill("Sound" & Intsound)
Intsound -= 1
Loop
Dispose()
End
End Sub
Private Sub Spaceinvaders_MouseMove(sender As Object, e As MouseEventArgs) Handles MyBase.MouseMove
_mouseX = e.X
_mouseY = e.Y
End Sub
Private Sub Spaceinvaders_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
If (290 + 110 < _mouseX Or _mouseX < 290 Or 336 + 63 < _mouseY Or _mouseY < 336) Then
Else
_paused = False
End If
End Sub
'Starfield Background Generation
Private Sub CreateStarField(numStars As Integer)
_stars.Clear()
For i = 1 To numStars
_stars.Add(New Point(_r.Next(0, Width), _r.Next(0, Height)))
Next
End Sub
'Runs the actual game over and over again until it is stopped
Sub StartGameLoop()
Do While _isRunning = True
Application.DoEvents()
LivesCheck()
SetMoveDir()
MovePlayer(_moveDir)
'Start the drawing events & FPS Counter
DrawGraphics()
Loop
Do While _isRunning = False
Application.DoEvents()
Loop
End Sub
'Subs to do with player creation and movement
Private Sub GetPlayer(ByVal dir As Int16)
Select Case dir
Case 1 'Upfacing Direction
_bmpPlayer = New Bitmap(My.Resources.Ship)
_sourceRec = New Rectangle(0, 0, 85, 50)
PlayerH = 50
PlayerW = 85
Case 2 'Downfacing Direction
_bmpPlayer = New Bitmap(My.Resources.Ship)
_sourceRec = New Rectangle(0, 0, 85, 50)
PlayerH = 50
PlayerW = 85
Case 3 'Left Facing Direction
_bmpPlayer = New Bitmap(My.Resources.ShipLeft)
_sourceRec = New Rectangle(0, 0, 96, 76)
PlayerH = 76
PlayerW = 96
Case 4 'Right Facing Direction
_bmpPlayer = New Bitmap(My.Resources.ShipRight)
_sourceRec = New Rectangle(0, 0, 96, 76)
PlayerH = 76
PlayerW = 96
End Select
End Sub
Sub SetMoveDir()
If GetKeyState(Keys.W) = True Then _moveDir = 1
If GetKeyState(Keys.A) = True Then _moveDir = 3
If GetKeyState(Keys.S) = True Then _moveDir = 2
If GetKeyState(Keys.D) = True Then _moveDir = 4
If GetKeyState(Keys.Space) = True Then _fire = True
If GetKeyState(Keys.P) = True Then
If _pauseNum = 0 Then
_paused = True
_pauseNum = 1
ElseIf _pauseNum = 1 Then
_paused = False
_pauseNum = 0
End If
End If
If GetKeyState(Keys.W) = False And
GetKeyState(Keys.A) = False And
GetKeyState(Keys.S) = False And
GetKeyState(Keys.D) = False Then
_moveDir = 0
End If
If _moveDir <> 0 Then _lastDir = _moveDir
End Sub
Private Sub MovePlayer(ByVal dir As Int16)
Select Case dir
Case 1
If YPos <= 0 Then
Else
YPos -= _movementSpeed
End If
Case 2
If YPos >= 544 Then
Else
YPos += _movementSpeed
End If
Case 3
If XPos <= -2 Then
Else
XPos -= _movementSpeed
End If
Case 4
If XPos >= 606 Then
Else
XPos += _movementSpeed
End If
End Select
End Sub
'Draw the stuff to the screen
Sub DrawGraphics()
If _paused = True Then
Gr.DrawString("Paused", New Font("Verdana", _pausedText), New SolidBrush(Color.White), New Point(235, 256))
If (290 + 110 < _mouseX Or _mouseX < 290 Or 336 + 63 < _mouseY Or _mouseY < 336) Then
Gr.DrawString("Play", New Font("Verdana", 25), New SolidBrush(Color.White), New Point(290, 336))
Else
Gr.DrawString("Play", New Font("Verdana", 25), New SolidBrush(Color.Red), New Point(290, 336))
End If
'Copy BackBuffer To Graphics Object
Gr = Graphics.FromImage(_backbuffer)
'Draw BackBuffer to the screen
Try
_backBufferGr = CreateGraphics()
_backBufferGr.DrawImage(_backbuffer, 0, 0, _resWidth, _resHeight)
Catch ex As Exception
MsgBox(ex)
_isRunning = False
Exit Sub
End Try
Gr.Clear(Color.Black)
'Runs when the game is unpaused
ElseIf _paused = False Then
Gr.Clear(Color.Black)
'Draws Stars to the screen
DrawStars()
'Draws Enemies to the screen
EnemyDraw()
'Draws bullets to the screen
BulletDraw()
'Draws Explosions
Expslostion()
'Draw the player
DrawPlayer()
'Draws lives to the screen
DrawHUD()
'Copy BackBuffer To Graphics Object
Gr = Graphics.FromImage(_backbuffer)
'Draw BackBuffer to the screen
Try
_backBufferGr = CreateGraphics()
_backBufferGr.DrawImage(_backbuffer, 0, 0, _resWidth, _resHeight)
Catch ex As Exception
MsgBox("ERROR: " & vbCrLf & ex.ToString)
_isRunning = False
Exit Sub
End Try
Gr.Clear(Color.Black)
GC.Collect()
_fire = False
WriteLog()
End If
End Sub
Sub BulletDraw()
If _bulletNum = 0 Then
_bulletNum = 0
Else
For i = 1 To _bulletNum
_bulletArray(i).Move(i)
Next
End If
If _cooldown < 2 Then
_cooldown += 1
Else : If _fire = True Then
_bulletNum += 1
_bulletArray(_bulletNum) = New Bullet
_bulletArray(_bulletNum).Spawn(_bulletNum, 4)
_cooldown = 0
End If : End If
End Sub
Sub EnemyDraw()
If EnemyNum = 0 Then
EnemyNum = 0
Else
For i = 1 To EnemyNum
EnemyArray(i).Move()
Next
End If
If _spawnNum < SpawnSpd Then
_spawnNum += 1
Else
Points += 5
EnemyNum += 1
EnemyArray(EnemyNum) = New Enemies
EnemyArray(EnemyNum).Spawn()
_spawnNum = 0
End If
End Sub
Sub Expslostion()
If ExploNum = 0 Then
ExploNum = 0
Else
For i = 1 To ExploNum
ExploArray(i).Animation()
Next
End If
End Sub
Sub DrawStars()
For Each pt As Point In _stars 'Loops until all the stars are added to the form background
Dim num = _random.Next(1, 6) 'Randomly Picks a number
Dim numSize = _random.Next(1, 3)
If num = 1 Then 'Picks a colour based on the number picked
Gr.FillEllipse(Brushes.White, New Rectangle(pt, New Size(numSize, numSize)))
ElseIf num = 2 Then
Gr.FillEllipse(Brushes.Blue, New Rectangle(pt, New Size(numSize, numSize)))
ElseIf num = 3 Then
Gr.FillEllipse(Brushes.DimGray, New Rectangle(pt, New Size(numSize, numSize)))
ElseIf num = 4 Then
Gr.FillEllipse(Brushes.DarkOrange, New Rectangle(pt, New Size(numSize, numSize)))
ElseIf num = 5 Then
Gr.FillEllipse(Brushes.Red, New Rectangle(pt, New Size(numSize, numSize)))
End If
Next
End Sub
Sub DrawPlayer()
If _moveDir = 0 Then
_bmpPlayer = New Bitmap(My.Resources.Ship)
Else
GetPlayer(_lastDir)
End If
_bmpPlayer.MakeTransparent(Color.Fuchsia)
Gr.DrawImage(_bmpPlayer, XPos, YPos, _sourceRec, GraphicsUnit.Pixel)
End Sub
Sub DrawHUD()
Select Case Lives
Case 3
Gr.FillRectangle(Brushes.Red, 510, 5, 150, 10)
Case 2
Gr.FillRectangle(Brushes.Red, 510, 5, 100, 10)
Case 1
Gr.FillRectangle(Brushes.Red, 510, 5, 50, 10)
End Select
Gr.DrawString("Ships Destroyed: " & EnemiesKilled, New Font("Verdana", 10), New SolidBrush(Color.White), New Point(5, 5))
Gr.DrawString("Score: " & Points, New Font("Verdana", 10), New SolidBrush(Color.White), New Point(5, 20))
End Sub
Sub WriteLog()
Dim sw As New StreamWriter(Application.StartupPath() & "\" & "Variables" & ".Log")
sw.WriteLine("--------Variables Log--------")
sw.WriteLine("")
sw.WriteLine("Sounds Playing: " & Intsound)
sw.WriteLine("")
sw.WriteLine("Window Resolution: " & _resWidth & " " & _resHeight)
sw.WriteLine("Game Running: " & _isRunning)
sw.WriteLine("")
sw.WriteLine("Player Postion: " & XPos & " " & YPos)
sw.WriteLine("Player Size: " & PlayerW & " " & PlayerH)
sw.WriteLine("Player Movement Speed: " & _movementSpeed)
sw.WriteLine("PLayer Last Direction: " & _lastDir)
sw.WriteLine("")
sw.WriteLine("Bullets Being Fired?: " & _fire)
sw.WriteLine("Number Of bullets spawned: " & _bulletNum)
sw.WriteLine("")
sw.WriteLine("Number of enemies spawned: " & EnemyNum)
sw.WriteLine()
sw.WriteLine("--------Bullet Variables--------")
sw.WriteLine("Bullet Number X Y")
For i = 1 To _bulletNum
sw.WriteLine(i & " " & _bulletArray(i).X & " " & _bulletArray(i).Y)
Next
sw.WriteLine("--------Enemy Variables--------")
sw.WriteLine("Enemy Number X Y")
For i = 1 To EnemyNum
sw.WriteLine(i & " " & EnemyArray(i).X & " " & EnemyArray(i).Y)
Next
sw.Close()
sw.Dispose()
End Sub
Sub LivesCheck()
If Lives = 0 Then
_isRunning = False
Gameover.Show()
End If
End Sub
End Class
Public Class Bullet
Dim _bulletX, _bulletY As Int16
Dim _bmpBullet As Bitmap = My.Resources.bullet1
Dim _bulletRec As New Rectangle
Dim _bulletSpd As Int16 = 4
Dim _enemyNum As Int16
Dim _active As Boolean = True
Function X()
Return _bulletX
End Function
Function Y()
Return _bulletY
End Function
Sub Spawn(ByVal i As Int16, ByVal s As Int16)
Spaceinvaders.Intsound += 1
With Spaceinvaders.Snd
.Name = "Sound" & Spaceinvaders.Intsound
.PlaySound(2, False)
End With
_bulletSpd = s
_bulletX = Spaceinvaders.XPos + (Spaceinvaders.PlayerW / 2)
_bulletY = Spaceinvaders.YPos + (Spaceinvaders.PlayerH / 2)
_bmpBullet = My.Resources.bullet1
_bmpBullet.MakeTransparent(Color.Fuchsia)
Spaceinvaders.Gr.DrawImage(_bmpBullet, _bulletX, _bulletY, _bulletRec, GraphicsUnit.Pixel)
End Sub
Sub Move(ByVal bulletNum As Int16)
If _active = False Then
Me.Finalize()
Else
_enemyNum = Spaceinvaders.EnemyNum
For i = 1 To _enemyNum
Dim EnemyRect As Rectangle
EnemyRect = Spaceinvaders.EnemyArray(i).Rectangle
If (_bulletRec.IntersectsWith(EnemyRect)) Then
If Spaceinvaders.EnemyArray(i).Invc >= 40 Then
Spaceinvaders.EnemyArray(i).Kill(-10, -10)
_active = False
Spaceinvaders.Points += 500
Spaceinvaders.CollitionDetc.WriteLine("Enemy Num: " & i & " & " & "Bullet Num: " & bulletNum & " - HIT")
_bulletX = -100
_bulletY = -100
_bulletRec = New Rectangle(-100, 100, 1, 1)
Spaceinvaders.Intsound += 1
With Spaceinvaders.Snd
.Name = "Sound" & Spaceinvaders.Intsound
.PlaySound(3, False)
End With
Dim enemyX, enemyY As Int16
enemyX = Spaceinvaders.EnemyArray(i).X
enemyY = Spaceinvaders.EnemyArray(i).Y
Spaceinvaders.ExploNum += 1
Spaceinvaders.ExploArray(Spaceinvaders.ExploNum) = New Explo()
Spaceinvaders.ExploArray(Spaceinvaders.ExploNum).Spawn(enemyX, enemyY)
Me.Finalize()
End If
End If
Next
If _bulletY <= 0 Then
_bulletX = -100
_bulletY = -100
Else
_bulletY -= _bulletSpd
_bmpBullet.MakeTransparent(Color.Fuchsia)
Spaceinvaders.Gr.DrawImage(_bmpBullet, _bulletX, _bulletY)
_bulletRec = New Rectangle(_bulletX, _bulletY, 16, 16)
End If
End If
End Sub
End Class
Public Class Enemies
Dim _enemyX, _enemyY As Int16
Dim _bmpEnemy As Bitmap = My.Resources.InvaderSkullWhite
Dim _moveNum As Int16 = 0
Dim _active As Boolean = True
Dim _tempInvc As Int16 = 0
Dim EnemyRect As Rectangle
Function X()
Return _enemyX
End Function
Function Y()
Return _enemyY
End Function
Function Kill(ByVal x, ByVal y)
_enemyX = x
_enemyY = y
_active = False
EnemyRect = New Rectangle(x, y, 1, 1)
Me.Finalize()
End Function
Function Invc()
Return _tempInvc
End Function
Function Rectangle()
Return EnemyRect
End Function
Sub Spawn()
Dim rand As New Random
_enemyY = 3
_enemyX = rand.Next(10, 600)
Select Case rand.Next(1, 5)
Case 1
_bmpEnemy = My.Resources.InvaderSkullWhite
Case 2
_bmpEnemy = My.Resources.InvaderSkullRed
Case 3
_bmpEnemy = My.Resources.InvaderSkullGreen
Case 4
_bmpEnemy = My.Resources.InvaderSkullYellow
End Select
_bmpEnemy.MakeTransparent(Color.Fuchsia)
Spaceinvaders.Gr.DrawImage(_bmpEnemy, _enemyX, _enemyY)
Move()
End Sub
Sub Move()
If _active = False Then
Me.Finalize()
Else
If _tempInvc < 40 Then
_tempInvc += 1
End If
If _moveNum < 10 Then
_moveNum += 1
_bmpEnemy.MakeTransparent(Color.Fuchsia)
Spaceinvaders.Gr.DrawImage(_bmpEnemy, _enemyX, _enemyY)
Else
If _enemyY >= 700 Then
Spaceinvaders.Lives -= 1
_enemyX = -5
_enemyY = -5
Else
Dim randX As New Random
_enemyY += 5
Select Case _enemyX
Case _enemyX <= 5
_enemyX = _enemyX + randX.Next(1, 4)
Case _enemyX >= 600
_enemyX = _enemyX + randX.Next(-4, -1)
Case Else
_enemyX = _enemyX + randX.Next(-4, 4)
End Select
_bmpEnemy.MakeTransparent(Color.Fuchsia)
Spaceinvaders.Gr.DrawImage(_bmpEnemy, _enemyX, _enemyY)
EnemyRect = New Rectangle(_enemyX, _enemyY, 64, 64)
End If
_moveNum = 0
End If
End If
End Sub
End Class
Public Class Sounds
Public Declare Function MciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Dim _appPath As String = Application.StartupPath()
Private _oName As String = Nothing
Public Property Name As String
Set(value As String)
_oName = value
End Set
Get
Return _oName
End Get
End Property
Public Sub PlaySound(ByVal id As Integer, ByVal repeat As Boolean, Optional vol As Integer = 35)
If repeat = True Then
MciSendString("Open " & GetFile(id) & " alias " & _oName, 0, 0, 0)
MciSendString("Play " & _oName & " repeat", CStr(0), 0, 0)
Else
MciSendString("Open " & GetFile(id) & " alias " & _oName, CStr(0), 0, 0)
MciSendString("Play " & _oName, CStr(0), 0, 0)
End If
'Set Vol
MciSendString("Open " & GetFile(id) & " alias " & _oName, CStr(0), 0, 0)
MciSendString("setaudio " & _oName & " volume to " & vol, CStr(0), 0, 0)
End Sub
Private Function GetFile(ByVal id As Integer) As String
Dim path As String = ""
'Here is where you put the sound paths so that your game can play sounds
Select Case id
Case 0 'Menu Background Music
path = _appPath & "\Audio\Menu.mp3"
Case 1 'Ingame Background Music
path = _appPath & "\Audio\InGame.mp3"
Case 2 'Fire Spund
path = _appPath & "\Audio\Lazer.mp3"
Case 3 'Expolsion sound
path = _appPath & "\Audio\Expolsion.mp3"
End Select
path = Chr(34) & path & Chr(34)
Return path
End Function
Public Sub Kill(ByVal song As String)
MciSendString("close " & song, CStr(0), 0, 0)
_oName = Nothing
End Sub
End Class
答案 0 :(得分：1)
每当你完成一个在几乎所有情况下实现IDisposable的对象时你都应该调用它（在这个答案的范围之外有例外）。注意，A＆＃34;使用＆＃34;语句总是在完成后调用Dispose（所以你在那个方面调用正在使用的图形调用就好了。）
我发现潜在问题的地方是您使用全班变量并将新的位图重置到其上的位置（我不认为旧的位图会被处理掉结果我认为他们会在那里闲逛并慢慢消耗你的记忆。）
_bmpPlayer = New Bitmap(My.Resources.Ship)
看看这样的事情是否有帮助：
If _bmpPlayer IsNot Nothing Then
_bmpPlayer.Dispose()
End If
_bmpPlayer = new Bitmap(My.Resources.Ship)
也就是说，如果你一遍又一遍地使用这些相同的图像，我可能会存储它们并重新使用它们，而不是每次都从资源中重写一个新的Bitmap。
答案 1 :(得分：0)
感谢大家试图帮我解决问题。我通过更改这段代码修复了内存不足错误：
If _bulletNum = 0 Then
_bulletNum = 0
Else
For i = 1 To _bulletNum
_bulletArray(i).Move(i)
Next
End If
对此：
If _bulletNum = 0 Then
_bulletNum = 0
Else
Dim skipbullet As Int16
skipbullet = _bulletNum - 50
If skipbullet >= 1 Then
For i = skipbullet To _bulletNum
_bulletArray(i).Move(i)
Next
For i = 1 To skipbullet
_bulletArray(i).Kill()
Next
Else
For i = 1 To _bulletNum
_bulletArray(i).Move(i)
Next
End If
End If