Bild drehen mit Point-PSet (GES) Code zum horizontalen oder vertikalen Drehen/Spiegeln von Bildern inkl. Zoom-Funktion - für alle Betriebssysteme!
Autor:   Guido Eisenbeis	Bewertung:     [ Jetzt bewerten ]	Views:  25.692
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Nach dem Erscheinen meines Tipps  Bild drehen mit PlgBlt-API (GES) gab es einige Anfragen, die sich auf das Betriebs-System bezogen. Leider wird auf Windows 9x/ME die API-Funktion PlgBlt NICHT unterstützt (auf deutsch: funktioniert nicht!).

Aus diesem Grund habe ich diese Version geschrieben, die vollkommen auf API-Funktionen verzichtet und auch auf Win 9x/ME läuft!

Dieser Tipp bietet die Möglichkeiten, ein Bild horizontal und vertikal zu drehen/spiegeln und auch noch zu zoomen. Die Codes zum Zoomen und Spiegeln können ohne weiteres mit der API-Version mithalten. Der Code zum Drehen ist leider nicht so schnell.

Der Original-Source "Bild-Rotation in beliebigem Winkel" stammt von Dieter Otter.

Ich habe auch diesen Tipp so ausgelegt, dass einfach und übersichtlich zu handhabende Prozeduren entstanden sind. Sogar die Einbindung in bestehende Projekte ist problemlos möglich. Eine vorhandene PictureBox kann einfach übergeben werden.

Benötigt werden 2 PictureBoxes. Voreinstellungen sind nicht nötig, da diese vom Code übernommen werden. Einfacher geht's nicht.

Option Explicit
 
' Konstante PI
Private Const pi = 3.14159265359

' Bild in beliebigem Winkel drehen
Public Sub BildDrehen(ByVal picSource As PictureBox, _
  ByVal picDest As PictureBox, _
  Optional ByVal DrehWinkel As Long = 0)
 
  ' cp0 - cp3 = Farbe eines einzelnen Pixels
  Dim cp0 As Long, cp1 As Long
  Dim cp2 As Long, cp3 As Long
 
  ' Bild-Dimensionen
  Dim w1 As Long, h1 As Long
  Dim w2 As Long, h2 As Long
 
  Dim p1x As Double, p1y As Double
  Dim p2x As Double, p2y As Double
  Dim n As Double, r As Double, a As Double
 
  picSource.AutoSize = True
  picSource.Visible = False
 
  ' AutoRedraw einschalten
  picSource.AutoRedraw = True
  picDest.AutoRedraw = True
 
  ' ScaleMode auf Pixel setzen
  picSource.ScaleMode = vbPixels
  picDest.ScaleMode = vbPixels
 
  ' Zielbild zunächst löschen
  Set picDest.Picture = Nothing
  picDest.Cls
 
  w1 = picSource.ScaleWidth \ 2
  h1 = picSource.ScaleHeight \ 2
  w2 = picDest.ScaleWidth \ 2
  h2 = picDest.ScaleHeight \ 2
 
  ' DrehWinkel = pi * (DrehWinkel / 180)
  If w2 < h2 Then n = h2 Else n = w2
  n = n - 1
 
  For p2x = 0 To n
    For p2y = 0 To n
      ' Position berechnen
      If p2x = 0 Then a = pi / 2 Else a = Atn(p2y / p2x)
      r = Sqr(p2x * p2x + p2y * p2y)
      p1x = r * Cos(a + (pi * DrehWinkel / 180))
      p1y = r * Sin(a + (pi * DrehWinkel / 180))
 
      ' Bildpunkte ermitteln
      cp0 = picSource.Point(w1 + p1x, h1 + p1y)
      cp1 = picSource.Point(w1 - p1x, h1 - p1y)
      cp2 = picSource.Point(w1 + p1y, h1 - p1x)
      cp3 = picSource.Point(w1 - p1y, h1 + p1x)
 
      ' neue Bildpunkte setzen
      If cp0 <> -1 Then picDest.PSet (w2 + p2x, h2 + p2y), cp0
      If cp1 <> -1 Then picDest.PSet (w2 - p2x, h2 - p2y), cp1
      If cp2 <> -1 Then picDest.PSet (w2 + p2y, h2 - p2x), cp2
      If cp3 <> -1 Then picDest.PSet (w2 - p2y, h2 + p2x), cp3
    Next p2y
  Next p2x
 
  Set picDest.Picture = picDest.Image
