vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 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, VB617.10.01
Bild-Rotation in beliebigem Winkel

Ein Codebeispiel, das zeigt, wie sich ein Bild in einem beliebigem Winkel drehen aus anzeigen lässt.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  23.483 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Das nachfolgende Codebeispiel zeigt, wie sich ein Bild in einem beliebigem Winkel drehen und anzeigen lässt.

Aber vorsicht!
Bei grossen Bildern kann das ganze ein wenig dauern, da die Prozedure RotatePicture Punkt für Punkt umsetzt, d.h. es muss für jede einzelne Bildposition des Originalbildes die neue Position im Ziel-Bild berechnet werden.

' zunächst die benötigten API-Deklarationen
Private Declare Function GetPixel Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long) As Long
 
Private Declare Function SetPixel Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal crColor As Long) As Long
 
' Konstante PI
Const Pi = 3.14159265359
Sub RotatePicture(picSource As PictureBox, _
  picDest As PictureBox, ByVal Winkel As Single)
 
  ' Drehen eines Bildes einer PictureBox
  ' und Anzeige des Bildes in einer zweiten PictureBox
 
  ' 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
 
  ' Geräte-Kontext der beiden PictureBoxen
  Dim p1hDC As Long
  Dim p2hDC As Long
 
  Dim a As Single
  Dim p1x As Long, p1y As Long
  Dim p2x As Long, p2y As Long
  Dim n As Long
  Dim r As Long
 
  ' ScaleMode auf Pixel setzen
  picSource.ScaleMode = vbPixels
  picDest.ScaleMode = vbPixels
 
  w1 = picSource.ScaleWidth \ 2
  h1 = picSource.ScaleHeight \ 2
  w2 = picDest.ScaleWidth \ 2
  h2 = picDest.ScaleHeight \ 2
 
  If w2 < h2 Then n = h2 Else n = w2
  n = n - 1
  p1hDC = picSource.hdc
  p2hDC = picDest.hdc
 
  ' Zielbild zunächst löschen
  picDest.Cls
 
  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 + Winkel)
      p1y = r * Sin(a + Winkel)
 
      ' Bildpunkte ermitteln
      cp0 = GetPixel(p1hDC, w1 + p1x, h1 + p1y)
      cp1 = GetPixel(p1hDC, w1 - p1x, h1 - p1y)
      cp2 = GetPixel(p1hDC, w1 + p1y, h1 - p1x)
      cp3 = GetPixel(p1hDC, w1 - p1y, h1 + p1x)
 
      ' Bildpunkte setzen
      If cp0 <> -1 Then SetPixel p2hDC, w2 + p2x, h2 + p2y, cp0
      If cp1 <> -1 Then SetPixel p2hDC, w2 - p2x, h2 - p2y, cp1
      If cp2 <> -1 Then SetPixel p2hDC, w2 + p2y, h2 - p2x, cp2
      If cp3 <> -1 Then SetPixel p2hDC, w2 - p2y, h2 + p2x, cp3
    Next p2y
  Next p2x
End Sub

Die Vorgehensweise ist folgende:
Sie benötigen neben der Quell-PictureBox noch eine zweite - die Ziel-PictureBox, welche das gedrehte Bild enthalten soll.

Der Aufruf ist ganz einfach:

' um 90° nach links drehen
RotatePicture Picture1, Picture2, PI / 2
 
' um 45° nach links drehen
RotatePicture Picture1, Picture2, PI / 4
 
' um 45° nach rechts drehen
RotatePicture Picture1, Picture2, -(PI / 4)

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