| |
VB.NET - FortgeschritteneRechteck 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 = True
‚Me.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 | |
Re: Rechteck mit Ziehpunkten vergrößern/verkleinern Teil2 | | | Autor: Dikn | Datum: 22.07.18 11:31 |
| Private Sub cbWH_CheckedChanged (sender As System.Object, e As _
System.EventArgs) Handles cbWH.CheckedChanged
Dim rect1 As Rectangle = Rect
If cbWH.Checked Then
If Rect.Width/16 > Rect.Height/9 Then
Rect.Height = CInt(Math.Truncate(rect1.Height/9)*9)
Rect.Width = CInt(Math.Truncate(rect1.Height/9)*16)
Rect.X += CInt((rect1.Width-Rect.Width)/2)
Rect.Y += CInt((rect1.Height-Rect.Height)/2)
ElseIf Rect.Width/16 < Rect.Height/9 Then
Rect.Width = CInt(Math.Truncate(rect1.Width/16)*16)
Rect.Height = CInt(Math.Truncate(rect1.Width/16)*9)
Rect.X += CInt((rect1.Width-Rect.Width)/2)
Rect.Y += CInt((rect1.Height-Rect.Height)/2)
Else
Exit Sub
End If
pb1.Refresh
End If
End Sub
Private Sub pb1_Paint(sender As Object, e As PaintEventArgs) Handles pb1.Paint
Dim p As New Pen(Color.Red, 1)
e.Graphics.DrawRectangle(p, Rect)
xM = Rect.X+CInt(Rect.Width/2)
yM = Rect.Y+CInt(Rect.Height/2)
With e.Graphics
.FillEllipse(Brushes.Cyan,Rect.X-4, Rect.Y-4, 8, 8)
.DrawEllipse(p, Rect.X-4, Rect.Y-4, 8, 8)
.FillRectangle(Brushes.Cyan, xM, Rect.Y-4, 8, 8)
.DrawRectangle(p, xM, Rect.Y-4, 8, 8)
.FillRectangle(Brushes.Cyan, Rect.X-4, yM-4, 8, 8)
.DrawRectangle(p, Rect.X-4, yM-4, 8, 8)
End With
End Sub
Private Function getRecType(x As Integer, y As Integer) As String
Dim rectOL As New Rectangle(Rect.X-4, Rect.Y-4, 8, 8)
Dim rectOM As New Rectangle(xM, Rect.Y-4, 8, 8)
Dim rectML As New Rectangle(Rect.X-4, yM-4, 8, 8)
If rectOL.Contains(x,y) Then
getRecType = "OL"
ElseIf rectOM.Contains(x,y) Then
getRecType = "OM"
ElseIf rectML.Contains(x,y) Then
getRecType = "ML"
ElseIf Rect.Contains(x,y)
getRecType = "Rect"
Else
getRecType = "0"
End If
End Function
End Class | |
| 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 |
|
|
sevISDN 1.0
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats Neu! sevDTA 3.0 Pro
SEPA mit Kontonummernprüfung
Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Weitere Infos
|