Die Community zu .NET und Classic VB.

Startseite / Tipps / VB.NET-Tipp 0062: Alphakanal-PNG in ein 32bit-Icon konvertieren

VB.NET-Tipp 0062: Alphakanal-PNG in ein 32bit-Icon konvertieren

 von Frank Schüler

Schwierigkeitsgrad:

Framework-Version(en): .NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5

.NET-Version(en): Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008

Download: Download des Beispielprojektes [28,13 KB]

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2005
' Option Strict:    An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ################################# Form1.vb ###################################
' ##############################################################################
Option Strict On
Option Explicit On

Imports System
Imports System.IO
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class Form1
    ' ----==== sonstige Const ====----
    Private BI_RGB As Integer = 0

    ' ----==== sonstige Typen ====----
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure IconHeader
        Dim ihReserved As Short
        Dim ihType As Short
        Dim ihCount As Short
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure IconEntry
        Dim ieWidth As Byte
        Dim ieHeight As Byte
        Dim ieColorCount As Byte
        Dim ieReserved As Byte
        Dim iePlanes As Short
        Dim ieBitCount As Short
        Dim ieBytesInRes As Integer
        Dim ieImageOffset As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure BITMAPINFOHEADER
        Dim biSize As Integer
        Dim biWidth As Integer
        Dim biHeight As Integer
        Dim biPlanes As Short
        Dim biBitCount As Short
        Dim biCompression As Integer
        Dim biSizeImage As Integer
        Dim biXPelsPerMeter As Integer
        Dim biYPelsPerMeter As Integer
        Dim biClrUsed As Integer
        Dim biClrImportant As Integer
    End Structure

    Private Enum ErrorCodes
        OK = 0
        PngFileNotExists = 1
        PngIsNotAlphaChannelPng = 2
        PngFileNameExtensionIsNotPng = 3
        IcoFileNameExtensionIsNotIco = 4
        ImageWidthNotEqualImageHeight = 5
        ImageWidthOrImageHeightNotValidIconSize = 6
    End Enum

    Private Function ConvertPngToAlphaChannelIcon(ByVal PngFileName As String, _
        ByVal IcoFileName As String) As ErrorCodes

        ' Wenn PngFileName nicht vorhanden ist
        If Not File.Exists(PngFileName) Then
            Return ErrorCodes.PngFileNotExists
        End If

        ' Wenn die Extension von PngFileName nicht ".PNG" ist
        If Path.GetExtension(PngFileName).ToUpper <> ".PNG" Then
            Return ErrorCodes.PngFileNameExtensionIsNotPng
        End If

        ' Wenn die Endung von IcoFileName nicht ".ICO" ist
        If Path.GetExtension(IcoFileName).ToUpper <> ".ICO" Then
            Return ErrorCodes.IcoFileNameExtensionIsNotIco
        End If

        ' PngFileName laden -> Bmp32
        Using Bmp32 As New Bitmap(PngFileName)

            ' Ist das Pixelformat des Bmp32 ungleich 32bppArgb?
            If Bmp32.PixelFormat <> PixelFormat.Format32bppArgb Then
                ' Bmp32 löschen
                Bmp32.Dispose()

                Return ErrorCodes.PngIsNotAlphaChannelPng
            End If

            ' Is die Höhe ungleich der Breite vom Bmp32?
            If Bmp32.Width <> Bmp32.Height Then
                ' Bmp32 löschen
                Bmp32.Dispose()

                Return ErrorCodes.ImageWidthNotEqualImageHeight
            End If

            ' Breite und Höhe von Bmp32 auf Standardicongrößen prüfen
            Select Case Bmp32.Width
                Case 16, 24, 32, 48, 64, 72, 96, 128, 256
                    ' alles in Ordnung

                    Select Case Bmp32.Height
                        Case 16, 24, 32, 48, 64, 72, 96, 128, 256
                            ' alles in Ordnung

                        Case Else
                            ' Wenn nicht Bmp32 löschen
                            Bmp32.Dispose()
                            Return ErrorCodes.ImageWidthOrImageHeightNotValidIconSize
                    End Select

                Case Else
                    ' Wenn nicht, Bmp32 löschen
                    Bmp32.Dispose()
                    Return ErrorCodes.ImageWidthOrImageHeightNotValidIconSize
            End Select

            ' Bmp32 horizontal spiegeln
            Bmp32.RotateFlip(RotateFlipType.Rotate180FlipX)

            ' Breite einer Bildzeile inkl. PadBytes berechnen
            Dim Bmp1Stride As Integer = _
                ((Bmp32.Width + 31) And Not 31) \ 8

            Dim Bmp32Stride As Integer = Bmp32.Width * 4

            ' ByteArrays zur Aufnahme der gesamten Bitmapdaten dimensionieren
            Dim Bmp1Data As Byte() = _
                New Byte((Bmp32.Height * Bmp1Stride) - 1) {}

            Dim Bmp32Data As Byte() = _
                New Byte((Bmp32.Height * Bmp32Stride) - 1) {}

            ' Bitmapdaten im Speicher zum Lesen sperren
            Dim Data As BitmapData = Bmp32.LockBits(New Rectangle(0, 0, _
                Bmp32.Width, Bmp32.Height), ImageLockMode.ReadOnly, _
                PixelFormat.Format32bppArgb)

            ' Komplette Bitmapdaten in das ByteArray Bmp32Data kopieren
            Marshal.Copy(Data.Scan0, Bmp32Data, 0, Bmp32Data.Length)

            ' Bitmapdaten wieder freigeben
            Bmp32.UnlockBits(Data)

            Dim intX As New Integer
            Dim intY As New Integer
            Dim Bmp1Pos As New Integer
            Dim Bmp32Pos As New Integer

            ' Alle Pixel im ByteArray durchlaufen
            For intY = 0 To Bmp32.Height - 1
                For intX = 0 To Bmp32.Width - 1

                    ' Pixelpositionen in den ByteArrays berechnen
                    Bmp1Pos = (intY * Bmp1Stride) + (intX \ 8)
                    Bmp32Pos = (intY * Bmp32Stride) + (intX * 4)

                    ' ist der Alphakanal des 32bpp-Pixels = 0
                    If Bmp32Data(Bmp32Pos + 3) = 0 Then

                        ' dann 32bppARGB-Pixel = schwarz
                        Bmp32Data(Bmp32Pos + 2) = 0 'R
                        Bmp32Data(Bmp32Pos + 1) = 0 'G
                        Bmp32Data(Bmp32Pos + 0) = 0 'B

                        ' 1bppIndexed-Pixel = weiß
                        Bmp1Data(Bmp1Pos) = Bmp1Data(Bmp1Pos) Or _
                            CByte(&H80 >> (intX And &H7))

                    End If

                Next
            Next

            Dim tIconHeader As New IconHeader
            Dim tIconEntry As New IconEntry
            Dim tBITMAPINFOHEADER As New BITMAPINFOHEADER

            tIconHeader.ihReserved = 0  ' muss 0 sein
            tIconHeader.ihType = 1      ' 1 = Typ Icon
            tIconHeader.ihCount = 1     ' Anzahl der Icons in der Datei

            ' Breite des Icons
            If Bmp32.Width < 256 Then
                ' wenn Breite kleiner 256 ist dann Breite eintragen
                tIconEntry.ieWidth = CByte(Bmp32.Width)
            Else
                ' ansonsten 0
                tIconEntry.ieWidth = 0
            End If

            ' Höhe des Icons
            If Bmp32.Height < 256 Then
                ' Wenn Höhe kleiner 256 ist, dann Höhe eintragen
                tIconEntry.ieHeight = CByte(Bmp32.Height)
            Else
                ' ansonsten 0
                tIconEntry.ieHeight = 0
            End If

            tIconEntry.ieColorCount = 0  ' 0 bei 32Bit-Icons
            tIconEntry.ieReserved = 0    ' muss 0 sein
            tIconEntry.iePlanes = 1      ' muss 1 sein
            tIconEntry.ieBitCount = 32   ' 32 = 32Bit-Icon

            ' Größe der Bitmap in Bytes berechnen
            tIconEntry.ieBytesInRes = _
                Marshal.SizeOf(tBITMAPINFOHEADER) + _
                Bmp32Data.Length + Bmp1Data.Length

            ' Beginn der Bitmap in der Icondatei berechnen
            tIconEntry.ieImageOffset = _
                Marshal.SizeOf(tIconHeader) + _
                Marshal.SizeOf(tIconEntry)

            ' Größe der Struktur in Bytes:
            tBITMAPINFOHEADER.biSize = Marshal.SizeOf(tBITMAPINFOHEADER)
            ' Breite der Bitmap:
            tBITMAPINFOHEADER.biWidth = Bmp32.Width
            ' Höhe der Bitmap * 2:
            tBITMAPINFOHEADER.biHeight = Bmp32.Height * 2
            ' Muss 1 sein
            tBITMAPINFOHEADER.biPlanes = 1
            ' 32 = 32Bit-Bitmap
            tBITMAPINFOHEADER.biBitCount = 32
            ' Nicht komprimiert:
            tBITMAPINFOHEADER.biCompression = BI_RGB

            ' Bildgröße in Bytes
            tBITMAPINFOHEADER.biSizeImage = _
                (Bmp32Data.Length - 1) + (Bmp1Data.Length - 1)

            tBITMAPINFOHEADER.biXPelsPerMeter = 0  ' kann 0 sein
            tBITMAPINFOHEADER.biYPelsPerMeter = 0  ' kann 0 sein
            tBITMAPINFOHEADER.biClrUsed = 0        ' 0 bei 32Bit-Bitmaps
            tBITMAPINFOHEADER.biClrImportant = 0   ' 0 bei 32Bit-Bitmaps

            ' Ist die zuschreibende Icondatei bereits vorhanden?
            If File.Exists(IcoFileName) Then
                ' Falls dies der Fall ist, die Datei löschen
                File.Delete(IcoFileName)
            End If

            ' Neue Datei erstellen
            Dim FS As New FileStream(IcoFileName, FileMode.CreateNew)
            Dim Writer As New BinaryWriter(FS)

            ' IconHeader schreiben
            Writer.Write(Structure2ByteArray(tIconHeader))

            ' IconEntry schreiben
            Writer.Write(Structure2ByteArray(tIconEntry))

            ' Bitmapinfoheader schreiben
            Writer.Write(Structure2ByteArray(tBITMAPINFOHEADER))

            ' DIB-Daten vom Bild schreiben
            Writer.Write(Bmp32Data)

            ' DIB-Daten der Maske schreiben
            Writer.Write(Bmp1Data)

            ' BinaryWriter schließen
            Writer.Close()

            ' FileStream schließen
            FS.Close()
        End Using

        Return ErrorCodes.OK
    End Function

    ' Diese Funktion dient zum Konvertieren einer Struktur in ein ByteArray
    Private Function Structure2ByteArray(ByVal InStructure As Object) As Byte()
        ' ByteArray dimensionieren
        Dim OutArray As Byte() = New Byte(Marshal.SizeOf(InStructure) - 1) {}

        ' Zeiger auf den reservierten Speicher im nicht verwalteten 
        '  Speicherblock
        Dim Ptr As IntPtr = Marshal.AllocHGlobal(OutArray.Length)

        ' Kopiert die Struktur an den angegebenen Zeiger im reservierten 
        ' Speicher
        Marshal.StructureToPtr(InStructure, Ptr, False)

        ' Kopiert die Daten aus dem Speicher in das Byte Array
        Marshal.Copy(Ptr, OutArray, 0, OutArray.Length)

        ' reservierten Speicher freigeben
        Marshal.FreeHGlobal(Ptr)

        ' ByteArray zurückgeben
        Structure2ByteArray = OutArray

    End Function

    Private Sub Button1_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles Button1.Click

        Me.Text = ConvertPngToAlphaChannelIcon("C:\Downloads\test.png", _
            "C:\Downloads\test.ico").ToString
    End Sub
End Class