vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Schützen Sie Ihre Software vor Software-Piraterie - mit sevLock 1.0 DLL!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

VB.NET - Fortgeschrittene
Re: 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
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Function ImageRotate1.435Dikn27.09.17 17:10
Re: Function ImageRotate829Manfred X27.09.17 19:17
Re: Function ImageRotate742Dikn28.09.17 09:43
Re: Function ImageRotate750Manfred X28.09.17 11:09
Re: Function ImageRotate710Dikn28.09.17 17:47
Re: Function ImageRotate784Manfred X28.09.17 19:43
Re: Function ImageRotate766Dikn30.09.17 12:12
Re: Function ImageRotate799Manfred X30.09.17 12:39
Re: Function ImageRotate800Dikn05.10.17 10:50
Re: Function ImageRotate0Dikn05.10.17 10:53

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

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

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