创建一个列表(位图)绘制一个列表(字符串)

Question

我有一个餐厅名称列表，我需要将这些字符串绘制到位图中。
我创建位图，绘制文本，但如果我不保存位图，然后将保存的文件加载到位图中，然后将其添加到列表中，则位图无效。
这是我的代码，为了简洁，我编辑了许多名字，我希望有人能解释为什么以及如何我可以避免保存到磁盘:

Option Strict On
Imports System.IO
Public Class Form1
Private R As New Random
Private Places As New List(Of String)
Private Images As New List(Of Bitmap)
Private TheFont As Font = New Font("Engravers MT", 18)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
PictureBox1.Visible = False
Using g As Graphics = Me.CreateGraphics
For Each S As String In Places ' List of Restaurant Names
Dim SF As SizeF = g.MeasureString(S, TheFont)
TextBox1.AppendText(S & " = " & SF.Width & ", " & SF.Height & vbNewLine)
PictureBox1.Size = New Size(CInt(SF.Width), CInt(SF.Height))
Using BM As Bitmap = New Bitmap(PictureBox1.Width, PictureBox1.Height)
Using gg As Graphics = Graphics.FromImage(BM)
gg.Clear(Color.White)
gg.DrawString(S, TheFont, Brushes.Black, 0, 0)
gg.Flush()
End Using
'Code that WORKS
BM.Save("D:AAAAAA" & S & ".jpg", Imaging.ImageFormat.Jpeg) '*************************
Images.Add(CType(Image.FromFile("D:AAAAAA" & S & ".jpg"), Bitmap)) '********************************
''The code above DOES WORK
'The code below DOES NOT WORK, using only one of the two at a time
'Images.Add(CType(BM, Bitmap)) '************************************
'Images.Add(BM) '************************************
'Code that DOES NOT WORK
End Using
Next
End Using
Stop ' for debugging
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
PictureBox1.Visible = True
Dim Index As Integer = R.Next(0, Images.Count)
Dim B As Bitmap = Images(Index)            ' was .Clone
PictureBox1.Width = B.Width
PictureBox1.Height = B.Height
PictureBox1.Image = B
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Places.Add("Arby's")
Places.Add("Baja Fresh Mexican Grill")
Places.Add("Black Bear Diner")
Places.Add("Burger King")
Places.Add("Carl's Jr.")
Places.Add("Chick-fil-A")
End Sub
End Class

Answer 1

您遇到的问题是由Using块隐式调用您创建的Bitmap对象上的Dispose()引起的。
当您创建位图对象并将其添加到List(Of Bitmap)时，您实际上添加了对位图对象的引用。列表不包含对象，只包含引用。

因为你需要保留那些位图，所以不要处理它们。当您声明一个新的位图时，只需删除Using语句。

我已经改变了一些字段/变量的名称，以遵循基本命名约定。

还增加了[Graphics].TextRenderingHint = TextRenderingHint.AntiAliasGridFit执行文本的抗锯齿渲染。看看你使用其他TextRenderingHint设置作为AntiAlias或ClearTypeGridFit(<=在控件表面上绘制时)和[Graphics]有什么其他效果。TextContrast财产。

Private textImages As New List(Of Bitmap)
Private bitmapFont As Font = New Font("Engravers MT", 18)
' [...]

' [... loop the collection of strings]
Using g As Graphics = CreateGraphics()
Dim textSize As Size = Size.Round(g.MeasureString(s, bitmapFont))
Dim bmp As Bitmap = New Bitmap(textSize.Width, textSize.Height)
Using bg As Graphics = Graphics.FromImage(bmp)
bg.Clear(Color.White)
bg.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
bg.DrawString(s, bitmapFont, Brushes.Black, 0, 0)
textImages.Add(bmp)
End Using
End Using

但是，当您不再需要这些对象时，处理bitmap(以及引用非托管资源的任何其他对象，如Font对象)是很重要的。
例如，由于您使用的是表单，您可以在表单关闭时处置这些对象:

Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
bitmapFont?.Dispose()
If textImages IsNot Nothing Then
For i As Integer = textImages.Count - 1 To 0 Step -1
textImages(i)?.Dispose()
Next
End If
End Sub

如果你想删除自动填充到渲染文本中，请参见这里:
从图像上绘制的文本中删除上下填充
使用图形路径正确绘制文本