| |
VB.NET - FortgeschritteneRe: Function ImageRotate | | | Autor: Manfred X | Datum: 28.09.17 19:43 |
| Hallo!
Ich habe den Code mal schnell in die Routine Rotate_Bitmap_Size
hinein gewurstelt.
Das Abschneiden ist natürlich nur sinnvoll bei Dreh-Winkeln in der
Nähe von 0, 90, 180, 270 Grad, sonst bleibt vom Bild nicht viel
übrig.
''' <summary>
''' Bestimmung der Größe eines Ziel-Rechtecks
''' für rotierte Bildbereiche (Ränder werden abgeschnitten!)
''' </summary>
''' <param name="width">Quell-Rechteck (Breite)</param>
''' <param name="height">Quell-Rechteck (Höhe)</param>
''' <param name="angle">Drehwinkel (Grad)</param>
''' <param name="rotate_width">Ziel-Rechteck (Breite)</param>
''' <param name="rotate_height">Ziel-Rechteck (Höhe)</param>
''' <returns>Alles OK?</returns>
Public Function Rotate_Bitmap_Size( _
ByVal width As Integer, _
ByVal height As Integer, _
ByVal angle As Single, _
ByRef rotate_width As Integer, _
ByRef rotate_height As Integer) As Boolean
rotate_width = -1 : rotate_height = -1
If width < 1 Or height < 1 Then Return False
If width > 2048 Or height > 2048 Then Return False
' Eckpunkte der Bitmap in ein Punkt-Array eintragen
Dim pts(3) As PointF
pts(0).X = 0 : pts(0).Y = 0
pts(1).X = 0 : pts(1).Y = height
pts(2).X = width : pts(2).Y = height
pts(3).X = width : pts(3).Y = 0
'Zentrum der Bitmap bestimmen
Dim p_center As Drawing.PointF
p_center.X = CSng(width / 2)
p_center.Y = CSng(height / 2)
' Rotationsmatrix (um Bildmitte) erstellen
Dim m As New Drawing.Drawing2D.Matrix
m.RotateAt(angle, p_center)
' Die Eckpunkte des Bildes rotieren
' --> pts enthält danach die neuen Koordinaten
m.TransformPoints(pts)
m.Dispose()
' Erforderliche Größe der Bitmap für das
' rotierte Bild aus diesen Koordinaten ermitteln
Dim xug As Single = Single.MaxValue
Dim xog As Single = Single.MinValue
Dim yug As Single = Single.MaxValue
Dim yog As Single = Single.MinValue
For i As Integer = 0 To 3
xug = Math.Min(pts(i).X, xug)
xog = Math.Max(pts(i).X, xog)
yug = Math.Min(pts(i).Y, yug)
yog = Math.Max(pts(i).Y, yog)
Next i
Dim xug2, xog2, yug2, yog2 As Single
xug2 = Single.MaxValue
xog2 = Single.MinValue
yug2 = Single.MaxValue
yog2 = Single.MinValue
For i As Integer = 0 To 3
If pts(i).X > xug Then
xug2 = Math.Min(pts(i).X, xug2)
End If
If pts(i).X < xog Then
xog2 = Math.Max(pts(i).X, xog2)
End If
If pts(i).Y > yug Then
yug2 = Math.Min(pts(i).Y, yug2)
End If
If pts(i).Y < yog Then
yog2 = Math.Max(pts(i).Y, yog2)
End If
Next i
If xug2 = Single.MaxValue Then xug2 = xug
If xog2 = Single.MinValue Then xog2 = xog
If yug2 = Single.MaxValue Then yug2 = yug
If yog2 = Single.MinValue Then yog2 = yog
'optional: Control zur Steuerung, ob abgeschnitten werden soll
'If chkCut.Checked Then
xog = xog2 : yog = yog2
xug = xug2 : yug = yug2
'End If
' Rückgabe-Parameter
rotate_width = CInt(xog - xug)
If rotate_width < 1 Then Return False
rotate_height = CInt(yog - yug)
If rotate_height < 1 Then Return False
Return True
End Function | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
TOP! Unser Nr. 1
Neu! sevDataGrid 3.0
Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Weitere InfosTipp des Monats März 2024 Dieter OtterUTF-8 Konvertierung von Dateien und StringsVB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
|
|
Copyright ©2000-2024 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
|
|