| |
VB.NET - Ein- und UmsteigerRe: Monocrom Bild erstellen | | | Autor: FohnBit | Datum: 06.09.11 06:34 |
| ummary>Konvertiert eine Bitmap In eine andere Farbtiefe</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
Dim ScanLine As New Integer 'Breite einer Zeile
Dim BitsPerPixel As New Short 'BPP für BITMAPINFO Struktur
Dim PalBmp As Boolean = False 'Palettenbitmap
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
MsgBox("Die Konvertierung In dieses " & _
"Bildformat wird nicht unterstützt!")
Return Nothing
End Select
' Kopie von InBitmap erstellen
Dim OrgBmp As New Bitmap(InBitmap)
' leeres Bitmapobjekt erstellen
Dim ConvBmp As Bitmap = Nothing
Dim tBitmap As New GDIBITMAP
' OrgBmp.Handle -> tBitmap
If GetObjectA(OrgBmp.GetHbitmap, Len(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 = Len(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, OrgBmp.GetHbitmap, 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 ConvBMPData As BitmapData = _
ConvBmp.LockBits(New Rectangle(0, 0, _
ConvBmp.Width, ConvBmp.Height), _
ImageLockMode.WriteOnly, ToPixelFormat)
' DIB-Daten In den Speicher kopieren
Call Marshal.Copy(bytData, 0, _
ConvBMPData.Scan0, bytData.Length)
' Bitmapdaten im Speicher wieder freigeben
Call ConvBmp.UnlockBits(ConvBMPData)
' ist es eine Palettenbitmap
' 1bpp, 4bpp, 8bpp
If PalBmp Then
[/code ] | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
Neu! sevDTA 3.0 Pro
SEPA mit Kontonummernprüfung
Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Weitere InfosTipp des Monats TOP Entwickler-Paket
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR...
Jetzt nur 599,00 EURWeitere Infos
|
|
|
Copyright ©2000-2024 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|