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