vb6中如何将数据库中的图片数据直接显示在picture或者image控件中

请问如何能够不通过临时文件的方法，直接能够将读取过来的二进制数据字段的值，直接用picture或者image控件来显示出来～

17 个解决方案

#1

老问题了，论坛上搜索一下应该就有
再贴一次吧：

'新增图片
    Dim Bag As PropertyBag
    Dim buff() As Byte
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set Bag = New PropertyBag
    Bag.WriteProperty "Image", Picture1.Image
    ReDim buff(LenB(Bag.Contents))
    buff = Bag.Contents
    
    Set cn = ConnectionToDB
    Set rs = New ADODB.Recordset
    rs.Open "select img from tb_image where 1=0", _
        cn, adOpenKeyset, adLockOptimistic
    rs.AddNew
    rs.Fields("img") = buff
    rs.Update
    
    Set rs = Nothing
    Set cn = Nothing
    Set Bag = Nothing

    '读出图片
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim Bag As PropertyBag
    Dim buff() As Byte
    
    Set cn = ConnectionToDB
    Set rs = New ADODB.Recordset
    rs.Open "Select * From tb_image Where ID=100", _
        cn, adOpenKeyset, adLockOptimistic
    
    buff = rs.Fields("Img").Value
    Set Bag = New PropertyBag
    Bag.Contents = buff
    Call Bag.WriteProperty("Image", buff)
    Set Picture1.Picture = Bag.ReadProperty("Image")
    Set rs = Nothing
    Set cn = Nothing
    Set Bag = Nothing

#2

Bag.Contents = Buff  
这里执行起来就有问题

#3

如果你用picturebox或imagebox绑定的方式保存图片入数据库，就可以直接用绑定的方式显示图片。

#4

引用 2 楼 fangyc 的回复:

Bag.Contents = Buff   
这里执行起来就有问题

你保存图片不是用的PropertyBag对象

#5

 Dim Bag As PropertyBag
        Dim buff() As Byte
        
        buff = RS.Fields("FileContent").Value
        Set Bag = New PropertyBag
        Bag.Contents = buff
        Call Bag.WriteProperty("Image", buff)
        Set Picture4.Picture = Bag.ReadProperty("Image")
        Set Bag = Nothing

我是按照你的代码这么写的。

#6

保存图片到数据库也是用我的示例代码？

#7

这个去试了下.好像有点儿问题啊.

    Debug.Print LenB(Bag.ReadProperty("Image"))<--打印出来值为:150884
    Set Me.Picture1.Picture = Bag.ReadProperty("Image")<---这句提示需要对象
.还请教..

#8

保存图片我没有用你说的那个方法插入的。
我还是用从图片中读出来，的方法放进去的。
是否一定要用你说的那种方法放进去才行的？

#9

引用 8 楼 fangyc 的回复:

保存图片我没有用你说的那个方法插入的。 
我还是用从图片中读出来，的方法放进去的。 
是否一定要用你说的那种方法放进去才行的？

通常情况下就是这样的
用stream对象写入的就要用stream对象读出
用bag对象写入的就要用bag对象读出

#10

好的谢谢！

#11

很奇怪在调试的时候，发现  Set Me.Picture1.Picture = Bag.ReadProperty("Image") 老是出错。

#12

我是VB的代码哦，不是VB.Net 的

#13

不知道你是什么错误
检查控件名称是不是正确
"image"是不是与 Bag.WriteProperty时的一致

#14

我明天把代码贴出来。你帮我分析分析看。谢谢了
我调试了好久，就是要出错。

#15

'========================================================================================
' 文件名称:     Form1.frm
' 作者:         lyserver
' 日期:         2008年5月24日 3:52
' 功能:         直接显示数据库中的二进制图像数据
'========================================================================================

Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long

Private Sub Command1_Click()
    Dim DB As Object
    Dim RS As Object
    Dim Bits() As Byte
    Dim nCount As Long
    
     '打开数据库和数据表
    Set DB = CreateObject("ADODB.Connection")
    DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp.mdb"
    Set RS = DB.Execute("SELECT * FROM 图像表")
    '获得图像二进制
    nCount = LenB(RS.Fields("图像字段").Value)
    Bits = RS.Fields("图像字段").GetChunk(nCount)
    '显示图像
    SetBitmapBits Me.Image, nCount, Bits(0)
    Me.Refresh
    '关闭数据表和数据库
    RS.Close
    DB.Close
    
    '释放资源
    Erase Bits
    Set RS = Nothing
    Set DB = Nothing
End Sub

Private Sub Form_Initialize()
    '由于没有源数据,所以我先写了一个把屏幕图像抓取到ACCESS数据库的函数
    CatchScreenToMDB
End Sub

