Ersatz für die VB6-LoadPicture Funktion Ersatzfunktion für fehlerbehaftetes LOADPICTURE durch GDIPLUS.DLL, mit der sich auch PNG- und TIF-Grafiken laden und anzeigen lassen.
Autor:   Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  85.271
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 52 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

JPEG- und GIF-Bilder können in Visual-Basic-Programmen durch die Funktion 'LOADPICTURE' geladen werden, aber ...

DIE VB-FUNKTION 'LOADPICTURE' ARBEITET NICHT IMMER FEHLERFREI !!

Beim Zugriff auf (stark) beschädigte Bild-Dateien des Typs GIF oder JPG kann es zu einer Endlosschleife kommen. Das betroffene Programm kann dann nur noch 'abgeschossen' werden. In seltenen Fällen kommt es beim Laden von JPG-komprimierten Bildern direkt zu einem Programmabsturz. Der Fehler wird auch durch das Service Pack 6 nicht behoben.

Mit WINDOWS XP wird die Bibliothek 'GDIPLUS.DLL' ausgeliefert. Bei älteren Windows-Versionen muss diese Bibliothek ergänzt und in den Systemordner kopiert werden.

Wer den möglichen Fehler in VB.LoadPicture umgehen will, kann das beigefügte Modul in seine Anwendung aufnehmen und die Aufrufe der Funktion 'LOADPICTURE' durch 'LOADPIC' ersetzen. Die Funktions-Parameter müssen dabei nicht geändert werden.

Die Ersatzfunktion 'LOADPIC' verwendet beim Laden von Bildern des Typs Bitmap, Metafile, Icon- oder Cursor intern weiterhin die VB-Funktion 'LOADPICTURE'.

Bildateien des Formats GIF, JPG, PNG und TIF werden durch Zugriff auf Funktionen der GDIPLUS.DLL geladen. Die Parameter 2-5 werden in diesem Fall ignoriert. Sie beziehen sich auf das Laden von 'Symboldateien' (Icons, Cursor).

Hinweise:

• GDIPLUS ist nur wenig fehler-tolerant. Manche beschädigte Bilder, die von anderen Graphik-Bibliotheken und Bildverarbeitungs-Programmen (teilweise) rekonstruiert werden können, werden von GDIPLUS nicht geladen.
   
• Falls eine Bild-Datei nicht geladen werden kann, meldet GDIPLUS meist die Fehlernummer 2 (ungeeigneter Parameter), gelegentlich Fehlernummer 7 (Windows-Fehler).
   
• 'LOADPIC' besitzt drei zusätzliche optionale Parameter. Der Rückgabe-Parameter 'Meldung' enthält ggf. eine Information über den Abbruch des Ladevorgangs. Der boolsche Parameter 'LOADPICTURE_ERLAUBT' führt dazu ('true'), dass bei fehlender 'GDIPLUS.DLL' auf 'VB.LOADPICTURE' ausgewichen wird (bezieht sich nur auf GIF/JPG-Dateien). Der boolsche Parameter 'BitmapPerGDIPlus' legt fest, wie Bitmap-Dateien (BMP, DIB, RLE) geladen werden.
   
• Die Routinen der Bibliothek 'GDIPLUS.DLL' kann mehr als nur Bild-Dateien laden. Beispiele zur Bildbearbeitung findet man z.B. bei 'www.vbaccelerator.com'.

Fügen Sie nachfolgenden Code in ein Modul ein:

' JPG- und GIF-komprimierte Bilder laden (GDIPLUS.DLL)
' TIF / PNG werden zusätzlich unterstützt
' Ersatz für fehlerbehaftete VB6-Funktion 'LoadPicture'
' durch die Routine 'LoadPic'
Option Explicit
 
' VB-Version eines 'General Unique Identifiers' (128 Bit)
Private Type GUID
  Data(0 To 15) As Byte
End Type
 
' VB-Version des Bildbeschreibungs-Typs
' (Parameter für 'OleCreatePictureIndirect')
Private Type PICTURE_DESCRIPTION
  cbSize As Long
  PicType As Long
  handle As Long
  hPal As Long
End Type
 
' SDK-Funktion: Erzeugt und Initialisiert ein Bild
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
  PictDesc As PICTURE_DESCRIPTION, _
  PICTURE_ID As GUID, _
  ByVal Destroy As Boolean, _
  InterfacePointer As Object) As Long
 
' SDK-Funktion: Erzeugt aus einem String einen GUID
Private Declare Function CLSIDFromString Lib "ole32" ( _
  ByVal StrPointer As Long, _
  Id As GUID) As Long
 
' ===================================================================
' GDIPLUS: benötigte Deklarationen für die Verbindung
' ===================================================================
' Verbindungsinformationen
Private Type GdiPlusConnection
  GdiplusVersion As Long
  etcetera(1 To 12) As Byte
End Type
 
