Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0685: Farbtiefe einer Bitmap mittels GDI+ ändern

 von 

Beschreibung 

VB kann Bitmaps immer nur im Format der aktuellen Monitoreinstellung abspeichern. Bei einfachen Grafiken ist es jedoch oft sinnvoll ein Bild mit geringerer Farbtiefe oder sogar in schwarz/weiß abzuspeichern. Dieses Beispiel zeigt, wie mittels GDI+ die Farbtiefe einer Bitmap verändert werden kann.

Aktualisierung von Frank Schüler (12. Januar 2008):
Es wurden einige Probleme beim Konvertieren zwischen den Pixelformaten behoben.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CLSIDFromString, GdipCreateBitmapFromGdiDib (GdipCreateBitmapFromGdiDib256), GdipCreateHBITMAPFromBitmap, GdipDisposeImage, GdipSaveImageToFile, GdiplusShutdown, GdiplusStartup, GetDC, GetDIBits (GetDIBits256), GetObjectA (GetObject), OleCreatePictureIndirect, ReleaseDC

Download:

Download des Beispielprojektes [6,29 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!

'---- Anfang Projektdatei GDIPlusConvertPixelformat.vbp  ----
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--- Anfang Formular "frmGDIPlusConvertPixelformat" alias frmGDIPlusConvertPixelformat.frm  ---
' Steuerelement: Rahmensteuerelement "frPixelFormat"
' Steuerelement: Optionsfeld-Steuerelement "obPixelFormat" (Index von 0 bis 5) auf frPixelFormat
' Steuerelement: Schaltfläche "cmdSavePicture"
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: Schaltfläche "cmdLoadPicture"
' Steuerelement: Bildfeld-Steuerelement "picConv"
' Steuerelement: Bildfeld-Steuerelement "picOrg"
Option Explicit

' ----==== GDI+ Const ====----
Private Const GdiPlusVersion As Long = 1&

Private Const mimeBMP As String = _
    "{557CF400-1A04-11D3-9A73-0000F81EF32E}"

' ----==== sonstige Const ====----
Private Const DIB_RGB_COLORS As Long = 0&
Private Const BI_RGB As Long = 0&

Private Const IPictureCLSID As String = _
    "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
    
' ----==== sonstige Types ====----
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO256
    bmiHeader As BITMAPINFOHEADER
    bmiColors(0 To 255) As RGBQUAD
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hgdiObj As Long
    hPalOrXYExt As Long
End Type

' ----==== GDI+ Types ====----
Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private Type GdiplusStartupOutput
    NotificationHook As Long
    NotificationUnhook As Long
End Type

' ----==== GDI+ Enums ====----
Private Enum Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

' ----==== sonstige Enums ====----
Private Enum PixelFormat
    PixelFormat1bppIndexed = 1
    PixelFormat4bppIndexed = 4
    PixelFormat8bppIndexed = 8
    PixelFormat16bppRGB = 16
    PixelFormat24bppRGB = 24
    PixelFormat32bppRGB = 32
End Enum

' ----==== GDI+ Deklarationen ====----
Private Declare Function GdipCreateBitmapFromGdiDib256 Lib "gdiplus" _
                         Alias "GdipCreateBitmapFromGdiDib" ( _
                         ByRef mGdiBitmapInfo As BITMAPINFO256, _
                         ByVal mGdiBitmapData As Long, _
                         ByRef mBitmap As Long) As Status
                         
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" ( _
                         ByVal BITMAP As Long, _
                         ByRef hbmReturn As Long, _
                         ByVal Background As Long) As Status
                         
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
                         ByVal mImage As Long) As Status
                         
Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
                         ByVal token As Long) As Status
                         
Private Declare Function GdiplusStartup Lib "gdiplus" ( _
                         ByRef token As Long, _
                         ByRef lpInput As GDIPlusStartupInput, _
                         ByRef lpOutput As GdiplusStartupOutput) As Status
                         
Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
                         ByVal Image As Long, _
                         ByVal FileName As Long, _
                         ByRef clsidEncoder As GUID, _
                         ByRef encoderParams As Any) As Status
                         
