View Code Snippet

Author: manish k. thanki
Date Submitted: 1/30/2005
Category: Graphics
Compatibility: VB 6
This code has been accessed 6550 times.

Task: 'without ocx u can save binary format picture data store in your database 'put picture1 ,textbox name as txtFilePath,cummand button name as cmdBrowse,comm dialog box name as cmdlFilePath,commandbutton name as cmdsave,commandbutton cmdexit 'make mdb --> Image.mdb

Declarations

Code

Dim cnnImage As New ADODB.Connection Dim rsImage As New ADODB.Recordset Dim strSql As String Dim Chunk() As Byte Dim lngLengh As Long Dim intChunks As Integer Dim intFragment As Integer Const ChunkSize = 1000 '16384 Const lngDataFile = 1 Private Sub cmdBrowse_Click() 'Select JPG OR Bitmap File to Store in DataBase On Error Resume Next With cmdlFilePath .Filter = "JPG Files|*.JPG|Bitmaps|*.BMP" .ShowOpen txtFilePath.Text = .FileName End With End Sub Private Sub cmdExit_Click() 'Close End End Sub Private Sub cmdLast_Click() 'Move Last On Error Resume Next rsImage.MoveLast 'Show Pic in PictureBox Call ShowPic End Sub Private Sub cmdNext_Click() 'Move Next On Error Resume Next rsImage.MoveNext 'Show Pic in PictureBox Call ShowPic End Sub Private Sub cmdPrev_Click() 'Move Previous On Error Resume Next rsImage.MovePrevious 'Show Pic in PictureBox Call ShowPic End Sub Private Sub cmdSave_Click() 'Save File If Trim(txtFilePath.Text) = "" Then MsgBox "Plz Select JPG or Bitmap File to Store in Database.!!", vbInformation + vbSystemModal, "Save" Exit Sub End If If (Dir(Trim(txtFilePath.Text)) = "") Then Exit Sub 'Open as Binary Open Trim(txtFilePath.Text) For Binary Access Read As lngDataFile lngLengh = LOF(lngDataFile) ' Length of data in file If lngLengh = 0 Then Close lngDataFile: Exit Sub intChunks = lngLengh \ ChunkSize intFragment = lngLengh Mod ChunkSize 'Add New Record in DataBase rsImage.AddNew ReDim Chunk(intFragment) 'Read data from a file into a variable Get lngDataFile, , Chunk() 'Appends data to a large text or binary data Field or Parameter object. rsImage!picImage.AppendChunk Chunk() ReDim Chunk(ChunkSize) For I = 1 To intChunks Get lngDataFile, , Chunk() rsImage!picImage.AppendChunk Chunk() Next I 'Update rsImage.Update 'Close File Close lngDataFile 'Show Pic in PictureBox Call ShowPic End Sub Private Sub cmdFirst_Click() ' On Error Resume Next rsImage.MoveFirst 'Show Pic in PictureBox Call ShowPic End Sub Private Sub Form_Load() rsImage.LockType = adLockOptimistic rsImage.CursorType = adOpenKeyset cnnImage.Provider = "Microsoft.Jet.OLEDB.4.0" strSql = App.Path & "\Image.mdb" cnnImage.Open strSql strSql = "Select * From ImageStore" rsImage.Open strSql, cnnImage If (rsImage.BOF = True) And (rsImage.EOF = True) Then Exit Sub 'Open Record Set Call cmdFirst_Click End Sub Public Sub ShowPic() On Error Resume Next Open "pictemp" For Binary Access Write As lngDataFile lngLengh = rsImage!picImage.ActualSize intChunks = lngLengh \ ChunkSize intFragment = lngLengh Mod ChunkSize ReDim Chunk(intFragment) Chunk() = rsImage!picImage.GetChunk(intFragment) Put lngDataFile, , Chunk() For I = 1 To intChunks ReDim Buffer(ChunkSize) 'Returns all or a portion of the contents of a large text or binary data Field object. Chunk() = rsImage!picImage.GetChunk(ChunkSize) 'Write data to a Temp file Put lngDataFile, , Chunk() Next I Close lngDataFile FileName = "pictemp" Picture1.Picture = LoadPicture(FileName) End Sub