Bilder formatfüllend drehen und zoomen Beim Drehen und Zommen von Bildern muss die Größe der Ziel-Bitmap angepasst werden. Hier ein Demoprojekt.
Autor:   Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  15.560
ohne Homepage	System:  Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 10 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.9 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Die Drehung eines Bildes ist durch die Verfügbarkeit einiger GDI+-Methoden in Visual Basic ziemlich einfach.

Im Namespace 'Drawing.Drawing2D' gibt es die Matrix-Klasse, die für Rotationen (und auch für Translationen, Skalierungen, Scherungen) verwendet werden kann. Die 'RotateAt'-Methode dieser Klasse erwartet als Parameter einen Winkel (in Grad) und einen Punkt, der das Zentrum der Drehung definiert. Um ein Bild zu drehen, verwendet man den Bildmittelpunkt als Rotationszentrum.

Möchte man eine Ziel-Bitmap, in die das rotierte Bild formatfüllend eingepasst ist, sind einige zusätzliche Berechnungen erforderlich (Größe der Ziel-Bitmap, Zentrierung des Bildes im Ziel).Statt selbst die geometrischen Berechnungen durchzuführen, wird in der Routine 'Bitmap_Rotate' die Matrix-Klasse dafür herangezogen.

Die Routine erwartet als Parameter eine Bitmap, deren Inhalt rotiert gezeichnet werden soll, den Drehwinkel (positiv = rechtsdrehend, negativ = linksdrehend) und eine Farbe, die den nicht vom Bild ausgefüllten Hintergrund der neuen Bitmap definiert. Der optionale Parameter 'Zoom_Factor' bestimmt, ob das gedrehte Bild zusätzlich noch vergrößert oder verkleinert (Wert < 1) wird.

Falls der Parameter 'BackGround' den Wert 'Color.Transparent' erhält, kann das gedrehte (und gezoomte) Bild (z.B durch die Routine 'Insert_Bitmap') in ein anderes Bild eingefügt werden, ohne dass die überstehenden Bereiche des Rechtecks im Zielbild sichtbar werden.

Die Hilfsfunktion 'Rotate_Bitmap_Size' kann verwendet werden, um vor der Drehung des Bildes die Größe des benötigten Ziel-Rechtecks zu ermitteln (z.B. für Einfüge-Operationen). Die Fläche des Ziel-Rechtecks einer Drehung ist größer als die Quell-Fläche, außer bei Drehungen um 90/180/270 Grad.)

Um das Anwendungsprogramm auszuführen, erstellen Sie ein neues Projekt und fügen Sie den gesamten Code dieses Tipps in das Formular 'Form1' ein.

Nach dem Laden einer Bilddatei können Sie am Slider rechts den Drehwinkel einstellen. Beachten Sie, dass der dunkelgraue Bildhintergrund (=die modifizierte Bitmap) immer exakt an die Bildgröße angepasst ist. Die Anzeigegröße des Bildes variiert mit dem Drehwinkel, weil die PictureBox auf Zoomen ('SizeMode') eingestellt ist. Das betrifft nicht die tatsächliche Bildgröße. Der eingestellte Drehwinkel wird im Formularkopf angezeigt.

Option Explicit On
Option Strict On
Imports System
 
