[Visual Baisc 6.0] 影像處理誤差擴散法

2013-12-04

摘要:[Visual Baisc 6.0] 影像處理誤差擴散法

Dim ColorArray(-1 To 2000 + 1, -1 To 2000 + 1)
Private Type DATA
    DATAS As Long
End Type

Private Type Color
    R As Byte
    G As Byte
    B As Byte
End Type

Private Sub Command1_Click()

A = 0
B = 0
For i = 0 To 4500 Step 15
    For j = 0 To 5300 Step 15
        Dim D As DATA, Col As Color
        D.DATAS = Picture1.Point(i, j)
        
        LSet Col = D
        
        t = (Val(Col.R) + Val(Col.G) + Val(Col.B)) / 3
        ColorArray(A, B) = t
        B = B + 1
    Next j
        M = B - 1
        B = 0
        A = A + 1
Next i

For i = 0 To A
    For j = 0 To M
        Er = ColorArray(i, j)
        If Er > 128 Then Er = Er - 255
        ColorArray(i, j + 1) = Val(ColorArray(i, j + 1)) + Er * 7 / 16
        ColorArray(i + 1, j + 1) = Val(ColorArray(i + 1, j + 1)) + Er * 1 / 16
        ColorArray(i + 1, j) = Val(ColorArray(i + 1, j)) + Er * 5 / 16
        ColorArray(i + 1, j - 1) = Val(ColorArray(i + 1, j - 1)) + Er * 3 / 16
    Next j
Next i


A = 0
B = 0

Picture2.Cls

For i = 0 To 4500 Step 15
    For j = 0 To 5300 Step 15
        t = ColorArray(A, B)
        
        If t > 128 Then
            t = 255
        Else
            If t < 0 Then t = 0
        End If
        
        If t < 0 Then t = 0
        
        Picture2.PSet (i, j), RGB(t, t, t)
        B = B + 1
    Next j
        B = 0
        A = A + 1
Next i

End Sub

Function OK(X, Y)
    If X >= 0 And X <= 450 And Y >= 0 And Y <= 450 Then
        OK = True
    Else
        OK = False
    End If
End Function

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim E As DATA, F As Color

    E.DATAS = Picture1.Point(X, Y)
    
    LSet F = E
    
    Me.Caption = "R= " & F.R & ",G= " & F.G & ",B= " & F.B
End Sub

[Visual Baisc 6.0] 誤差擴散法.rar

#0xDe 從分享中學習

#Facebook：ProgrammerDe (https://www.facebook.com/MicrosoftDes) 有問題歡迎提問

回首頁