Tampilan Form Utama Dan Tampilan Histogram
Untuk Source Code nya
Private Sub Form_Load()
Drive1.Drive = "d:\"
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 "Nggax Bisa Di Tampilin Gambar nya", 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
.jpg)
