Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Saving Image to Access Database
Message
From
20/02/2003 00:07:32
Osmaro Gariando
Michelin Asia Pacific Support Center
Manila, Philippines
 
 
To
27/01/2003 20:36:55
General information
Forum:
Visual Basic
Category:
Pictures and Image processing in VB
Miscellaneous
Thread ID:
00746058
Message ID:
00755342
Views:
13
Try this one.



Public Sub FillPhoto(RecSet as Recordset, PFName As String, SizeField As String)
On Error GoTo Handler
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
Screen.MousePointer = vbHourglass
DoEvents
file_name = TemporaryFileName()
file_num = FreeFile
Open file_name For Binary As #file_num
file_length = PrimaryCLS.ogADO(SizeField).Value
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
For block_num = 1 To num_blocks
bytes() = recset.fields(PFName).GetChunk(BLOCK_SIZE)
Put #file_num, , bytes()
Next block_num
If left_over > 0 Then
bytes() = recset.fields(PFName).GetChunk(left_over)
Put #file_num, , bytes()
End If
Close #file_num
Image1.Picture = LoadPicture(file_name)
Screen.MousePointer = vbDefault
Exit Sub

Handler:
Debug.Print Err.Description
Resume Next
End Sub
Private Sub GetPhoto(recset as recordset,filename As String, FieldName As String, SizeField As String)
On Error GoTo Handler
Dim file_num As String
Dim file_length As Long
Dim bytes() As Byte
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
file_num = FreeFile
Open filename For Binary Access Read As #file_num
file_length = LOF(file_num)
If file_length > 0 Then
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
PrimaryCLS.ogADO(SizeField).Value = file_length
ReDim bytes(BLOCK_SIZE)
For block_num = 1 To num_blocks
Get #file_num, , bytes()
recset.fields(FieldName).AppendChunk bytes()
Next block_num
If left_over > 0 Then
ReDim bytes(left_over)
Get #file_num, , bytes()
recset.fields(FieldName).AppendChunk bytes()
End If
Close #file_num
End If
Exit Sub
Handler:
MsgBox Err.Description
Resume
Debug.Print Err.Description
End Sub

Regards,
Osmar
Previous
Reply
Map
View

Click here to load this message in the networking platform