imagefunc.bas

Oracle 10g数据库Java开发 源码

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