Untuk melakukan persiapan awal, kita buat suatu database. (disini menggunakan Ms.Access sebagai bahan contoh):
Persiapan Awal:
Nama file : dbaImage.mdb
Nama Table : Pegawai
Nama field Type Size
-------------------------
NRP Text 7
Photo OleObject
Setelah selesai melakukan persiapan awal kita buat Project Baru dan tambahakan Referency ADODB ke project kita. Dengan cara memilih menu Project » References » Microsoft ActiveX Data Object 2.1 Library (atau ADODB dengan versi yang lebih tinggi).
Selanjutnya kita buat syntax untuk meload Database tersebut
Pada Global Declaration kita tambahkan sebuah variable:
Option Explicit
Dim DB As New ADODB.Connection
'*// Pada form_load tambahkan syntax untuk meload databasenya
Private Sub Form_Load()
DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;" & _
"Data Source=C:\dbaImage.mdb"
End Sub
'*// Selanjutnya kita buat fungsi untuk mengkonversi gambar kedalam _
bentuk data.
Function ConvImage(NamaFile As String, Byref ErrRet As Long) As Byte()
On Error GoTo Salah
Dim UkuranFile As Long
Dim imgData() As Byte
'*// mendapatkan besar file yang akan di load dengan fungsi FileLen
UkuranFile = FileLen(NamaFile)
'*// Periksa Besar File yang di load
If UkuranFile > 0 Then
'*// Lakukan ReDim variable array sesuai dengan ukuran file yang _
diload
ReDim imgData(UkuranFile) As Byte
'*// Nah disini kita memanipulasi gambar untuk dimasukan ke _
database. Sebelumnya kita load gambar tsb dari file, _
kemudian masukan Byte demi Byte ke variable array dengan _
metode GET
Open NamaFile For Binary As #1
Get #1, , imgData
Close #1
'*// Setelah berhasil mendapatkan data tsb, kita lakukan _
pemindahan data ke fungsi ConvImage
ConvImage = imgData
'*// Kemudian beri tanda dgn nilai 0, bahwa tidak ada Error
ErrRet = 0
Else
'*// Beri tanda, bahwa ada Error
ErrRet = 1
End If
Exit Function
Salah:
'*// Beri tanda, bahwa ada Error
ErrRet = Err.Number
End Function
'*// Selanjutnya Buat Fungsi untuk menampilkan gambar
Function TampilImage(imgData() As Byte, Byref ErrRet As Long) _
As Picture
On Error GoTo Salah
If UBound(imgData) Then '*// Cek besar data > 0
Dim hFile As String
'*// Periksa apakah file img.tmp ada pada directory C:
hFile = Dir("C:\img.tmp", vbNormal)
'*// Jika ada, kita hapus terlebih dahulu dengan fungsi Kill
If hFile <> "" Then Kill "C:\img.tmp"
'*// Selanjutnya kita buat file penampung gambar dengan data _
yang diterima dari variable imgData
Open "C:\img.tmp" For Binary As #1
Put #1, , imgData
Close #1
'*// Setelah file dibuat, kita coba untuk memindahkannya kedalam _
fungsi
Set TampilImage = LoadPicture("C:\img.tmp")
'*// Beri tanda bahwa file berhasil di load
ErrRet = 0
Else
'*// Beri tanda, bahwa ada Error
ErrRet = 1
End If
Exit Function
Salah:
'*// Beri tanda, bahwa ada Error
ErrRet = Err.Number
End Function
'*// Setelah dua fungsi diatas dibuat, kita coba dengan menyimpan _
sebuah data kedalam database.
Private Sub Command1_Click()
Dim ErrRet As Long, imgData() As Byte
Dim Rc As New ADODB.Recordset
'*// Melakukan pengisian variable imgData dengan menggunakan fungsi _
ConvImage dengan parameter yang dikirim. _
Jangan lupa rubah nama file gambar yang akan di load
imgData = ConvImage("C:\vbwarik\lunatic.bmp", ErrRet)
'*// Dikarenakan disini kita menggunakan Type OleObject maka metode _
penyimpanan data tidak menggunakan Query melainkan langsung _
memanggil nama table nya.
Rc.Open "pegawai", DB, 3, 3
If ErrRet = 0 Then
'*// Buat data baru dengan menggunakan perintah AddNew
Rc.AddNew
'*// Isi pada field
Rc.Fields("NRP") = "001"
Rc.Fields("Photo").AppendChunk imgData()
'*// Simpan Data
Rc.Update
End If
Rc.Close
End Sub
'*// Setelah melakukan proses penyimpanan data, kita coba untuk _
menampilkannya.
Private Sub Command3_Click()
Dim ErrRet As Long, imgData As StdPicture
Dim Rc As New ADODB.Recordset
'*// Kita panggil data yang kita simpan tadi dengan menggunakan Query _
dengan NRP = 001
Rc.Open "Select * from Pegawai Where NRP='001'", DB, 3, 3
If Not Rc.EOF Then
Set imgData = TampilImage(Rc("Photo").GetChunk( _
Rc("Photo").ActualSize), ErrRet)
If ErrRet = 0 Then
'*// Kita load gambar dari file ke Object Image1
Set Image1.Picture = imgData
End If
End If
End Sub
Oke segitu aja scriptnya silakan kalian coba...
4 komentar:
mas tolong kasi link dapetnya dari mana ini source code dong. orang vb-bego pada teriak2 tuh
mas tolong kasi link dapet darimana ini source code vbnya. orang2 vb-bego teriak2 tuh
mas tolong kasi link dapet dari mana ini source codenya. orang2 vb-bego teriak2 tuh
mas aku mo minta bantu ne, tlg tampilkan contoh program pengiriman paket barang (TIKI) mas dengan menggunakan db sql server 2000, dengan laporannya perbulan...truz cara mendaftarkan pelanggan atau konsumen...tahnkssss...
Posting Komentar