HOWTO: View Photos from the NWIND.MDB Database in VB 4.0

ID: Q147727

The information in this article applies to:

Microsoft Visual Basic Professional and Enterprise Editions, 16-bit only, for Windows, version 4.0
Microsoft Access versions 1.0, 1.1, 2.0

SUMMARY

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

MORE INFORMATION

Step-by-Step Example to View the Photos

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

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

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
   Text1       DataSource          Data1
   Text1       DataField           First Name
   Text2       DataSource          Data2
   Text2       DataField           First Name
   Data1       DatabaseName        C:\ACCESS1\NWIND.MDB
   Data1       RecordSource        Employees
   Data2       DatabaseName        C:\ACCESS2\SAMPAPPS\NWIND.MDB
   Data2       RecordSource        Employees

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

    Public Declare Function GetTempFileName Lib "Kernel" _
       (ByVal cDriveLetter As Integer, ByVal lpPrefixString As String, _
        ByVal wUnique As Integer,  ByVal lpTempFileName As String) _
        As Integer
    Public Declare Sub hmemcpy Lib "Kernel" (dest As Any, source As Any, _
        ByVal bytes As Long)
    Public 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:
                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, temporary 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
                   Buffer = OleField.GetChunk(BitmapOffset + i * _
                      BUFFER_SIZE, BUFFER_SIZE)
                   Put #Handle, , Buffer
                Next

                ' Copy the remaining chunk of the bitmap to the file:
                Buffer = OleField.GetChunk(BitmapOffset + Buffers * _
                   BUFFER_SIZE, Remainder)
                Put #Handle, , Buffer
                Close #Handle
             End If
          End If
       End If
       CopyOleBitmapToFile = Trim(tempFileName)
    End Function

    Public 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

Add the following to the Data1 Reposition event:


      Private 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

Add the following to the Data2 Reposition event:


      Private 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

On the Run menu, click 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:


Keywords          : kbcode kbVBp400 
Version           : WINDOWS:1.0,1.1,2.0,4.0
Platform          : WINDOWS 
Issue type        :

Last Reviewed: June 3, 1999