Option Explicit

'独自の直線絵画関数です
'他にも応用ができそうです
'自由に関数内をｶｽﾀﾏｲｽﾞしてください

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Private Sub Command1_Click()
    Dim j As Integer
    
    Command1.Enabled = False
    
    For j = 0 To 200 Step 5
        MyLine Picture1, 0, j, j, 200 ' MyLine を使います
    Next
    
    '三角形を描きます
    MyLine Picture1, 100, 150, 180, 130
    MyLine Picture1, 180, 130, 100, 70
    MyLine Picture1, 100, 70, 100, 150

    Command1.Enabled = True

End Sub

Private Sub Command2_Click()
    Picture1.Cls
End Sub

'独自の直線関数（ＤＤＡ補間）
Sub MyLine(ByVal Obj As Object, ByVal X1, ByVal Y1, ByVal X2, ByVal Y2)
    Dim Dx, Dy, Kx, Ky, Ae, j, jMax
    
    Dx = X2 - X1
    Dy = Y2 - Y1
    
    Kx = X1
    Ky = Y1
    
    If Abs(Dy) < Abs(Dx) Then
    
        Ae = -Abs(Dx)
        jMax = Abs(Dx)
        
        For j = 0 To jMax
            
            SetPixel Obj.hdc, Kx, Ky, RGB(0, Kx, Ky * 2) 'この部分で色の設定をｶｽﾀﾏｲｽﾞできます
            
            '↓は、Psetﾒｿｯﾄﾞを使うとき
            'Obj.PSet (Kx, Ky), RGB(0, Kx, Ky * 2)
            
            Kx = Kx + Sgn(Dx)
            Ae = Ae + 2 * Abs(Dy)
            
            If Ae >= 0 Then
                Ky = Ky + Sgn(Dy)
                Ae = Ae - 2 * Abs(Dx)
            End If
            
        Next
        
    Else
    
        Ae = -Abs(Dy)
        jMax = Abs(Dy)
        
        For j = 0 To jMax
            
            SetPixel Obj.hdc, Kx, Ky, RGB(0, Kx, Ky * 2) 'この部分で色の設定をｶｽﾀﾏｲｽﾞできます
            
            '↓は、Psetﾒｿｯﾄﾞを使うとき
            'Obj.PSet (Kx, Ky), RGB(0, Kx, Ky * 2)
            
            Ky = Ky + Sgn(Dy)
            Ae = Ae + 2 * Abs(Dx)
            
            If Ae >= 0 Then
                Kx = Kx + Sgn(Dx)
                Ae = Ae - 2 * Abs(Dy)
            End If
            
        Next
        
    End If
    
    '不要なときは、削除してください
    If Obj.AutoRedraw = True Then ' AutoRedraw が True の時だけ Refresh で再絵画します
        Obj.Refresh
    End If
    
End Sub