'Saves the image Filename (any kind Pict
' urebox supports: jpg, gif, ico, bmp, wmf
' ..) in to
'the current record of the recordset rsI
' mg, using the field FieldName (must be a
' memo field!!!)
'USE: SaveImage("c:\sample.gif", rs)
Public Sub SaveImage(Filename As String, rsImg As Recordset, Optional FieldName As String = "Image")
On Error Goto EH
Dim fh As Integer
Dim strFile As String
If rsImg.BOF Or rsImg.EOF Then Err.Raise vbObjectError + 1, "SaveImage", "EOF or BOF encountered"
fh = FreeFile
Open Filename For Binary Access Read As fh
strFile = String(LOF(fh), " ")
Get fh, , strFile
Close fh
rsImg(FieldName) = strFile
Exit Sub
EH:
End Sub
'Reads the image (any kind Picturebox su
' pports: jpg, gif, ico, bmp, wmf..) from
'
'the current record of the recordset rsI
' mg, using the field FieldName, and retur
' ns it.
'USE: picture1.picture=ReadImage(rsImg)
Public Function ReadImage(rsImg As Recordset, Optional FieldName As String = "Image") As IPictureDisp
On Error Goto EH
Dim strFile As String
Dim fh As Integer
If rsImg.BOF Or rsImg.EOF Then Err.Raise vbObjectError + 2, "EeadImage", "EOF or BOF encountered"
ChDir App.Path
strFile = rsImg(FieldName)
fh = FreeFile
Open GetTempDir & "tmpimage.temp" For Binary Access Write As fh
Put #fh, , strFile
Close fh
Set LeerImagen = LoadPicture(GetTempDir & "tmpimage.temp")
Kill GetTempDir & "tmpimage.temp"
Exit Function
EH:
End Function
Private Function GetTempDir() As String
GetTempDir = String(255, " ")
GetTempPath 255, GetTempDir
GetTempDir = Left(Trim(GetTempDir), Len(Trim(GetTempDir)) - 1)
End Function