' ----==== GDI32 Deklarationen ====----
Private Declare Function GetDIBits256 Lib "gdi32" _
                         Alias "GetDIBits" ( _
                         ByVal aHDC As Long, _
                         ByVal hBitmap As Long, _
                         ByVal nStartScan As Long, _
                         ByVal nNumScans As Long, _
                         ByRef lpBits As Any, _
                         ByRef lpBI As BITMAPINFO256, _
                         ByVal wUsage As Long) As Long
                         
Private Declare Function GetObject Lib "gdi32" _
                         Alias "GetObjectA" ( _
                         ByVal hObject As Long, _
                         ByVal nCount As Long, _
                         ByRef lpObject As Any) As Long
                         
' ----==== OLE32 Deklarationen ====----
Private Declare Function CLSIDFromString Lib "ole32" ( _
                         ByVal str As Long, _
                         ByRef id As GUID) As Long
                         
' ----==== OLEOUT32 Deklarationen ====----
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32" ( _
                    ByRef lpPictDesc As PICTDESC, _
                    ByRef riid As GUID, _
                    ByVal fOwn As Boolean, _
                    ByRef lplpvObj As Object)
                    
' ----==== USER32 Deklarationen ====----
Private Declare Function GetDC Lib "user32" ( _
                         ByVal Hwnd As Long) As Long
                         
Private Declare Function ReleaseDC Lib "user32" ( _
                         ByVal Hwnd As Long, _
                         ByVal hdc As Long) As Long
                         
' ----==== Variablen ====----
Private GdipToken As Long
Private GdipInitialized As Boolean
Private LastPixelFormat As PixelFormat

' ------------------------------------------------------
' Funktion     : SaveBitmap_AllRes
' Beschreibung : Speichert ein StdPicture als Bitmap
'                in einer anderen Farbtiefe ab
' Übergabewert : InPicture = StdPicture
'                FileName = Pfad\Datei.bmp
'                BitsPerPixel = Enum PixelFormat
' Rückgabewert : True = speichern war erfolgreich
'                False = speichern war nicht erfolgreich
' ------------------------------------------------------
Private Function SaveBitmap_AllRes(ByVal InPicture As StdPicture, ByVal _
    FileName As String, ByVal BitsPerPixel As PixelFormat) As Boolean
    
    Dim lngDC As Long
    Dim lngBitmap As Long
    Dim lngStride As Long
    Dim tGUID As GUID
    Dim tBitmap As BITMAP
    Dim tBITMAPINFO As BITMAPINFO256
    Dim bytData() As Byte
    Dim bolRet As Boolean

    ' ist GDI+ initialisiert
    If GdipInitialized Then
    
        ' BitsPerPixel auf gültige Werte prüfen
        Select Case BitsPerPixel
        
        Case 1, 4, 8, 16, 24, 32
        
            ' wenn kein Bild vorhanden oder
            ' kein Dateiname angegeben ist
            If InPicture = Empty Or Len(FileName) = 0 Then
            
                ' Funktion verlassen
                Exit Function
                
            End If
            
        Case Else
        
            MsgBox "Fehler!" & vbCrLf & "Dieses Bildformat wird nicht " & _
                "unterstützt!"
                
            ' Funktion verlassen
            Exit Function
            
        End Select
        
        ' InPicture.Handle -> tBitmap
        If GetObject(InPicture.Handle, Len(tBitmap), tBitmap) <> 0 Then
        
            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
            
            ' Breite einer Zeile, inklusiv eventuell vorhander PadBytes, in
            ' Abhängigkeit vom PixelFormat berechnen
            Select Case BitsPerPixel
            
            Case 1
                lngStride = ((tBitmap.bmWidth + 31) And Not 31) \ 8
                
            Case 4
                lngStride = ((tBitmap.bmWidth + 7) And Not 7) \ 2
                
            Case 8
                lngStride = (tBitmap.bmWidth + 3) And Not 3
                
            Case 16
                lngStride = ((tBitmap.bmWidth * 2) + 2) And Not 2
                
            Case 24
                lngStride = ((tBitmap.bmWidth * 3) + 3) And Not 3
                
            Case 32
                lngStride = tBitmap.bmWidth * 4
                
            End Select
            
            ' ByteArray zur Aufnahme der DIB-Daten dimensionieren
            ReDim bytData((tBitmap.bmHeight * lngStride) - 1)
            
            ' DC des Desktop ermitteln
            lngDC = GetDC(0&)
            
            ' ist ein DC vorhanden
            If lngDC <> 0 Then
            
                ' DIB-Daten auslesen -> bytData
                If GetDIBits256(lngDC, InPicture.Handle, 0&, _
                    tBitmap.bmHeight, bytData(0), tBITMAPINFO, _
                    DIB_RGB_COLORS) <> 0 Then
                    
                    ' GDI+ Bitmap aus den DIB-Daten erstellen -> lngBitmap
                    If Execute(GdipCreateBitmapFromGdiDib256(tBITMAPINFO, _
                        VarPtr(bytData(0)), lngBitmap)) = OK Then
                        
                        ' mimeBMP -> tGUID
                        If CLSIDFromString(StrPtr(mimeBMP), tGUID) = 0 Then
                        
                            ' lngBitmap als Bitmap speichern
                            If Execute(GdipSaveImageToFile(lngBitmap, _
                                StrPtr(FileName), tGUID, ByVal 0&)) = OK _
                                Then
                                
                                ' das speichern war erfolgreich
                                bolRet = True
                                
                            End If
                            
                        End If
                        
                        ' lngBitmap löschen
                        Call Execute(GdipDisposeImage(lngBitmap))
                        
                    End If
                    
                End If
                
                ' DC freigeben
                Call ReleaseDC(0&, lngDC)
                
            End If
            
        End If
        
    End If
    
    ' Status des speicherns zurückliefern
    SaveBitmap_AllRes = bolRet
    
