首页 /编程语言和算法/VB6/ASP
 VB6 二进制方式载入BMP图片
2024年11月19日 14:43

新建From1(窗体),新建Command1(按钮CommandButton),代码:

Private Sub Command1_Click()
    Dim arrPic() As Byte
    Open App.Path & "\123.bmp" For Binary As #1
        ReDim arrPic(LOF(1) - 1) '二进制方式载入文件
        Get #1, , arrPic
    Close #1
    Set Me.Picture = PictureFromBits(arrPic())
End Sub

新建模块 modBinaryPicture.bas,代码:

Option Explicit

Public Enum CBoolean
    CFalse = 0
    CTrue = 1
End Enum

Private Const S_OK = 0
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As CBoolean, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As CBoolean, riid As GUID, ppvObj As Any) As Long

Public Type GUID
    dwData1 As Long
    wData2 As Integer
    wData3 As Integer
    abData4(7) As Byte
End Type

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Public Function PictureFromBits(abPic() As Byte) As IPicture
    Dim nLow As Long
    Dim cbMem As Long
    Dim hMem As Long
    Dim lpMem As Long
    Dim IID_IPicture As GUID
    Dim istm As stdole.IUnknown
    Dim ipic As IPicture
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
    hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
    If hMem Then
        lpMem = GlobalLock(hMem)
        If lpMem Then
            MoveMemory ByVal lpMem, abPic(nLow), cbMem
            Call GlobalUnlock(hMem)
            If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
                If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
                    Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
                End If
            End If
        End If
    End If
Out:
End Function

记得准备123.bmp在当前目录,jpg不行。

 
全部回复(0)
首页 | 电脑版 |