我见过许多代码，在从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, _
    ByVal dwCount 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 nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
    ByVal xSrc As Long, ByVal ySrc 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, vbHimetric, vbPixels)
    hMemDC = CreateCompatibleDC(Me.hdc)
    hMemBmp = CreateCompatibleBitmap(Me.hdc, PicWidth, PicHeight)
    hOldBmp = SelectObject(hMemDC, hMemBmp)
    m_Pic.Render CLng(hMemDC), 0, 0, CLng(PicWidth), CLng(PicHeight), 0, m_Pic.Height, _
    m_Pic.Width, -m_Pic.Height, 0
    BitsLen = GetBitmapBits(hMemBmp, 0, 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, BitsLen As Long
    Dim PicWidth As Long, PicHeight As Long
    Dim hMemDC As Long, hMemBmp As Long, 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, PicWidth, PicHeight)
        hOldBmp = SelectObject(hMemDC, hMemBmp)
        SetBitmapBits hMemBmp, BitsLen, Bits(0)
        '显示图片
        BitBlt Me.hdc, 0, 0, PicWidth, PicHeight, hMemDC, 0, 0, vbSrcCopy
        '显示缩略图
        'StretchBlt Me.hdc,0,0,PicWidth/4,PicHeight/4,hMemDC,0,0,PicWidth,PicHeight,vbSrcCopy
        DeleteObject SelectObject(hMemDC, hOldBmp)
        DeleteDC hMemDC
    End If
    adoRS.Close
    adoDB.Close
    
    Set adoRS = Nothing
    Set adoDB = Nothing
    Erase Bits
End Sub

	

9月
25日
VB学习有难题，关注跟我学VB！
今天给大家讲解一下：如何在VB编程中，编写代码来实现调用电脑上的其他应用软件或者程序。
VB调用其他软件
Shell函数的应用
【功能】
 Shell函数可以调用(执行)磁盘上已保存的命令文件。所谓命令文件就是可执行文件。需要注意的是程序扩展名必须是.COM、.EXE、.BAT。
【语法格式】
Shell(“命令文件名”[,窗体模式])
【说明】
1)、命令文件名必须是全名，包括盘符、路径、主文件名、扩展
名；
2)、窗体模式是可选项，取不同的值，打开的窗体模式不同。
具体值总结如下。
VBhide(值0)：窗体被隐藏，且焦点会移倒隐式窗口；
VBnormaIFocus(值1)：窗体具有焦点，切会还原到原来的大小和位置；
VBMinimizedFocus(值2)：窗体会以一个具有焦点的图标来显示；
VBMaximizedFocus(值3)：窗体是一个具有焦点的最大化窗口；
VBNoemalNoFocus(值4)：窗口会被还原到最近使用的大小和位置，而当前活动的窗口仍然保持活动；
VbminimizedNofocus(值6)：窗口最小化为图标，而当前活动的窗口仍然保持活动。
实际应用
用VB编程来实现调用QQ软件。
1、首先找到电脑上QQ软件的全路径，如下图：
2、复制其中红色框选的内容；
3、将复制的内容粘贴到代码窗口中，如下所示：
Private Sub Command1_Click()  Shell "D:\qq\Bin\QQScLauncher.exe"End Sub
4、运行程序，单击"打开QQ"的命令按钮，就实现了在VB程序中调用QQ软件，程序功能完成。
更多VB知识VB编程语言基础知识点总结
VB编程开发的实际程序展示
VB编程视频安装讲解
掌握VB编程的好处：
1.适应信息时代发展，紧跟时代潮流;2.提高自己的逻辑思维能力以及分析能力;3.方便、高效的解决工作和学习中的难题;4.提高自身的综合能力，让自己更加优异;5.技多不压身，在求职时能够更胜一筹。
愿大家都能顺利学好VB编程！
学习VB中有问题可以添加小编微信号：vbyjk521 ，学习问题在线答疑。
长按识别上图，关注跟我学VB微信平台
	

