VB直接保存和显示ACCESS数据库中的图像数据

我见过许多代码，在从ACCESS数据库读取图像数据后，往往需要借助一个临时文件进行转换才能显示，其实借助API，完全可以直接显示，而不需要临时文件，此外，大家还可以使用OleCreatePictureIndirect函数转图像数据转换成标准的IPicture接口，以实现VB图像显示的自动性和持续性，具体代码如下：

'* ************************************************************** * '* 程序名称：form1.frm '* 程序功能：直接显示ACCESS数据库中的图像数据 '* 作者：lyserver '* 联系方式：http://blog.csdn.net/lyserver '* ************************************************************** * Option Explicit Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long,_ ByVal nWidth As Long,ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long,_ ByVal hObject 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 SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long,lpBits 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 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 StretchBlt Lib "gdi32" (ByVal hdc As Long,ByVal x As Long,_ ByVal y As Long,ByVal hSrcDC As Long,_ ByVal xSrc As Long,ByVal nSrcWidth As Long,_ ByVal nSrcHeight As Long,ByVal dwRop As Long) As Long Dim m_Pic As New StdPicture Dim WithEvents btnSave As CommandButton '图片保存按钮 Dim WithEvents btnShow As CommandButton '图片显示按钮 '窗口启动时加载C盘下名为pic1.jpg的图片文件 Private Sub Form_Load() If Len(Dir("c:/pic1.jpg")) = 0 Then Exit Sub Set m_Pic = LoadPicture("c:/pic1.jpg") Set btnSave = Me.Controls.Add("VB.CommandButton","btnSave") btnSave.Caption = "保存" btnSave.Visible = True Set btnShow = Me.Controls.Add("VB.CommandButton","btnShow") btnShow.Caption = "显示" btnShow.Left = btnSave.Left + btnSave.Width + 10 btnShow.Visible = True End Sub '保存图片到ACCESS数据库中 Private Sub btnSave_Click() Dim Bits() As Byte,BitsLen As Long Dim PicWidth As Long,PicHeight As Long Dim hMemDC As Long,hMemBmp As Long,hOldBmp As Long Dim adoxCat As Object,adoDB As Object,adoRS As Object Dim strDatabaseName As String If m_Pic.Handle = 0 Then Exit Sub PicWidth = Me.ScaleX(m_Pic.Width,vbHimetric,vbPixels) PicHeight = Me.ScaleY(m_Pic.Height,vbPixels) hMemDC = CreateCompatibleDC(Me.hdc) hMemBmp = CreateCompatibleBitmap(Me.hdc,PicWidth,PicHeight) hOldBmp = SelectObject(hMemDC,hMemBmp) m_Pic.Render CLng(hMemDC),CLng(PicWidth),CLng(PicHeight),m_Pic.Height,_ m_Pic.Width,-m_Pic.Height,0 BitsLen = GetBitmapBits(hMemBmp,ByVal 0&) ReDim Bits(BitsLen - 1) GetBitmapBits hMemBmp,BitsLen,Bits(0) strDatabaseName = "C:/TEMP.MDB" If Len(Dir(strDatabaseName)) > 0 Then Kill strDatabaseName Set adoxCat = CreateObject("ADOX.Catalog") adoxCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabaseName Set adoDB = CreateObject("ADODB.Connection") adoDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDatabaseName adoDB.Execute "CREATE TABLE 图像表(图像宽度 LONG,图像高度 LONG,图像字段 IMAGE)" Set adoRS = CreateObject("ADODB.Recordset") adoRS.Open "图像表",adoDB,1,3 adoRS.AddNew adoRS.Fields("图像宽度").Value = PicWidth adoRS.Fields("图像高度").Value = PicHeight adoRS.Fields("图像字段").AppendChunk Bits adoRS.Update adoRS.Close adoDB.Close Set adoRS = Nothing Set adoDB = Nothing DeleteObject SelectObject(hMemDC,hOldBmp) DeleteDC hMemDC Erase Bits End Sub '从ACCESS数据库中读取并显示图片 Private Sub btnShow_Click() Dim Bits() As Byte,hOldBmp As Long Dim adoDB As Object,adoRS As Object If Len(Dir("c:/temp.mdb")) = 0 Then Exit Sub Set adoDB = CreateObject("ADODB.Connection") adoDB.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:/temp.mdb" Set adoRS = adoDB.Execute("SELECT * FROM 图像表") If Not adoRS.EOF Then PicWidth = adoRS.Fields("图像宽度").Value PicHeight = adoRS.Fields("图像高度").Value BitsLen = LenB(adoRS.Fields("图像字段").Value) Bits = adoRS.Fields("图像字段").GetChunk(BitsLen) hMemDC = CreateCompatibleDC(Me.hdc) hMemBmp = CreateCompatibleBitmap(Me.hdc,PicHeight) hOldBmp = SelectObject(hMemDC,hMemBmp) SetBitmapBits hMemBmp,Bits(0) '显示图片 BitBlt Me.hdc,PicHeight,hMemDC,vbSrcCopy '显示缩略图 'StretchBlt Me.hdc,PicWidth/4,PicHeight/4,vbSrcCopy DeleteObject SelectObject(hMemDC,hOldBmp) DeleteDC hMemDC End If adoRS.Close adoDB.Close Set adoRS = Nothing Set adoDB = Nothing Erase Bits End Sub