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

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

'* ************************************************************** * '* 程序<a href="https://www.jb51.cc/tag/mingcheng/" target="_blank" class="keywords">名称</a>：form1.frm '* 程序<a href="https://www.jb51.cc/tag/gongneng/" target="_blank" class="keywords">功能</a>：直接<a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a>ACCESS<a href="https://www.jb51.cc/tag/shujuku/" target="_blank" class="keywords">数据库</a>中的图像数据 '* 作者：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 '<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>保存按钮 Dim WithEvents btnShow As CommandButton '<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a><a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a>按钮 '窗口启动时加载C盘下名为pic1.jpg的<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a><a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a> 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 = "<a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a>" btnShow.Left = btnSave.Left + btnSave.Width + 10 btnShow.Visible = True End Sub '保存<a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a>到ACCESS<a href="https://www.jb51.cc/tag/shujuku/" target="_blank" class="keywords">数据库</a>中 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 = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> Set adoDB = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> DeleteObject SelectObject(hMemDC,hOldBmp) DeleteDC hMemDC Erase Bits End Sub '从ACCESS<a href="https://www.jb51.cc/tag/shujuku/" target="_blank" class="keywords">数据库</a>中读取并<a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a><a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a> 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) '<a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a><a href="https://www.jb51.cc/tag/tupian/" target="_blank" class="keywords">图片</a> BitBlt Me.hdc,PicHeight,hMemDC,vbSrc<a href="https://www.jb51.cc/tag/cop/" target="_blank" class="keywords">cop</a>y '<a href="https://www.jb51.cc/tag/xianshi/" target="_blank" class="keywords">显示</a><a href="https://www.jb51.cc/tag/suoluetu/" target="_blank" class="keywords">缩略图</a> 'StretchBlt Me.hdc,PicWidth/4,PicHeight/4,vbSrc<a href="https://www.jb51.cc/tag/cop/" target="_blank" class="keywords">cop</a>y DeleteObject SelectObject(hMemDC,hOldBmp) DeleteDC hMemDC End If adoRS.Close adoDB.Close Set adoRS = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> Set adoDB = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> Erase Bits End Sub

原文地址：https://www.jb51.cc/vb/263866.html