Attribute VB_Name = "ImageFunc"
Const ChunkSize As Long = 100
Const BlockSize As Long = 100
Const TempFile As String = "tempfile.tmp"

Dim ByteData() As Byte '定義數據塊數組
Dim DiskFile As String '圖像文件名
Dim NumBlocks As Long  '定義數據塊個數
Dim FileLength As Long '標識文件長度
Dim LeftOver As Long   '定義剩余字節長度
Dim SourceFile As Long '定義自由文件號
Dim byteChunk() As Byte
Dim i As Long '定義循環變量

Public Sub ShowImage(Image1 As Image, fld1 As Field)
  '清空數組
  Erase byteChunk()
  '讀取圖像數據的實際大小
  FieldSize = fld1.ActualSize
  '如果實際大小為0，則裝入空數據到Image控件中
  If FieldSize <= 0 Then
    Image1.Picture = LoadPicture("")
    Exit Sub
  End If
  '提供一個尚未使用的文件號
  SourceFile = FreeFile
  '以寫方式打開文件
  Open TempFile For Binary Access Write As SourceFile
  '計算數據塊，每個數據塊的大小為100個字節
  NumBlocks = FieldSize \ BlockSize
  LeftOver = FieldSize Mod BlockSize '得到剩余字節數
  '分塊讀取圖像數據，并寫入到文件中
  If LeftOver <> 0 Then
    ReDim byteChunk(LeftOver)
    byteChunk() = fld1.GetChunk(LeftOver)
    Put SourceFile, , byteChunk()
  End If
  For i = 1 To NumBlocks
    ReDim byteChunk(BlockSize)
    byteChunk() = fld1.GetChunk(BlockSize)
    Put SourceFile, , byteChunk()
  Next i
  '關閉圖像文件
  Close SourceFile
  '將文件裝入到Image1控件中
  Image1.Picture = LoadPicture(TempFile)
  '刪除臨時文件
  Kill (TempFile)
End Sub


Public Sub SaveImage(ByVal ImageFile As String, rs As ADODB.Recordset, pos As Integer)
  '如果Adodc1的記錄集沒有內容，則不能向其中寫入圖像數據
  If rs.BOF = True Or rs.EOF = True Then
    Exit Sub
  End If
  '如果圖像文件字符串為空，則無法讀取圖像數據
  If ImageFile = "" Then
    Exit Sub
  End If

  '提供一個尚未使用的文件號
  SourceFile = FreeFile
  '打開文件
  Open ImageFile For Binary Access Read As SourceFile
  '得到文件長度
  FileLength = LOF(SourceFile)
  '判斷文件是否存在
  If FileLength = 0 Then
    Close SourceFile
    MsgBox DiskFile & "無內容或不存在!"
  Else
    NumBlocks = FileLength \ BlockSize '得到數據塊的個數
    LeftOver = FileLength Mod BlockSize '得到剩余字節數
    rs.Fields(pos).Value = Null  '首先將要寫入圖像數據的字段清空
    ReDim ByteData(BlockSize) '重新定義數據塊的大小
    For i = 1 To NumBlocks
      Get SourceFile, , ByteData() '讀到內存塊中
      rs.Fields(pos).AppendChunk ByteData()  '寫入圖像數據
    Next i
    ReDim ByteData(LeftOver) '重新定義數據塊的大小
    Get SourceFile, , ByteData() '讀到內存塊中
    rs.Fields(pos).AppendChunk ByteData()  '寫入剩余的圖像數據
    Close SourceFile '關閉源文件
    rs.Update '將記錄數據寫入到數據庫中
  End If
End Sub