' Manfred Bohn für VBARCHIV (JUNI 2008)
Public Class Form1
  Dim picDisplay As New PictureBox
  Dim ofd As New OpenFileDialog
  Dim WithEvents btnLoad As New Button
  Dim WithEvents trbRotate As New TrackBar
 
  Dim gBitmap As Drawing.Bitmap

  Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
 
    Me.Width = 800 : Me.Height = 600
    Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Fixed3D
 
    With picDisplay
      .Top = 40 : .Height = Me.Height - 80
      .Left = 10 : .Width = Me.Width - 80
      .SizeMode = PictureBoxSizeMode.Zoom
      .BackColor = Color.WhiteSmoke
    End With
 
    With btnLoad
      .Text = "Bild laden"
      .Width = 200 : .Top = 5
      .Height = 30 : .Left = 5
    End With
 
    With trbRotate
      .Orientation = Orientation.Vertical
      .Left = Me.Width - 40 : .Width = 40
      .Top = picDisplay.Top : .Height = picDisplay.Height
      .Minimum = -360
      .Maximum = 360
      .Value = 0
      .TickFrequency = 45
      .SmallChange = 1 : .LargeChange = 45
    End With
 
    Me.Controls.Add(picDisplay)
    Me.Controls.Add(btnLoad)
    Me.Controls.Add(trbRotate)
  End Sub

  Private Sub btnLoad_Click(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles btnLoad.Click
 
    With ofd
      .CheckFileExists = True
      .Multiselect = False
      .Title = "Bild für Drehung laden"
      .Filter = "Bilder|*.jpg;*.bmp;*.png;*.tif"
      .InitialDirectory = My.Computer.FileSystem. _
      SpecialDirectories.MyPictures
      If .ShowDialog = _
      Windows.Forms.DialogResult.Cancel Then Exit Sub
      Try
        trbRotate.Value = 0
        gBitmap = New Bitmap(.FileName)
        picDisplay.Image = gBitmap
      Catch
      End Try
    End With
  End Sub

  Private Sub trbRotate_ValueChanged(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles trbRotate.ValueChanged
 
    Static sperre As Boolean
    If sperre Then Exit Sub
    If IsNothing(gBitmap) Then Exit Sub
    sperre = True
    picDisplay.Image = Rotate_Bitmap(gBitmap, _
      trbRotate.Value, Color.LightGray)
    Me.Text = "Winkel: " + CStr(trbRotate.Value)
    sperre = False
  End Sub

  ''' <summary>
  ''' Drehen (und Zoomen) eines Bildes
  ''' </summary>
  ''' <param name="bmp">zu drehendes Bild</param>
  ''' <param name="angle">Drehwinkel (in Grad)</param>
  ''' <param name="BackGround">Hintergrundfarbe</param>
  ''' <param name="Zoom_Factor">Vergrößerung bzw. 
  ''' Verkleinerung</param>
  ''' <returns>Ziel-Bitmap: gedrehtes (gezoomtes) Bild
  ''' </returns>
  Public Function Rotate_Bitmap( _
    ByVal bmp As Drawing.Bitmap, _
    ByVal angle As Single, _
    ByVal BackGround As Drawing.Color, _
    Optional ByVal Zoom_Factor As Single = 1) As Drawing.Bitmap
 
    Try
      Dim rotate_width, rotate_height As Integer
 
      ' Check der Parameter
      If IsNothing(bmp) Then Return Nothing
      If Single.IsNaN(angle) Then Return Nothing
      If Math.Abs(angle) > 360 Then Return Nothing
 
      Dim draw_width As Integer = CInt(bmp.Width * Zoom_Factor)
      Dim draw_height As Integer = CInt(bmp.Height * Zoom_Factor)
 
      ' Erforderliche Größe der Ziel-Bitmap
      ' unter Beachtung des Zoomfaktors
      If Not Rotate_Bitmap_Size(draw_width, draw_height, angle, _
        rotate_width, rotate_height) Then Return Nothing
 
      ' Ziel-Bitmap in erforderlicher Größe erstellen
      Dim bmp_out As New Bitmap(rotate_width, rotate_height)
 
      ' Zeichenobjekt für Ziel-Bitmap erstellen
      Dim g As Drawing.Graphics = Graphics.FromImage(bmp_out)
 
      ' Ziel-Bitmap mit Hintergrundfarbe füllen 
      g.Clear(BackGround)
 
      ' Zentrum der neuen Bitmap
      Dim p_center As PointF
      p_center.X = CSng(bmp_out.Width / 2)
      p_center.Y = CSng(bmp_out.Height / 2)
 
      ' Matrix-Instanz für Rotation
      Dim m As New Drawing.Drawing2D.Matrix
      ' Rotationsmatrix erstellen (neues Zentrum)
      ' m.Scale(Zoom_Factor, Zoom_Factor)
      m.RotateAt(angle, p_center)
 
      ' Rotationsmatrix für's Zeichnen verwenden
      g.Transform = m
 
      Dim source_rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
 
      ' Bild in Ziel-Bitmap gezoomt zentrieren
      ' (unrotierte Koordinaten !!)
      Dim x As Integer = CInt((rotate_width - draw_width) / 2)
      Dim y As Integer = CInt((rotate_height - draw_height) / 2)
      Dim destination_rect As New Rectangle(x, y, draw_width, draw_height)
 
      ' zentriertes Bild rotiert in die Ziel-Bitmap zeichnen
      g.DrawImage(bmp, destination_rect, source_rect, GraphicsUnit.Pixel)
 
      m.Dispose() : g.Dispose()
 
      ' Ziel-Bitmap zurückgeben
      Return bmp_out
    Catch ex As Exception
      Return Nothing
    End Try
  End Function

  ''' <summary>
  ''' Bestimmung der Größe eines Ziel-Rechtecks
  ''' für rotierte Bildbereiche
  ''' </summary>
  ''' <param name="width">Quell-Rechteck (Breite)</param>
  ''' <param name="height">Quell-Rechteck (Höhe)</param>
  ''' <param name="angle">Drehwinkel (Grad)</param>
  ''' <param name="rotate_width">Ziel-Rechteck (Breite)</param>
  ''' <param name="rotate_height">Ziel-Rechteck (Höhe)</param>
  ''' <returns>Alles OK?</returns>
  Public Function Rotate_Bitmap_Size( _
    ByVal width As Integer, _
    ByVal height As Integer, _
    ByVal angle As Single, _
    ByRef rotate_width As Integer, _
    ByRef rotate_height As Integer) As Boolean
 
    rotate_width = -1 : rotate_height = -1
    If width < 1 Or height < 1 Then Return False
    If width > 2048 Or height > 2048 Then Return False
 
    ' Eckpunkte der Bitmap in ein Punkt-Array eintragen
    Dim pts(3) As PointF
    pts(0).X = 0 : pts(0).Y = 0
    pts(1).X = 0 : pts(1).Y = height
    pts(2).X = width : pts(2).Y = height
    pts(3).X = width : pts(3).Y = 0
 
    'Zentrum der Bitmap bestimmen
    Dim p_center As Drawing.PointF
    p_center.X = CSng(width / 2)
    p_center.Y = CSng(height / 2)
 
    ' Rotationsmatrix (um Bildmitte) erstellen
    Dim m As New Drawing.Drawing2D.Matrix
    m.RotateAt(angle, p_center)
    ' Die Eckpunkte des Bildes rotieren
    ' --> pts enthält danach die neuen Koordinaten
    m.TransformPoints(pts)
    m.Dispose()
 
    ' Erforderliche Größe der Bitmap für das 
    ' rotierte Bild aus diesen Koordinaten ermitteln
    Dim xug As Single = Single.MaxValue
    Dim xog As Single = Single.MinValue
    Dim yug As Single = Single.MaxValue
    Dim yog As Single = Single.MinValue
    For i As Integer = 0 To 3
      xug = Math.Min(pts(i).X, xug)
      xog = Math.Max(pts(i).X, xog)
      yug = Math.Min(pts(i).Y, yug)
      yog = Math.Max(pts(i).Y, yog)
    Next i
 
    ' Rückgabe-Parameter
    rotate_width = CInt(xog - xug)
    If rotate_width < 1 Then Return False
    rotate_height = CInt(yog - yug)
    If rotate_height < 1 Then Return False
    Return True
  End Function

  ''' <summary>
  ''' Bild einfügen
  ''' </summary>
  ''' <param name="bmp_Insert">einzufügendes Bild</param>
  ''' <param name="x">Horizontal-Position im Zielbild</param>
  ''' <param name="y">Vertikal-Position im Zielbild</param>
  ''' <param name="bmp_dest">Ziel-Bild</param>
  ''' <returns>Alles OK?</returns>
  Public Function Insert_Bitmap( _
    ByVal bmp_Insert As Drawing.Bitmap, _
    ByVal x As Integer, ByVal y As Integer, _
    ByRef bmp_dest As Drawing.Bitmap) As Boolean
 
    Try
      If IsNothing(bmp_Insert) Or _
      IsNothing(bmp_dest) Then Return False
      Dim sr As New Rectangle(0, 0, bmp_Insert.Width, bmp_Insert.Height)
      Dim dr As New Rectangle(x, y, sr.Width, sr.Height)
      Dim g As Graphics = Graphics.FromImage(bmp_dest)
      g.DrawImage(bmp_Insert, dr, sr, GraphicsUnit.Pixel)
      g.Dispose()
      Return True
    Catch
      Return False
    End Try
  End Function

End Class