VB3 How to View Photos from the NWIND.MDB Database in VB

• Microsoft Visual Basic programming system for Windows, version 3.0

SUMMARY

This article shows by example how to view the photos in the Microsoft Access versions 1.x and 2.0 NWIND.MDB database.

NOTE: To run the code in this article, you will need to have both Microsoft Access version 1.x or 2.0 and the Microsoft Jet 2.0/Visual Basic 3.0 Compatibility Layer .DLL files.

MORE INFORMATION

Step-by-Step Example to View the Photos

1. Start a new project in Visual Basic. Form1 is created by default.



2. Add two Labels, two Text box controls, two Picture box controls and two Data controls to Form1.



3. Using the following table as a guide, set the properties of the controls you added in step 2.

   
      Control     Property               New Value
      ----------------------------------------------------------------
      Label1      Caption                Access 1.x
      Label2      Caption                Access 2.0
      Data1       DatabaseName           C:\ACCESS\NWIND.MDB
      Data1       RecordSource           Employees
      Data2       DatabaseName           C:\ACCESS2\SAMPAPPS\NWIND.MDB
      Data2       RecordSource           Employees 




4. Place the following code in the (general) (declarations) section of MODULE1.BAS:

   
      Option Explicit
   
      Global Const LENGTH_FOR_SIZE = 4
      Global Const OBJECT_SIGNATURE = &H1C15
      Global Const OBJECT_HEADER_SIZE = 20
      Global Const CHECKSUM_SIGNATURE = &HFE05AD00
      Global Const CHECKSUM_STRING_SIZE = 4
   
      ' PT : Window sizing information for object
      '      Used in OBJECTHEADER type
      Type PT
         Width As Integer
         Height As Integer
      End Type
   
      ' OBJECTHEADER : Contains relevant information about object
      '
      Type OBJECTHEADER
         Signature As Integer         'Type signature (0x1c15)
         HeaderSize As Integer        'Size of header (sizeof(struct
                                      'OBJECTHEADER) + cchName +
                                      'cchClass)
         ObjectType As Long           'OLE Object type code (OT_STATIC,
                                      'OT_LINKED, OT_EMBEDDED)
         NameLen As Integer           'Count of characters in object
                                      'name (CchSz(szName) + 1)
         ClassLen As Integer          'Count of characters in class
                                      'name (CchSz(szClass) + 1)
         NameOffset As Integer        'Offset of object name in
                                      'structure (sizeof(OBJECTHEADER))
         ClassOffset As Integer       'Offset of class name in
                                      'structure (ibName + cchName)
         ObjectSize As PT             'Original size of object (see
                                      'code below for value)
         OleInfo As String * 256
      End Type
   
      Type OLEHEADER
         OleVersion As Long
         Format As Long
         OleInfo As String * 512
      End Type
   
      ' Enter each of the following Declare statements as one, single line:
      Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As
         Integer, ByVal  lpPrefixString As String, ByVal wUnique As Integer,
         ByVal lpTempFileName As String) As Integer
      Declare Sub hmemcpy Lib "Kernel" (dest As Any, source As Any,
         ByVal bytes As Long)
   
      Function CopyOleBitmapToFile (OleField As Field) As String
   
         Const BUFFER_SIZE = 8192
   
         Dim tempFileName As String
         Dim Handle As Integer
         Dim Buffer As String
   
         Dim BytesNeeded As Long
   
         Dim Buffers As Long
         Dim Remainder As Long
   
         Dim ObjHeader As OBJECTHEADER
         Dim sOleHeader As String
   
         Dim ObjectOffset As Long
         Dim BitmapOffset As Long
         Dim BitmapHeaderOffset As Integer
   
         Dim r As Integer
         Dim i As Long
   
         tempFileName = ""
         If OleField.FieldSize() > OBJECT_HEADER_SIZE Then
   
            ' Get the Microsoft Access OLE header:
            sOleHeader = OleField.GetChunk(0, OBJECT_HEADER_SIZE)
            hmemcpy ObjHeader, ByVal sOleHeader, OBJECT_HEADER_SIZE
   
            ' Calculate the offset where the OLE object starts:
            ObjectOffset = ObjHeader.HeaderSize + 1
   
            ' Get enough bytes after the OLE header to get the bitmap header:
            Buffer = OleField.GetChunk(ObjectOffset, 512)
   
            ' Make sure the class of the object is a Paint Brush object:
            If Mid(Buffer, 12, 6) = "PBrush" Then
   
               BitmapHeaderOffset = InStr(Buffer, "BM")
   
               If BitmapHeaderOffset > 0 Then
   
                  ' Calculate the beginning of the bitmap:
                  BitmapOffset = ObjectOffset + BitmapHeaderOffset - 1
   
                  ' Calculate the size of the bitmap:
                  ' Enter the following two lines as one, single line:
                  BytesNeeded = OleField.FieldSize() - OBJECT_HEADER_SIZE -
                     BitmapHeaderOffset - CHECKSUM_STRING_SIZE + 1
   
                  ' Calculate the number of buffers needed to copy
                  ' the OLE object based on the bitmap size:
                  Buffers = BytesNeeded \ BUFFER_SIZE
                  Remainder = BytesNeeded Mod BUFFER_SIZE
   
                  ' Get a unique, temp filename:
                  tempFileName = Space(255)
                  r = GetTempFileName(0, "", -1, tempFileName)
   
                  ' Copy the bitmap to the temporary file chunk by chunk:
                  Handle = FreeFile
                  Open tempFileName For Binary As #Handle
   
                  For i = 0 To Buffers - 1
                     ' Enter the following two lines as one, single lin:
                     Buffer = OleField.GetChunk(BitmapOffset + i *
                        BUFFER_SIZE, BUFFER_SIZE)
                     Put #Handle, , Buffer
                  Next
   
                  ' Copy the remaining chunk of the bitmap to the file:
                  ' Enter the following two lines as one, single line:
                  Buffer = OleField.GetChunk(BitmapOffset + Buffers *
                     BUFFER_SIZE, Remainder)
                  Put #Handle, , Buffer
                  Close #Handle
               End If
            End If
         End If
         CopyOleBitmapToFile = Trim(tempFileName)
      End Function
   
      Sub DisplayOleBitmap (ctlPict As Control, OleField As Field)
   
         Const DT_LONGBINARY = 11
   
         Dim r As Integer
         Dim Handle As Integer
         Dim OleFileName As String
   
         If OleField.Type = DT_LONGBINARY Then
   
            OleFileName = CopyOleBitmapToFile(OleField)
   
            If OleFileName <> "" Then
   
               ' Display the bitmap:
               ctlPict.Picture = LoadPicture(OleFileName)
   
               ' Delete the temporary file:
               Kill OleFileName
            End If
         End If
      End Sub 




