|
Public Function SavePicture() As Boolean
Dim i As Integer
Const ChunkSize As Integer = 16384
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte
On Error GoTo err
SavePicture = False
If Not Form2.txtPicFileTop.Text = "" Then
Fl = 0: Fragment = 0: Chunks = 0
DataFile = 1
If Len(Form2.txtPicFileTop.Text) = 0 Then
MsgBox "尚未选择图片"
Exit Function
End If
TopFileName = CStr(Form2.txtPicFileTop.Text)
Open TopFileName For Binary Access Read As DataFile
Fl = LOF(DataFile) ' 文件中数据长度
If Fl = 0 Then
Close DataFile
Exit Function
End If
Chunks = Fl \ ChunkSize
Fragment = Fl Mod ChunkSize
'Rs!Pic.AppendChunk Null
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
rs!TopPicture.AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For i = 1 To Chunks
Get DataFile, , Chunk()
rs!TopPicture.AppendChunk Chunk()
Next i
Close DataFile
End If
If Not Form2.txtPicFileBot.Text = "" Then
Fl = 0: Fragment = 0: Chunks = 0
DataFile = 2
If Len(Form2.txtPicFileBot.Text) = 0 Then
MsgBox "尚未选择图片"
Exit Function
End If
BottomFileName = CStr(Form2.txtPicFileBot.Text)
Open BottomFileName For Binary Access Read As DataFile
Fl = LOF(DataFile) ' 文件中数据长度
If Fl = 0 Then
Close DataFile
Exit Function
End If
Chunks = Fl \ ChunkSize
Fragment = Fl Mod ChunkSize
'Rs!Pic.AppendChunk Null
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
rs!BottomPicture.AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For i = 1 To Chunks
Get DataFile, , Chunk()
rs!BottomPicture.AppendChunk Chunk()
Next i
Close DataFile
End If
SavePicture = True
Exit Function
err:
MsgBox "发生错误" & vbCrLf & "请确认图片路径是否无误！", vbExclamation
End Function |
