|
■No92030 (犬 さん) に返信 > イラレのペンツールみたいに、ライン上のポイントのない場所をマウスでクリックすると > そこに新たにポイントが挿入されるようなことがしたいのですが。
『イラレ』を使ったことがないので、どういう処理なのか分かりませんが、 想像で補って作ってみました。
・マウスカーソルは消して、代わりに点滅破線円で表現しています。 ・ライン上に無いエリアはクリックしても反応しません。 ・クリック可能なエリアでは、カーソル円の色が変わります。 ・スプラインの制御点近くに来ると、カーソルを吸着させています。 ・制御点はドラッグでドラッグで移動できます。ただし PictureBox の枠外にドラッグすることはできません。 ・制御点ドラッグ中に Shift キーを押すと、その制御点が削除されます。 ・制御点を 2 個未満にすることはできません。
> PathPointsで得られた配列から自分でピクセルを内挿して、 > 二次元Boolean配列でライン近傍だけをTrueにして、 > 判定するとかしかないですかね > 相当面倒な処理が必要ですよね
区間判定が手抜き実装なので、しばしば誤判定します…。orz
Imports System.Drawing.Drawing2D Public Class Form1 Private Points As New List(Of Point)() 'スプライン曲線用の制御点座標群 Private LinePen As New Pen(Color.Red, 3.0F) '曲線描画用 Private GrabPen As New Pen(Color.Transparent, 5.0F) '座標探索用 Private dragIndex As Integer = -1 'ドラッグ中のグラブ番号
Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed LinePen.Dispose() GrabPen.Dispose() End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Points.AddRange(New Point() { New Point(30, 20), New Point(60, 150), New Point(120, 30), New Point(200, 140), New Point(220, 100), New Point(190, 60)}) End Sub
Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint Dim p = PictureBox1.PointToClient(Cursor.Position) Dim g = e.Graphics Dim gs = g.Save() g.SmoothingMode = SmoothingMode.AntiAlias
Dim grapColor As Color = Color.Olive
Using gp As New GraphicsPath() '曲線を描画 gp.AddCurve(Points.ToArray()) g.DrawPath(LinePen, gp)
'制御点上に居る場合の処理 If MouseButtons.HasFlag(MouseButtons.Left) AndAlso 0 <= dragIndex AndAlso dragIndex < Points.Count Then grapColor = Color.Cyan Points(dragIndex) = p 'ドラッグによりグラブ座標を移動 If Points.Count > 2 AndAlso ModifierKeys.HasFlag(Keys.Shift) Then 'ドラッグ中に Shift キーが押された場合は、その制御点を削除する Points.RemoveAt(dragIndex) dragIndex = -1 End If Else dragIndex = -1 End If
If dragIndex = -1 Then 'ドラッグ中で無い場合は、曲線上に居るかどうかで色を変える If gp.IsOutlineVisible(p, GrabPen) Then grapColor = Color.Magenta '曲線上に居る End If End If
'制御点を描画 For n = 0 To Points.Count - 1 Dim pt = Points(n) Dim rect = Rectangle.FromLTRB(pt.X - 3, pt.Y - 3, pt.X + 3, pt.Y + 3) gp.Reset() gp.AddEllipse(rect) If gp.IsVisible(p, g) Then '制御点上にカーソルがある場合は ● として描く g.FillEllipse(Brushes.Blue, rect) 'グラブ番号を更新 If dragIndex = -1 Then dragIndex = n grapColor = Color.Magenta End If Else '制御点上にカーソルが無い場合は ○ として描く g.DrawEllipse(Pens.Blue, rect) End If Next
'点滅するカーソルを描画 Dim grapPos = If(dragIndex = -1, p, Points(dragIndex)) Dim grabRect = Rectangle.FromLTRB(grapPos.X - 6, grapPos.Y - 6, grapPos.X + 6, grapPos.Y + 6) Using cursorPen As New Pen(grapColor, 1.5F) cursorPen.DashStyle = DashStyle.Dash cursorPen.DashOffset = Now.Millisecond \ 100 g.DrawEllipse(cursorPen, grabRect) End Using
End Using g.Restore(gs) PictureBox1.Invalidate() End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp dragIndex = -1 Cursor.Clip = Nothing PictureBox1.Invalidate() End Sub Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove PictureBox1.Invalidate() End Sub
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown If Not e.Button.HasFlag(MouseButtons.Left) Then Return '左クリックで無ければ無視 Else 'ドラッグ可能エリアを PictureBox 内に制限 Dim clip = PictureBox1.RectangleToScreen(PictureBox1.ClientRectangle) clip.Inflate(-7, -7) Cursor.Clip = clip End If
If 0 <= dragIndex AndAlso dragIndex < Points.Count Then '制御点を掴んでいる最中 PictureBox1.Invalidate() Return End If
'座標の挿入位置を判定 Dim p = e.Location Using gp As New GraphicsPath() gp.AddCurve(Points.ToArray())
'曲線上にあった場合は、平坦化して区間を調べる If gp.IsOutlineVisible(p, GrabPen) Then gp.Flatten(New Matrix(), 0.0125F) Dim pd = gp.PathData Dim i As Integer = 1 Dim p0 = pd.Points(0) For j = 1 To pd.Points.Count - 1 Dim p1 = pd.Points(j) gp.Reset() gp.AddLine(p0, p1) If gp.IsOutlineVisible(p, GrabPen) Then '区間内に「挿入」して再描画 Points.Insert(i, p) PictureBox1.Invalidate() Return End If If i < Points.Count AndAlso Points(i) = New Point(CInt(p1.X), CInt(p1.Y)) Then i += 1 '次の区間に進む End If Next End If End Using End Sub
Private Sub PictureBox1_MouseEnter(sender As Object, e As EventArgs) Handles PictureBox1.MouseEnter Cursor.Hide() PictureBox1.Invalidate() End Sub
Private Sub PictureBox1_MouseLeave(sender As Object, e As EventArgs) Handles PictureBox1.MouseLeave Cursor.Show() End Sub End Class
|