vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Grafik und Font · Bilder & Icons   |   VB-Versionen: VB630.05.05
Bild-Dateien in VB.PictureBox laden durch GDIPlus

Dieser Tipp zeigt, wie sich Bild-Dateien per GDIPLUS.DLL direkt in die VB.PictureBox laden lassen.

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  28.024 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Im Tipp  Ersatz für die VB6-LoadPicture-Funktion werden Bild-Dateien durch GDIPlus geladen und über das Bild-Handle unter Verwendung der Funktion 'OLECREATEPICTUREINDIRECT' in ein VB-Picture-Objekt umgewandelt.

Dabei können Informationen verloren gehen - z.B. die Transparenz-Information bei entsprechenden GIF-Bildern.

Einen direkteren Weg zum Laden von Bildern durch 'GDIPlus' bietet das Zeichnen in eine VB.PictureBox unter Verwendung des Gerätekontexts dieses Objekts. Bei dieser Vorgehensweise gehen weniger Bild-Informationen verloren - nur diejenigen, die von der VB.PictureBox nicht unterstützt werden können.

' ==============================================================
' Start Quellcode modLoadPicBox
' ==============================================================
 
Option Explicit
 
' Bilddatei per 'GDIPlus.DLL' in 'VB.PictureBox' laden
 
' ===============================================================
' Benötigte GDIPlus-Deklarationen zum Laden/Zeichnen eines Bildes
' ===============================================================
 
Private Type GDIPlusStartupInput
  Version As Long
  etctetera(1 To 12) As Byte
End Type
 
' Verbindung herstellen
Private Declare Function GdiplusStartup Lib "gdiplus" ( _
  ByRef GDIP_Connection As Long, _
  ByRef udtInput As GDIPlusStartupInput, _
  Optional ByRef udtOutput As Any) As Long
 
' Verbindung zum DeviceKontext herstellen
Private Declare Function GdipCreateFromHDC Lib "gdiplus" ( _
  ByVal hDC As Long, _
  ByRef Graphics As Long) As Long
 
' Bild aus Datei laden (in Bitmap)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _
  ByVal FileName As Long, _
  ByRef image As Long) As Long
 
' Abmessungen des Bildes ermitteln
Private Declare Function GdipGetImageDimension Lib "gdiplus" ( _
  ByVal image As Long, _
  ByRef Width As Single, _
  ByRef Height As Single) As Long
 
' Bild zeichnen
Private Declare Function GdipDrawImageRect Lib "gdiplus" ( _
  ByVal Graphics As Long, _
  ByVal image As Long, _
  ByVal X As Single, _
  ByVal Y As Single, _
  ByVal Width As Single, _
  ByVal Height As Single) As Long
 
' Bild-Ressource freigeben
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
  ByVal image As Long) As Long
 
' Graphik-Ressource freigeben
Private Declare Function GdipDeleteGraphics Lib "gdiplus" ( _
  ByVal Graphics As Long) As Long
 
' GDIPLus freigeben
Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
  ByVal token As Long) As Long
