The information in this article applies to:
- Professional and Enterprise Editions of Microsoft Visual Basic,
16-bit only, for Windows, version 4.0
- Microsoft Access for Windows, versions 1.x and 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:
ARTICLE-ID: Q103115
TITLE : PRB: Invalid Picture Error When Try to Bind Picture Control
|