マウスドラッグでラベルコントロールの移動と直線の描画その3、頂点の追加方法修正

続き

頂点の追加を修正できた

http://www.geocities.jp/gogowaten/labal_control_move_animation6.gif

期待通りに動くようになった

線が交差するようなところだとより近い方を選ぶ

同じ距離なら頂点の順番の小さい方を選ぶ

 

線は頂点の順番の小さい方から順番に引かれていく

追加された頂点はどの順番にすればいいのか

この場合なら新頂点は4番目にして4番目だった頂点を5番めになるようにしたい

昨日のはこれがうまく判定できなくて新頂点が2番めになっていた

 

 

頂点1の座標が(1,1)、頂点2が(5,3)、追加された新頂点が(3,2)のとき

新頂点は線の上にあるのか無いのかの判定はどうすればいいのか

エクセル方眼紙使って考えた

1から2への線はxとyの関係で表すと

y=0.5x、まはたx=2yになる

この関係が1から新頂点の関係に当てはまれば

新頂点は1と2の線の上にあるってことになる

xA=頂点1のx-頂点2のx

yA=頂点1のy-頂点2のy

xB=頂点1のx-新頂点のx

yB=頂点1のy-新頂点のy

のとき

yB=(yA/xA)*xB

が正しければ線の上

それぞれ当てはめると

xA=1-5=-4

yA=1-3=-2

xB=1-3=-2

yB=1-2=-1

のとき

-1=(-2÷ -4)× -2

は正しいので新頂点は頂点1と頂点2の線の上

うーん、やっぱり小学校か中学校の算数だった…

 

頂点がもっとたくさんある時

順番に1と2の間、2と3の間、3と4の間……と調べていく

 

もっとまともな方法がある気がするのは

線が垂直だった場合0で割ることになってしまうのでエラーになる

 

あとは先には太さがあるので新頂点が線の上にあっても

yB=(yA/xA)*xB

これがぴったり正しくならないこともある

今回のアクア色の線の太さは3ピクセルにしているので

最大で2か3ずれることがあるはずなので

水色が太さ3の線

新頂点はずれているけど線の上

 

yB=(yA/xA)*xB

これの左辺と右辺の差(ズレ)が小さいものを探すことにした

ズレが小さいところに新頂点を追加

 

まとめた結果

 

↓

新頂点(62,95)を挿入する位置を決めたところ

ズレが一番小さい(2.0)のは3番めの線

3番目の線は頂点3と4の間の線なので

新頂点は頂点3の次に挿入すればいいことになる

新頂点が4番めになり元の頂点4は5番めになる

↓

できた！

 

頂点を中心にして太くなるんだなあ

正解は新頂点の順番が3番目になること

新頂点の座標は(144,52)

ズレの最小値は2番めの5.454545…

なので3番目になればいい

3番目に入った

 

 

Private nowPic As exPictureBox

Private Sub ToolStripMenuItem頂点の追加_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem頂点の追加.Click
    '右クリックしたところに頂点を追加
    Dim newPoint As New Point(mousePoint) '新しい頂点の座標
    Dim ps As Generic.List(Of Point) = nowPic.PointN '頂点のコレクションリスト
    Dim i As Long
    Dim diffX As Long
    Dim diffY As Long
    Dim diffnX As Long
    Dim diffnY As Long
    Dim d As New ArrayList 'ズレのリスト

    'どの頂点とどの頂点との間に新頂点を入れるかの判定
    '一番近い線を探す、各線と新頂点のズレを収集
    For i = 0 To ps.Count - 2
        diffX = ps(i).X - ps(i + 1).X
        diffY = ps(i).Y - ps(i + 1).Y
        diffnX = ps(i).X - newPoint.X
        diffnY = ps(i).Y - newPoint.Y
        If diffX = 0 Then '0で割るのを回避
            d.Add(Math.Abs(diffnX - diffX / diffY * diffnY))’絶対値に直してリストに追加
        Else
            d.Add(Math.Abs(diffnY - diffY / diffX * diffnX))
        End If
    Next

    'ズレの一番小さい頂点は？
    Dim min As Double = d.Item(0)
    Dim ix As Long = 0 'インデックス番号
    For i = 1 To UBound(d.ToArray)
        If min > d.Item(i) Then
            min = d.Item(i)
            ix = i '一番小さいズレのインデックス
        End If
    Next

    nowPic.PointN.Insert(ix + 1, newPoint) '新頂点をexPictureBoxのPointNに挿入

    Call 頂点の初期化(nowPic)

End Sub

 

ダウンロード

VisualBasic2013 - OneDrive

OneDrive 線の描画20141221.zip

https://onedrive.live.com/?cid=39DEECDB8489B195&id=39DEECDB8489B195%21541

 

 

関連記事

次回、2014/12/23は2日後

 

前回、2014/12/20は1日前