Jumat, 17 Juni 2011

PROGRAM MENAMPILKAN DETEKSI TEPI DENGAN MICROSOFT VISUAL BASIC 6.0

::. LANGKAH - LANGKAH MEMBUAT
DETEKSI TEPI .::


1. Tampilan
>>Letakkan kontrol :
a. PictureBox sebanyak 2 ( Dua )
b. DriveListBox sebanyak 1 ( Satu )
c. DirListBox sebanyak 1 ( Satu )
d. FileListBox sebanyak 1 ( Satu )
e. CommandButton sebanyak 2 ( Dua )
f. CommonDialog sebanyak 1 ( Satu )





2. Pengaturan Property Setiap Objek nya Adalah Sebagai Berikut :




3. Buka Jendela Code Dan Pada Bagian Code Editor Ketikkan Kode Program nya Sebagai Berikut :

Dim Pixel
Dim Pixel2

Dim Rred
Dim Ggreen
Dim Bblue

Dim RR1
Dim GG1
Dim BB1

Dim RR2
Dim GG2
Dim BB2

Dim RR3
Dim GG3
Dim BB3

Dim XXX As Integer
Dim YYY As Integer


Private Sub Form_Load()
Drive1.Drive = "c:\"
End Sub


Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub


Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub


Private Sub File1_Click()
On Error GoTo Pesan
Picture1.Picture = LoadPicture(Dir1.Path & "\" & File1.FileName)
Pesan:
If Err.Number = 481 Then
MsgBox "TIDAK BISA DI TAMPILKAN", vbOKOnly, "PESAN"
End If
End Sub


Private Sub GetRGB(ByVal Col As String)
On Error Resume Next
Bblue = Col \ (256 ^ 2)
Ggreen = (Col - Bblue * 256 ^ 2) \ 256
Rred = (Col - Bblue * 256 ^ 2 - Ggreen * 256) '\ 256
End Sub


Private Sub Command1_Click()
On Error Resume Next
Q = InputBox("Enter a value for find horizontal edges (higher value = brighter image)", "", "6")
If Q = "" Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1

Pixel2 = GetPixel(Picture1.HDC, XXX + 2, YYY)
Pixel = GetPixel(Picture1.HDC, XXX + 1, YYY)

GetRGB Pixel
RR1 = Rred
GG1 = Ggreen
BB1 = Bblue

GetRGB Pixel2
RR2 = Rred
GG2 = Ggreen
BB2 = Bblue

If RR1 = RR2 Then RR3 = 0
If RR1 > RR2 Then
RR3 = RR1 - RR2
Else
RR3 = RR2 - RR1
End If

If GG1 = GG2 Then GG3 = 0
If GG1 > GG2 Then
GG3 = GG1 - GG2
Else
GG3 = GG2 - GG1
End If

If BB1 = BB2 Then BB3 = 0
If BB1 > BB2 Then
BB3 = BB1 - BB2
Else
BB3 = BB2 - BB1
End If

SetPixelV Picture2.HDC, XXX, YYY, RGB(RR3 * Q, GG3 * Q, BB3 * Q)
Next
Picture2.Refresh
Next
Picture2.Refresh
End Sub


Private Sub Command2_Click()
Unload Me
End Sub


Declare Function GetPixel Lib "gdi32" (ByVal HDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Declare Function SetPixelV Lib "gdi32" (ByVal HDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long




4. Hasil Akhir







1 komentar:

  1. Permisi kk bs tanya ?
    Private Sub GetRGB(ByVal Col As String)
    On Error Resume Next
    Bblue = Col \ (256 ^ 2)
    Ggreen = (Col - Bblue * 256 ^ 2) \ 256
    Rred = (Col - Bblue * 256 ^ 2 - Ggreen * 256) '\ 256
    End Sub

    itu perintah mana ya?

    BalasHapus