End Function

' ------------------------------------------------------
' Funktion     : ConvBitmap_AllRes
' Beschreibung : Konvertiert ein StdPicture in
'                eine andere Farbtiefe
' Übergabewert : InPicture = StdPicture
'                BitsPerPixel = Enum PixelFormat
' Rückgabewert : konvertiertes StdPicture
' ------------------------------------------------------
Private Function ConvBitmap_AllRes(ByVal InPicture As StdPicture, ByVal _
    BitsPerPixel As PixelFormat) As StdPicture
    
    Dim lngDC As Long
    Dim lngBitmap As Long
    Dim lngStride As Long
    Dim hBitmap As Long
    Dim tBitmap As BITMAP
    Dim tBITMAPINFO As BITMAPINFO256
    Dim bytData() As Byte
    Dim oStdPicture As StdPicture
    
    ' ist GDI+ initialisiert
    If GdipInitialized Then
    
        ' BitsPerPixel auf gültige Werte prüfen
        Select Case BitsPerPixel
        
        Case 1, 4, 8, 16, 24, 32
        
            ' wenn kein Bild vorhanden ist
            If InPicture = Empty Then
            
                ' Funktion verlassen
                Exit Function
                
            End If
        
        Case Else
        
            MsgBox "Fehler!" & vbCrLf & "Dieses Bildformat wird nicht " & _
                "unterstützt!"
                
            ' Funktion verlassen
            Exit Function
            
        End Select
        
        ' InPicture.Handle -> tBitmap
        If GetObject(InPicture.Handle, Len(tBitmap), tBitmap) <> 0 Then
        
            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
            
            ' Breite einer Zeile, inklusiv eventuell vorhander PadBytes, in
            ' Abhängigkeit vom PixelFormat berechnen
            Select Case BitsPerPixel
            
            Case 1
                lngStride = ((tBitmap.bmWidth + 31) And Not 31) \ 8
                
            Case 4
                lngStride = ((tBitmap.bmWidth + 7) And Not 7) \ 2
                
            Case 8
                lngStride = (tBitmap.bmWidth + 3) And Not 3
                
            Case 16
                lngStride = ((tBitmap.bmWidth * 2) + 2) And Not 2
                
            Case 24
                lngStride = ((tBitmap.bmWidth * 3) + 3) And Not 3
                
            Case 32
                lngStride = tBitmap.bmWidth * 4
                
            End Select
            
            ' ByteArray zur Aufnahme der DIB-Daten dimensionieren
            ReDim bytData((tBitmap.bmHeight * lngStride) - 1)
            
            ' DC des Desktop ermitteln
            lngDC = GetDC(0&)
            
            ' ist ein DC vorhanden
            If lngDC <> 0 Then
            
                ' DIB-Daten auslesen -> bytData
                If GetDIBits256(lngDC, InPicture.Handle, 0&, _
                    tBitmap.bmHeight, bytData(0), tBITMAPINFO, _
                    DIB_RGB_COLORS) <> 0 Then
                    
                    ' GDI+ Bitmap aus den DIB-Daten erstellen -> lngBitmap
                    If Execute(GdipCreateBitmapFromGdiDib256(tBITMAPINFO, _
                        VarPtr(bytData(0)), lngBitmap)) = OK Then
                        
                        ' Handle von lngBitmap ermitteln -> hBitmap
                        If Execute(GdipCreateHBITMAPFromBitmap(lngBitmap, _
                            hBitmap, 0&)) = OK Then
                            
                            ' hBitmap zu einem StdPicture konvertieren
                            Set oStdPicture = HandleToPicture( _
                                hBitmap, vbPicTypeBitmap)
                                
                        End If
                        
                        ' lngBitmap löschen
                        Call Execute(GdipDisposeImage(lngBitmap))
                        
                    End If
                    
                End If
                
                ' DC freigeben
                Call ReleaseDC(0&, lngDC)
                
            End If
            
        End If
        
    End If
    
    ' konvertiertes Bitmap zurückliefern
    Set ConvBitmap_AllRes = oStdPicture
    
