Jumat, 04 Februari 2011

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"

Tidak ada komentar:

Posting Komentar