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: 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 25.722 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |