vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 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

Fortgeschrittene Programmierung
Re: Function ImageRotate 
Autor: Dikn
Datum: 19.02.18 09:33

Teil 2:
  Private Sub HScrollBar1_ValueChanged (...) Handles HScrollBar1.ValueChanged, _
    chbVollbild.Click
  If sender.Text = "Vollbild" Then
    If chbVollbild.Checked = True Then
      chbRaster.Enabled = False: chbDiagonalen.Enabled = False
    Else
      chbRaster.Enabled = True: chbDiagonalen.Enabled = True
    End If
  End If
  Dim rotW_half, rotH_half, rotL, rotT As Decimal
  Dim relPicIn, RelPic2 As Decimal
  Dim inW_half, inH_half As Decimal
  Dim theta As Double =  HScrollBar1.Value * 0.5 * PI / 180.0
    If theta < 0 Then theta *= -1
  Dim sin_theta As Double = Sin(theta): Dim cos_theta As Double = Cos(theta)
  tb4.Text = HScrollBar1.Value * 0.5
  inW_half = bmp_In.Width/2: inH_half = bmp_In.Height/2
  rotW_half = inW_half*cos_theta+inH_half*sin_theta: rotH_half = _
    inW_half*sin_theta+inH_half*cos_theta
  rotL = rotW_half-inW_half*cos_theta+inH_half*sin_theta: rotT = rotH_half-( _
  -inW_half*sin_theta+inH_half*cos_theta)
  bmp_Out = New Bitmap(CInt(2*rotW_half), CInt(2*rotH_half))
  Dim g As Drawing.Graphics = Graphics.FromImage(bmp_Out)
    g.Clear(Color.LightGray)
    Dim p_center As PointF
    p_center.X = rotW_half
    p_center.Y = rotH_half
    Dim m As New Drawing.Drawing2D.Matrix
      m.RotateAt( HScrollBar1.Value*0.5, p_center)
      g.Transform = m
      Dim source_rect As New Rectangle(0, 0, bmp_In.Width, bmp_In.Height)
      Dim intX As Integer = CInt((bmp_Out.Width-bmp_In.Width)/2)
      Dim intY As Integer = CInt((bmp_Out.Height-bmp_In.Height)/2)
      Dim dest_rect As New Rectangle(intX,intY,bmp_In.Width,bmp_In.Height)
      g.DrawImage(bmp_In, dest_rect, source_rect, GraphicsUnit.Pixel)
    m.Dispose()
  g.Dispose()
  pb1.Image = bmp_Out
  RelPic2 = rotT/(2*rotW_half-rotL)
  relPicIn = bmp_In.Height/bmp_In.Width
  If relPicIn < 1 Then
    If relPicIn = pb1.Height/pb1.Width Then
      out_rect.Width = Math.Floor(2*(rotH_half-rotT+rotW_half*RelPic2)/( _
        relPicIn+RelPic2)/16)*16
      decZoom = bmp_Out.Height/pb1.Height
    Else
      out_rect.Width = 2*(rotH_half-rotT+rotW_half*RelPic2)/(relPicIn+RelPic2)
      decZoom = bmp_Out.Width/pb1.Width
    End If
    out_rect.Height = out_rect.Width*relPicIn
  Else
    out_rect.Height = 2*(rotW_half-rotL+rotH_half*RelPic2)/( _
      bmp_In.Width/bmp_In.Height+RelPic2)
    out_rect.Width = out_rect.Height/relPicIn
    decZoom = bmp_Out.Height/pb1.Height
  End If
  out_rect.X = rotW_half-out_rect.Width/2
  out_rect.y =  rotH_half-out_rect.Height/2
  Dim ImagePart As Bitmap = New Bitmap(out_rect.Width, out_rect.Height)
  g = Graphics.FromImage(ImagePart)
  Dim TargetRect As Rectangle = New Rectangle(0, 0, out_rect.Width, _
    out_rect.Height)
  g.DrawImage(bmp_Out, TargetRect, out_rect, GraphicsUnit.Pixel)
  g.Dispose
  pb2.Image = ImagePart
  If chbVollbild.Checked = True Then pb1.Image = ImagePart
  End Sub
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Function ImageRotate1.651Dikn27.09.17 13:34
Re: Function ImageRotate950Franki28.09.17 01:14
Re: Function ImageRotate898VB3-Guru08.02.18 16:03
Re: Function ImageRotate824Franki09.02.18 03:17
Re: Function ImageRotate792Dikn19.02.18 09:31
Re: Function ImageRotate756Dikn19.02.18 09:33
VB.net-Code774VB3-Guru19.02.18 10:41

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