Option Explicit

'// ドラッグ開始点座標
Dim SelStartX As Single, SelStartY As Single

'// マウスの状態
Dim DragDirty As Integer

'// ドラッグ開始 / ドラッグ中 / ドラッグ終了
Private Const StartDr = 2, UnderDr = 1, EndDr = 0
'

Private Sub Form_Load()
'// フォームがロードされた時
    
    '// 最大化する
    Me.WindowState = 2
    
    '// DrawWidthを変更する
    HScroll1_Change
    
End Sub

Private Sub Form_Resize()
'// フォームがリサイズされた時

    On Error Resume Next
    
    '// 位置合わせ
    With Picture1
        .Top = HScroll1.Height
        .Left = 0
        .Width = Width
        .Height = Height
    End With
    
    HScroll1.Width = ScaleWidth
    
End Sub

Private Sub HScroll1_Change()
    
    '// DrawWidthを変更する
    Picture1.DrawWidth = HScroll1
End Sub

Private Sub HScroll1_Scroll()
    HScroll1_Change
End Sub

Private Sub mnuClear_Click()
    Picture1.Cls
End Sub

'独自の直線関数（ＤＤＡ補間）
Private Sub MyLine( _
    ByVal Obj As Object, _
    ByVal X1 As Long, _
    ByVal Y1 As Long, _
    ByVal X2 As Long, _
    ByVal Y2 As Long)
    
    On Error GoTo EXIT_PROC
    
    Dim Kx As Long, Ky As Long
    
    With Obj
        .CurrentX = X1
        .CurrentY = Y1
    End With
    
    If Abs(Y2 - Y1) < Abs(X2 - X1) Then
        Kx = X1 + Sgn(X2 - X1)
        Ky = Y1 + Sgn(Y2 - Y1)
    Else
        Kx = X1 + Sgn(X2 - X1)
        Ky = Y1 + Sgn(Y2 - Y1)
    End If
    
    Obj.Line -(X2, Y2), RGB(0, Kx, Ky)
    
EXIT_PROC:
    
End Sub

Private Sub Picture1_MouseDown( _
    Button As Integer, _
    Shift As Integer, _
    x As Single, _
    y As Single)
    
    On Error GoTo EXIT_PROC
    
    '// ドラッグ開始
    DragDirty = StartDr
    SelStartX = x
    SelStartY = y
    
EXIT_PROC:
End Sub

Private Sub Picture1_MouseMove( _
    Button As Integer, _
    Shift As Integer, _
    x As Single, _
    y As Single)
    
    On Error GoTo EXIT_PROC
    
    '// ドラッグ中なら
    If DragDirty >= UnderDr Then
        
        MyLine Picture1, SelStartX, SelStartY, x, y
        
        SelStartX = x
        SelStartY = y
        
    End If
    
EXIT_PROC:
End Sub

Private Sub Picture1_MouseUp( _
    Button As Integer, _
    Shift As Integer, _
    x As Single, _
    y As Single)
    
    On Error Resume Next
    
    '// ドラッグ終了
    DragDirty = EndDr
    
End Sub