Simpan / Tampil Gambar Dari Dan Ke Database Access

Oke … Langsung aja, yah………..
Yang dibutuh..in,untuk membuat_nya :
2 Form -> FormGambar.frm , and FormCariGambar.frm
1 Module -> Pengaturan.bas
1DataBase -> Tempat Gambar.mdb

Sebelum Men_Desain Form, alang_kah baik_nya buat DataBase_Nya dulu.

Cara_nya Seperti ini :
Pada Menu Visual Basic, Klik Add-Ins
Pilih Visual Data Manager…
Setelah Muncul Visual Data Manager, Klik Menu File
Pilih New ->Microsoft Access ->Version 7.0 MDB…
Simpan Dengan Nama -> Tempat Gambar.mdb atau Terserah Anda…
Setelah itu Buat Table Baru,Dan Buat Structure Table -> Sesuai Keinginan Anda..
Atau kamu bisa,guna..in Structure Table Aq,
Cara_nya Seperti ini :
Table
Table Name : Gambar
Fields List :
KodeGambar
DataGambar
Alamat
KataKunci
Index List :
KataKunci
KodeGambar
KunciUtamaGambar

Kalo sudah dibuat Database_nya, Hubungkan Database dengan Project,
Cara Nge_Hubung..in_nya :
Klik Menu Project, Pilih References,
Cari dan Aktifkan Microsoft DAO 3.51 Object Library
Desain Form_nya:

Form Gambar

Form

Name : FormGambar
BoderStyle : Fixed ToolWindow
Caption : .:: Demo Program ::.
StartUpPositon : CenterScreen

PictureBox

Name : Picture1
AutoSize : False
BorderStyle :Fixed Single

CommandButton

Name : TambahGambar -> AmbilGambar
Caption : Tambah Gambar -> Ambil Gambar
BackColor : &H00FFC0C0&
Style : Graphical
Taruh Coding dibawah ini pada Form Gambar :

Ini Coding_nya


Code:
Option Explicit
Const UkuranGambar = 8192

Private Sub TambahGambar_Click()
Dim Penyesuaian_Gambar As Recordset
Dim Atur As Long
Dim Ukuran As Long
Dim AlamatGambar As String
Dim Kode_Gambar As Integer
Dim Pusat_Gambar1() As Byte
Dim Pusat_Gambar5 As Integer
Dim Shadow_Angel As Integer
Dim Pusat_Gambar2 As Long
Dim Kode_Kunci As Long
Dim ShadowAngel_SQL As String
On Error GoTo TambahGambarShadow
FormCariGambar.Show vbModal
If NamaFile <> "" Then
Kode_Kunci = InputBox("Masuk..kan Kode Gambar... (Nomor)")
If Kode_Kunci > 0 Then
ShadowAngel_SQL = "select * from Gambar"
ShadowAngel_SQL = ShadowAngel_SQL & " where KataKunci=" & Kode_Kunci
Set Penyesuaian_Gambar = DataBase_ShadowAngel.OpenRecordset(ShadowAngel_SQL, dbOpenDynaset)
If Not Penyesuaian_Gambar.EOF Then
MsgBox "Kode Gambar,sudah ada di DataBase.Cari yang laen_nya..."
GoTo TambahGambarAngel
End If
Set Picture1.Picture = LoadPicture(NamaFile)
Set Penyesuaian_Gambar = DataBase_ShadowAngel.OpenRecordset("Gambar", dbOpenDynaset)
Kode_Gambar = FreeFile
Open NamaFile For Binary Access Read As Kode_Gambar
Ukuran = LOF(Kode_Gambar)
If Kode_Gambar = 0 Then
Close Kode_Gambar
End If
Pusat_Gambar2 = Ukuran \ UkuranGambar
Pusat_Gambar5 = Ukuran Mod UkuranGambar
Penyesuaian_Gambar.AddNew
Penyesuaian_Gambar("Alamat") = NamaFile
Penyesuaian_Gambar("KataKunci") = Kode_Kunci
ReDim Pusat_Gambar1(Pusat_Gambar5)
Get Kode_Gambar, , Pusat_Gambar1()
Penyesuaian_Gambar("DataGambar").AppendChunk Pusat_Gambar1()
ReDim Pusat_Gambar1(UkuranGambar)
Atur = Pusat_Gambar5
For Shadow_Angel = 1 To Pusat_Gambar2
Get Kode_Gambar, , Pusat_Gambar1()
Penyesuaian_Gambar("DataGambar").AppendChunk Pusat_Gambar1()
Atur = Atur + UkuranGambar
DoEvents
Next
Penyesuaian_Gambar.Update
End If
End If
TambahGambarAngel:
Exit Sub
TambahGambarShadow:
#If Melati Then
Stop
Resume
#End If
Resume TambahGambarAngel
End Sub

