vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB4, VB5, VB631.12.03
Bild drehen mit Point-PSet (GES)

Code zum horizontalen oder vertikalen Drehen/Spiegeln von Bildern inkl. Zoom-Funktion - für alle Betriebssysteme!

Autor:   Guido EisenbeisBewertung:     [ Jetzt bewerten ]Views:  24.084 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 24.084 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-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