首页 > 解决方案 > 创建一个列表(位图)绘制一个列表(字符串)

问题描述

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

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

标签: vb.netimagewinformsgraphics

解决方案


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

由于您需要保留这些位图,因此不要丢弃它们。Using只需在声明新位图时删除该语句。

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

此外,添加[Graphics].TextRenderingHint = TextRenderingHint.AntiAliasGridFit以执行文本的抗锯齿渲染。查看使用其他TextRenderingHint设置作为AntiAliasClearTypeGridFit(<= 在控件表面上绘制时)和[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

然而,当您不再需要这些对象时,处置位图(以及引用非托管资源的任何其他对象,作为 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

如果您想删除添加到渲染文本的自动填充,请参见此处:
从在图像上绘制的文本中删除顶部和底部填充

此处可能有趣的其他注释:
Properly draw text using Graphics Path


推荐阅读