' Verbindung herstellen
Private Declare Function GdiplusStartup Lib "gdiplus" ( _
  pointer As Long, _
  inputbuffer As GdiPlusConnection, _
  Optional ByVal outputbuffer As Long = 0) As Long
 
' Verbindung lösen
Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
  ByVal pointer As Long) As Long
 
' ===================================================================
' GDIPLUS: benötigte Funktionen (Laden)
' ===================================================================
 
' GDIPlus-Funktion zum Laden eines Bildes aus einer Datei
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" ( _
  ByVal FileName As Long, _
  BITMAP As Long) As Long
 
' GDIPlus-Funktion zur Erzeugung einer GDIPlus-kompatiblen Bitmap
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" ( _
  ByVal BITMAP As Long, _
  HBITMAP As Long, _
  ByVal etcetera As Long) As Long
 
' GDIPlus-Funktion: Freigabe einer Bild-Ressource
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
  ByVal image As Long) As Long

Public Function LoadPic(Optional ByVal FileName As String, _
  Optional ByVal Size As Variant, _
  Optional ByVal ColorDepth As Variant, _
  Optional ByVal x As Variant, _
  Optional ByVal y As Variant, _
  Optional ByRef Meldung As String, _
  Optional ByVal LoadPicture_Erlaubt As Boolean = False, _
  Optional ByVal BitmapPerGDIPLUS As Boolean = False) As StdPicture
 
  ' Ersatzfunktion für VB.Loadpicture
 
  Dim ext As String             ' Datei-Extension
  Dim ext4 As String
 
  Dim con As GdiPlusConnection  ' GDIPlus einrichten
  Dim GDI_Connection As Long
  Dim Retcode As Long
  Dim lp As Boolean             ' VB.LoadPicture verwenden?
 
  On Error GoTo fehler
 
  Meldung = ""
  Set LoadPic = Nothing
 
  FileName = Trim(FileName)
 
  ' Löschfunktion von VB.Loadpicture ?
  If FileName = "" Then
    Set LoadPic = VB.LoadPicture()
    Exit Function
  End If
 
  If Len(FileName) < 5 Then
    Meldung = "Ungeeigneter Dateiname"
    Exit Function
  End If
 
  ' Datei vorhanden?
  If Dir$(FileName, vbNormal Or vbReadOnly Or vbHidden) = "" Then
    Meldung = "Datei nicht vorhanden/verfügbar"
    Exit Function
  End If
 
  ' Leere / kurze Datei ?
  If FileLen(FileName) < 10 Then
    Meldung = "Leere Datei"
    Exit Function
  End If
 
  ' File-Typ checken
  ext = Right$(LCase$(FileName), 4)
  ext4 = Right$(LCase$(FileName), 5)
 
  ' geeignetes Verfahren für Bildformat festlegen
  If ext = ".bmp" Or ext = ".dib" Or ext = ".rle" Then
    If BitmapPerGDIPLUS Then
      lp = False  ' GDIPLUS für Bitmaps verlangt
    Else
      lp = True   ' Bitmaps per VB.Loadpicturey
    End If
  ElseIf ext = ".ico" Or ext = ".cur" _
    Or ext = ".emf" Or ext = ".wmf" Then
    lp = True   ' stets VB.Loadpicture verwenden
  ElseIf ext = ".gif" Or ext = ".png" _
    Or ext = ".tif" Or ext4 = ".tiff" _
    Or ext = ".jpe" Or ext = ".jpg" Or _
    ext4 = ".jpeg" Or ext4 = ".jfif" Then
    lp = False  ' GDIPLUS verwenden
  Else
    Meldung = "Bildformat wird nicht unterstützt"
    Exit Function
  End If
 
  ' GDIPLus erforderlich oder angefordert?
  If Not lp Then
    ' GDIPlus vorhanden ?
    ' Initialisierung durchführen
    con.GdiplusVersion = 1
    Retcode = 18
    On Error Resume Next
    Retcode = GdiplusStartup(GDI_Connection, con)
    If Retcode <> 0 Then
      If Not LoadPicture_Erlaubt Then
        Meldung = "Initialisierung scheitert" + _
        vbCrLf + GDIPLUS_Fehler(Retcode)
        ' GDIPLUS nicht verfügbar
        Exit Function
      Else
        lp = True ' VB.Loadpicture verwenden
      End If
    End If
    On Error GoTo fehler
  End If
 
  ' Bild laden
  If lp Then
    ' Dateiname verweist auf
    ' ( Bitmap), (Enh)Metafile, Icon oder Cursor
    ' oder:
    ' GDIPlus fehlt
    ' ---> VB.Loadpicture verwenden
    Set LoadPic = VB.LoadPicture(FileName, Size, ColorDepth, x, y)
    If LoadPic Is Nothing Then
      Meldung = "Laden des Bildes scheitert (Loadpicture)"
    End If
  Else
    ' Dateiname verweist auf ein komprim. Bildformat
    ' oder Bitmap falls gewünscht
    ' ---> GDIPlus verwenden
    ' Die LoadPicture-Parameter für Icons/Cursor
    ' werden hier nícht beachtet
    Set LoadPic = iLoadPic(FileName, Meldung)
  End If
 
  ' Wichtig: GDIPlus nach Gebrauch freigeben
  ' sonst droht IDE-Absturz
  If GDI_Connection <> 0 Then
    GdiplusShutdown GDI_Connection
  End If
  Exit Function
 
