关于图片的问题!

Question

我没有用过Access 存取图片，但是用Sql Server 里我是先将数据库里的图片字段恢复成临时文件，然后用PICTURE1.PICTURE = LoadPicture(App.Path & 临时文件名）来实现的如果没说清除再问我

Answer 1

这是那段从数据库取图片的函数
参数：strPicField 数据库里存图片的字段名，rs 是ADO记录集
Public Function getPicture(strPicField As String, ByVal rs As ADODB.Recordset) As Boolean
'从数据库读取图片,生成磁盘文件
  Const BlockSize = 15000
  Dim ByteData() As Byte                                            '以二进制形式存储图片的字节数组
  Dim DestFileNum As Integer
  Dim DiskFile As String
  Dim FileLength As Long                                            '图片文件的长度
  Dim Numblocks As Integer                                          '图片的块数
  Dim LeftOver As Long                                              '剩余部分
  Dim i As Integer
 On Error GoTo Line1
  
  '删除已存在的图形文件
  DiskFile = App.Path & "\temp.bmp"
  If Len(Dir$(DiskFile)) > 0 Then
     Kill DiskFile
  End If
    
  '把图片文件分解成几部分
  DestFileNum = FreeFile
  FileLength = rs.Fields(strPicField).ActualSize
  Numblocks = FileLength \ BlockSize
  LeftOver = FileLength Mod BlockSize
    
  '打开文件,开始按块存入数据库
  Open DiskFile For Binary As DestFileNum
  rs.Move 0, adBookCurrent
  ByteData() = rs.Fields(strPicField).GetChunk(LeftOver)
  Put DestFileNum, , ByteData()  For i = 1 To Numblocks
      ByteData() = rs.Fields(strPicField).GetChunk(BlockSize)
      Put DestFileNum, , ByteData()
  Next i  Close DestFileNum  getPicture = TrueLine1:
End Function

Answer 2

同意楼上
你还可以在CSDN中搜索到很多关于在数据库中存储图片的文章，自己看看吧

Answer 3

那你知道如何控制这图片的大小位置,因为我要把放放到EXCEL中去啊!总不能老是手动调整吧!

Answer 4

我感觉图片最好不存在数据库里的好，随着数据的变多，效率会很明显的下降可以把图片存在硬盘上，然后用一个字段寸它的路径，然后用image的loadpicture很简单的，而且效率也很好

Answer 5

Private Sub DBOpen()
    'open the database with ADO
    MYcon.Open "PROVIDER=MICROSOFT.JET.OLEDB.4.0; DATA SOURCE=" & App.Path + "/DBpic.MDB"
    MYrs.Open "PICTABLE", MYcon, 1, 3End Sub
'Close the open database
Private Sub DBClose()
    MYrs.Close
    MYcon.Close
    Set MYrs = Nothing
    Set MYcon = Nothing
End SubPrivate Sub SaveInto(ByVal strPath As String)Dim lngFileLength   As Long   'the length of the file
Dim lngBlockCount   As Long   'the number of total whole block
Dim lngLastBlock   As Integer   'the length of the last block
Dim lngBlockIndex   As Long   'the index of each block
Dim ByteGet()   As Byte   '用于传送数据的二进制数组
Dim FileNum As Integer 'return the file number which the next file will use
Dim strFilepath As String
        
        strFilepath = strPath
        FileNum = FreeFile()
        
        Open strFilepath For Binary Access Read As #FileNum
        lngFileLength = LOF(FileNum) '返回一个 Long，表示用 Open 语句打开的文件的大小，该大小以字节为单位。
        lngBlockCount = lngFileLength \ lngBlockSize
        lngLastBlock = lngFileLength Mod lngBlockSize
        
        MYrs.AddNew
            MYrs.Fields("size") = lngFileLength
            MYrs.Fields("date") = Date
            MYrs.Fields("name") = Trim(Text1)
            ReDim ByteGet(lngBlockSize)
            For lngBlockIndex = 1 To lngBlockCount
                Get #FileNum, , ByteGet()
                MYrs.Fields("pic").AppendChunk ByteGet()
            Next
    
        If lngLastBlock > 0 Then
            ReDim ByteGet(lngLastBlock)
            Get #FileNum, , ByteGet()
            MYrs.Fields("pic").AppendChunk ByteGet()
        End If
            MYrs.Update
        Close #FileNum
End SubPrivate Sub ShowImg(ByVal RecordPoint As Long)
On Error Resume NextDim temp_path As String
Dim temp_file As String
Dim length As Long
Dim lngFileLength   As Long   'the length of the file
Dim lngBlockCount   As Long   'the number of total whole block
Dim lngLastBlock   As Integer   'the length of the last block
Dim lngBlockIndex   As Long   'the index of each block
Dim ByteGet()   As Byte   '用于传送数据的二进制数组
Dim FileNum As Integer 'return the file number which the next file will use
Dim strFileName As Stringtemp_path = Space$(MAX_PATH)
length = GetTempPath(MAX_PATH, temp_path)
temp_path = Left$(temp_path, length)
temp_file = Space$(MAX_PATH)
GetTempFileName temp_path, "per", 0, temp_file
strFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)    MYrs.MoveFirst
    MYrs.Move RecordPoint
    Label1 = MYrs.AbsolutePosition
    frmMain.Caption = MYrs.Fields("name") + Str(i)
    FileNum = FreeFile()
    Open strFileName For Binary As #FileNum
    lngFileLength = MYrs.Fields("size")
    lngBlockCount = lngFileLength \ lngBlockSize
    lngLastBlock = lngFileLength Mod lngBlockSize
    For lngBlockIndex = 1 To lngBlockCount
        ByteGet() = MYrs.Fields("pic").GetChunk(lngBlockSize)
        Put #FileNum, , ByteGet()
    Next
    If lngLastBlock > 0 Then
    ReDim ByteGet(lngLastBlock)
        ByteGet() = MYrs.Fields("pic").GetChunk(lngBlockSize)
        Put #FileNum, , ByteGet()
    End If
    
    Picture1.Picture = LoadPicture(strFileName)
    
    Close #FileNum
    Kill strFileName
    
    Err.Clear
End SubPrivate Sub AimFilePath(ByVal strPath As String)
Dim PathVal As String
    PathVal = Dir(strPath)
    If PathVal = Null Then MsgBox "null"
    Do While PathVal <> ""
        SaveInto (strPath + PathVal)
        PathVal = Dir
    Loop
End Sub