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

VB.NET - Fortgeschrittene
Re: Function ImageRotate 
Autor: Dikn
Datum: 05.10.17 10:50

so funktioniert's!!!
wie geht's einfacher/besser???

Code Teil 1:
Imports System.Drawing.Drawing2D
 
Public Class Form1
 
  Dim WithEvents pb1 As New PictureBox
  Dim WithEvents HScrollBar1 As New HScrollbar
  Dim WithEvents lb1 As New Label
  Dim WithEvents chb1, chb2 As New CheckBox
  Dim xBitmap As Drawing.Bitmap
  Dim gBitmap As Drawing.Bitmap
  Dim angle As Decimal = Nothing
  Dim decGrad As Decimal = 0.0
  Dim pen As System.Drawing.Graphics
 
  Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles _
    Me.Load
'------------------------------------------------------------------------------
  Me.Width = 550: Me.Height = 350: Me.BackColor = Color.DarkGray: Me.Text = _
    "Rotate"
 
  With Me.pb1: .Left = 20: .Top = 15: .Width = 400: .Height = 225
  .BorderStyle = BorderStyle.FixedSingle: .SizeMode = _
    PictureBoxSizeMode.StretchImage
  .BackColor = Color.Red: End With
 
  With Me.HScrollBar1: .Left= 20: .Top = 260: .Width = 400: .Height = 17: _
    .Minimum = 0: .Maximum = 20
                       .largeChange = 1: .Value = 10: End With
 
  With lb1: .Left = 207: .Top = 277: .Width = 30: .Height = 17:
    .Font = New Font("Microsoft Sans Serif", 14): .Name = "lb1"
    .TextAlign = ContentAlignment.MiddleCenter: .Text = "^": End With
 
  With chb1: .Left = 445: .Top = 35: .Width = 60: .Height = 17: .Text = _
    "Vollbild"
    .Name = "chb1": .Checked = True: End With
  With chb2: .Left = 445: .Top = 58: .Width = 60: .Height = 17: .Text = "Raster"
    .Name = "chb2": .Checked = True: End With
 
  Me.Controls.Add(pb1): Me.Controls.Add(HScrollBar1): Me.Controls.Add(lb1)
  Me.Controls.Add(chb1): Me.Controls.Add(chb2)
 
  xBitmap = New Bitmap("C:\--- Programmentwicklung\Bilder\IMG_1000.JPG")
  gBitmap = xBitmap
 
  Me.pb1.Width = CInt(pb1.Height * (gBitmap.Width / gBitmap.Height))  
 
  Me.pb1.Image = gBitmap
  Me.HScrollBar1.Value = 10
  End Sub
 
  Private Sub chb2_CheckStateChanged _
    (sender As Object, e As System.EventArgs) Handles chb2.CheckStateChanged
'------------------------------------------------------------------------------
    pb1.Refresh
  End Sub
 
  Private Sub pb1_Paint _
    (ByVal sender As System.Object, ByVal e As _
    System.Windows.Forms.PaintEventArgs) Handles pb1.Paint
'------------------------------------------------------------------------------
  If chb2.Checked = False Then Exit Sub
 
  Dim myPen As Pen = New Pen(Color.White)
  Dim intY As Integer = CInt(pb1.Height/8)
  Dim intY_2 As Integer = CInt(intY/2)
  Dim intX As Integer = intY 
  Dim intX_2 As Integer
 
  myPen.DashStyle = DashStyle.DashDot
 
  e.Graphics.DrawLine(myPen, 0, intY_2, pb1.Width, intY_2)
  For i = 1 To CInt((pb1.Height-(2*intY_2))/intX)
    e.Graphics.DrawLine(myPen, 0, i*intY+intY_2, pb1.Width, i*intY+intY_2)
  Next                                 
 
  intX_2 = CInt((pb1.Width - (CInt(pb1.Width/intY)*intY))/2)
  If intX_2 < intY/2 Then intX_2 += intY                  
  e.Graphics.DrawLine(myPen, CInt(intX_2), 0, CInt(intX_2), pb1.Height) 
  For i = 1 To CInt((pb1.Width-(2*intX_2))/intY)                          
    e.Graphics.DrawLine(myPen, i*intX+intX_2, 0, i*intX+intX_2, pb1.Height)
  Next                                                                   
  End Sub  
 
  Private Sub lb1_Click _
    (sender As Object, e As System.EventArgs) Handles lb1.Click
'------------------------------------------------------------------------------
    Me.HScrollBar1.Value = 10
  End Sub
 
  Protected Overrides Function ProcessCmdKey _
    (ByRef msg As System.Windows.Forms.Message, keyData As _
    System.Windows.Forms.Keys) As Boolean
'------------------------------------------------------------------------------
  Select Case keyData.ToString
    Case "Home":  Me.HScrollBar1.Value = 0
    Case "Right": If Me.HScrollBar1.Value < Me.HScrollBar1.Maximum Then: _
      Me.HScrollBar1.Value += 1
                  Else: Beep: End If
    Case "Clear", "Down": Me.HScrollBar1.Value = 10
    Case "Left":  If Me.HScrollBar1.Value > Me.HScrollBar1.Minimum Then: _
      Me.HScrollBar1.Value -= 1
                  Else: Beep: End If
    Case "End":   Me.HScrollBar1.Value = 20
  End Select
 
  Return True
  End Function
 
  Private Sub HScrollBar1_ValueChanged _
    (sender As Object, e As System.EventArgs) Handles HScrollBar1.ValueChanged
'------------------------------------------------------------------------------
  If Me.HScrollBar1.Value - 10 <> 0 Then: Me.pb1.Image = Rotate_Bitmap(gBitmap, _
      CDec((Me.HScrollBar1.Value - 10) * 0.5), Color.LightGray): Else: _
      Me.pb1.Image = xBitmap: End If
  End Sub
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 ImageRotate741Dikn28.09.17 09:43
Re: Function ImageRotate750Manfred X28.09.17 11:09
Re: Function ImageRotate710Dikn28.09.17 17:47
Re: Function ImageRotate783Manfred 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