Untuk Menyimpan Picture ke database kita perlu meload file (msado27.tlb)
Carana
Aktifkan Visual Basic anda
Buat prpject baru dengan nama terserah anda
Pilih menu Project – Preferent
Beri Conteng pada Microsoft AktiveX Data Object 2.7 Library - OK
- Pilih lagi menu Project – Componen – beri conteng pada
- Microsoft ADO Data Control 6.0 (OLDB)
- Microsoft DataGrid Control 6.0 (OLDB)
- Microsoft Common Dialog Control 6.0 (SP 6)
setelah itu buat rancangan form sebagai berikut
Tool yang digunakan:
1. Text Box
2. Command Botton
3. Image
4. Adodc
5. DataGrid
6. Commad Dialog
7. Cristal Report Control
Code Programnya :
Option Explicit
Dim RsImg As ADODB.Stream
Dim Vimg As Boolean
Dim Url_Image As String
'-------------------
Dim Database As Connection
Dim WithEvents rs As Recordset
Sub konek()
Set Database = Nothing
Set Database = New Connection
Database.CursorLocation = adUseClient
Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _
& App.Path & "\Database1.mdb;Jet OLEDB:Database Password=rahman; " ' path DB & password databse
End Sub
Private Sub Command1_Click() 'broese file foto
cd1.ShowOpen
cd1.Filter = "Image (*.jpg)|*.jpg" 'menyaring agar object yang tampil pada commad dialg hanya file JPG
Url_Image = cd1.FileName
Image1.Picture = LoadPicture(Url_Image)
Vimg = True
End Sub
Private Sub Command3_Click() 'Save
If Text1.Text = "" Then 'Jika no kosong
MsgBox "Nomor Harus di isi !", vbCritical
Text1.SetFocus
Exit Sub
End If
If Text2.Text = "" Then ' jika nama kosong
MsgBox "Nama harus di isi !", vbCritical
Text2.SetFocus
Exit Sub
End If
If Text3.Text = "" Then 'jika alamat kosong
MsgBox " Alamat harus di isi !", vbCritical
Text3.SetFocus
Exit Sub
End If
'------------------------------ -------------------------------------
With Adodc1.Recordset
.AddNew
.Fields("NO") = Text1.Text
.Fields("NAMA") = Text2.Text
.Fields("ALAMAT") = Text3.Text
' code berikut berfungsi untuk menyimpan data gambar ke database
RsImg.LoadFromFile (Url_Image)
Adodc1.Recordset!FOTO = RsImg.Read
Adodc1.Recordset.Update
Adodc1.Recordset.Close
MsgBox "Data baru berhasil disimpan ", _
0 + vbInformation, "Input Data Baru" 'pesan tersimpan
End With
Adodc1.Refresh
DataGrid1.Refresh
Url_Image = "" 'mengosongkan fileName
Adodc1.Caption = "Count : " & Adodc1.Recordset.RecordCount & " Tabel :" & Adodc1.RecordSource
End Sub
Private Sub Command4_Click() 'Edit
If Command4.Caption = "Edit" Then
Command4.Caption = "Update"
Url_Image = "" 'mengosongkan fileName
Else
'------------------------------------------------------------------------------------
If Url_Image = "" Then
If MsgBox("Apakah anda ingin mengganti Picture? ", vbQuestion + vbYesNo) = vbYes Then
Call Command1_Click 'memanggil tombol browse
Else
Url_Image = (App.Path + "\temp.jpg") ' meload image dari temp
End If
End If
'----------------------------------------------------------------------------------
With Adodc1.Recordset
.Fields("NO") = Text1.Text
.Fields("NAMA") = Text2.Text
.Fields("ALAMAT") = Text3.Text
' code berikut berfungsi untuk menyimpan data gambar ke database
RsImg.LoadFromFile (Url_Image)
!FOTO = RsImg.Read
.Update
.Close
MsgBox "Data berhasil diperbaharuai ", _
0 + vbInformation, "Input Data Baru" ' Pessan Kosong
End With
Adodc1.Refresh
DataGrid1.Refresh
Url_Image = ""
Command4.Caption = "Edit"
Adodc1.Caption = "Count : " & Adodc1.Recordset.RecordCount & " Tabel :" & Adodc1.RecordSource
End If
End Sub
Private Sub Command5_Click() 'Hapus
Dim X As String
'Buat pernyatanya sebelum dihapus
X = MsgBox(("Anda yakin Mau Menghapus data ini ? " + Chr(13) + _
"" + Chr(13) + _
"NAMA = " + Adodc1.Recordset!NAMA), vbYesNo + vbCritical) ' menampilkan nama pada MesageBOx
If X = vbYes Then
On Error Resume Next
Adodc1.Recordset.Delete
End If
Adodc1.Caption = "Count : " & Adodc1.Recordset.RecordCount & " Tabel :" & Adodc1.RecordSource
End Sub
Private Sub DataGrid1_Click()
On Error Resume Next
If Not Adodc1.Recordset.EOF Then
RsImg.Write (Adodc1.Recordset!FOTO)
RsImg.SaveToFile (App.Path + "\temp.jpg"), adSaveCreateOverWrite 'menyimpan image ke library dengan file Temp.jpg
Set Image1.Picture = VB.LoadPicture(App.Path + "\temp.jpg") 'menampilakn gambar ke tool Image
Text1.Text = Adodc1.Recordset!NO
Text2.Text = Adodc1.Recordset!NAMA
Text3.Text = Adodc1.Recordset!ALAMAT
End If
End Sub
Private Sub Form_Load()
konek 'memanggil prosedure coneksi string
Adodc1.ConnectionString = Database.ConnectionString
Adodc1.RecordSource = "TABEL1"
Set DataGrid1.DataSource = Adodc1
Set RsImg = New ADODB.Stream
RsImg.Type = adTypeBinary
RsImg.Open
Adodc1.Caption = "Count : " & Adodc1.Recordset.RecordCount & " Tabel : " & Adodc1.RecordSource
End Sub
Private Sub Form_Unload(Cancel As Integer)
Kill (App.Path + "\temp.jpg") 'menghapus foto pada libray ketika form exit
End Sub
Code Programnya :
Option Explicit
Dim rsPerson As New ADODB.Recordset
Public conn As New ADODB.Connection
Public Function OpenConnection() As Boolean
On Error GoTo ErrHandler
Dim strCon As String
strCon = "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _
& App.Path & "\Database1.mdb;Jet OLEDB:Database Password=rahman; "
Set conn = New ADODB.Connection
conn.ConnectionString = strCon
conn.Open
OpenConnection = True
Exit Function
ErrHandler:
OpenConnection = False
End Function
Private Sub Command1_Click()
Dim strFormula As String
strFormula = "{TABEL1.NO}= '" & Combo1.Text & "'"
With CrystalReport1
.Destination = crptToWindow
.SelectionFormula = IIf(Combo1.Text = "NONE", "", strFormula)
.ReportFileName = App.Path & "\BIODATA.rpt" 'assign report file
.Password = Chr(10) & "rahman" 'membuka password database
.WindowState = crptMaximized 'maximized - minimized or normal
.DataFiles(0) = App.Path & "\Database1.mdb" 'get db current path
.Action = 1 'show report
End With
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
OpenConnection
'====================MENGISI PILIHAN PADA COMBOBOX NOMOR =====================
Combo1.AddItem "NONE"
rsPerson.Open "select * from TABEL1", conn
Do While Not rsPerson.EOF
Combo1.AddItem rsPerson!NO
rsPerson.MoveNext
Loop
If rsPerson.State <> adStateClosed Then
rsPerson.Close
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rsPerson.State <> adStateClosed Then
rsPerson.Close
End If
Set rsPerson = Nothing
If conn.State <> adStateClosed Then
conn.Close
End If
Set conn = Nothing
End Sub
Selamat Belajar
Download Artikelnya : Save Picture Ke Database Berpassword
Donload Sampel Projectnya : Save Picture Db Acces Berpassword
Tidak ada komentar:
Posting Komentar