我有一个餐厅名称列表,我需要将这些字符串绘制到位图中。
我创建位图,绘制文本,但如果我不保存位图,然后将保存的文件加载到位图中,然后将其添加到列表中,则位图无效。
这是我的代码,为了简洁,我编辑了许多名字,我希望有人能解释为什么以及如何我可以避免保存到磁盘:
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
您遇到的问题是由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
如果你想删除自动填充到渲染文本中,请参见这里:
从图像上绘制的文本中删除上下填充
使用图形路径正确绘制文本