引子

常规的方法可能是循环读取每一行每一个格子的内容并存入 Recordset 并保存 

 此处使用Open Recordset 的方式，将 Excel Worksheet 作为一个数据源直接读取 

 速度将是数量级的差别，几万笔记录的情况下，将由几十秒，甚至几分钟，加快至几秒钟



解决代码



'导入Excel 文件内容
'Excel 格式为 Excel 2007 之上的 .xlsx 格式，需使用 ACE 读取
'其中的 HDR=No (Yes) 代表是否处理第一行的标题行
Private Function ImportExcelSheetData(ByVal p_sExcelFilePath As String, ByVal p_sSheetName As String) As Boolean
    On Error GoTo errHandler

    ImportExcelSheetData = False

    Dim cn As New ADODB.Connection
    Set m_rstImportData_Excel = New ADODB.Recordset

    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & p_sExcelFilePath & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"

    m_rstImportData_Excel.Open "SELECT * FROM [" & p_sSheetName & "$]", cn, adOpenStatic, adLockOptimistic

    ImportExcelSheetData = True

errHandler:
    If Err.Number <> 0 Then
        Screen.MousePointer = vbDefault
        MsgBox Err.Description, vbOKOnly + vbExclamation, "ImportExcelSheetData"
    End If
End Function



可能的问题


有时会出现读取到记录，但实际内容却为 Empty 的情况
有时则出现读取到内容，但在后续使用时其中的值均变为 Empty 的情况




解决方法


<推荐>最大的可能是因为在使用 Recordset.Open() 方式打开Excel 文件时，那个文件已经被 Excel Application 打开，故有时会导致此情况，最简单的办法即在使用Open()方式之前关闭Excel Object; 
另一个方法是完全处理完成数据（如保存至DB Table)后，再关闭或释放Excel Object

       有时在进行网络程序设计时，我们希望客户端接收到服务器传来的图像文件的二进制数组的，能够直接显示，而不是通过保存到临时文件后显示，其实通过COM的IPicture接口，在VB里非常容易做到,代码如下： 




Option Explicit
'* ******************************************************* *
'*    模块名称：frmTest.frm
'*    模块功能：直接显示图像数据
'*    作者：lyserver
'*    联系方式：http://blog.csdn.net/lyserver
'* ******************************************************* *
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As stdole.IUnknown) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (ByVal pStream As Long, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As stdole.IUnknown) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpwsz As Long, pclsid As Any) As Long
Private Const ERROR_SUCCESS = 0&
Function ShowPictureFromStream(ByRef bPic() As Byte) As StdPicture
    Dim IID_IPicture As GUID
    Dim IStm As stdole.IUnknown, IPic As IPicture
    Dim PicW As Long, PicH As Long
    
    If CreateStreamOnHGlobal(VarPtr(bPic(0)), 1, IStm) = ERROR_SUCCESS Then
        If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture) = ERROR_SUCCESS Then
            If OleLoadPicture(ByVal ObjPtr(IStm), UBound(bPic) + 1, 0, IID_IPicture, IPic) = ERROR_SUCCESS Then
                PicW = Me.ScaleX(IPic.Width, vbHimetric, vbPixels)
                PicH = Me.ScaleY(IPic.Height, vbHimetric, vbPixels)
                Set ShowPictureFromStream = IPic
            End If
        End If
        Set IStm = Nothing
    End If
    Erase bPic
End Function
Private Sub Command1_Click()
    Dim b() As Byte
    
    Open "c:/temp2.jpg" For Binary As #1
    b = InputB(LOF(1), 1)
    Close #1
    
    Set Me.Picture = ShowPictureFromStream(b)
    Erase b
End Sub

 请注意，因为要模拟直接显示二进制图像数据，上述代码中并没有使用LoadPicture方法。

摘自：如何直接显示内存中的二进制图像数据 



更多精彩>>>