5. Add the following to the Data1 Reposition event:

   
      Sub Data1_Reposition ()
         Screen.MousePointer = 11
         ' Make sure this is the current record:
         If Not (Data1.Recordset.EOF And Data1.Recordset.BOF) Then
            ' Change Photo to the name of the OLE field
            ' for the record set you are using:
            DisplayOleBitmap Picture1, Data1.Recordset("Photo")
         End If
         Screen.MousePointer = 0
      End Sub 




6. Add the following to the Data2 Reposition event:

   
      Sub Data2_Reposition ()
         Screen.MousePointer = 11
         ' Make sure this is the current record:
         If Not (Data2.Recordset.EOF And Data2.Recordset.BOF) Then
            ' Change Photo to the name of the OLE field
            ' for the record set you are using:
            DisplayOleBitmap Picture2, Data2.Recordset("Photo")
         End If
         Screen.MousePointer = 0
      End Sub 




7. From the Run menu, choose Start (ALT, R, S), or press the F5 key to run the program. Click the Data1 control; then click the Data2 control.

REFERENCES

In order to work around the 'Invalid Picture' error, the code in this article is based on the code published in the following article in the Microsoft Knowledge Base:

Q103115 PRB: Invalid Picture Error When Try to Bind Picture Control

Additional query words: 3.00

Keywords : kbcode APrgDataAcc
Version : 3.00
Platform : WINDOWS
Issue type :