End Function

' ------------------------------------------------------
' Funktion     : HandleToPicture
' Beschreibung : Umwandeln eines Bitmap Handle
'                in ein StdPicture Objekt
' Übergabewert : hGDIHandle = Bitmap Handle
'                ObjectType = Bitmaptyp
' Rückgabewert : StdPicture Objekt
' ------------------------------------------------------
Private Function HandleToPicture(ByVal hGDIHandle As Long, ByVal _
    ObjectType As PictureTypeConstants, Optional ByVal hPal As Long = 0) _
    As StdPicture
    
    Dim tPictDesc As PICTDESC
    Dim IID_IPicture As GUID
    Dim oPicture As IPicture
    
    ' IPictureCLSID -> IID_IPicture
    If CLSIDFromString(StrPtr(IPictureCLSID), IID_IPicture) = 0 Then
    
        ' Initialisiert die PICTDESC Structur
        With tPictDesc
        
            .cbSizeOfStruct = Len(tPictDesc)
            .picType = ObjectType
            .hgdiObj = hGDIHandle
            .hPalOrXYExt = hPal
            
        End With
        
        ' StdPicture aus Handle erstellen
        Call OleCreatePictureIndirect(tPictDesc, IID_IPicture, True, _
            oPicture)
            
        ' StdPicture zurückliefern
        Set HandleToPicture = oPicture
        
    End If
    
End Function

' ------------------------------------------------------
' Funktion     : StartUpGDIPlus
' Beschreibung : Initialisiert GDI+ Instanz
' Übergabewert : GDI+ Version
' Rückgabewert : GDI+ Status
' ------------------------------------------------------
Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status

    ' Initialisieren der GDI+ Instanz
    Dim GdipStartupInput As GDIPlusStartupInput
    Dim GdipStartupOutput As GdiplusStartupOutput
    
    GdipStartupInput.GdiPlusVersion = GdipVersion
    
    StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, _
        GdipStartupOutput)
        
End Function

' ------------------------------------------------------
' Funktion     : ShutdownGDIPlus
' Beschreibung : Beendet die GDI+ Instanz
' Rückgabewert : GDI+ Status
' ------------------------------------------------------
Private Function ShutdownGDIPlus() As Status

    ' Beendet GDI+ Instanz
    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
    
