Option Explicit

'描画するピクチャボックスに使います
Private mPic As PictureBox

'線の位置の保存するのに使います
Private mXY(1 To 4) As POINTAPI

'線を何回描いたかに使います
Private mLineNumber As Integer

'2次スプライン曲線関数のサブ関数です
Private Sub Spline_Sub()
    Dim j   As Integer
    Dim k   As Double
    Dim n1  As Double
    Dim n2  As Double
    Dim n3  As Double
    Dim x   As Single
    Dim y   As Single
    Dim pos As POINTAPI
    
    'mXYとmLineNumberをもとに
    'スプライン曲線を描画します
    MoveToEx mPic.hDC, mXY(1).x, mXY(1).y, pos
    For j = 1 To mLineNumber - 2
        For k = 0 To 1.05 Step 0.1
            n1 = 0.5 * (1 - k) ^ 2
            n2 = (-k + 1) * k + 0.5
            n3 = k ^ 2 * 0.5
            x = n1 * mXY(j).x + n2 * mXY(j + 1).x + n3 * mXY(j + 2).x
            y = n1 * mXY(j).y + n2 * mXY(j + 1).y + n3 * mXY(j + 2).y
            LineTo mPic.hDC, x, y
    Next k, j
    LineTo mPic.hDC, mXY(mLineNumber).x, mXY(mLineNumber).y
End Sub

'Paintイベントが発生したときに線を描画します
Sub Spline_PaintEvent()
    If Not (mLineNumber = 0) Then
        mLineNumber = mLineNumber - 1
        Spline_Sub
        mLineNumber = mLineNumber + 1
    End If
End Sub

'スプライン曲線を描画する
'オブジェクトをセットするプロパティです
Property Set SetDrawObject(pic As PictureBox)
    Set mPic = pic
End Property

'2次スプライン曲線関数です
Sub Spline(ByVal x As Long, ByVal y As Long, ByVal flg As MouseEventConstants)
    Dim pos As POINTAPI
    Dim j   As Integer
    
    'マウスを離し、3度目に描画し線を
    '最終的な線として描画します
    If flg = eEventMouseUp And mLineNumber = 4 Then
        mPic.AutoRedraw = True
    Else
        mPic.AutoRedraw = False
        mPic.Cls
    End If
    
    'マウスのボタンが押されているときの処理です
    If flg = eEventMouseDown Then
        If mLineNumber = 0 Then
            mXY(1).x = x
            mXY(1).y = y
            mXY(2).x = x
            mXY(2).y = y
            MoveToEx mPic.hDC, mXY(1).x, mXY(1).y, pos
            LineTo mPic.hDC, mXY(2).x, mXY(2).y
        ElseIf mLineNumber = 3 Then
            mXY(3).x = mXY(2).x
            mXY(3).y = mXY(2).y
            mXY(2).x = x
            mXY(2).y = y
            Spline_Sub
        ElseIf mLineNumber = 4 Then
            mXY(4).x = mXY(3).x
            mXY(4).y = mXY(3).y
            mXY(3).x = x
            mXY(3).y = y
            Spline_Sub
        End If
        
    'マウスが動いたときの処理です
    ElseIf flg = eEventMouseMove Then
        If mLineNumber = 0 Then
            mXY(2).x = x
            mXY(2).y = y
            MoveToEx mPic.hDC, mXY(1).x, mXY(1).y, pos
            LineTo mPic.hDC, mXY(2).x, mXY(2).y
        ElseIf mLineNumber = 3 Then
            mXY(2).x = x
            mXY(2).y = y
            Spline_Sub
        ElseIf mLineNumber = 4 Then
            mXY(3).x = x
            mXY(3).y = y
            Spline_Sub
        End If
        
    'マウスのボタンを離したときの処理です
    ElseIf flg = eEventMouseUp Then
        If mLineNumber = 0 Then
            mXY(2).x = x
            mXY(2).y = y
            MoveToEx mPic.hDC, mXY(1).x, mXY(1).y, pos
            LineTo mPic.hDC, mXY(2).x, mXY(2).y
            mLineNumber = 3
        ElseIf mLineNumber = 3 Then
            mXY(2).x = x
            mXY(2).y = y
            Spline_Sub
            mLineNumber = 4
        ElseIf mLineNumber = 4 Then
            'ここで最終的な線を描画します
            mXY(3).x = x
            mXY(3).y = y
            Spline_Sub
            mLineNumber = 0
            For j = 1 To 4
                mXY(j).x = 0
                mXY(j).y = 0
            Next
        End If
    End If
End Sub

'描画をリセットします
'(線を3度描かれていないとき)
Sub Reset()
    Dim j As Integer
    
    If mPic.AutoRedraw = False Then
        mPic.Cls
        For j = 1 To 4
            mXY(j).x = 0
            mXY(j).y = 0
        Next
        mLineNumber = 0
    End If
End Sub