将多个图像层渲染为透明的 PNG 图像答案

【问题标题】：Render multiple Image Layers to transparent PNG image将多个图像层渲染为透明的 PNG 图像
【发布时间】：2014-07-21 17:42:35
【问题描述】：

不太清楚这个问题该怎么表达，所以我会继续解释细节，并尽可能地提出问题。

我有一个项目，它由以下组件组成

Canvas - 继承 PictureBox 控件

图层 - “图层”的集合层 - 可以包含图形集合作为带有信息的图像。

每个图层都可以移动，并且图层的选择框被限制在图层的最大范围内包含图形的部分。

以上所有方法都有效！

什么不起作用，是当我想保存组合结果（包括透明度和 alpha 的）时，Canvas 控件为空。我知道图像是在框中绘制的，因为在我执行 Canvas1.Invalidate() 之前它不会显示任何内容。

我的课程代码如下：

画布

    Imports System.Drawing
    Imports System.Drawing.Graphics

    Public Class Canvas
        Inherits PictureBox

        Private _MoveStart As Point
        Private _Layers As List(Of Layer)

        Public Sub New()
            Me.DoubleBuffered = True

            _Layers = New List(Of Layer)
        End Sub

        Public ReadOnly Property Layers() As List(Of Layer)
            Get
                Return _Layers
            End Get
        End Property

        Public Property SelectedLayer As Layer
            Get
                'Loop through all layers and return the one that is selected
                For Each l As Layer In Me.Layers
                    If l.Selected Then Return l
                Next
                Return Nothing
            End Get
            Set(ByVal value As Layer)
                'Loop through all layers and set their Selected property to True if it is the assigned layer ("value") or False if it isn't.
                For Each l As Layer In Me.Layers
                    l.Selected = (l Is value)
                Next
            End Set
        End Property

        Private Function GetLayerFromPoint(ByVal p As Point) As Layer
            ' Finds the layer that contains the point p
            For Each l As Layer In Me.Layers
                If l.Bounds.Contains(p) Then Return l
            Next
            Return Nothing
        End Function

        Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseDown(e)

            If e.Button = Windows.Forms.MouseButtons.Left Then
                ' Store the previous selected layer to refresh the image there
                Dim oldSelection = Me.SelectedLayer

                ' Get the new selected layer
                Me.SelectedLayer = Me.GetLayerFromPoint(e.Location)

                'Update the picturebox
                If oldSelection IsNot Nothing Then Me.InvalidateLayer(oldSelection)
                Me.InvalidateLayer(Me.SelectedLayer)
                Me.Update()

                _MoveStart = e.Location
            End If
        End Sub

        Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseMove(e)

            If Control.MouseButtons = Windows.Forms.MouseButtons.Left Then
                If Me.SelectedLayer IsNot Nothing Then

                    'Store the old bounds for refreshing
                    Dim oldBounds As Rectangle = Me.SelectedLayer.Bounds

                    'Move the selected layer
                    Me.SelectedLayer.Move(e.Location.X - _MoveStart.X, e.Location.Y - _MoveStart.Y)
                    _MoveStart = e.Location

                    'Update the picturebox
                    Me.InvalidateRectangle(oldBounds)
                    Me.InvalidateLayer(Me.SelectedLayer)
                    Me.Update()
                End If
            End If
        End Sub

        Private Sub InvalidateLayer(ByVal l As Layer)
            If l IsNot Nothing Then
                Me.InvalidateRectangle(l.Bounds)
            End If
        End Sub

        Private Sub InvalidateRectangle(ByVal r As Rectangle)
            'Inflate by 1 pixel otherwise the border isnt visible 
            r.Inflate(1, 1)
            Me.Invalidate(r)
        End Sub

        Protected Overrides Sub OnPaint(ByVal pe As System.Windows.Forms.PaintEventArgs)
            MyBase.OnPaint(pe)
            For Each l As Layer In Me.Layers
                l.Draw(pe.Graphics)
            Next
        End Sub

    End Class

