By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,435 Members | 2,939 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,435 IT Pros & Developers. It's quick & easy.

Picture controls, Access Image controls, DIBS and BLOBs

P: 11
I had a wonderful time working out how to read and write BLOBs using GetChunk until I found the new streaming object in ADO 2.6 very easy.
Now I am confronted with DIBs
The code I have is VB6 but only partial so I can't actually run it. Anyhow I need to get it to work in Access but there are a couple of properties and methods of the picture control in VB6 that don't have corresponding ones in Access. Like TwipsPerPixel which I can just estimate at 15 but I have no idea what Picture.hDC is - can anyone tell me please.
Or if anyone has any working code for viewing DIBs that will work in VBA then that would be even better.
Jul 26 '07 #1
Share this Question
Share on Google+
2 Replies


P: 82
I had a wonderful time working out how to read and write BLOBs using GetChunk until I found the new streaming object in ADO 2.6 very easy.
Now I am confronted with DIBs
The code I have is VB6 but only partial so I can't actually run it. Anyhow I need to get it to work in Access but there are a couple of properties and methods of the picture control in VB6 that don't have corresponding ones in Access. Like TwipsPerPixel which I can just estimate at 15 but I have no idea what Picture.hDC is - can anyone tell me please.
Or if anyone has any working code for viewing DIBs that will work in VBA then that would be even better.
Hi kentgorrell -

Can you try this VBA code?

Make an MS Access table called "EmpTable" or any name you want
And make this fields

EmpID Text
FullName Text
EmpPicture OLE Object

