| |
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 | |
| 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 |
|
|
sevZIP40 Pro DLL
Zippen und Unzippen wie die Profis!
Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Weitere InfosTipp des Monats Access-Tools Vol.1
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
|
|
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
|
|