Jumat, 17 Juni 2011

MENAMPILKAN GAMBAR DAN HISTOGRAM DENGAN VISUAL BASIC

Tampilan Form Utama












Untuk Load Image Tampilan seperti ini.....

















Untuk Tampilan Histogram Bisa dilihat ......


Untuk Source Code nya Bisa dilihat......

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



Semoga Bermanfaat......

Tidak ada komentar:

Posting Komentar