Private Sub AmbilGambar_Click()
Dim ShadowAngel_SQL As String
Dim Kode_Kunci As Long
Dim Penyesuaian_Gambar As Recordset
Dim Ukuran As Long
Dim Pusat_Gambar3() As Byte
Dim Atur As Long
Dim AlamatGambar As String
Dim Kode_Gambar As Integer
Dim Pusat_Gambar4 As Integer
Dim Pusat_Gambar5 As Integer
Dim Shadow_Angel As Integer
Dim Tempat_File_Berkas As String
On Error GoTo AmbilGambar_Shadow
Kode_Kunci = InputBox("Masuk..kan Kode Gambar..nya")
If Kode_Kunci > 0 Then
ShadowAngel_SQL = "select * from Gambar"
ShadowAngel_SQL = ShadowAngel_SQL & " where KataKunci=" & Kode_Kunci
Set Penyesuaian_Gambar = DataBase_ShadowAngel.OpenRecordset(ShadowAngel_SQL, dbOpenDynaset)
Screen.MousePointer = vbHourglass
If Not Penyesuaian_Gambar.EOF Then
Kode_Gambar = FreeFile
AlamatGambar = App.Path
Tempat_File_Berkas = AlamatGambar & "\Penyimpanan Data Gambar.bin"
Open Tempat_File_Berkas For Binary Access Write As Kode_Gambar
Ukuran = Penyesuaian_Gambar("DataGambar").FieldSize
Pusat_Gambar4 = Ukuran \ UkuranGambar
Pusat_Gambar5 = Ukuran Mod UkuranGambar
ReDim Buffer(Pusat_Gambar5) As Byte
Pusat_Gambar3() = Penyesuaian_Gambar("DataGambar").GetChunk(Atur, Pusat_Gambar5)
Put Kode_Gambar, , Pusat_Gambar3()
Atur = Pusat_Gambar5
For Shadow_Angel = 1 To Pusat_Gambar4
ReDim Pusat_Gambar3(UkuranGambar) As Byte
Pusat_Gambar3() = Penyesuaian_Gambar("DataGambar").GetChunk(Atur, UkuranGambar)
Put Kode_Gambar, , Pusat_Gambar3()
Atur = Atur + UkuranGambar
DoEvents
Next
End If
Close Kode_Gambar
Set Picture1.Picture = LoadPicture(Tempat_File_Berkas, , vbLPColor)
End If
AmbilGambar_Angel:
Screen.MousePointer = vbDefault
Exit Sub
AmbilGambar_Shadow:
#If Melati Then
Stop
Resume
#End If
Resume AmbilGambar_Angel
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not DataBase_ShadowAngel Is Nothing Then
DataBase_ShadowAngel.Close
End If
Set DataBase_ShadowAngel = Nothing
End Sub



Oke.. Kita langsung aja.. ke Form Cari Gambar

Form Cari Gambar

Form

Name : FormCariGambar
BoderStyle : Fixed ToolWindow
Caption : Cari - > Gambar / Icon...
StartUpPositon : CenterScreen

Label

Name : Label1,Label2,Label3,
Label4,Label5

Caption rive,Alamat,Direktori,
File/Berkas,Create By Shadow Angel

DriveListBox :

Name : Drive1
BackColor : &H00C0FFC0&

TextBox :
Name : AlamatGambar
BackColor : &H00C0FFC0&
DataFormat : General

DirListBox :
Name : Dir1
BackColor : &H00C0FFC0&

FileListBox :
Name : File1
BackColor : &H00C0FFC0&

CommandButton :
Name : Oke, Batal
Caption : Oke... , Batal
Kalo Sudah masuk_kan Coding dibawah ini pada Form Cari Gambar :
Ini Coding..nya :


Code:
Option Explicit
Dim Sesuaikan_Gambar As Boolean

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Batal_Click()
NamaFile = ""
Unload Me
End Sub

Private Sub Oke_Click()
NamaFile = AlamatGambar
Unload Me
End Sub

Private Sub Dir1_Change()
On Error GoTo Salah_Direktori
AlamatGambar = Dir1.Path
File1.Path = Dir1.Path
If Sesuaikan_Gambar = False Then
Alamat_Lengkap = File1.Path
End If
Ganti_Direktori:
Exit Sub
Salah_Direktori:
#If Melati Then
Stop
Resume
#End If
Resume Ganti_Direktori
End Sub

Private Sub Drive1_Change()
On Error GoTo Salah_Drive
Dir1.Path = Drive1.Drive
NamaDrive = Drive1.Drive
Ganti_Drive:
Exit Sub
Salah_Drive:
#If Melati Then
Stop
Resume
#End If
Resume Ganti_Drive
End Sub

Private Sub File1_Click()
On Error GoTo Salah_File
AlamatGambar = File1.Path + "\" + File1.FileName
Ganti_File:
Exit Sub
Salah_File:
#If Melati Then
Stop
Resume
#End If
Resume Ganti_File
End Sub

Private Sub Form_Load()
Sesuaikan_Gambar = True
If NamaDrive <> "" Then
Drive1.Drive = NamaDrive
Dir1.Path = Drive1.Drive
End If
If Alamat_Lengkap <> "" Then
Dir1.Path = Alamat_Lengkap
File1.Path = Dir1.Path
End If
Sesuaikan_Gambar = False
End Sub



Lanjut..kan dengan membuatModule pada Form anda,

Lalu masuk..kan Coding dibawah ini pada Module tersebut :

Ini Coding Module_nya :


Code:
Option Explicit
Public DataBase_ShadowAngel As Database
Public NamaFile As String
Public NamaDrive As String
Public Alamat_Lengkap As String
Public PesanSalah As String

Sub main()
On Error GoTo Mawar
Dim AlamatGambar As String
AlamatGambar = App.Path
Set DataBase_ShadowAngel = OpenDatabase(AlamatGambar & "\Tempat Gambar.mdb", False)
FormGambar.Show
Mawar_2:
Exit Sub
Mawar:
#If Melati Then
Stop
Resume
#End If
Resume Mawar_2
End Sub