Rubrik: Grafik und Font · Grafische Effekte | VB-Versionen: VB4, VB5, VB6 | 31.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 Eisenbeis | Bewertung: | Views: 25.694 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | 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