图层

    Imports System.Drawing
    Imports System.Drawing.Graphics

    Public Class Layer

        Private _Graphics As List(Of Graphic)
        Private _Name As String
        Private _Selected As Boolean

        Public Sub New(ByVal name As String)
            Me.Name = name
            Me.Selected = False
            Me.Graphics = New List(Of Graphic)
        End Sub

        Public Property Name() As String
            Get
                Return _Name
            End Get
            Set(ByVal value As String)
                _Name = value
            End Set
        End Property

        Public Property Selected() As Boolean
            Get
                Return _Selected
            End Get
            Set(ByVal value As Boolean)
                _Selected = value
            End Set
        End Property

        Public ReadOnly Property Bounds As Rectangle
            Get
                'Combine the bounds of all items
                If Me.Graphics.Count > 0 Then
                    Dim b = Me.Graphics(0).Bounds
                    For i As Integer = 1 To Me.Graphics.Count - 1
                        b = Rectangle.Union(b, Me.Graphics(i).Bounds)
                    Next
                    Return b
                End If
                Return Rectangle.Empty
            End Get
        End Property

        Public Property Graphics() As List(Of Graphic)
            Get
                Return _Graphics
            End Get
            Set(ByVal value As List(Of Graphic))
                _Graphics = value
            End Set
        End Property

        Public Sub Move(ByVal dx As Integer, ByVal dy As Integer)
            'Simply move each item 
            For Each item As Graphic In Me.Graphics
                item.Move(dx, dy)
            Next
        End Sub

        Public Sub Draw(ByVal g As System.Drawing.Graphics)
            'Draw each item
            For Each item As Graphic In Me.Graphics
                item.Draw(g)
            Next

            'Draw a selection border if selected
            If Me.Selected Then
                g.DrawRectangle(Pens.Red, Me.Bounds)
            End If
        End Sub

    End Class

图形

    Public Class Graphic
        Private _Image As Image
        Private _Location As Point
        Private _Size As Size

        Public Sub New(ByVal img As Image)
            Me.Bounds = Rectangle.Empty
            Me.Image = img
        End Sub

        Public Sub New(ByVal img As Image, ByVal location As Point)
            Me.New(img)
            Me.Location = location
            Me.Size = img.Size
        End Sub

        Public Sub New(ByVal img As Image, ByVal location As Point, ByVal size As Size)
            Me.New(img)
            Me.Location = location
            Me.Size = size
        End Sub

        Public Property Location() As Point
            Get
                Return _Location
            End Get
            Set(ByVal value As Point)
                _Location = value
            End Set
        End Property

        Public Property Size() As Size
            Get
                Return _Size
            End Get
            Set(ByVal value As Size)
                _Size = value
            End Set
        End Property

        Public Property Bounds() As Rectangle
            Get
                Return New Rectangle(Me.Location, Me.Size)
            End Get
            Set(ByVal value As Rectangle)
                Me.Location = value.Location
                Me.Size = value.Size
            End Set
        End Property

        Public Property Image() As Image
            Get
                Return _Image
            End Get
            Set(ByVal value As Image)
                _Image = value
            End Set
        End Property

        Public Sub Move(ByVal dx As Integer, ByVal dy As Integer)
            ' We need to store a copy of the Location, change that, and save it back,
            ' because a Point is a structure and thus a value-type!!
            Dim l = Me.Location
            l.Offset(dx, dy)
            Me.Location = l
        End Sub

        Public Sub Draw(ByVal g As Graphics)
            If Me.Image IsNot Nothing Then
                g.DrawImage(Me.Image, Me.Bounds)
            End If
        End Sub

    End Class

示例用法

新建一个 WinForms 项目 (Form1)
在表单中添加一个 Canvas 对象（将命名为 Canvas1）
向表单添加一个 Button 对象（将命名为 Button1）
将以下代码粘贴到 Form1 源视图中

