PROGRAM KOMPRESI CITRA DENGAN MICROSOFT VISUAL BASIC 6.0

::. LANGKAH - LANGKAH MEMBUAT

KOMPRESI CITRA
DENGAN MENGURANGI PIXEL .::

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 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 Command1_Click()
On Error Resume Next
On Error Resume Next
Q = InputBox("Masukkan Nilai Pixel", "", "6")
If Q = "" Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1 Step Q
For XXX = 0 To Picture1.ScaleWidth - 1 Step Q
Pixel = GetPixel(Picture1.HDC, XXX + 1, YYY + 1)
Picture2.Line (XXX, YYY)-(XXX + Q, YYY + Q), Pixel, BF
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




4. Hasil Akhir

BACA SELENGKAPNYA - PROGRAM KOMPRESI CITRA DENGAN MICROSOFT VISUAL BASIC 6.0

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

BACA SELENGKAPNYA - PROGRAM MENAMPILKAN DETEKSI TEPI DENGAN MICROSOFT VISUAL BASIC 6.0

PROGRAM MENAMPILKAN EFEK SUATU GAMBAR DENGAN MICROSOFT VISUAL BASIC 6.0

::. LANGKAH - LANGKAH

MEMBUAT APLIKASI SEDERHANA

UNTUK MENAMPILKAN
EFEK
( BRIGHTNESS, DARKNESS, BLACK AND WHITE, GRAYSCALE, COLORIZE )
SUATU GAMBAR .::

1. Tampilan
>>Letakkan kontrol :
a. DriveListBox sebanyak 1 ( Satu )
b. DirListBox sebanyak 1 ( Satu )
c. FileListBox sebanyak 1 ( Satu )
d. PictureBox sebanyak 1 ( Satu )
e. Label sebanyak 1 ( Satu )
f. CommandButton sebanyak 9 ( Sembilan )
g. 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 Q As String
Dim Q2 As String

Dim Temp As Integer
Dim Temp2 As Integer

Dim XXX As Integer
Dim YYY As Integer

Dim XX As Integer
Dim YY As Integer

Dim RR As Integer
Dim RG As Integer
Dim RB As Integer

Dim CurX
Dim CurY

Dim JB As Byte


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()
Form2.Show
End Sub


Private Sub Command2_Click()
On Error Resume Next
Q = InputBox("Enter a value for brightness", "", "30")
If Q = "" Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1
Pixel = GetPixel(Picture1.HDC, XXX, YYY)
GetRGB Pixel

If Cred.Value = 1 Then Rred = Rred + Q
If Cgreen.Value = 1 Then Ggreen = Ggreen + Q
If Cblue.Value = 1 Then Bblue = Bblue + Q

SetPixelV Picture1.HDC, XXX, YYY, RGB(Rred, Ggreen, Bblue)
Next
Picture1.Refresh
Next
Picture1.Refresh
End Sub


Private Sub Command3_Click()
On Error Resume Next
Q = InputBox("Enter a value for darkness", "", "30")
If Q = "" Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1
Pixel = GetPixel(Picture1.HDC, XXX, YYY)
GetRGB Pixel

If Cred.Value = 1 Then Rred = Rred - Q
If Cgreen.Value = 1 Then Ggreen = Ggreen - Q
If Cblue.Value = 1 Then Bblue = Bblue - Q

SetPixelV Picture1.HDC, XXX, YYY, RGB(Rred, Ggreen, Bblue)
Next
Picture1.Refresh
Next
Picture1.Refresh
End Sub


Private Sub Command4_Click()
On Error Resume Next
Q = InputBox("Enter a value for black and white (0-255, high value will make a darker image)", "", "127")
If Q = "" Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1

Pixel = GetPixel(Picture1.HDC, XXX, YYY)

GetRGB Pixel

Temp = (Rred + Ggreen + Bblue)
Temp = (Temp / 3)

If Val(Temp) >= Q Then
Pixel = vbWhite
Else
Pixel = vbBlack
End If


SetPixelV Picture1.HDC, XXX, YYY, Pixel
Next
Picture1.Refresh
Next
Picture1.Refresh
End Sub


Private Sub Command5_Click()
On Error Resume Next
Q = InputBox("Channels to read from? (0 = All, 1 = Red, 2 = Green, 3 = Blue)", "", "0")
If Q = "" Then Exit Sub
If Q > 3 Then Exit Sub
If Q < 0 Then Exit Sub
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1

Pixel = GetPixel(Picture1.HDC, XXX, YYY)

GetRGB Pixel

If Q = 0 Then
Temp = (Rred + Ggreen + Bblue)
Temp = (Temp / 3)
End If
If Q = 1 Then
Temp = (Rred)
End If
If Q = 2 Then
Temp = (Ggreen)
End If
If Q = 3 Then
Temp = (Bblue)
End If


SetPixelV Picture1.HDC, XXX, YYY, RGB(Temp, Temp, Temp)
Next
Picture1.Refresh
Next
Picture1.Refresh
End Sub


