标题函数能得到一幅位图的句柄。

解决方案 »

  1.   

    Option ExplicitPrivate Type PictDesc
        cbSizeofStruct As Long
        picType As Long
        hImage As Long
        xExt As Long
        yExt As Long
    End TypePrivate Type Guid
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
          lpPictDesc As PictDesc, _
          riid As Guid, _
          ByVal fPictureOwnsHandle As Long, _
          ipic As IPicture _
        ) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
        (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule _
        As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" _
        (ByVal hInst As Long, ByVal lpsz As String, _
        ByVal iType As Long, _
        ByVal cx As Long, ByVal cy As Long, _
        ByVal fOptions As Long) As LongPrivate Const IMAGE_BITMAP = 0
    Private Const IMAGE_ICON = 1
    Private Const IMAGE_CURSOR = 2Private Const LR_LOADMAP3DCOLORS = &H1000
    Private Const LR_LOADFROMFILE = &H10
    Private Const LR_LOADTRANSPARENT = &H20
    Private Sub Command1_Click()
        Dim hModule As Long, hBitmap As Long
        hModule = LoadLibrary("CARDS.DLL")
        hBitmap = LoadImage(hModule, "#1", 0, 0, 0, LR_LOADMAP3DCOLORS)
        Set Picture1.Picture = BitmapToPicture(hBitmap)
        FreeLibrary hModule
    End Sub
        Public Function BitmapToPicture(ByVal hBmp As Long) As IPicture
       If (hBmp = 0) Then Exit Function
       Dim NewPic As Picture, tPicConv As PictDesc, IGuid As Guid
       With tPicConv
          .cbSizeofStruct = Len(tPicConv)
          .picType = vbPicTypeBitmap
          .hImage = hBmp
       End With
       With IGuid
          .Data1 = &H20400
          .Data4(0) = &HC0
          .Data4(7) = &H46
       End With
       OleCreatePictureIndirect tPicConv, IGuid, True, NewPic
       Set BitmapToPicture = NewPic
    End Function