End Function

' ------------------------------------------------------
' Funktion     : Execute
' Beschreibung : Gibt im Fehlerfall die entsprechende
'                GDI+ Fehlermeldung aus
' Übergabewert : GDI+ Status
' Rückgabewert : GDI+ Status
' ------------------------------------------------------
Private Function Execute(ByVal eReturn As Status) As Status

    Dim eCurErr As Status
    
    If eReturn = OK Then
    
        eCurErr = OK
        
    Else
    
        eCurErr = eReturn
        
        MsgBox GdiErrorString(eReturn) & " GDI+ Error:" & eReturn, _
            vbOKOnly, "GDI Error"
            
    End If
    
    Execute = eCurErr
    
End Function

' ------------------------------------------------------
' Funktion     : GdiErrorString
' Beschreibung : Umwandlung der GDI+ Statuscodes in Stringcodes
' Übergabewert : GDI+ Status
' Rückgabewert : Fehlercode als String
' ------------------------------------------------------
Private Function GdiErrorString(ByVal eError As Status) As String

    Dim s As String
    
    Select Case eError
    
    Case GenericError:              s = "Generic Error."
    Case InvalidParameter:          s = "Invalid Parameter."
    Case OutOfMemory:               s = "Out Of Memory."
    Case ObjectBusy:                s = "Object Busy."
    Case InsufficientBuffer:        s = "Insufficient Buffer."
    Case NotImplemented:            s = "Not Implemented."
    Case Win32Error:                s = "Win32 Error."
    Case WrongState:                s = "Wrong State."
    Case Aborted:                   s = "Aborted."
    Case FileNotFound:              s = "File Not Found."
    Case ValueOverflow:             s = "Value Overflow."
    Case AccessDenied:              s = "Access Denied."
    Case UnknownImageFormat:        s = "Unknown Image Format."
    Case FontFamilyNotFound:        s = "FontFamily Not Found."
    Case FontStyleNotFound:         s = "FontStyle Not Found."
    Case NotTrueTypeFont:           s = "Not TrueType Font."
    Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
    Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
    Case PropertyNotFound:          s = "Property Not Found."
    Case PropertyNotSupported:      s = "Property Not Supported."
    Case ProfileNotFound:           s = "Profile Not Found"
    Case Else:                      s = "Unknown GDI+ Error."
    
    End Select
    
    GdiErrorString = s
    
End Function

Private Sub cmdLoadPicture_Click()

    ' Fehlerbehandlung
    On Error Goto errorhandler
    
    ' ist GDI+ initialisiert
    If GdipInitialized Then
    
        ' Dialogparameter setzen
        With CommonDialog1
        
            .Filter = "All Picture Files (*.BMP;*.DIB;*.JPG;*.GIF;*.EM" & _
                "F;*.WMF;*.ICO;*.CUR)|*.BMP;*.DIB;*.JPG;*.GIF;*.EMF;*." & _
                "WMF;*.ICO;*.CUR"
                
            .CancelError = True
            
            .ShowOpen
            
        End With
        
        ' Frame und Button aktivieren
        frPixelFormat.Enabled = True
        cmdSavePicture.Enabled = True
        
        ' Bild laden
        picOrg.Picture = LoadPicture(CommonDialog1.FileName)
        
        ' Bild konvertieren
        picConv.Picture = ConvBitmap_AllRes(picOrg.Picture, _
            LastPixelFormat)
            
    End If
    
    Exit Sub
    
errorhandler:

End Sub

Private Sub cmdSavePicture_Click()

    ' Fehlerbehandlung
    On Error Goto errorhandler
    
    ' ist GDI+ initialisiert
    If GdipInitialized Then
    
        ' Dialogparameter setzen
        With CommonDialog1
        
            .Filter = "Bitmap Files (*.BMP|*.BMP"
            .FileName = "*.bmp"
            .CancelError = True
            .ShowSave
            .Flags = cdlOFNOverwritePrompt
            
        End With
        
        ' Bild konvertieren und speichern
        If SaveBitmap_AllRes(picConv.Picture, CommonDialog1.FileName, _
            LastPixelFormat) Then
        
            MsgBox "Das speichern der Bitmap war erfolgreich.", _
                vbOKOnly Or vbInformation
        
        Else
        
            MsgBox "Das speichern der Bitmap war nicht erfolgreich.", _
                vbOKOnly Or vbCritical
        
        End If
            
    End If
    
    Exit Sub
    