表格1

    Public Class Form1
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            Me.DoubleBuffered = True
            Me.Show()

            Dim l As Layer

            l = New Layer("Layer 1")
            l.Graphics.Add(New Graphic(My.Resources.ActualSizeHS, New Point(10, 10)))
            Canvas1.Layers.Add(l)

            l = New Layer("Layer 2")
            l.Graphics.Add(New Graphic(My.Resources.AlignObjectsRightHS, New Point(320, 240)))
            l.Graphics.Add(New Graphic(My.Resources.AlignToGridHS, New Point(290, 140)))
            l.Graphics.Add(New Graphic(My.Resources.AlignObjectsBottomHS, New Point(320, 130)))
            Canvas1.Layers.Add(l)

            l = New Layer("Layer 3")
            l.Graphics.Add(New Graphic(My.Resources.AlignObjectsTopHS, New Point(520, 240)))
            l.Graphics.Add(New Graphic(My.Resources.AlignTableCellMiddleRightHS, New Point(390, 240)))
            l.Graphics.Add(New Graphic(My.Resources.AlignTableCellMiddleCenterHS, New Point(520, 130)))
            Canvas1.Layers.Add(l)

            Canvas1.Invalidate()
        End Sub

        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Canvas1.Image.Save("MyRenderedPicture.png", System.Drawing.Imaging.ImageFormat.Png)
        End Sub
    End Class

在上面的 Form1 示例中，将 My.Resources.* 替换为图形所在的位置。该参数只是一个 System.Drawing.Image 对象。

我遇到的问题是，当我单击 Button1 保存图像时，输出不包含任何添加到控件的图形。请注意，我使用的所有图形都是具有完全透明背景的 PNG，并且在容器内拖动它们不会产生使用图片框分层图像的块状效果。每个图像都是真正透明的。当我保存文件时，我希望保持这种透明度（以及 alpha 混合，如果有的话）——但首先......我需要能够保存除清楚包含图像的空白图片框以外的其他内容。

提前致谢。

（“阴影”未正确渲染其不透明度级别的保存图像示例）

现在，如果我执行以下操作：

    Dim x As Integer = 0
    Using bmp As Bitmap = New Bitmap(Me.Width, Me.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        'Me.DrawToBitmap(bmp, New Rectangle(0, 0, bmp.Width, bmp.Height))
        For Each l As Layer In Me.Layers
            For Each g As Graphic In l.Graphics
                g.Image.Save("layer" & x & ".png")
                x = x + 1
            Next
        Next

        bmp.MakeTransparent(Me.BackColor)
        bmp.Save(FileName, Format)
        bmp.Dispose()
    End Using

每一层都被正确保存——单独保存。所以 Graphics 控件正在正常工作，当我将它们组合起来时（并且需要保持位置和透明度），我认为这是我正在寻找的例程 ---

如何合并 System.Drawing.Graphics 对象我将尝试创建一个新的 Graphics 对象，并尝试使用其他图形对象及其位置在其上“绘制”。到目前为止，每个示例都使用剪裁矩形，因为这会拍摄 Graphic 后面的东西的图片，然后需要明确，等等。

【问题讨论】：

标签： vb.net winforms transparency system.drawing alpha-transparency

【解决方案1】：

您没有将图像分配给 picbox/canvas，因此 Image 什么都不是。毕竟，您只是将它用作画布而不是图像支架。由于助手已经知道他们在哪里，你只需要创建一个位图并从下往上绘制图像/图层：

Public Function GetBitmap(format As System.Drawing.Imaging.ImageFormat) As Bitmap

    ' ToDo: add graphics settings
    Dim bmp As New Bitmap(Me.Width, Me.Height)

    Using g As Graphics = Graphics.FromImage(bmp)
        ' ToDo: draw Canvas BG / COlor to bmp to start
        ' for BMP, JPG / non Transparents
        For n As Integer = 0 To Layers.Count - 1
            Layers(n).Draw(g)
        Next

    End Using

    Return bmp

End Function

然后在表格上：

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    ' to do - add a literal SAve
    Using bmp As Bitmap = Canvas1.GetBitmap(Imaging.ImageFormat.Png)

        bmp.Save("C:\Temp\myImage.png", System.Drawing.Imaging.ImageFormat.Png)

    End Using

End Sub

【讨论】：

这适用于保存，但是它带来了一个问题，因为它不再透明。当使用 bmp.MakeTransparent() ... 时，它非常接近，但是，问题仍然存在于阴影中。
这不是问题的一部分 - 什么你要透明吗？
它是原始问题的一部分“每个图像都是真正透明的。我希望在保存文件时保持这种透明度（如果存在 alpha 混合）”，但是，那是说，加载到图层中的图像是具有透明度的PNG。透明部分似乎没问题，是半透明的像素导致了问题。将发布图片。
尝试这个建议......这可能适用于当前问题:)
您遗漏了一个小细节，否则，谢谢。将“Dim bmp As New Bitmap(Me.Width, Me.Height)”改为“Dim bmp As New Bitmap(Me.Width, Me.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)”的原因，就是当创建位图，以保留 Alpha 通道和透明度，这是需要创建的格式。您的其余代码很棒，我不知道如何在没有剪切矩形的情况下将 Graphic 对象绘制到虚拟画布上。