Expand|Select|Wrap|Line Numbers
  1. Dim Con As Connection
  2. Dim Rs As Recordset
  3.  
  4. Private Sub cmdBrowse_Click()
  5.     txtPath = BrowsePicture
  6.         If txtPath <> "" Then
  7.         Image1.PictureSizeMode = fmPictureSizeModeStretch
  8.         Image1.Picture = LoadPicture("")
  9.         Image1.Picture = LoadPicture(txtPath)
  10.     Else
  11.         Image1.Picture = LoadPicture("")
  12.     End If
  13. End Sub
  14.  
  15. Public Function BrowsePicture() As String
  16. Dim FileLocation As String
  17.     Excel.Application.Dialogs.Application.FileDialog(msoFileDialogOpen).Title = "Select Employee Picture"
  18.     Excel.Application.Dialogs.Application.FileDialog(msoFileDialogOpen).Show
  19.     FileLocation = Excel.Application.Dialogs.Application.FileDialog(msoFileDialogOpen).InitialFileName
  20.  
  21.     FileLocation = Excel.Application.Dialogs.Application.FileDialog(msoFileDialogOpen).SelectedItems.Item(1)
  22.     'Set FS = CreateObject("Scripting.FileSystemObject")
  23.     'Set A = FS.OpenTextFile(FileLocation, 1, False) '"c:\COMFILE.txt"
  24.     If LCase(Right(FileLocation, 4)) <> ".jpg" And _
  25.        LCase(Right(FileLocation, 4)) <> ".bmp" And _
  26.        LCase(Right(FileLocation, 4)) <> ".gif" Then
  27.         MsgBox "Invalid picture selection.", vbCritical, "Saving BLOB"
  28.         Exit Function
  29.     End If
  30.     BrowsePicture = FileLocation
  31. End Function
  32.  
  33. Private Sub cmdSave_Click()
  34. If cmdSave.Caption = "New Record" Then
  35.     cmdSave.Caption = "Save Record"
  36.     txtPath.Enabled = True
  37.     ClearText
  38. Else
  39.     SavePic
  40.     txtPath.Enabled = False
  41.     ClearText
  42.     cmdSave.Caption = "New Record"
  43. End If
  44. End Sub
  45.  
  46. Public Sub ClearText()
  47.     txtFullname = ""
  48.     txtID = ""
  49. End Sub
  50. Private Sub cmdShow_Click()
  51. Dim ProvSSN As String
  52. Dim SavePath As String
  53. Dim PicEdit As Picture
  54. Dim strtmpFilename As String
  55. On Error GoTo ErrHandler
  56.     txtPath = ""
  57.     strtmpFilename = IIf(txtPath <> "", txtPath, "C:\tmpPic.jpg")
  58.     Set Con = New Connection
  59.     Con.Open "SavePicture"
  60.     Set Rs = New Recordset
  61.     Rs.ActiveConnection = Con
  62.     Rs.Open "Select * from EmpTable where EmpID = '" & txtID & "'", Con, adOpenKeyset, adLockOptimistic
  63.     If Rs.EOF Then
  64.         Image1.Picture = LoadPicture("")
  65.         Me.Caption = "Saving and Retrieving BLOB"
  66.         MsgBox "No record found.", vbInformation, "Saving BLOB"
  67.         Exit Sub
  68.     End If
  69.     Rs.MoveFirst
  70.     Me.Caption = Rs!FullName
  71.     txtFullname = Me.Caption
  72.     Image1.Picture = LoadPicture("")
  73.     Call BintoFile(strtmpFilename, Rs.Fields("EmpPicture"))
  74.     'If Rs.Fields("EmpPicture").Type = adLongVarBinary Then
  75.      Image1.Picture = LoadPicture(strtmpFilename)
  76.     'Else
  77.         'Me.Caption = "Saving and Retrieving BLOB"
  78.     'End If
  79.     Image1.PictureSizeMode = fmPictureSizeModeStretch
  80.     'Remove any existing destination file
  81.     If Len(Dir$(strtmpFilename)) > 0 Then
  82.        Kill strtmpFilename
  83.     End If
  84.     Exit Sub
  85. ErrHandler:
  86.     MsgBox Err.Description, vbCritical, "Saving BLOB"
  87. End Sub
  88.  
  89. Private Sub BintoFile(sFileName As String, fld As Field)
  90. Dim bBuffer() As Byte
  91. Dim ChunkSize As Long
  92. Dim Chunks As Long
  93. Dim Fl As Long
  94. Dim Fragment As Long
  95. Dim Chunk() As Byte
  96.  
  97.     'Recreate a new file
  98.     Open sFileName For Binary As #1
  99.     'Use a 32K initial chuck size
  100.     ChunkSize = 16384
  101.     Fl = fld.ActualSize
  102.     Chunks = Fl \ ChunkSize
  103.     Fragment = Fl Mod ChunkSize
  104.    ' Resize the byte array Chunk to the size of the fraction of a chunk calced above
  105.     ReDim Chunk(Fragment)
  106.    ' Get this fraction first and output it to the binary file
  107.     Chunk() = fld.GetChunk(Fragment)
  108.     Put #1, , Chunk()
  109.     For i = 1 To Chunks
  110.        ReDim Buffer(ChunkSize)
  111.        Chunk() = fld.GetChunk(ChunkSize)
  112.        Put #1, , Chunk()
  113.     Next i
  114.     Close #1
  115. End Sub
  116.  
  117. Public Function SavePic()
  118. Dim b() As Byte, f As Long, fn As String
  119. On Error GoTo ErrHandler
  120.     Set Con = New Connection
  121.     Con.Open "SavePicture"
  122.     f = FreeFile()
  123.     fn = txtPath
  124.     Open fn For Binary Access Read As #f
  125.     ReDim b(FileLen(fn) - 1)
  126.     Get #f, , b()
  127.     Set Rs = New Recordset
  128.     Set Rs.ActiveConnection = Con
  129.     Rs.Open "Select * from EmpTable", Con, adOpenDynamic, adLockOptimistic
  130.     Rs.AddNew
  131.     Rs("EmpID") = txtID
  132.     Rs("Fullname") = txtFullname
  133.     Rs("EmpPicture") = b()
  134.     Rs.Update
  135.     Close #f
  136.     txtPath = ""
  137.     MsgBox "Record has been saved.", vbInformation, "Saving BLOB"
  138.     Exit Function
  139. ErrHandler:
  140.     MsgBox Err.Description, vbCritical, "Saving BLOB"
  141. End Function
  142.  
  143. Private Sub txtPath_Change()
  144.  
  145. End Sub
  146.  
  147. Private Sub UserForm_Activate()
  148.     Me.Caption = "Saving and Retrieving BLOB"
  149. End Sub
  150.  
  151.  
Note: SavePicture is the name of my ODBC, if you want... replace it with a connection string.

I apologize if I can't give a detail on this but, i will attach, snapshots for a better understanding of this program and a bit of a clue.

Oh, sorry, can I insert images here? I think, there's no way for me to do that.

If you cant get the codes running, just give me your email and i will send you the snapshots.

Godspeed.
Jul 27 '07 #2

P: 11
Thanks for that - it helped to clarify what was happening with the reading in and out of the BLOB using GetChunk but it didn't help with the DIB specific display, specifically this line -
DrawDibDraw(hDibOpen, Picture1.hDC, 0, 0, xSize, ySize, BInfoHeader, ByVal pMem, 0, 0, BInfoHeader.biWidth, BInfoHeader.biHeight, 0)
That uses the picture.hDC that is in VB6 but not in Access VBA
Do you know what this is, or if there is an Access equivalent?
Jul 28 '07 #3

Post your reply

Sign in to post your reply or Sign up for a free account.