| |
VB.NET - Ein- und UmsteigerToolTip von Listview | | | Autor: Marty** | Datum: 20.04.17 21:33 |
| Hallo,
hiermit lasse ich mir Kreise zeichnen
Public Class Form1
Dim WithEvents pb As New PictureBox With {.Parent = Me, .Size = New Size( _
300, 300)}
Dim WithEvents lbo As New ListBox With {.Parent = Me, .Top = 330, .Width = _
300, .Height = 60}
Private Sub frmBlink_Load(sender As System.Object, e As System.EventArgs) _
Handles MyBase.Load
Me.Size = New Size(320, 440)
'Die Listenindices definieren die Position der Kreise in der Picturebox
' pb
lbo.Items.AddRange({"100,100", "130, 130", "160, 160", "100, 160"})
End Sub
Private Sub pb_Paint(sender As Object, e As _
System.Windows.Forms.PaintEventArgs) Handles pb.Paint
Dim vl() As String, x%, y%
'Nicht-selektierte Kreise zeichnen (grau)
Using br As New SolidBrush(Color.Gray)
For i As Integer = 0 To lbo.Items.Count - 1
If Not i = lbo.SelectedIndex Then
vl = lbo.Items(i).ToString.Split(","c)
x = CInt(vl(0)) : y = CInt(vl(1))
e.Graphics.FillEllipse(br, x, y, 20, 20)
End If
Next i
End Using
End Sub
End Class Wie kann man sich, wenn man mit der Maus über die Kreise zieht, sich ein Tooltip mit den x u. y Koordinaten anzeigen lassen ?
MfG | |
Hinweis zu einem Zeichnungselement anzeigen | | | Autor: Manfred X | Datum: 21.04.17 00:21 |
| Hallo!
Was hat dieses Thema mit einem Listview zu tun ???
Tooltips beziehen sich auf Controls.
Hinweise zu einem Zeichnungselement anzeigen ...
Public Class frmDrawToolTip
'Kreisparameter
Private Structure CircleParams
Property center As Point
Property radius As UShort
Property color As Drawing.Color
End Structure
'Liste der Kreisparameter
Dim circles As New List(Of CircleParams)
Dim WithEvents pb As New PictureBox With _
{.Parent = Me, .Size = New Size(400, 400)}
'Label für Tipps
Dim lbl As New Label With _
{.Parent = Me, .AutoSize = False, .Visible = False, _
.Width = 150, .Height = 20, .BackColor = Color.LightYellow, _
.BorderStyle = BorderStyle.FixedSingle, _
.Font = New Font("Arial", 8)}
Private Sub frmDrawToolTip_Load _
(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Me.Size = New Size(450, 450)
'Einge Kreis-Parameter
With circles
.Add(New CircleParams With _
{.center = New Point(100, 120), .radius = 30, .color = Color.Red})
.Add(New CircleParams With _
{.center = New Point(200, 180), .radius = 60, .color = _
Color.Green})
.Add(New CircleParams With _
{.center = New Point(280, 220), .radius = 60, .color = Color.Blue})
End With
End Sub
Private Sub pb_MouseMove(sender As Object, _
e As System.Windows.Forms.MouseEventArgs) Handles pb.MouseMove
Dim mpos As New Point(e.X, e.Y)
Dim c As Integer = FindCircle(mpos)
If c = -1 Then lbl.Visible = False : Exit Sub
With circles(c)
'Listenindex und Kreismittelpunkt anzeigen
lbl.Text = c.ToString & ".) Center: " & _
.center.X.ToString & " | " & .center.Y.ToString
lbl.Location = .center 'Position des Tipp-Labels
lbl.Visible = True
lbl.BringToFront()
End With
End Sub
Private Sub bp_Paint(sender As Object, _
e As System.Windows.Forms.PaintEventArgs) Handles pb.Paint
For i As Integer = 0 To circles.Count - 1
With circles(i)
Using pn As New Pen(.color, 2)
e.Graphics.DrawEllipse(pn, GetCircleRect(circles(i)))
End Using
End With
Next i
End Sub
Private Function GetCircleRect(cp As CircleParams) As Rectangle
'Zeichenfläche (Quadrat) aus den Kreisparametern bestimmen
With cp
Return New Rectangle _
(.center.X - .radius, .center.Y - .radius, _
.radius * 2, .radius * 2)
End With
End Function
Private Function FindCircle(Pos As Point) As Integer
For i As Integer = 0 To circles.Count - 1
With circles(i)
'Berechnung der Distanzen zwischen Mausposition und
'den Kreismittelpunkten
Dim distance As Double = Math.Sqrt( _
(Pos.X - .center.X) ^ 2 + _
(Pos.Y - .center.Y) ^ 2)
'erster gefundener Kreis in der Liste
If distance <= .radius Then Return i
End With
Next i
Return -1
End Function
End Class
Beitrag wurde zuletzt am 21.04.17 um 00:27:51 editiert. | |
| 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 |
|
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats sevAniGif (VB/VBA)
Anzeigen von animierten GIF-Dateien
Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Weitere Infos
|