'抓取屏幕图像并保存到ACCESS数据库中
Public Function CatchScreenToMDB()
    Dim hMemoryDC As Long
    Dim hScreenDC As Long
    Dim hMemoryBitmap As Long
    Dim hPrevMemoryBitmap As Long
    Dim ScreenWidth As Long
    Dim ScreenHeight As Long
    Dim Bits() As Byte
    Dim BitmapInfo(1 To 6) As Long
    Dim AdoxCat As Object
    Dim AdodbCn As Object
    Dim AdodbRs As Object
    Dim strDatabase As String
    
    '取屏幕高宽
    ScreenWidth = Screen.Width \ 15
    ScreenHeight = Screen.Height \ 15
    '准备内存DC和内存位图
    hScreenDC = GetDC(0)
    hMemoryDC = CreateCompatibleDC(0&)
    hMemoryBitmap = CreateCompatibleBitmap(hScreenDC, ScreenWidth, ScreenHeight)
    hPrevMemoryBitmap = SelectObject(hMemoryDC, hMemoryBitmap)
    '复制屏幕图像到二进制数组中
    BitBlt hMemoryDC, 0, 0, ScreenWidth, ScreenHeight, hScreenDC, 0, 0, vbSrcCopy
    ReDim Bits(0 To ScreenWidth * ScreenHeight * 4) '下标必须为0,以便ADO能正确保存
    Call GetBitmapBits(hMemoryBitmap, UBound(Bits) + 1, Bits(0))
    '将图数据保存到数据库中
    strDatabase = "C:\TEMP.MDB"
    If Len(Dir(strDatabase)) > 0 Then Kill strDatabase
    Set AdoxCat = CreateObject("ADOX.Catalog")
    AdoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabase '创建数据库
    Set AdodbCn = CreateObject("ADODB.Connection")
    AdodbCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabase '打开数据库
    AdodbCn.Execute "CREATE TABLE 图像表(图像字段 IMAGE)" '创建数据表
    Set AdodbRs = CreateObject("ADODB.Recordset")
    AdodbRs.Open "图像表", AdodbCn, 1, 3
    AdodbRs.AddNew
    AdodbRs.Fields("图像字段").AppendChunk Bits
    AdodbRs.Update
    AdodbRs.Close
    AdodbCn.Close
    '释放资源
    DeleteObject SelectObject(hMemoryDC, hPrevMemoryBitmap)
    DeleteDC hMemoryDC
    ReleaseDC 0, hScreenDC
    Erase Bits
    Set AdodbRs = Nothing
    Set AdodbCn = Nothing
    Set AdoxCat = Nothing
End Function

#16

调试环境：winxp sp2 ，SQL SERVER 2000.
'加载图片
Private Function JiaZai()

    Dim RS As ADODB.Recordset
    Set RS = New ADODB.Recordset
    Dim GCONN As ADODB.Connection
    Set GCONN = New ADODB.Connection
    
    GCONN.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=xlwwgly;Initial Catalog=wwdb;Data Source= 127.0.0.1", "sa", "sa"
    '============================
    Dim Bag As PropertyBag
    Dim buff() As Byte
    Dim BagObj As Object
    '============================
    RS.Open "select * from  Tab_Files where  filename="'aa.jpg'", GCONN, adOpenStatic, adLockPessimistic
    buff = RS.Fields("FileContent").Value
    
    Set Bag = New PropertyBag
    
    Bag.Contents = buff
    Call Bag.WriteProperty("ImageE", buff)
    Debug.Print LenB(Bag.ReadProperty("ImageE"))
    Set Picture1.Picture = Nothing
    Set Picture1.Picture = Bag.ReadProperty("ImageE", vbNullString) '调试的时候这里就要出错的。
 
    Set RS = Nothing
    Set Bag = Nothing
End Function

'保存图片到数据库
Private Function saveimg()
    Dim as_FilePath
    as_FilePath = "C:\aa.jpg"

    Dim RS As ADODB.Recordset
    Set RS = New ADODB.Recordset
    Dim Bag As PropertyBag
    Set Bag = New PropertyBag
    Dim buff() As Byte
    Dim GCONN As ADODB.Connection
    Set GCONN = New ADODB.Connection
    GCONN.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=xlwwgly;Initial Catalog=wwdb;Data Source= 127.0.0.1", "sa", "sa"

    Me.Picture1.Picture = LoadPicture(as_FilePath)
    Bag.WriteProperty "ImageE", Me.Picture1.Image


    ReDim buff(LenB(Bag.Contents))
    buff = Bag.Contents
    RS.Open "select * from  Tab_Files", GCONN, adOpenStatic, adLockPessimistic
    RS.AddNew
    RS("Filename") = "aa.jpg"
    RS.Fields("FileContent") = buff
    RS.Update
    Set RS = Nothing
    Set Bag = Nothing
    
End Function

#17

代码没看出问题，错误提示是什么？