vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB5, VB601.07.02
Bild in einem Bildfeld optimal anpassen

Diesmal zeigen wir Ihnen, wie sich ein Bild optimal in einem Bildfeld anpassen lässt - mit vielen Einstellmöglichkeiten.

Autor:  Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.614 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Diesmal zeigen wir Ihnen, wie sich ein Bild optimal in einem Bildfeld anpassen lässt. Ist das Bild breiter als der Bild-Container (PictureBox, Form), so wird die Breite angepasst, wobei die Höhe neu berechnet wird und umgekehrt. Optional lässt sich das Bild auch zentriert anzeigen, falls es nicht den gesamten Bildcontainer ausfüllt.

Ist das Bild sowohl in der Breite als auch in der Höhe kleiner als der Bildcontainer lässt sich festlegen, ob das Bild optimal gestretcht werden oder in der Originalgröße dargestellt werden soll.

Zu nachfolgender Prozedur gibt es nicht viel zu sagen. Alle wichtigen Codeblöcke sind mit entsprechenden Kommentierungen versehen.

' Parameter:
' ----------
' 
' picContainer: Form oder PictureBox-Control
' pic         : anzuzeigendes Bild
' bStretch    : Optional. True, wenn ein kleines Bild
'               an die Größe des Containers angepasst
'               werden soll.
' bCenter     : Optional. True, wenn das Bild innerhalb
'               des Bild-Containers zentriert angezeigt
'               werden soll.
' lBackColor  : Optional. Hintergrundfarbe des
'               Bild-Containers
' =====================================================
Private Sub Picture_Show(picContainer As Object, _
  pic As Picture, _
  Optional ByVal bStretch As Boolean = True, _
  Optional ByVal bCenter As Boolean = True, _
  Optional ByVal lBackColor As Long)
 
  Dim picWidth As Long
  Dim picHeight As Long
  Dim picLeft As Long
  Dim picTop As Long
  Dim contAspectRatio As Single
  Dim picAspectRatio As Single
 
  With picContainer
    ' Größenverhältnis Container (Breite : Höhe)
    contAspectRatio = .ScaleWidth / .ScaleHeight
 
    ' Bild-Größe + Größen-Verhältnis
    picWidth = .ScaleX(pic.Width, 8, .ScaleMode)
    picHeight = .ScaleY(pic.Height, 8, .ScaleMode)
    picAspectRatio = picWidth / picHeight
 
    ' Bild anpassen?
    If (picWidth > .ScaleWidth Or picHeight > .ScaleHeight) Or (bStretch) Then
      ' Größenverhältnis des Bildes ist kleiner als
      ' das des Containers
      If picAspectRatio <= contAspectRatio Then
        ' Bildbreite muss angepasst werden
        picWidth = picWidth / (picHeight / .ScaleHeight)
        picHeight = .ScaleHeight
 
        ' Left-Position
        If bCenter Then
          picLeft = Int((.ScaleWidth - picWidth) / 2)
        End If
 
      ' Größenverhältnis des Bildes ist größer als
      ' das des Containers
      Else
        ' Bildhöhe muss angepasst werden
        picHeight = picHeight / (picWidth / .ScaleWidth)
        picWidth = .ScaleWidth
 
        ' Top-Position
        If bCenter Then
          picTop = Int((.ScaleHeight - picHeight) / 2)
        End If
      End If
 
    ' Bild ist kleiner als der Container
    Else
 
      ' Bild zentrieren?
      If bCenter Then
        picLeft = Int((.ScaleWidth - picWidth) / 2)
        picTop = Int((.ScaleHeight - picHeight) / 2)
      End If
    End If
 
    ' Bild zeichnen
    Set .Picture = Nothing
    If Not IsMissing(lBackColor) Then .BackColor = lBackColor
    .AutoRedraw = True
    .PaintPicture pic, picLeft, picTop, picWidth, picHeight
    Set .Picture = .Image
    .AutoRedraw = False
  End With
End Sub

Aufruf:

Picture_Show Picture1, LoadPicture("Bild1.jpg")

Oder:

Picture_Show Form1, Image1.Picture, False

Oder...