Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0713: Bildformat einer Grafikdatei ermitteln

VB 5/6-Tipp 0713: Bildformat einer Grafikdatei ermitteln

 von Frank Schüler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GdipDisposeImage, GdipGetImageRawFormat, GdipLoadImageFromFile, GdiplusShutdown, GdiplusStartup, StringFromGUID2

Download: Download des Beispielprojektes [208,3 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 GdipImageFormat.vbp  ---------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--- Anfang Formular "frmGdipImageFormat" alias frmGdipImageFormat.frm  ---
' Steuerelement: Standarddialog-Steuerelement "CDlg"
' Steuerelement: Schaltfläche "Command1"
Option Explicit

' ----==== GDIPlus Const ====----
Private Const GdiPlusVersion As Long = 1&

Private Const ImageFormatBMP As String = _
    "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatEMF As String = _
    "{B96B3CAC-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatEXIF As String = _
    "{B96B3CB2-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatGIF As String = _
    "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatIcon As String = _
    "{B96B3CB5-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatJPEG As String = _
    "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatMemoryBMP As String = _
    "{B96B3CAA-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatPNG As String = _
    "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatTIFF As String = _
    "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatUndefined As String = _
    "{B96B3CA9-0728-11D3-9D7B-0000F81EF32E}"
    
Private Const ImageFormatWMF As String = _
    "{B96B3CAD-0728-11D3-9D7B-0000F81EF32E}"
    
' ----==== GDIPlus Types ====----
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

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

' ----==== GDIPlus Enums ====----
Private Enum Status ' GDI+ 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

' ----==== GDI+ API Deklarationen ====----
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
                         ByVal image As Long) As Status
                         
Private Declare Function GdipGetImageRawFormat Lib "gdiplus" ( _
                         ByVal image As Long, _
                         ByRef format As GUID) As Status
                         
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _
                         ByVal FileName As Long, _
                         ByRef image 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
                         
' ----==== OLE32 API Deklarationen ====----
Private Declare Function StringFromGUID2 Lib "ole32.dll" ( _
                         ByRef rguid As GUID, _
                         ByVal lpsz As Long, _
                         ByVal cchMax As Long) As Long
                         
' ----==== Variablen ====----
Private GdipToken As Long
Private GdipInitialized As Boolean

' ------------------------------------------------------
' Funktion     : GetImageFormat
' Beschreibung : Ermitteln des Imageformates
' Übergabewert : FileName = Pfad\Bild.ext
' Rückgabewert : Imagefotmat als String
' ------------------------------------------------------
Private Function GetImageFormat(ByVal FileName As String) As String

    Dim lngImage As Long
    Dim lngRet As Long
    Dim tGUID As GUID
    Dim strGUID As String
    Dim strImageFormat As String
    
    ' ist die Länge des Strings > 0
    If Len(FileName) > 0 Then
    
        ' ist GDI+ initialisiert
        If GdipInitialized Then
        
            ' Bild laden -> lngImage
            If Execute(GdipLoadImageFromFile(StrPtr(FileName), lngImage)) = _
                OK Then
                
                ' GUID des Bildes ermitteln -> tGUID
                If Execute(GdipGetImageRawFormat(lngImage, tGUID)) = OK Then
                
                    strGUID = String$(40, vbNullChar)
                
                    ' tGUID in einen String konvertieren -> strGUID
                    lngRet = StringFromGUID2(tGUID, StrPtr(strGUID), Len(strGUID) - 1)
                
                    If lngRet > 0 Then
                    
                        ' strGUID auswerten
                        Select Case Left$(strGUID, lngRet - 1)
                        
                        Case ImageFormatBMP
                            strImageFormat = "BMP"
                            
                        Case ImageFormatEMF
                            strImageFormat = "EMF"
                            
                        Case ImageFormatEXIF
                            strImageFormat = "EXIF"
                            
                        Case ImageFormatGIF
                            strImageFormat = "GIF"
                            
                        Case ImageFormatIcon
                            strImageFormat = "ICON"
                            
                        Case ImageFormatJPEG
                            strImageFormat = "JPEG"
                            
                        Case ImageFormatMemoryBMP
                            strImageFormat = "MemoryBMP"
                            
                        Case ImageFormatPNG
                            strImageFormat = "PNG"
                            
                        Case ImageFormatTIFF
                            strImageFormat = "TIFF"
                            
                        Case ImageFormatUndefined
                            strImageFormat = "Undefined"
                            
                        Case ImageFormatWMF
                            strImageFormat = "WMF"
                            
                        End Select
                        
                    End If
                End If
                
                ' lngImage löschen
                Call Execute(GdipDisposeImage(lngImage))
                
            End If
        End If
    End If
    
    GetImageFormat = strImageFormat
    
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 Command1_Click()

    Dim strImagesPath As String
    
    ' Fehlerbehandlung
    On Error Goto errorhandler
    strImagesPath = App.Path
    
    If Right$(strImagesPath, 1) <> "\" Then strImagesPath = strImagesPath & _
        "\"
        
    strImagesPath = strImagesPath & "Images\"
    
    ' Parameter für den Commondialog setzen
    With CDlg
    
        .CancelError = True
        .Filter = "All Files|*.BMP; *.DIB; *.RLE; *.JPG; *.JPEG; " & _
            "*.JPE; *.JFIF; *.GIF; *.EMF; *.WMF; *.TIF; *.TIFF; " & _
            "*.PNG; *.ICO"
        .InitDir = strImagesPath
        .ShowOpen
        
    End With
    
    ' Ausgabe der Infos
    MsgBox "Bei der Datei " & Chr$(34) & CDlg.FileTitle & Chr$(34) & _
        " handelt es sich um eine " & GetImageFormat(CDlg.FileName) & _
        " Datei."
        
    Exit Sub
    
errorhandler:

End Sub

Private Sub Form_Load()

    GdipInitialized = False
    
    ' GDI+ starten
    If Execute(StartUpGDIPlus(GdiPlusVersion)) = OK Then
    
        GdipInitialized = 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

'--- Ende Formular "frmGdipImageFormat" alias frmGdipImageFormat.frm  ---
'---------- Ende Projektdatei GdipImageFormat.vbp  ----------