| |
Fortgeschrittene ProgrammierungRechteck auf PictureBox verschieben | | | Autor: Dikn | Datum: 11.07.18 11:00 |
| Hallo!
Ich möchte ein Rechteck auf einer PictureBox mit der Maus bewegen.
Dies funktioniert auch mit:
Public Class Form1
Dim x1, y1, x2, y2, w, h As Integer
Dim dragRec As Boolean
Dim memX, memY As Integer
Private Sub Form1_Load _
(sender As Object, e As EventArgs) Handles Me.Load
x1 = 80: y1 = 45: x2 = 240: y2 = 135 : w = 160: h = 90
End Sub
Private Sub pb1_MouseDown _
(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles pb1.MouseDown
dragRec = True
memX = e.X: tb1.Text = memX
memY = e.Y: tb2.Text = memY
End Sub
Private Sub pb1_MouseMove _
(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles pb1.MouseMove
If Not dragRec Then Exit Sub
x1 = x1+(e.X-memX)
memX = e.X
y1 = y1+(e.Y-memY)
memY = e.Y
x2 = x1+w
y2 = y1+h
If x1 < 0 OR y1 < 0 OR x2 > pb1.Width-3 OR y2 > pb1.Height-3 Then Exit Sub
pb1.Refresh
End Sub
Private Sub pb1_MouseUp_
(ByVal sender As Object, ByVal e As _
System.Windows.Forms.MouseEventArgs) Handles pb1.MouseUp
dragRec = False
End Sub
Private Sub pb1_Paint _
(sender As Object, e As PaintEventArgs) Handles pb1.Paint
e.Graphics.DrawRectangle(Pens.Red, x1, y1, x2-x1, y2-y1)
End Sub
End Class Aber:
Warum wird das Rechteck manchmal nicht bis an den Rand geschoben???? | |
Re: Rechteck auf PictureBox verschieben | | | Autor: Kuno60 | Datum: 11.07.18 11:34 |
| Dikn schrieb:
Zitat: | | Warum wird das Rechteck manchmal nicht bis an den Rand geschoben???? | |
Das liegt daran, weil das MouseMove-Ereignis nicht für jeden Pixel ausgelöst wird. Es ist auch Abhängig davon, wie schnell man die Maus bewegt.
Ebenfalls Falsch:
Du berechnest im MouseMove-Ereignis immer die neue Position des Rechtecks, unterdrückst aber dann nur das Neuzeichnen.
Und auch noch im falschen Forum! | |
Re: Rechteck auf PictureBox verschieben | | | Autor: Kuno60 | Datum: 11.07.18 12:23 |
| Hallo,
hier mal ein funktionierendes Beispiel:
Class Form1
Dim dragRec As Boolean, mPos As Point
Dim Rect As New Rectangle(80, 45, 160, 90)
Private Sub pb1_MouseDown(sender As Object, e As MouseEventArgs) Handles _
PB1.MouseDown
If e.Button = MouseButtons.Left AndAlso Rect.Contains(e.Location) Then
dragRec = True
mPos = e.Location
TB1.Text = mPos.ToString
End If
End Sub
Private Sub pb1_MouseMove(sender As Object, e As MouseEventArgs) Handles _
PB1.MouseMove
If Not dragRec Then Exit Sub
Dim p As Point = Rect.Location + (e.Location - mPos) 'neue Rechteck-Position
mPos = e.Location 'aktuelle Mausposition merken
If p.X < 0 Then p.X = 0
If p.Y < 0 Then p.Y = 0
If p.X + Rect.Width > PB1.Width - 3 Then p.X = PB1.Width - 3 - Rect.Width
If p.Y + Rect.Height > PB1.Height - 3 Then p.Y = PB1.Height - 3 - Rect.Height
If p <> Rect.Location Then
Rect.Location = p
PB1.Refresh()
End If
End Sub
Private Sub pb1_MouseUp(sender As Object, e As MouseEventArgs) Handles _
PB1.MouseUp
dragRec = False
End Sub
Private Sub pb1_Paint(sender As Object, e As PaintEventArgs) Handles PB1.Paint
e.Graphics.DrawRectangle(Pens.Red, Rect)
End Sub
End Class Kleine Verbesserung:
Durch "If e.Button = MouseButtons.Left AndAlso Rect.Contains(e.Location) Then"
kann das Rechteck nur verschoben werden, wenn mit der linken Maustaste in das Rechteck geklickt wird. | |
Re: Rechteck auf PictureBox verschieben | | | Autor: Dikn | Datum: 11.07.18 18:30 |
| Vielen, vielen Dank!!!
Da ich einige Tage unterwegs bin, kann ich leider Dein Beispiel nicht gleich ausprobieren...
Ich melde mich! | |
Re: Rechteck auf PictureBox verschieben | | | Autor: Dikn | Datum: 17.07.18 11:21 |
| Antwort verschoben in "richtiges" Forum | |
| 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! sevCoolbar 3.0
Professionelle Toolbars im modernen Design!
Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Weitere 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
|
|