Public Function LoadPicBox(ByVal DateiName As String, _
  ByRef PicBox As VB.PictureBox, _
  Optional ByVal AdjustPicBoxSize As Boolean = True, _
  Optional ByRef Meldung As String) As Boolean
 
  ' Öffnet die Bilddatei 'DateiName' und trägt sie
  ' unter Verwendung des Gerätekontexts der Picturebox
  ' in die Zeichenfläche der PictureBox ein
 
  ' Falls AdjustPicBoxSize = true
  ' die Picturebox wird ggf. vergrößert,
  ' um das gesamte Bild zeichnen zu können
 
  Dim retcode As Long              ' Funktions-Rückgaben
  Dim Bitmap As Long
  Dim Graphics As Long
  Dim picWidth As Single           ' Bildabmessungen
  Dim picHeight As Single
  Dim GDIP_Connection As Long      ' Verbindung zu GDIPlus
  Dim GDIP_Startup As GDIPlusStartupInput
  Dim w As Long, h As Long         ' Bildgröße in Twips
 
  On Error GoTo exitfunction
  Err.Clear
 
  If Trim(DateiName) = "" Or PicBox Is Nothing Then
    Meldung = "Eingabeparameter fehlen"
    Exit Function
  End If
 
  If Dir(DateiName, vbNormal Or vbReadOnly) = "" Then
    Meldung = "Datei existiert nicht"
    Exit Function
  End If
 
  Meldung = ""
  GDIP_Startup.Version = 1
  retcode = GdiplusStartup(GDIP_Connection, GDIP_Startup, ByVal 0&)
  If retcode <> 0 Then
    Meldung = "GDIPlus nicht verfügbar"
     Exit Function
  End If
 
  ' Trägt das Bild aus der Datei in die Bitmap ein
  retcode = GdipLoadImageFromFile(StrPtr(DateiName), Bitmap)
  If retcode <> 0 Then
    Meldung = "Bitmap kann nicht geöffnet werden"
     GoTo exitfunction
  End If
 
  ' Abfrage der Abmessungen der Bitmap
  retcode = GdipGetImageDimension(Bitmap, picWidth, picHeight)
  If retcode <> 0 Then
    Meldung = "Bitmap-Abmessungen nicht verfügbar"
    GoTo exitfunction
  End If
 
  ' PictureBox einrichten und ggf.
  ' auf die benötigten Bildabmessungen einstellen
  With PicBox
    .AutoRedraw = True
    .BorderStyle = 0
    .Picture = LoadPicture() 'PictureBox löschen
    If AdjustPicBoxSize Then
      ' Skala: Pixel --> Twips umrechnen
      w = .ScaleX(picWidth, vbPixels, vbTwips)
      h = .ScaleY(picHeight, vbPixels, vbTwips)
      ' PictureBox-Arbeitsfläche ggf. vergrößern
      If .Width < w Then .Width = w
      If .Height < h Then .Height = h
    End If
  End With
 
  ' Erzeugen eines GDIPlus Grafikobjekts
  ' für die Verwendung mit Hdc
  retcode = GdipCreateFromHDC(PicBox.hDC, Graphics)
  If retcode <> 0 Then
    Meldung = "Graphikobjekt nicht verfügbar"
    GoTo exitfunction
  End If
 
  ' Bitmap in die PictureBox zeichnen
  retcode = GdipDrawImageRect(Graphics, Bitmap, 0, 0, picWidth, picHeight)
  If retcode <> 0 Then
    Meldung = "Bild kann nicht gezeichnet werden"
    GoTo exitfunction
  End If
 
  ' Rückgabe: alles OK
  Meldung = ""
  LoadPicBox = True
 
exitfunction:
  ' Fehler ?
  If Err.Number <> 0 Then
     Meldung = Err.Description
  End If
 
  ' Ressourcen und GDIPLus freigeben
  If Bitmap <> 0 Then
    ' Bitmap löschen
    GdipDisposeImage Bitmap
  End If
 
  If Graphics <> 0 Then
    ' GDIPLus-Grafikobjekt löschen
    GdipDeleteGraphics Graphics
  End If
 
  If GDIP_Connection <> 0 Then
    ' GDIPlus-DLL freigeben
    GdiplusShutdown GDIP_Connection
  End If      
End Function
 
' ==============================================================
' Ende Quellcode 'modLoadPicBox'
' ==============================================================

Aufruf-Beispiel (in einem Formular):

' Bild_Datei: Pfad und Dateiname eines Bildes (BMP, JPG, GIF, PNG, TIF)
' Picture1: Name einer VB.PictureBox
Dim Meldung As String
If Not LoadPicBox(Bild_Datei, Picture1, , Meldung) Then
  MsgBox Meldung, vbExclamation
End If

Dieser Tipp wurde bereits 28.024 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

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-2017 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