Private Sub Command6_Click()
On Error GoTo ja

CD.CancelError = True
CD.ShowColor
GetRGB CD.Color
RR3 = Rred
GG3 = Ggreen
BB3 = Bblue
On Error Resume Next
For YYY = 0 To Picture1.ScaleHeight - 1
For XXX = 0 To Picture1.ScaleWidth - 1
Pixel = GetPixel(Picture1.HDC, XXX, YYY)
GetRGB Pixel

Temp = (Rred + Ggreen + Bblue)
Temp = Temp / 3

SetPixelV Picture1.HDC, XXX, YYY, RGB((RR3 + Temp), (GG3 + Temp), (BB3 + Temp))
Next
Picture1.Refresh
Next
Picture1.Refresh
Exit Sub
ja:
Exit Sub
End Sub


Private Sub Command7_Click()
Picture1.Cls
End Sub


Private Sub Command8_Click()
CD.CancelError = True
On Error GoTo ja
CD.Filter = "Bitmap|*.bmp"
CD.ShowSave
SavePicture Picture1.Image, CD.FileName
Exit Sub
ja:
Exit Sub
End Sub


Private Sub Command9_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

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long




4. Hasil Akhir

BACA SELENGKAPNYA - PROGRAM MENAMPILKAN EFEK SUATU GAMBAR DENGAN MICROSOFT VISUAL BASIC 6.0

PROGRAM MENAMPILKAN GAMBAR BESERTA HISTOGRAM NYA DENGAN MICROSOFT VISUAL BASIC 6.0

::. LANGKAH - LANGKAH
MEMBUAT APLIKASI SEDERHANA
UNTUK MENAMPILKAN
GAMBAR BESERTA HISTOGRAM NYA .::

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




2. Pengaturan Property Setiap Objek nya Adalah Sebagai Berikut :



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

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 Command1_Click()
Dim hr(256) As Integer, hg(256) As Integer, hb(256) As Integer
Dim ht2 As Long
Dim xp As Integer, i As Integer, j As Integer
Dim r As Integer, g As Integer, b As Integer
Dim warna As Long, x As Long, a As Long
Picture2.Cls
Picture3.Cls
Picture4.Cls
Me.MousePointer = vbHourglass
For i = 1 To 256
hr(i) = 0
hg(i) = 0
hb(i) = 0
Next
For i = 1 To Picture1.Width Step 15
For j = 1 To Picture1.Height Step 15
warna = Picture1.Point(i, j)
r = warna And RGB(255, 0, 0)
g = Int((warna And RGB(0, 255, 0)) / 256)
b = Int(Int((warna And RGB(0, 0, 255)) / 256) / 256)
If r > 255 Then r = 255
If g > 255 Then g = 255
If b > 255 Then b = 255
hr(r) = hr(r) + 1
hg(g) = hg(g) + 1
hb(b) = hb(b) + 1
Next j
Next i
ht2 = Picture2.Height
For i = 1 To 256
xp = 15 * (i - 1) + 1
Picture2.Line (xp, ht2 - hr(i))-(xp, ht2), RGB(255, 0, 0)
Picture3.Line (xp, ht2 - hg(i))-(xp, ht2), RGB(0, 255, 0)
Picture4.Line (xp, ht2 - hb(i))-(xp, ht2), RGB(0, 0, 255)
Next i
Me.MousePointer = vbNormal
End Sub

Private Sub Command2_Click()
Unload Me
End Sub


4. Hasil Akhir

BACA SELENGKAPNYA - PROGRAM MENAMPILKAN GAMBAR BESERTA HISTOGRAM NYA DENGAN MICROSOFT VISUAL BASIC 6.0

PROGRAM MENAMPILKAN GAMBAR DENGAN MICROSOFT VISUAL BASIC 6.0

::. LANGKAH - LANGKAH

MEMBUAT APLIKASI SEDERHANA
UNTUK MELIHAT GAMBAR YANG MEMILIKI FORMAT
*.JPG DAN *.BMP .::

1. Tampilan
>> Letakkan sebuah kontrol :
a. Image
b. DriveListBox
c. DirListBox
d. FileListBox




2. Pengaturan Property Setiap Objek nya Adalah Sebagai Berikut :


>> Pada kontrol Image properti Stretch yang default-nya adalah False diset menjadi True agar ukuran gambar ditampilkan seluruhnya dan di sesuaikan dengan ukuran Image. Jika properti Stretch tetap bernilai False, gambar akan ditampilkan dalam ukuran aslinya sehingga gambar yang ukurannya melebihi Image, tidak dapat tampil seluruhnya.


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

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
Image1.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 Command1_Click()
Unload Me
End Sub

" Dengan adanya kode On Error GoTo Pesan... pada Private Sub File1_Click( ), jika file yang diklik pengguna tidak berekstensi JPG atau BMP, akan muncul pesan berikut. "

4. Hasil Akhir

BACA SELENGKAPNYA - PROGRAM MENAMPILKAN GAMBAR DENGAN MICROSOFT VISUAL BASIC 6.0