jpg数组到pic.bas

把图片缩小压缩成jpg格式并保存到sql数据库

Attribute VB_Name = "jpg数组到pic"
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type


Private Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, id As GUID) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
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



'**************************************************************
'   参数说明:
'
'   bImageData():   保存图像信息的字节数组。
'
'   返回值：
'
'   返回转换后的   IPictreDisp   对象。
'**************************************************************
Public Function GetPictureFromByteStream(bImageData() As Byte) As IPicture
Dim lngByteCount     As Long
Dim hMem     As Long
Dim lpMem     As Long
Dim IID_IPicture(15) As GUID
Dim IStream     As stdole.IUnknown

On Error GoTo Err_Init

lngByteCount = UBound(bImageData) + 1           '   计算数组大小
hMem = GlobalAlloc(&H2 Or GMEM_ZEROINIT, lngByteCount)             '   按数组大小分配一块内存空间
If hMem <> 0 Then
' '   若分配内存成功
lpMem = GlobalLock(hMem)       '   锁定内存,   返回第一块的指针
If lpMem <> 0 Then
CopyMemory ByVal lpMem, bImageData(0), lngByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, IStream) = 0 Then
 If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
 'If CLSIDFromString(StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(IStream), lngByteCount, 0, IID_IPicture(0), GetPictureFromByteStream)
End If
End If
End If
End If

GlobalFree hMem

Exit Function

Err_Init:
MsgBox Err.Number & "   -   " & Err.Description
End Function


'把图像数据存入字节数组，按如下调用即可：

'Set Picture1.Picture = GetPictureFromByteStream(bytData())

'Private Sub Command1_Click()
'Dim a() As Byte
'Open App.Path & "\temp.jpg" For Binary Access Read As #1
' ReDim a(LOF(1))
' Get #1, , a()
'Close #1
'Set Picture1.Picture = GetPictureFromByteStream(a())
'End Sub