Schön, dass es in VB für das Anzeigen von Grafiken ein ImageBox- bzw. PictureBox-Control gibt. Schade nur, dass bei sehr großen Bilddateien kein Lade-Fortschritt angezeigt werden kann. Aber was heißt eigentlich schade. Wäre in VB alles möglich, bräuchte man das vb@rchiv ja nicht Unser Extra-Tipp "Dezember 2003" stellt Ihnen eine Klasse vor, mit deren Hilfe sich Bilddateien lassen lassen - und zwar mit Fortschrittsanzeige. Erstellen Sie ein neues Projekt, platzieren auf die Form ein ImageBox-Control, eine ProgressBar (Windows-Common-Controls), sowie einen CommandButton. Erstellen Sie jetzt noch ein Klassenmodul, nennen es clsLoadBitmap und fügen nachfolgenden Code in das Codefenster des Klassenmoduls ein: Option Explicit ' Benötigte API-Deklarationen Private Declare Function GlobalAlloc Lib "kernel32" ( _ ByVal wFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" ( _ ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" ( _ ByVal hMem As Long) As Long Private Declare Function GlobalUnlock Lib "kernel32" ( _ ByVal hMem As Long) As Long 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 Declare Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameA" ( _ ByVal lpszLongPath As String, _ ByVal lpszShortPath As String, _ ByVal cchBuffer As Long) As Long Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" ( _ ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ Optional ByVal dwFlagsAndAttributes As Long = 0, _ Optional ByVal hTemplateFile As Long = 0) As Long Private Declare Function GetFileSize Lib "kernel32" ( _ ByVal hFile As Long, _ lpFileSizeHigh As Long) As Long Private Declare Function ReadFile Lib "kernel32" ( _ ByVal hFile As Long, _ lpBuffer As Any, _ ByVal nNumberOfBytesToRead As Long, _ lpNumberOfBytesRead As Long, _ Optional ByVal lpOverlapped As Long = 0) As Long Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long) As Long Private Const GMEM_MOVEABLE = &H2 Private Const GENERIC_READ = &H80000000 Private Const OPEN_EXISTING = 3 Private Const FILE_SHARE_READ = &H1 Private Const BUFFER_READ = 256 ' beschreibt die Datenmenge in ' Bytes die pro Durchlauf eingelesen ' werden ' Ereignis für die Fortschrittsanzeige Public Event LoadProgress(ByVal BytesRead As Long, _ ByVal BytesLeft As Long, ByVal TotalBytes As Long) ' Bild aus Datei laden und als "StdPicture" zurückgeben Public Function LoadBitmap(ByVal FileName As String) As StdPicture Dim Retval As Long Dim FilePath As String Dim FileLength As Long Dim I As Long, BytesRead As Long Dim hMem As Long Dim pMem As Long Dim hFile As Long Dim TmpStr As String * 256 Dim IStream As IUnknown Dim IID_IPicture(3) As Long Dim TmpPicture As IPicture ' kurzen Dateipfad ermitteln FilePath = Space(256) Retval = GetShortPathName(FileName, FilePath, Len(FilePath)) FileName = Left$(FilePath, Retval) If Retval > 0 Then ' Datei öffnen und Größe ermitteln hFile = CreateFile(FileName, GENERIC_READ, _ FILE_SHARE_READ, 0&, OPEN_EXISTING) FileLength = GetFileSize(hFile, ByVal 0&) If hFile <> -1 And FileLength > 0 Then ' globalen Speicherbereich reservieren und einfrieren hMem = GlobalAlloc(GMEM_MOVEABLE, FileLength) pMem = GlobalLock(hMem) If hMem <> 0 And pMem <> 0 Then ' Datei in den Speicher lesen und ' Progress-Event auslösen For I = 0 To FileLength - (FileLength Mod BUFFER_READ) _ Step BUFFER_READ ReadFile hFile, ByVal CLng(pMem + I), BUFFER_READ, BytesRead RaiseEvent LoadProgress(I, FileLength - I, FileLength) DoEvents Next I If (FileLength Mod BUFFER_READ) > 0 Then ReadFile hFile, ByVal CLng(pMem + I - BUFFER_READ), _ FileLength Mod BUFFER_READ, BytesRead RaiseEvent LoadProgress(FileLength, FileLength, FileLength) End If ' Datei schließen und globalen Speicher auftauen CloseHandle hFile GlobalUnlock hMem ' 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 ' OLE IPicture-Objekt erstellen If CreateStreamOnHGlobal(hMem, Abs(True), IStream) = 0 Then Retval = OleLoadPicture(IStream, FileLength, 0, _ IID_IPicture(0), TmpPicture) If Retval = 0 Then Set LoadBitmap = TmpPicture Else MsgBox "Grafik konnte nicht geladen werden" End If Else MsgBox "OLE-Stream konnte nicht erstellt werden" End If ' globalen Speicher wieder freigeben GlobalFree hMem Else MsgBox "zu wenig Speicher" If hMem <> 0 Then Call GlobalFree(hMem) End If Else MsgBox "Datei konnte nicht geöffnet werden" End If Else MsgBox "Datei wurde nicht gefunden" End If End Function Beim Klick auf den CommandButton in der Form1 soll nun ein Bild angezeigt werden, inkl. Lade-Fortschrittsanzeige im ProgressBar-Control. Zunächst müssen Sie die neue "LoadBitmap"-Klasse deklarieren. Fügen Sie hierzu nachfolgenden Code in das Codefenster der Form1 ein: Option Explicit ' LoadBitmap-Klasse deklarieren Public WithEvents clsLP As clsLoadBitmap Private Sub Form_Load() ' Klasse referenzieren und ' Progressbar einstellen Set clsLP = New clsLoadBitmap With ProgressBar1 .Min = 0 .Max = 100 .Value = 0 End With End Sub ' Progress beim laden des Bildes anzeigen Private Sub clsLP_LoadProgress(ByVal BytesRead As Long, _ ByVal BytesLeft As Long, _ ByVal TotalBytes As Long) ProgressBar1.Value = Val(100 / TotalBytes * BytesRead) End Sub Private Sub Command1_Click() Dim oPic As StdPicture Dim sFilename As String ' Bilddatei (am besten eines mit ein paar ' MegaBytes :-)) sFilename = "c:\bild1.jpg" ' ImageBox leeren Set Image1.Picture = Nothing Image1.Refresh ' Bild laden und in die ImageBox setzen Set oPic = LP.LoadBitmap(sFilename) Set Image1.Picture = oPic ' ImageBox aktualisieren Image1.Refresh ProgressBar1.Value = 0 ' PictureObjekt zerstören Set oPic = Nothing End Sub |