【解决方案2】：

是否曾经将 PNG 添加到画布的图像中？这不完全一样，所以我很抱歉，但我最近做了一个快速测试应用程序，我试图在其中堆叠 PNG，所以我想我会分享我所做的。

这会循环通过 lstImages（实际上是一个字符串列表），将图像加载到 bmpTemp 中，并将图像绘制到 bmpBmp 上。然后在 PictureBox 的 Image 属性中使用该图像并添加到表单的 Controls 集合中。

我刚刚添加了另一个按钮来测试保存，它可以很好地与下面的内容配合使用（在为图片框添加名称之后）。

Private Sub StackImages()

    Dim bmpBmp As New Bitmap(picStack.Width, picStack.Height)
    Dim graGraphic As Graphics = Graphics.FromImage(bmpBmp)

    For Each i As String In Me.lstImages
        Dim bmpTemp As New Bitmap(i)
        graGraphic.DrawImage(bmpTemp, 0, 0)
    Next

    Dim picTemp As New PictureBox
    picTemp.Top = picStack.Top
    picTemp.Left = picStack.Left
    picTemp.Width = picStack.Width
    picTemp.Height = picStack.Height
    picTemp.Image = bmpBmp
    picTemp.Name = "NewPictureBox"

    Me.Controls.Add(picTemp)
    picTemp.BringToFront()

End Sub

Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click

    Dim picNew As PictureBox = CType(Me.Controls.Item("NewPictureBox"), PictureBox)
    picNew.Image.Save("c:\temp\picTest.png")

End Sub

【讨论】：

这有点不同。分层图片框不起作用，因为由于控件的限制，您无法获得真正的透明度。本质上，我创建了一个图层，它只是一个集合，并向其中添加多个图形。您可以在每个图层上添加多个具有多个图像的图层，并且每个图层都独立于其他所有图层进行操作。你是对的，没有任何东西被“画布”也就是图片框所吸引。感谢您分享您的代码。我想你会发现我的有用（结合 Plutonix 的保存程序）
这不会对 PictureBox 进行分层，它会循环遍历 PNG 图像列表并将它们（具有透明度）绘制到同一个 Bitmap 对象上，然后将该 Bitmap 放置为 PictureBox 的图像。
是的，我明白了。对不起。合并图像绝对是一种有趣的方式。我会试试这个，看看我在保存有阴影（部分透明像素）的图像时是否会遇到同样的问题。
如果我能接受两个答案，你的答案是部分正确的，但是当它添加到 picTemp 时，由于混合，我失去了透明和 alpha。
如果你还在看这个帖子，你的图像是否以 32 位位深度保存？我在查看其他内容时发现了这一点：“Image 类不支持位图中的 Alpha 透明度。要启用 Alpha 透明度，请使用每像素 32 位的 PNG 图像。”我试过了，它对我有用。