VB.NET-Tipp 0061: Bitmapobjekt in eine andere Farbtiefe konvertieren
von Frank Schüler
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: | 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: |
' 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.