fehler:
  Meldung = Err.Description
  If GDI_Connection <> 0 Then
    GdiplusShutdown GDI_Connection
  End If
End Function

Private Function iLoadPic(ByVal Bild_Datei As String, _
  Optional ByRef Meldung As String) As StdPicture
 
  ' Laden eines Bildes aus einer Datei (GDIPlus)
 
  Dim Retcode As Long                    ' Funktionsrückgabe
  Dim lBitmap As Long, HBITMAP As Long   ' Zeiger auf Bitmaps
  Dim ext As String                      ' Datei-Extension
 
  ' Rückgabe initialisieren
  Set iLoadPic = Nothing
  Meldung = ""
 
  ' Bilddatei öffnen
  Retcode = GdipCreateBitmapFromFile(StrPtr(Bild_Datei), lBitmap)
  If Retcode = 0 Then
    ' GDI-Bitmap erzeugen
    Retcode = GdipCreateHBITMAPFromBitmap(lBitmap, HBITMAP, 0&)
    If Retcode = 0 Then
      ' StdPicture-Object aus GDI-Bitmap erzeugen
      Set iLoadPic = HandleToPicture(HBITMAP)
      If iLoadPic Is Nothing Then
        Meldung = "Bitmap kann nicht aus Handle erstellt werden"
      End If
    Else
      Meldung = "Bitmap-Handle kann nicht erzeugt werden" _
        + vbCrLf + GDIPLUS_Fehler(Retcode)
    End If
    ' Ressource freigeben
    GdipDisposeImage lBitmap
  Else
    Meldung = "Bitmap kann nicht aus Bild-Datei erstellt werden" _
      + vbCrLf + GDIPLUS_Fehler(Retcode)
  End If
End Function

Private Function HandleToPicture(ByVal GDI_Handle As Long) As StdPicture
  ' Hilfsfunktion für: LoadPicture
  ' aus dem übergebenen Bild-Handle wird
  ' ein StdPicture-Objekt erstellt
  ' per 'OLECREATEPICTUREINDIRECT'
 
  Dim PictDesc As PICTURE_DESCRIPTION  ' Beschreibung des gew. Bildes
  Dim PICTURE_ID As GUID
  Dim KennString As String
  Dim oPicture As IPicture
  Dim Retcode As Long                   ' Funktions-Rückgabe
 
  ' Rückgabe initialisieren
  Set HandleToPicture = Nothing
 
  ' Initialisierung der PICTDESC-Variable
  With PictDesc
    .cbSize = Len(PictDesc)
    .PicType = vbPicTypeBitmap
    .handle = GDI_Handle
    .hPal = 0&
  End With
 
  ' GUID für IPicture erstellen
  KennString = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
  Retcode = CLSIDFromString(StrPtr(KennString), PICTURE_ID)
  If Retcode <> 0 Then Exit Function
 
  ' Bild erzeugen
  Retcode = OleCreatePictureIndirect(PictDesc, PICTURE_ID, True, oPicture)
  If Retcode <> 0 Then
    Exit Function ' Fehler beim Erstellen
  End If
 
  ' Verweis auf das erstellte Bild zurückgeben
  Set HandleToPicture = oPicture
End Function

Private Function GDIPLUS_Fehler(ByVal Errorcode As Long) As String
  ' Wichtige GDIPlus-Fehlermeldungen
  Dim r(1 To 20) As String
 
  If Errorcode < 1 Or Errorcode > 20 Then Exit Function
 
  r(1) = "fehlerhafte Initialisierung"
  r(2) = "Ungeeigneter Parameter"
  r(3) = "Speichermangel"
  r(4) = "GDIPlus ist noch beschäftigt"
  r(5) = "Buffer zu klein"
  r(7) = "Windows32-Fehler"
  r(8) = "Falscher interner Zustand"
  r(9) = "Abbruch der Operation"
  r(10) = "Datei nicht gefunden"
  r(11) = "Wert-Überlauf"
  r(12) = "Zugriff verweigert"
  r(13) = "unbekanntes Bildformat"
  r(17) = "GDIPlus-Version wird nicht unterstützt"
  r(18) = "Keine GDIPlus-Verbindung"
  r(19) = "Eigenschaft nicht gefunden"
  r(20) = "Eigenschaft wird nicht unterstützt"
 
  GDIPLUS_Fehler = r(Errorcode)
End Function

Beispiel für den Aufruf:

Dim sMessage As String
 
Image1.Picture = LoadPic("d:\bilder\bild1.png", , , , , sMessage)
If Len(sMessage) > 0 Then MsgBox sMessage