Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" ( _
  ByVal hGlobal As Long, _
  ByVal fDeleteOnRelease As Long, _
  lpIStream As IUnknown) As Long
 
Private Declare Function OleLoadPicture Lib "oleaut32.dll" ( _
  ByVal lpStream As IUnknown, _
  ByVal lSize As Long, _
  ByVal fRunmode As Long, _
  riid As Any, _
  lpIPicture As IPicture) As Long
 
Private Type PackFile 'Type für die einzelnen Dateien
  FileName As String  'Hier steht der Dateiname der Datei
  Contents As String  'Hier der Inhalt
End Type
 
Dim Files(0) As PackFile   'Wir haben 2 Dateien zum entpacken
Dim Programme(0) As String 'und 2 Dateien zum Verpacken
Public Function Bild_laden(Source As String) As StdPicture
  Dim FNr As Long
  Dim i As Long
  Dim bImg() As Byte
  Dim IID_IPicture(3) As Long
  Dim oPicture As IPicture
  Dim hGlobal As Long
  Dim oStream As IUnknown
  Dim nResult As Long
 
 
  FNr = FreeFile
  Open Source For Binary As #FNr        'Zu entpackende Datei öffnen
    Get #FNr, , Files                   'und eilesen
  Close
  FNr = FreeFile
 
 
        bImg() = Files(0).Contents
 
 
     ' Array füllen um den KlassenID (CLSID) IID_IPICTURE
  ' zu simulieren
  IID_IPicture(0) = &H7BF80980
  IID_IPicture(1) = &H101ABF32
  IID_IPicture(2) = &HAA00BB8B
  IID_IPicture(3) = &HAB0C3000
 
  ' Stream erstellen
  Call CreateStreamOnHGlobal(VarPtr(bImg(LBound(bImg))), 0, oStream)
 
  ' OLE IPicture-Objekt erstellen
  nResult = OleLoadPicture(oStream, 0, 0, IID_IPicture(0), oPicture)
    If nResult = 0 Then
        Set Bild_laden = oPicture
    End If
End Function
 
'Funktion um den Dateinamen aus dem Pfad zu "extrahieren"
Public Function GetFileName(xFile As String) As String
  Dim a() As String
 
  a = Split(xFile, "\") 'Pfad aufsplitten
 
  GetFileName = a(UBound(a())) 'Der Dateiname ist der Letzte Abschnitt
End Function

-------------------------
AMD 1800+ | 1 GB SDRAM | Win XP Home SP2 | MSI Geforce 7600GS 256 MB
Visual Basic 2005 | MVS 6