vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 17 bzw. 24 Entwickler-Vollversionen zum unschlagbaren Preis!  
 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
Rechteck mit Ziehpunkten vergrößern/verkleinern Teil1 
Autor: Dikn
Datum: 22.07.18 11:30

vb2010
PictureBox [pb1] – BorderStyle: None, W/H: 480/270, SizeMode: Zoom,
CheckBox [cbWH] – Haken, wenn Rechteck nur im Seitenverhältnis 16/9

Funktioniert, aber geht das einfacher/besser????

Option Strict On
 
Class Form1
 
  Dim Rect As New Rectangle(190, 45, 160, 90)
  Dim Diff As Size
  Dim DragRect As Boolean
 
  Dim typeRect As String = "0"
  Dim xM, yM As Integer
 
  Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles _
    Me.Load
  DoubleBuffered = TrueMe.pb1.Image = Bitmap.FromFile("C:\...\Bilder\IMG_1000.JPG")
  End Sub
 
 
  Private Sub pb1_MouseDown (sender As Object, e As MouseEventArgs) Handles _
    pb1.MouseDown
  typeRect = getRecType(e.X, e.Y)
 
  Select Case typeRect
    Case "Rect"
      Cursor.Current = Cursors.Hand
      If e.Button = MouseButtons.Left AndAlso Rect.Contains(e.Location) Then
        Diff.Width = e.X - Rect.X
        Diff.Height = e.Y - Rect.Y
        DragRect = True
      End If
    Case "OL"
      Cursor.Current = Cursors.SizeNWSE
      DragRect = True
    Case "OM"
      Cursor.Current = Cursors.SizeNS
      DragRect = True
    Case "ML"
      DragRect = True
      Cursor.Current = Cursors.SizeWE
    Case Else
      Beep
  End Select
  End Sub
 
  Private Sub pb1_MouseMove (sender As Object, e As MouseEventArgs) Handles _
    pb1.MouseMove
  Dim x1, x2, y1, y2, w, h As Integer
 
  If typeRect = "Rect" Then
    Rect.Location = e.Location - Diff
 
    If Rect.X < 0 Then Rect.X = 0
    If Rect.Y < 0 Then Rect.Y = 0
    If Rect.X+Rect.Width > pb1.Width-1 Then Rect.X = pb1.Width-1-Rect.Width
    If Rect.Y+Rect.Height > pb1.Height-1 Then Rect.Y = pb1.Height-1-Rect.Height
 
  ElseIf typeRect <> "0" Then
    x1 = Rect.X
    y1 = Rect.Y
    x2 = Rect.X+Rect.Width
    y2 = Rect.Y+Rect.Height
    w = Rect.Width
    h = Rect.Height
 
    Select Case typeRect
      Case "OL"
        x1 = e.X
        y1 = e.y
        If x1 < 0 Then x1 = 0
        If y1 < 0 Then y1 = 0
 
        If cbWH.Checked = True Then
          w = CInt((x2-x1)/16)*16
          h = CInt(w/16*9)
          x1 = x2-w
          y1 = y2-h
        Else
          w = x2-x1
          h = y2-y1
        End If
 
      Case "OM"
        If e.y < 0 Then Exit Sub
        y1 = e.Y
 
        If cbWH.Checked = True Then
          h = CInt((y2-y1)/9)*9
          w =  CInt(h/9)*16
          x1 -= CInt((w-Rect.Width)/2)
          y1 = y2-h
        Else
          h = y2-y1
        End If
 
      Case "ML"
        If e.x < 0 Then Exit Sub
        x1 = e.X
 
        If cbWH.Checked = True Then
          w =  CInt((x2-x1)/16)*16
          h = CInt(w/16)*9
          x1 = x2-w
          y1 -= CInt((h-Rect.Height)/2)
        Else
          w = x2-x1
        End If
    End Select
 
 
    If cbWH.Checked = True AND w = Rect.Width Then Exit Sub
    If y1 < 0 Or x1 < 0 Or x1+w > pb1.Width-1 Or y1+h > pb1.Height-1 OR h _
      < 90 OR w < 160 Then Exit Sub
 
    Rect.X = x1
    Rect.Y = y1
    Rect.Width = w
    Rect.Height = h
 
  Else
    Select Case getRecType(e.X, e.Y)
      Case "Rect"
        Cursor.Current = Cursors.Hand
      Case "OL"
        Cursor.Current = Cursors.SizeNWSE
      Case "OM"
        Cursor.Current = Cursors.SizeNS
      Case "ML"
        Cursor.Current = Cursors.SizeWE
    End Select
 
    Exit Sub
  End If
 
  pb1.Invalidate()
  End Sub
 
  Private Sub pb1_MouseUp (sender As Object, e As MouseEventArgs) Handles _
    pb1.MouseUp
  DragRect = False
  typeRect = "0"
  End Sub
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Rechteck mit Ziehpunkten vergrößern/verkleinern Teil11.024Dikn22.07.18 11:30
Re: Rechteck mit Ziehpunkten vergrößern/verkleinern Teil2518Dikn22.07.18 11:31

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