Menyimpan dan Menampilkan File Gambar di VB

Banyak artikel dan tutorial tentang cara menyimpan dan menampilkan file gambar ke atau dari Database (Ms. Access khususnya) yang pernah saya searching di mbah google, …. tapi saya belum pernah mendapatkan persis seperti yg saya harapkan.
Sampai suatu ketika, saya akhirnya menemukan caranya….
Saya akan coba sharing buat temen2 yg mungkin membutuhkannya..
Langkah langkahnya adalah sebagai berikut :
1. Siapkan Project dan 1 buah Form serta databases accessnya.
2. Desain Form sesuka hati anda, jangan lupa tambahkan Command Button untuk:
a. Menu Ganti Background
b. Menu Lihat Daftar Background (yg ditampilkan di DataGrid)
c. Menu Keluar

3. Tambahkan CommonDialog. Jika Belum ada di ToolBox, Masuk ke Menu Project – Component

4. Masukkan ke Form dengan cara mengklik di Toolbox kemudian klik sembarang di FORM.

5. Tambahkan Class Module dengan cara mengklik kanan di nama Project lalu pilih Class Module.

Sekarang kita lanjut ke coding…
Istirahat sejenak, lalu minum kopi dan isap rokok anda… Heheheee😉
Kemudian, ketik listing code berikut di Class Module yg di insert tadi. ato copas (copy paste) aja biar cepet… ato KLIK DISINI untuk download codenya….

———————————————————
Option Explicit
Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long
Private Declare Function lstrcpy Lib “kernel32” Alias “lstrcpyA” (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Const MAX_PATH = 260

Public Function VBGetOpenFile(hwnd As Long, _
Filter As String, _
lpBufferFile As String) As Boolean
Dim ofn As OPENFILENAME
Dim c As String, temp As String, i As Integer

For i = 1 To Len(Filter)
c = Mid$(Filter, i, 1)
If (c = “|”) Then
temp = temp & vbNullChar
Else
temp = temp & c
End If
Next i

ofn.lStructSize = Len(ofn)
ofn.hWndOwner = hwnd
ofn.lpstrFilter = temp
lpBufferFile = String$(MAX_PATH, 0)
ofn.lpstrFile = lpBufferFile
ofn.nMaxFile = MAX_PATH
If (GetOpenFileName(ofn) = 1) Then
lstrcpy lpBufferFile, ofn.lpstrFile
VBGetOpenFile = True
Else
lpBufferFile = “”
End If
End Function
———————————————————–

6. Kemudian Ketik ato copas sintax berikut di Form anda:

===================================================
‘//jackysan programming 2010
‘/https://jackysan.wordpress.com
’email : badface85@gmail.com

Private Sub Form_Activate()
Me.Image1.Picture = LoadPicture(App.Path & “\temp.jpg”) ‘//load background default yg bernama temp.jpg
End Sub
Private Sub Form_Load()
Ado.ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & App.Path & _
“\background.mdb;Persist Security Info=False”
Ado.CommandType = adCmdTable
Ado.RecordSource = “rsImage”
Ado.Refresh
Set Me.DataGrid1.DataSource = Ado.Recordset
End Sub
Private Sub cmd_keluar_Click()
End
End Sub
Private Sub Command3_Click() ‘//ketika tombol close table di klik, akan menyembunyikan table dan perangkatnya
Me.DataGrid1.Visible = False
Me.Ado.Visible = False
Me.Command3.Visible = False
End Sub
‘//menampilkan gambar yg terdaftar di datagrid ke image
Sub ado_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As _
ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
If (Not Ado.Recordset.EOF) And (Not Ado.Recordset.BOF) Then
On Error Resume Next
Ado.Caption = Ado.Recordset(1).Value
TampilkanGambar
End If
End Sub
Private Sub SimpanGambar(FilePath As String)
Dim ByteData() As Byte
AmbilIsiFile FilePath, ByteData
Ado.Recordset.AddNew
Ado.Recordset(1).Value = Dir(FilePath)
Ado.Recordset(2).AppendChunk CStr(ByteData())
Ado.Recordset.Update
Ado.Refresh
Ado.Recordset.MoveLast
‘RapikanGrid
End Sub
Private Sub TampilkanGambar()
TulisKeFileTemporary
Image1.Picture = LoadPicture(App.Path & “\temp.jpg”)
End Sub
Private Sub cmd_background_Click()
Dim CommondDialog As New clsCommonDialog
Dim lpFileName As String
If (CommondDialog.VBGetOpenFile(Me.hwnd, “JPEG(*.jpg)|*.jpg|All(*.*)|*.*”, lpFileName)) Then
SimpanGambar lpFileName
End If
End Sub
‘//menampilkan datagrid untuk memudahkan memilih gambar yg ada di table
Private Sub cmd_daftar_Click()
Me.DataGrid1.Visible = True
Me.Ado.Visible = True
Me.Command3.Visible = True
End Sub
Private Sub DataGrid1_Click()
Ado.Recordset.Move (0)
End Sub
Private Sub TulisKeFileTemporary()
Dim ByteData() As Byte
ByteData() = Ado.Recordset(2).GetChunk(Ado.Recordset(2).ActualSize)
Open App.Path & “\temp.jpg” For Binary Access Write As #1
Put 1, , ByteData()
Close #1
End Sub
Private Sub AmbilIsiFile(ByVal FilePath As String, ByRef ByteData() As Byte)
Dim FileHandler, FileLength As Double
FileHandler = FreeFile
FileLength = FileLen(FilePath)
ReDim ByteData(FileLength)
Open FilePath For Binary Access Read As #FileHandler
Get FileHandler, , ByteData()
Close #FileHandler
End Sub
===================================================

7. Kemudian Setting Properti seperti berikut :
a. Command1 | Name = cmd_background | Caption = GANTI BACKGROUND
b. Command2 | Name = cmd_daftar | Caption = LIHAT DAFTAR BACKGROUND
c. Adodc1 | Name = ado | Caption = kosongkan | Visible = False
d. Image1 | Name = biarkan default | Picture = terserah mau masukkan gambar ato tidak
e. CommonDialog1 | Name = CommonDialog
f. ClassModule | Name = clsCommonDialog
g. DataGrid1 | Visible = False
h. Command3 | Name = Command3 | Caption = Close Table | Visible = False
i. Databases | Name = Background.mdb
j. Table | Name = rsImage | berisi 3 Field sebagai berikut :
* ID – Type Autonumber
* filename – Type Text
* filedata – Type Memo

Download databasesnya DISINI. atau Project Lengkapnya DISINI

Baca juga Artikel saya tentang berbelanja online murah disini

4 thoughts on “Menyimpan dan Menampilkan File Gambar di VB

  1. eko says:

    kami tim vb-edan.blogspot.com
    mengajak anda untuk bergabung dalam memasarkan produk source aplikasi
    kami.
    kunjungi bisnissource.com

  2. tamy says:

    gan saya sudah doownload projectnya tp kok eror dsni
    Sub ado_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As _
    ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

  3. aan says:

    mas, kok error di :
    Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function lstrcpy Lib “kernel32? Alias “lstrcpyA” (ByVal lpString1 As String, ByVal lpString2 As String) As Long

    pesan errornya:
    expected: string constant.

    saat debug yang disorot comdlg32.dll

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s