创建一个列表（位图）绘制一个列表（字符串）

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 块在您创建的位图对象上隐式调用 Dispose() 引起的。
当您创建一个 Bitmap 对象并将其添加到 List(Of Bitmap) 时，您实际上添加了对 Bitmap 对象的引用。该列表不包含对象，仅包含引用。

由于您需要保留这些位图，请不要丢弃它们。声明新位图时只需删除Using 语句即可。

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

另外，添加了 [Graphics].TextRenderingHint = TextRenderingHint.AntiAliasGridFit 来执行文本的抗锯齿渲染。查看使用其他TextRenderingHint 设置作为AntiAlias 或ClearTypeGridFit（[Graphics].TextContrast property 的其他效果。

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

当您不再需要这些对象时，处置位图（以及引用非托管资源的任何其他对象，作为字体对象）非常重要。
例如，由于您使用的是表单，因此您可以在表单关闭时处理这些对象：

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

如果您想删除添加到渲染文本的自动填充，请参见此处：
Remove top and bottom padding from Text drawn on an Image

其他可能有趣的注释：
Properly draw text using Graphics Path