errorhandler:

End Sub

Private Sub Form_Load()

    GdipInitialized = False
    LastPixelFormat = PixelFormat24bppRGB
    cmdSavePicture.Enabled = False
    cmdLoadPicture.Enabled = False
    frPixelFormat.Enabled = False
    
    ' GDI+ starten
    If Execute(StartUpGDIPlus(GdiPlusVersion)) = OK Then
    
        GdipInitialized = True
        
        cmdLoadPicture.Enabled = True
        
    Else
    
        MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error"
        
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    If GdipInitialized = True Then
    
        ' GDI+ beenden
        Call Execute(ShutdownGDIPlus)
        
    End If
    
End Sub

Private Sub obPixelFormat_Click(Index As Integer)

    Select Case Index
    
    Case 0
        LastPixelFormat = PixelFormat1bppIndexed
        
    Case 1
        LastPixelFormat = PixelFormat4bppIndexed
        
    Case 2
        LastPixelFormat = PixelFormat8bppIndexed
        
    Case 3
        LastPixelFormat = PixelFormat16bppRGB
        
    Case 4
        LastPixelFormat = PixelFormat24bppRGB
        
    Case 5
        LastPixelFormat = PixelFormat32bppRGB
        
    End Select
    
    picConv.Picture = ConvBitmap_AllRes(picOrg.Picture, LastPixelFormat)
    
End Sub
'--- Ende Formular "frmGDIPlusConvertPixelformat" alias frmGDIPlusConvertPixelformat.frm  ---
'----- Ende Projektdatei GDIPlusConvertPixelformat.vbp  -----

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Frank Schüler am 01.02.2007 um 12:03

Hallo Jürgen.

Du hast Post.

MFG Frank

Kommentar von FienauBerlin am 01.02.2007 um 11:27

Da dieses Script unter WinXP auch nur mit der Version 6.xxx funktioniert, hoffe ich Ihr habt für mich vielleicht eine Lösung. Wie schaffe ich es, ohne das System zu ändern, die GDIplus.dll aus meinen Install-Ordner heraus für meine Anwendung zum laufen zu bringen, wie es zB. MS-Office macht. Registrieren, auch durch das Installationssript von Inno (restartreplace uninsneveruninstall sharedfile regserver), funktioniert leider nicht (Fehlermeldung). Oder gibt es eine Alternative?
Vielen Dank
Gruß
Jürgen Fienau
www.web-computerecke.de

Kommentar von Frank Schüler am 11.07.2006 um 06:42

Der Fehler ist mir bekannt. Leider funktioniert der Tipp 0685 erst mit der GDI+ Version 6.xx korrekt. In Deinem Fall ist der Tipp 0688 der richtige. Dieser Tipp funktioniert mit der Version 5 und 6 der GDI+. Wenn Du ein Schwarz/Weiß TIFF erstellen möchtest, kannst Du die Komprimierungsmodi "TiffCompressionCCITT3" und "TiffCompressionCCITT4" verwenden.

Kommentar von Uwe Engel am 10.07.2006 um 16:55

Hallo,
wir wollen aus einer vom HOST kommenden Textdatei ein schwarz/weiß TIFF erstellen.
Bei mir (W2000 SP 4 Version 5) wird jedoch immer der GDI Error 3 Out of memory angezeigt, sobald ich die Datei mit einer Farbtiefe von weniger als 16 bpp RGB 555 anzeigen will.
Der Fehler tritt auch auf, wenn die Ursprungsdatei bereits eine Farbtiefe von 1 bpp Indexed hat.
Woran kann das liegen und wie stelle ich das ab?

Viele Grüße
Uwe Engel