マウスドラッグでラベルコントロールの移動と直線の描画
2014/12/19は5年前
このときと同じなんだけど、書き直してみた
直線はGraphicsクラスのDrawLinesを使って描画
DrawLinesはPointの配列を渡すと、各Point間を直線で描画してくれる
各Pointの■はLabelを使って表示、これをマウスドラッグで移動できるようにして、移動させたら直線も再描画
LabelとPointの関連付けは、LabelのTagプロパティに通し番号を入れて、Pointの配列のindexと合わせるようにしている
ここまでは5年前と同じ
書き直したところ
5年前はPictureBoxを継承したクラスを作成して、そこに各Pointの情報を記録していたけど、今回のは新しいクラスを作成しないで書いてみた
Public Class Form1
Private beginPoint As Point
Private myPen As New Pen(Brushes.Magenta, 5)
Private myPoints As New List(Of Point)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Call MyInitialize()
End Sub
Private Sub MyInitialize()
myPoints = New List(Of Point)(New Point() {
New Point(0, 0),
New Point(150, 40),
New Point(80, 100),
New Point(100, 150)})
For i = 0 To myPoints.Count - 1
Call MakeLabel(myPoints(i), i)
Next
Call MyDrawLines()
End Sub
Private Sub MyMouseDown(sender As Object, e As MouseEventArgs)
beginPoint = e.Location
End Sub
Private Sub MyMouseMove(sender As Object, e As MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim myLabel = DirectCast(sender, Label)
Dim newLocate As Point
newLocate = New Point(e.X - beginPoint.X + myLabel.Location.X,
e.Y - beginPoint.Y + myLabel.Location.Y)
myLabel.Location = newLocate
myPoints(myLabel.Tag) = newLocate
Call MyDrawLines()
End If
End Sub
Private Sub MyDrawLines()
Dim canvas As New Bitmap(Me.PictureBox1.Width, Me.PictureBox1.Height)
Dim g As Graphics = Graphics.FromImage(canvas)
g.DrawLines(myPen, myPoints.ToArray)
g.Dispose()
Me.PictureBox1.Image = canvas
End Sub
Private Function MakeLabel(locate As Point, number As Integer) As Point
Dim myLabel = New Label()
With myLabel
.Width = 10
.Height = 10
.BackColor = Color.Black
.Location = locate
.Tag = number
End With
Me.PictureBox1.Controls.Add(myLabel)
AddHandler myLabel.MouseDown, AddressOf MyMouseDown
AddHandler myLabel.MouseMove, AddressOf MyMouseMove
End Function
End Class
デザイン画面
ギットハブ
関連記事
ブログ
平均室温が32度を超えたあたりで睡眠不足で頭が休眠状態になるけど
今日は珍しく涼しい(今の室温30.9度)ので、なんとか動けて
このまま涼しくなってくれるといいねえ