vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik:    |   VB-Versionen: VB5, VB601.12.03
Bild laden - mit Fortschrittsanzeige

Unser Extra-Tipp "Dezember 2003" stellt Ihnen eine Klasse vor, mit deren Hilfe sich Bilddateien lassen lassen - und zwar mit Fortschrittsanzeige.

Autor:   LonelySuicide666Bewertung:     [ Jetzt bewerten ]Views:  1.344 
http://www.vbapihelpline.de/System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt 

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

Dieser Tipp wurde bereits 1.344 mal aufgerufen.

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2021 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel