pengolahan citra warna ke kontraks

Dim DataR() As Integer, DataB() As Integer, DataG() As Integer
Dim KP As Integer
----------------------------------------------------------------------------------------------------
Sub Contrast()
Dim Tinggi As Integer, Lebar As Integer
Dim Red As Integer, Green As Integer, Blue As Integer
Dim X As Integer, Y As Integer, grey As Integer
Dim Tot_Pix As Long

    '========= Mendapatkan Tinggi dan Lebar Citra =====
        Tinggi = Picture1.ScaleHeight
        Lebar = Picture1.ScaleWidth
    '==================================================

    '=== PEMESANAN Array Pada Data R,G,B ====
    ReDim DataR(Lebar, Tinggi) As Integer '(baris,kolom)
    ReDim DataG(Lebar, Tinggi) As Integer '(baris,kolom)
    ReDim DataB(Lebar, Tinggi) As Integer '(baris,kolom)
    '========================================
   
    '====Agar Picture 2 Lebar dan tingginya sama dengan Picture 1====
        With Picture2
            .Cls
            .Height = Tinggi
            .Width = Lebar
        End With
    '================================================================
   
    '==== PROSES PENGAMBILAN CITRA ====================
        For X = 0 To Lebar - 1  'kolom
            For Y = 0 To Tinggi - 1  'Baris
                '===== Get Total Pixel =======
                Tot_Pix = Picture1.Point(X, Y)
                '=============================
               
                '===== Get Red, Green, Blue ==
                Red = Tot_Pix And 255
                   'Rekam red
                   DataR(X, Y) = Red
                Tot_Pix = Tot_Pix / 256
                Green = Tot_Pix And 255
                    'Rekam green
                   DataG(X, Y) = Green
                Tot_Pix = Tot_Pix / 256
                Blue = Tot_Pix And 255
                    'Rekam Blue
                   DataB(X, Y) = Blue
                '=============================
           
                '==========Proses Contrast=================
                grey = Int((Red + Green + Blue) / 3)
                Redbaru = KP * (Red - grey) + grey
                Greenbaru = KP * (Green - grey) + grey
                Bluebaru = KP * (Blue - grey) + grey
                If (Redbaru > 255) Then Redbaru = 255
                If (Redbaru < 0) Then Redbaru = 0
                If (Greenbaru > 255) Then Greenbaru = 255
                If (Greenbaru < 0) Then Greenbaru = 0
                If (Bluebaru > 255) Then Bluebaru = 255
                If (Bluebaru < 0) Then Bluebaru = 0
                '===========================================
               
                '====Menampilkan citra=================================
                Picture2.PSet (X, Y), RGB(Redbaru, Greenbaru, Bluebaru)
                '======================================================
            Next
        Next
End Sub

---------------------------------------------------------------------------------------------------
Private Sub Command1_Click()
End
End Sub
--------------------------------------------------------------------------------------------------
Private Sub HScroll1_Change()
KP = HScroll1.Value
Label1.Caption = KP
Contrast
End Sub

silahkan download disini:http://www.4shared.com/rar/a3JzMRvK/Contrast.html