線の選択

<戻る

ここに載せてあるソースコードは、参考のために載せてあります

サンプルコードは、一番下にLZHとしてあります




Option Explicit

'---------------------------------------------
'欠点があります
'太い線などには1ピクセルで判定を行っているため
'正しく動作しません
'太い線などには
'OrbitLine関数で当たり範囲を広げるなどの
'修正が必要になります
'----------------------------------------------

'フォームをロードしました
Private Sub Form_Load()
    Dim j       As Long
    Dim jmax    As Long
    
    '乱数で20ライン描きます
    For j = 1 To 20
        '線を追加します
        AddLine CInt(Rnd * 200), CInt(Rnd * 140), CInt(Rnd * 200), CInt(Rnd * 140)
    Next
    
    'すべての線を描画します
    jmax = LineCount - 1
    For j = 0 To jmax
        DrawLine j, vbBlack
    Next
End Sub

'ピクチャボックス上でマウスのボタンを押しました
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lngIndex    As Long
    
    '指定した位置を通過する
    '線を探します
    lngIndex = FindLine(X, Y)
    If lngIndex >= 0 Then
        '見つかったら
        'その線を赤色で表示します
        DrawLine lngIndex, vbRed
    End If
End Sub

'指定した線配列のインデックスから線の描画を行います
Sub DrawLine(ByVal Index As Long, ByVal lngColor As Long)
    Dim x1  As Long
    Dim y1  As Long
    Dim x2  As Long
    Dim y2  As Long
    
    '線データを取得します
    If GetLine(Index, x1, y1, x2, y2) = True Then
        '取得した線データから線を描画します
        Picture1.Line (x1, y1)-(x2, y2), lngColor
    End If
End Sub


<戻る

Sample91.lzh


http://hp.vector.co.jp/authors/VA015521/