Menyimapn foto dengan VB 6.0

-->

Menyimapn foto

Berikut ini adalah cara menyimpan foto ke folder fot o dan memangilnya kembali dengan mengunakan database Acces 2003 dalam teknik ini mengunkan textbot untuk memcocokan nama foto agar bias di tampilkan ke form Image

Tabel Tool

 

 

-->

Buat Rancangan Form Seperti Gambar Berikut:

 

-->

Option Explicit

Private koneksi As ADODB.Connection

Dim rsImage As New ADODB.Recordset

---

Private Function konek() As Boolean

    On Error GoTo out

        Set koneksi = New ADODB.Connection

        koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database1.mdb;Persist Security Info=False"

        koneksi.CursorLocation = adUseClient

        konek = True

out:

End Function

---

Private Sub CmdBrowse_Click()

With Cd1

    .FileName = ""

    .Filter = "Image (*.jpg)|*.jpg"

    .ShowOpen

        Image1.Picture = LoadPicture(.FileName)

End With

Text1.Text = ""

Text2.Text = ""

End Sub

---

Private Sub Cmdfrev_Click()

If Adodc1.Recordset.BOF Then

MsgBox "Ini adalah Foto paling Awal", vbInformation + vbOKOnly = vbIgnore

Else

Adodc1.Recordset.MovePrevious

Call DataGrid1_Click

End IfEnd Sub

---

Private Sub CmdNext_Click()

If Adodc1.Recordset.EOF Then

MsgBox "Ini Adalah Foto Paling Akhir", vbInformation + vbOKOnly = vbIgnore

Else

Adodc1.Recordset.MoveNext

Call DataGrid1_Click

End IfEnd Sub

---

Private Sub CmdSimpan_Click()

If Text1.Text = "" Then

MsgBox "Nama foto harus di isi"

Else

    Adodc1.Recordset.Find "NIP='" + Text1.Text + "'", , adSearchForward, 1

    If Not Adodc1.Recordset.EOF Then

     MsgBox "Maaf, NIP sudah ada!"

     Text1.Text = ""

     Text1.SetFocus

    Else

    Adodc1.Recordset.AddNew

    Adodc1.Recordset!NIP = Text1.Text

    Adodc1.Recordset!Nama = Text2.Text

    Adodc1.Recordset.Update

    ' code berikut berfungsi untuk menyimpan gambar ke dalam folder foto

    ' nama file gambar didepannya ada kata NIP, contoh: nama foto = NIP_12

    SavePicture Image1.Picture, App.Path & "\foto\NIP_" & Text1.Text & ".jpg"

    'membuat laporan

    MsgBox "Foto telah di Simpan!", vbInformation + vbOKOnly = vbIgnore

    End If

End IfEnd Sub

---

Private Sub Command1_Click()

Dim x As String

'Buat pernyatanya sebelum dihapus

x = MsgBox(("Anda yakin data ini mau dihapus?"), vbYesNo + vbCritical)

If x = vbYes Then

'Hapus Record

Adodc1.Recordset.Delete

Adodc1.Recordset.MoveFirst

DataGrid1.ReBind

DataGrid1.Refresh

'menghaous foto pada filder foto\ NIP0000.jpg

Kill (App.Path & "\foto\NIP_" & Text1.Text & ".jpg")

' buat laporanya

MsgBox "foto telah dihapus!", vbInformation + vbOKOnly = vbIgnore

Call DataGrid1_Click

End If

End Sub

---

Private Sub DataGrid1_Click()

If Adodc1.Recordset.RecordCount <= 0 Then Exit Sub

    If Not Adodc1.Recordset.BOF And Not Adodc1.Recordset.EOF Then

        Text1.Text = Adodc1.Recordset.Fields("NIP")

        Text2.Text = Adodc1.Recordset.Fields("Nama")

        Image1.Picture = LoadPicture(App.Path & "\foto\NIP_" & Text1.Text & ".jpg")

    End If

End Sub

---

Private Sub Form_Load()

If Not konek() Then

        MsgBox "Gak bisa terhubung ke database!", vbCritical

        End

    End If

    Adodc1.ConnectionString = koneksi.ConnectionString

    Adodc1.RecordSource = "Gambar"

    Set DataGrid1.DataSource = Adodc1

End Sub

Jika Anda tekan tombol  Ctrl + F5 Maka Hasil nya adalah

foto.rar
Menyimapan_foto.pdf"