End Sub

' Bild horizontal/vertikal spiegeln
Public Sub BildSpiegeln(ByVal picSource As PictureBox, _
  ByVal picDest As PictureBox, _
  Optional Vertical As Boolean = False)
 
  Dim picDummy As StdPicture
 
  Set picDummy = picSource
  With picDest
    picSource.ScaleMode = vbPixels
    .ScaleMode = vbPixels
    .AutoRedraw = True
    .Picture = Nothing
    .Cls
 
    If Vertical Then
      .PaintPicture picDummy, _
        (.ScaleWidth - picSource.ScaleWidth) / 2, _
        (.ScaleHeight - picSource.ScaleHeight) / 2, _
        picSource.ScaleWidth, picSource.ScaleHeight, _
        0, picSource.ScaleHeight, _
        picSource.ScaleWidth, -picSource.ScaleHeight
    Else
      .PaintPicture picDummy, _
        (.ScaleWidth - picSource.ScaleWidth) / 2, _
        (.ScaleHeight - picSource.ScaleHeight) / 2, _
        picSource.ScaleWidth, picSource.ScaleHeight, _
        picSource.ScaleWidth, 0, _
        -picSource.ScaleWidth, picSource.ScaleHeight
    End If
    Set .Picture = .Image
  End With
End Sub

' Bild zoomen
Public Sub ZoomPicture(ByVal picSource As PictureBox, _
  ByVal picDest As PictureBox, _
  Optional lZoomFactor As Long = 100, _
  Optional lStep As Long = 3)
 
  Dim sZoom As Single
 
  ' Minimum Zoom-Factor = 76 (empfohlen = 80)
  If lZoomFactor < 80 Then lZoomFactor = 80
 
  ' Step = Scrollgeschwindigkeit
  lStep = (lZoomFactor - 100) * lStep
  sZoom = (lZoomFactor + lStep) / 100
 
  picSource.AutoSize = True
  picSource.Visible = False
 
  With picDest
    .AutoRedraw = True
    .ScaleMode = vbPixels
    .Picture = Nothing
    .Cls
    .PaintPicture picSource, _
      (.ScaleWidth - (picSource.Width * sZoom)) / 2, _
      (.ScaleHeight - (picSource.Height * sZoom)) / 2, _
      (picSource.Width * sZoom), _
      (picSource.Height * sZoom)
    Set .Picture = .Image
  End With
End Sub

Anwendungsbeispiel:
Starten Sie ein neues Projekt und fügen obigen Code in ein Modul ein. Platzieren Sie auf die Form1 2 PictureBox-Controls: picOriginalBild und picAnzeigeBox. Weiterhin werden noch 3 CommandButtons benötigt (Command1, Command2 und Command3), eine TextBox (Text1), sowie eine horizontale Scrollbar (HScroll1).

Fügen Sie nachfolgenden Code in das Codefenster der Form1 ein:

Option Explicit
 
Private Sub Form_Load()
  ' Bild laden
  picOriginalBild.Picture = LoadPicture( _
    App.Path & "\IgrnedeinBild.JPG")
 
  ' Bild ohne Drehung darstellen
  Call BildDrehen(picOriginalBild, picAnzeigeBox)
 
  ' Zoombereich festlegen
  With HScroll1
    .Min = 76
    .Max = 1000
    .SmallChange = 1
    .LargeChange = 1
    .Value = 100
  End With
End Sub

Private Sub Command1_Click()
  ' Bild drehen
  Call BildDrehen(picOriginalBild, picAnzeigeBox, Text1.Text)
End Sub

Private Sub Command2_Click()
  ' Bild horizontal spiegeln
  Call BildSpiegeln(picAnzeigeBox, picAnzeigeBox)
End Sub

Private Sub Command3_Click()
  ' Bild vertikal spiegeln
  Call BildSpiegeln(picAnzeigeBox, picAnzeigeBox, True)
End Sub

Private Sub HScroll1_Change()
  ' Bild zoomen
  Call BildDrehen(picOriginalBild, picAnzeigeBox, , _
    HScroll1.Value)
End Sub