Die Community zu .NET und Classic VB.
Menü

VB.NET-Tipp 0061: Bitmapobjekt in eine andere Farbtiefe konvertieren

 von 

Beschreibung

Dieses Beispiel zeigt zwei Möglichkeiten, wie ein Bitmapobjekt in eine andere Farbtiefe konvertiert werden kann. Die Funktion "ConvertTo2" kann sogar in die Indexed-Bitmapformate konvertieren. Die Funktion "ConvertTo" kann hingegen in andere Bitmapformate konvertieren, welche die Funktion "ConvertTo2" nicht unterstützt.

Aktualisierung: Durch einen Fehler wurde die GDI-Bitmapressource nicht freigegeben. Dieser Fehler ist in dieser Version behoben.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Framework-Version(en):

.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Compact Framework 1.0, .NET Compact Framework 2.0, .NET Framework 4

.NET-Version(en):

Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010

Download:

Download des Beispielprojektes [50,44 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: 
'  - 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.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class Form1

    ' ----==== sonstige Const ====----
    Private DIB_RGB_COLORS As Integer = 0
    Private BI_RGB As Integer = 0

    ' ----==== sonstige Types ====----
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure GDIBITMAP
        Dim bmType As Integer
        Dim bmWidth As Integer
        Dim bmHeight As Integer
        Dim bmWidthBytes As Integer
        Dim bmPlanes As Short
        Dim bmBitsPixel As Short
        Dim bmBits 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

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure RGBQUAD
        Dim rgbBlue As Byte
        Dim rgbGreen As Byte
        Dim rgbRed As Byte
        Dim rgbReserved As Byte
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Private Structure BITMAPINFO256
        Dim bmiHeader As BITMAPINFOHEADER
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=256)> _
        Dim bmiColors() As RGBQUAD
    End Structure

    ' ----==== GDI32 Deklarationen ====----
    ' für die Funktion "ConvertTo2" und "ConvertTo3"
    <DllImport("gdi32.dll", EntryPoint:="GetDIBits")> _
        Private Shared Function GetDIBits256(ByVal aHDC As IntPtr, _
        ByVal hBitmap As IntPtr, ByVal nStartScan As Integer, _
        ByVal nNumScans As Integer, ByRef lpBits As Byte, _
        ByRef lpBI As BITMAPINFO256, ByVal wUsage As Integer) As Integer
    End Function

    <DllImport("gdi32.dll", EntryPoint:="GetObjectA")> _
        Private Shared Function GetObjectA(ByVal hObject As IntPtr, _
        ByVal nCount As Integer, ByRef lpObject As GDIBITMAP) As Integer
    End Function

    <DllImport("gdi32.dll", EntryPoint:="DeleteObject")> _
        Private Shared Function DeleteObject(ByVal hObject As IntPtr) As Integer
    End Function

    ' ----==== USER32 Deklarationen ====----
    ' für die Funktion "ConvertTo2" und "ConvertTo3"
    <DllImport("user32.dll", EntryPoint:="GetDesktopWindow")> _
        Private Shared Function GetDesktopWindow() As IntPtr
    End Function

    <DllImport("user32.dll", EntryPoint:="GetDC")> _
        Private Shared Function GetDC(ByVal Hwnd As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", EntryPoint:="ReleaseDC")> _
        Private Shared Function ReleaseDC(ByVal Hwnd As IntPtr, _
        ByVal hdc As IntPtr) As Integer
    End Function

    ' ----==== GDI+ Deklarationen ====----
    ' für die Funktion "ConvertTo3"
    <DllImport("gdiplus.dll", EntryPoint:="GdipCreateBitmapFromGdiDib")> _
        Private Shared Function GdipCreateBitmapFromGdiDib256( _
        ByRef mGdiBitmapInfo As BITMAPINFO256, _
        ByRef mGdiBitmapData As Byte, _
        ByRef mBitmap As IntPtr) As Integer
    End Function

    <DllImport("gdiplus.dll", EntryPoint:="GdipCreateHBITMAPFromBitmap")> _
        Private Shared Function GdipCreateHBITMAPFromBitmap( _
        ByVal mBITMAP As IntPtr, _
        ByRef hbmReturn As IntPtr, _
        ByVal Background As Integer) As Integer
    End Function

    <DllImport("gdiplus.dll", EntryPoint:="GdipDisposeImage")> _
    Private Shared Function GdipDisposeImage( _
        ByVal mImage As IntPtr) As Integer
    End Function

    ''' <summary>Konvertiert eine Bitmap in eine andere Farbtiefe
    '''  mit reinen .NET-Mitteln</summary>
    ''' <param name="InBitmap">zu konvertierende Bitmap</param>
    ''' <param name="ToPixelFormat">in die zu konvertierende Farbtiefe</param>
    ''' <returns>Konvertierte Bitmap</returns>
    Private Function ConvertTo(ByVal InBitmap As Bitmap, _
        ByVal ToPixelFormat As PixelFormat) As Bitmap

        ' neue Bitmap erstellen -> ConvBmp
        Dim ConvBmp As New Bitmap(InBitmap.Width, _
            InBitmap.Height, ToPixelFormat)

        Try
            ' Graphicsobjekt von ConvBmp erstellen -> BmpGra
            Using BmpGra As Graphics = Graphics.FromImage(ConvBmp)
                ' InBitmap in das Graphicsobjekt zeichnen
                BmpGra.DrawImage(InBitmap, _
                    ConvBmp.GetBounds(GraphicsUnit.Pixel))
            End Using

            ' konvertierte Bitmap zurückgeben
            Return ConvBmp
        Catch ex As Exception
            ' bei einem Fehler ConvBmp löschen
            ConvBmp.Dispose()

            ' nicht unterstützte Pixelformate
            MessageBox.Show("Die Konvertierung der Bitmap in das " & _
                "Pixelformat """ & ToPixelFormat.ToString & _
                """ wird in der Funktion """ & "ConvertTo" & _
                """ nicht unterstützt!")
        End Try

        ' nichts zurückgeben
        Return Nothing
    End Function

    ''' <summary>Konvertiert eine Bitmap in eine andere Farbtiefe
    '''  unter Zuhilfenahme von GDI32 und USER32</summary>
    ''' <param name="InBitmap">zu konvertierende Bitmap</param>
    ''' <param name="ToPixelFormat">in die zu konvertierende Farbtiefe</param>
    ''' <returns>Konvertierte Bitmap</returns>
    Private Function ConvertTo2(ByVal InBitmap As Bitmap, _
        ByVal ToPixelFormat As PixelFormat) As Bitmap

        Dim ScanLine As New Integer 'Breite einer Zeile
        Dim BitsPerPixel As New Short 'BPP für BITMAPINFO Struktur
        Dim PalBmp As Boolean = False 'Palettenbitmap

        ' diverse Parameter für die entsprechenden Pixelformate setzen
        Select Case ToPixelFormat
            Case PixelFormat.Format1bppIndexed
                ScanLine = ((InBitmap.Width + 31) And Not 31) \ 8
                BitsPerPixel = 1
                PalBmp = True

            Case PixelFormat.Format4bppIndexed
                ScanLine = ((InBitmap.Width + 7) And Not 7) \ 2
                BitsPerPixel = 4
                PalBmp = True

            Case PixelFormat.Format8bppIndexed
                ScanLine = (InBitmap.Width + 3) And Not 3
                BitsPerPixel = 8
                PalBmp = True

            Case PixelFormat.Format16bppRgb555
                ScanLine = ((InBitmap.Width * 2) + 2) And Not 2
                BitsPerPixel = 16

            Case PixelFormat.Format24bppRgb
                ScanLine = ((InBitmap.Width * 3) + 3) And Not 3
                BitsPerPixel = 24

            Case PixelFormat.Format32bppRgb
                ScanLine = InBitmap.Width * 4
                BitsPerPixel = 32

            Case Else
                ' Nicht unterstützte Pixelformate:
                MessageBox.Show("Die Konvertierung der Bitmap in das " & _
                    "Pixelformat """ & ToPixelFormat.ToString & _
                    """ wird in der Funktion """ & "ConvertTo2" & _
                    """ nicht unterstützt!")

                Return Nothing
        End Select

        ' leeres Bitmapobjekt erstellen
        Dim ConvBmp As Bitmap = Nothing

        Dim tBitmap As New GDIBITMAP

        ' Handle vom GDI-Bitmap holen
        Dim hGdiBmp As IntPtr = InBitmap.GetHbitmap

        ' ist ein Handle vorhanden
        If hGdiBmp <> IntPtr.Zero Then

            ' Handle -> tBitmap
            If GetObjectA(hGdiBmp, Marshal.SizeOf(tBitmap), tBitmap) <> 0 Then

                Dim tBITMAPINFO As New BITMAPINFO256

                ' tBitmap.bmHeight muss als negativer Wert an 
                ' tBITMAPINFO.bmiHeader.biHeight übergeben werden,
                ' da ansonsten das Bild horizontal gespiegelt wird
                tBITMAPINFO.bmiHeader.biHeight = -tBitmap.bmHeight
                tBITMAPINFO.bmiHeader.biWidth = tBitmap.bmWidth
                tBITMAPINFO.bmiHeader.biPlanes = tBitmap.bmPlanes
                tBITMAPINFO.bmiHeader.biBitCount = BitsPerPixel
                tBITMAPINFO.bmiHeader.biSize = _
                    Marshal.SizeOf(tBITMAPINFO.bmiHeader)
                tBITMAPINFO.bmiHeader.biCompression = BI_RGB

                ' Handle des Desktopfensters ermitteln
                Dim DeskHwndPtr As IntPtr = GetDesktopWindow()

                ' Ist ein Handle vorhanden?
                If CBool(DeskHwndPtr) Then
                    ' DeviceContext des Desktop ermitteln
                    Dim DeskDcPtr As IntPtr = GetDC(DeskHwndPtr)

                    ' Ist ein DeviceContext vorhanden?
                    If CBool(DeskDcPtr) Then

                        ' ByteArray zur Aufnahme der DIB-Daten dimensionieren
                        Dim bytData As Byte() = _
                            New Byte((tBitmap.bmHeight * ScanLine) - 1) {}

                        ' DIB-Daten auslesen -> bytData
                        If GetDIBits256(DeskDcPtr, hGdiBmp, 0, _
                            tBitmap.bmHeight, bytData(0), tBITMAPINFO, _
                            DIB_RGB_COLORS) <> 0 Then

                            ' Neue Bitmap mit neuem Pixelformat erstellen
                            ConvBmp = New Bitmap(tBitmap.bmWidth, _
                                tBitmap.bmHeight, ToPixelFormat)

                            ' Bitmapdaten im Speicher sperren (schreiben)
                            Dim BmpData As BitmapData = _
                                ConvBmp.LockBits(New Rectangle(0, 0, _
                                ConvBmp.Width, ConvBmp.Height), _
                                ImageLockMode.WriteOnly, ToPixelFormat)

                            ' DIB-Daten in den Speicher kopieren
                            Marshal.Copy(bytData, 0, _
                                BmpData.Scan0, bytData.Length)

                            ' Bitmapdaten im Speicher wieder freigeben
                            ConvBmp.UnlockBits(BmpData)

                            ' ist es eine Palettenbitmap
                            ' 1bpp, 4bpp, 8bpp
                            If PalBmp Then
                                ' Palette auslesen
                                Dim ConvBMPPal As _
                                    ColorPalette = ConvBmp.Palette

                                ' DIB-Palette umkopieren
                                For lngItem As Integer = _
                                    0 To ConvBMPPal.Entries.Length - 1

                                    ConvBMPPal.Entries(lngItem) = _
                                    Color.FromArgb(255, _
                                    tBITMAPINFO.bmiColors(lngItem).rgbRed, _
                                    tBITMAPINFO.bmiColors(lngItem).rgbGreen, _
                                    tBITMAPINFO.bmiColors(lngItem).rgbBlue)
                                Next

                                ' geänderte Palette zurück schreiben
                                ConvBmp.Palette = ConvBMPPal
                            End If
                        End If

                        ' DeviceContext freigeben
                        ReleaseDC(DeskHwndPtr, DeskDcPtr)
                    End If
                End If
            End If

            ' GDI-Bitmap löschen
            DeleteObject(hGdiBmp)
        End If

        ' konvertierte Bitmap zurückgeben
        Return ConvBmp
    End Function

    ''' <summary>Konvertiert eine Bitmap in eine andere Farbtiefe
    '''  unter Zuhilfenahme von GDI32, USER32 und GDIPLUS</summary>
    ''' <param name="InBitmap">zu konvertierende Bitmap</param>
    ''' <param name="ToPixelFormat">in die zu konvertierende Farbtiefe</param>
    ''' <returns>Konvertierte Bitmap</returns>
    Private Function ConvertTo3(ByVal InBitmap As Bitmap, _
        ByVal ToPixelFormat As PixelFormat) As Bitmap

        Dim ScanLine As New Integer 'Breite einer Zeile
        Dim BitsPerPixel As New Short 'BPP für BITMAPINFO Struktur

        ' Diverse Parameter für die entsprechenden Pixelformate setzen
        Select Case ToPixelFormat
            Case PixelFormat.Format1bppIndexed
                ScanLine = ((InBitmap.Width + 31) And Not 31) \ 8
                BitsPerPixel = 1

            Case PixelFormat.Format4bppIndexed
                ScanLine = ((InBitmap.Width + 7) And Not 7) \ 2
                BitsPerPixel = 4

            Case PixelFormat.Format8bppIndexed
                ScanLine = (InBitmap.Width + 3) And Not 3
                BitsPerPixel = 8

            Case PixelFormat.Format16bppRgb555
                ScanLine = ((InBitmap.Width * 2) + 2) And Not 2
                BitsPerPixel = 16

            Case PixelFormat.Format24bppRgb
                ScanLine = ((InBitmap.Width * 3) + 3) And Not 3
                BitsPerPixel = 24

            Case PixelFormat.Format32bppRgb
                ScanLine = InBitmap.Width * 4
                BitsPerPixel = 32

            Case Else
                ' nicht unterstützte Pixelformate
                MessageBox.Show("Die Konvertierung der Bitmap in das " & _
                    "Pixelformat """ & ToPixelFormat.ToString & _
                    """ wird von der Funktion """ & "ConvertTo3" & _
                    """ nicht unterstützt!")

                Return Nothing
        End Select

        ' Leeres Bitmapobjekt erstellen
        Dim ConvBmp As Bitmap = Nothing

        Dim tBitmap As New GDIBITMAP

        ' Handle vom GDI-Bitmap holen
        Dim hGdiBmp As IntPtr = InBitmap.GetHbitmap

        ' ist ein Handle vorhanden
        If hGdiBmp <> IntPtr.Zero Then

            ' Handle -> tBitmap
            If GetObjectA(hGdiBmp, Marshal.SizeOf(tBitmap), tBitmap) <> 0 Then

                Dim tBITMAPINFO As New BITMAPINFO256

                tBITMAPINFO.bmiHeader.biHeight = tBitmap.bmHeight
                tBITMAPINFO.bmiHeader.biWidth = tBitmap.bmWidth
                tBITMAPINFO.bmiHeader.biPlanes = tBitmap.bmPlanes
                tBITMAPINFO.bmiHeader.biBitCount = BitsPerPixel
                tBITMAPINFO.bmiHeader.biSize = _
                    Marshal.SizeOf(tBITMAPINFO.bmiHeader)
                tBITMAPINFO.bmiHeader.biCompression = BI_RGB

                ' Handle des Desktopfensters ermitteln
                Dim DeskHwndPtr As IntPtr = GetDesktopWindow()

                ' ist ein Handle vorhanden
                If CBool(DeskHwndPtr) Then
                    ' DeviceContext des Desktop ermitteln
                    Dim DeskDcPtr As IntPtr = GetDC(DeskHwndPtr)

                    ' ist ein DeviceContext vorhanden
                    If CBool(DeskDcPtr) Then
                        ' ByteArray zur Aufnahme der DIB-Daten dimensionieren
                        Dim bytData As Byte() = _
                            New Byte((tBitmap.bmHeight * ScanLine) - 1) {}

                        ' DIB-Daten auslesen -> bytData
                        If GetDIBits256(DeskDcPtr, hGdiBmp, 0, _
                            tBitmap.bmHeight, bytData(0), tBITMAPINFO, _
                            DIB_RGB_COLORS) <> 0 Then

                            ' Zeiger auf Bitmap für 
                            ' GdipCreateBitmapFromGdiDib256
                            Dim mBmpPtr As IntPtr

                            ' Bitmap im Speicher aus den DIB-Daten 
                            '  erstellen -> mBmpPtr
                            If GdipCreateBitmapFromGdiDib256(tBITMAPINFO, _
                                bytData(0), mBmpPtr) = 0 Then

                                ' Zeiger auf das Bitmaphandle für 
                                ' GdipCreateHBITMAPFromBitmap()
                                Dim hBmpPtr As New IntPtr

                                ' Handle des GDI+ Bitmaps ermitteln
                                If GdipCreateHBITMAPFromBitmap(mBmpPtr, _
                                    hBmpPtr, 0) = 0 Then

                                    ' Bitmap vom Handle erstellen
                                    ConvBmp = Bitmap.FromHbitmap(hBmpPtr)
                                End If

                                ' Durch GdipCreateBitmapFromGdiDib256 erstellte 
                                ' Bitmap(löschen)
                                GdipDisposeImage(mBmpPtr)
                            End If
                        End If

                        ' DeviceContext freigeben
                        ReleaseDC(DeskHwndPtr, DeskDcPtr)
                    End If
                End If
            End If

            ' GDI-Bitmap löschen
            DeleteObject(hGdiBmp)
        End If

        ' Konvertierte Bitmap zurückgeben
        Return ConvBmp
    End Function

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

        ' ist ein Bild in der PictureBox vorhanden
        If Not PictureBox2.Image Is Nothing Then
            ' Bild löschen  
            PictureBox2.Image.Dispose()
        End If

        ' Konvertiert das Bild aus der PictureBox1 in das 4bppIndexed-
        ' Bitmapformat und gibt die konvertierte Bitmap in der PictureBox2 aus
        PictureBox2.Image = _
            ConvertTo3(CType(PictureBox1.Image, Bitmap), _
            PixelFormat.Format4bppIndexed)
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, _
        ByVal e As System.EventArgs) Handles Me.Load

        PictureBox1.Image = My.Resources.City005
    End Sub
End Class

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.