你是一位高级VB6.0程序员，我有以下的类模块，Option Explicit
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal GpBitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
' 定义 GUID 结构
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
' 定义 PICTDESC 结构
Private Type PICTDESC
Size As Long
Type As Long
hBitmap As Long
hPalette As Long
End Type
' 常量定义
Private Const GMEM_MOVEABLE = &H2
Private Const PICTYPE_BITMAP = 1
' 全局变量
Private g_GdiplusToken As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Const UnitPixel As Long = &H2&
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Enum EncoderParameterValueType
[EncoderParameterValueTypeByte] = 1
[EncoderParameterValueTypeASCII] = 2
[EncoderParameterValueTypeShort] = 3
[EncoderParameterValueTypeLong] = 4
[EncoderParameterValueTypeRational] = 5
[EncoderParameterValueTypeLongRange] = 6
[EncoderParameterValueTypeUndefined] = 7
[EncoderParameterValueTypeRationalRange] = 8
End Enum
Private Type EncoderParameter
GUID(0 To 3) As Long
NumberOfValues As Long
Type As EncoderParameterValueType
Value As Long
End Type
Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type
Private Type ImageCodecInfo
ClassID(0 To 3) As Long
FormatID(0 To 3) As Long
CodecName As Long
DllName As Long
FormatDescription As Long
FilenameExtension As Long
MimeType As Long
Flags As Long
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, Size As Long) As Long
Private Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal Size As Long, Encoders As Any) As Long
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal Image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hPal As Long, Bitmap As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, Image As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal Hdc As Long, hGraphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal hGraphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal Callback As Long = 0, Optional ByVal CallbackData As Long = 0) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszProgID As Long, pCLSID As Any) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
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 mToken As Long
Private Sub Class_Initialize()
Dim Gsp As GdiplusStartupInput
Gsp.GdiplusVersion = 1
GdiplusStartup mToken, Gsp
End Sub
Private Sub Class_Terminate()
GdiplusShutdown mToken
End Sub
Public Function GetGifArrayForm24Dib(Img As StdPicture) As Byte()
Dim Image As Long
Dim Data() As Byte
Dim Memory As Long
Dim OldMemory As Long
Dim MemorySize As Long
Dim uEncCLSID(3) As Long
Dim IIStream As IUnknown
GdipCreateBitmapFromHBITMAP Img.Handle, 0, Image
GetEncoderClsID "Image/gif", uEncCLSID
CreateStreamOnHGlobal 0, 1, IIStream
GdipSaveImageToStream Image, IIStream, uEncCLSID(0&), ByVal 0&
GetHGlobalFromStream ByVal ObjPtr(IIStream), Memory
MemorySize = GlobalSize(Memory)
OldMemory = GlobalLock(Memory)
ReDim Data(0 To MemorySize - 1)
CopyMemory Data(0), ByVal OldMemory, MemorySize
GlobalUnlock Memory
GdipDisposeImage Image
GetGifArrayForm24Dib = Data
End Function
'函数的主要作用是将一个 StdPicture 对象（即图片对象）转换为 JPEG 格式的字节数组，并支持设置 JPEG 图片的质量参数。
'该函数利用 GDI+ 提供的 API 完成图像编码和质量控制，最终返回包含 JPEG 数据的字节数组。
Public Function GetJpgArrayForm24Dib(Img As StdPicture, Optional Quality As Long = 80) As Byte()
Dim Image As Long
Dim IIStream As IUnknown
Dim uEncCLSID(3) As Long
Dim aEncParams() As Byte
Dim uEncParams As EncoderParameters
Dim Data() As Byte
Dim Memory As Long
Dim OldMemory As Long
Dim MemorySize As Long
' 将 StdPicture 转换为 GDI+ 的 Bitmap 对象
GdipCreateBitmapFromHBITMAP Img.Handle, 0, Image
' 获取 JPEG 编码器的 CLSID（类标识符）
GetEncoderClsID "Image/jpeg", uEncCLSID
' 设置编码参数结构体
uEncParams.Count = 1 ' 只有一个编码参数
ReDim aEncParams(1 To Len(uEncParams)) ' 为编码参数分配内存
With uEncParams.Parameter
.NumberOfValues = 1 ' 参数值的数量为 1
.Type = [EncoderParameterValueTypeLong] ' 参数类型为长整型
' 将字符串形式的 GUID 转换为二进制形式
Call CLSIDFromString(StrPtr(EncoderQuality), .GUID(0))
' 确保质量值在 0 到 100 的范围内
If Quality < 0 Then
Quality = 0
ElseIf Quality > 100 Then
Quality = 100
End If
' 设置质量值的指针
.Value = VarPtr(Quality)
End With
' 将编码参数结构体复制到字节数组中
Call CopyMemory(aEncParams(1), uEncParams, Len(uEncParams))
' 创建一个基于全局内存的流对象，用于存储编码后的图像数据
CreateStreamOnHGlobal 0, 1, IIStream
' 使用 GDI+ 将图像保存到流中，指定编码器和编码参数
GdipSaveImageToStream Image, IIStream, uEncCLSID(0&), aEncParams(1)
' 获取流背后的全局内存句柄及其大小
GetHGlobalFromStream ByVal ObjPtr(IIStream), Memory
MemorySize = GlobalSize(Memory)
' 锁定全局内存并读取数据
OldMemory = GlobalLock(Memory)
ReDim Data(0 To MemorySize - 1) ' 分配字节数组以存储数据
CopyMemory Data(0), ByVal OldMemory, MemorySize ' 将内存中的数据复制到数组中
' 解锁全局内存并释放资源
GlobalUnlock Memory
GdipDisposeImage Image
' 返回包含 JPEG 数据的字节数组
GetJpgArrayForm24Dib = Data
End Function
Public Function ShowImageFormArray(Data() As Byte, Hdc As Long) As Boolean
Dim MemoryHandle As Long
Dim LockMemory As Long
Dim Size As Long
Dim IIStream As IUnknown
Dim Graphics As Long
Dim Image As Long
Dim Width As Long
Dim Height As Long
Size = UBound(Data) - LBound(Data) + 1
MemoryHandle = GlobalAlloc(&H2, Size)
LockMemory = GlobalLock(MemoryHandle)
CopyMemory ByVal LockMemory, Data(0), Size
Call GlobalUnlock(MemoryHandle)
CreateStreamOnHGlobal MemoryHandle, 1, IIStream
GdipLoadImageFromStream IIStream, Image
GdipCreateFromHDC Hdc, Graphics
GdipGetImageWidth Image, Width
GdipGetImageHeight Image, Height
GdipDrawImageRectRectI Graphics, Image, 0, 0, Width, Height, 0, 0, Width, Height, UnitPixel
GdipDeleteGraphics Graphics
GdipDisposeImage Image
End Function
Private Function GetEncoderClsID(strMimeType As String, ClassID() As Long) As Long
Dim Num As Long
Dim Size As Long
Dim i As Long
Dim Info() As ImageCodecInfo
Dim Buffer() As Byte
GetEncoderClsID = -1
Call GdipGetImageEncodersSize(Num, Size) '得到解码器数组的大小
If (Size = 0) Then Exit Function ' 失败
ReDim Info(1 To Num) As ImageCodecInfo '给数组动态分配内存
ReDim Buffer(1 To Size) As Byte
Call GdipGetImageEncoders(Num, Size, Buffer(1)) '得到数组和字符数据
Call CopyMemory(Info(1), Buffer(1), (Len(Info(1)) * Num)) '复制类头
For i = 1 To Num '循环检测所有解码
If (StrComp(PtrToStrW(Info(i).MimeType), strMimeType, vbTextCompare) = 0) Then '必须把指针转换成可用的字符
CopyMemory ClassID(0), Info(i).ClassID(0), 16 '保存类的ID
GetEncoderClsID = i '返回成功的索引值
Exit For
End If
Next
End Function
Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim Out As String
Dim lLen As Long
lLen = lstrlenW(lpsz)
If (lLen > 0) Then
Out = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal Out, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(Out, vbFromUnicode)
End If
End Function
'这个函数可以将包含恰当内容的字节数组转换成一副图像
'用倒了COM组件的 IPicture接口，支持JPG\BMP\GIF的格式的流
'如果自己去解析JPG格式，那将是一件很复杂的事情，但是操作
'系统已经有了相关函数帮我们去解析他。所以调用吧
Public Function ArrayToPicture(Data() As Byte) As IPicture
On Error Resume Next
Dim MemoryHandle As Long
Dim LockMemory As Long
Dim GUID(0 To 3) As Long
Dim Size As Long
Dim IIStream As IUnknown
GUID(0) = &H7BF80980
GUID(1) = &H101ABF32
GUID(2) = &HAA00BB8B
GUID(3) = &HAB0C3000
Size = UBound(Data) - LBound(Data) + 1
MemoryHandle = GlobalAlloc(&H2, Size) '从堆中分配指定数量字节的一整块，这时系统无法提供零零碎碎的局部或全局的堆
If MemoryHandle <> 0 Then 'MemoryHandle <> 0 说明我们创建成功了
LockMemory = GlobalLock(MemoryHandle) '锁定全局内存对象并返回它的首地址，LockMemory就是首地址
If LockMemory <> 0 Then 'LockMemory <> 0标识锁定成功
CopyMemory ByVal LockMemory, Data(0), Size '把我们的数据拷贝倒这个堆中
Call GlobalUnlock(MemoryHandle) 'GlobalUnlock函数把以GMEM_MOVEABLE方式分配的内存对象的锁定计数器减1
If CreateStreamOnHGlobal(MemoryHandle, 1, IIStream) = 0 Then '从全局内存中创建stream对象，第二个参数为1表示当stream释放时自动释放全局内存
'创建一个新的picture对象并用stream对象中的内容初始化,OleLoadPicture是COM中的函数
Call OleLoadPicture(ByVal ObjPtr(IIStream), 0, 0, GUID(0), ArrayToPicture)
End If
End If
End If
End Function
Public Function SaveImageToFileFromArray(Data() As Byte, FilePath As String) As Boolean
On Error GoTo ErrorHandler
Dim MemoryHandle As Long
Dim LockMemory As Long
Dim Size As Long
Dim IIStream As IUnknown
Dim Image As Long
Dim FileNum As Integer
' 1. 计算字节数组大小
Size = UBound(Data) - LBound(Data) + 1
' 2. 分配全局内存并复制字节数组
MemoryHandle = GlobalAlloc(&H2, Size)
If MemoryHandle = 0 Then Exit Function ' 分配失败
LockMemory = GlobalLock(MemoryHandle)
If LockMemory = 0 Then
GlobalFree MemoryHandle
Exit Function ' 锁定失败
End If
CopyMemory ByVal LockMemory, Data(0), Size
GlobalUnlock MemoryHandle
' 3. 从全局内存创建流对象
If CreateStreamOnHGlobal(MemoryHandle, 1, IIStream) <> 0 Then
GlobalFree MemoryHandle
Exit Function ' 创建流失败
End If
' 4. 加载图像数据
If GdipLoadImageFromStream(IIStream, Image) <> 0 Then
GlobalFree MemoryHandle
Exit Function ' 加载图像失败
End If
' 5. 将图像保存为文件
FileNum = FreeFile
Open FilePath For Binary As #FileNum
Put #FileNum, , Data
Close #FileNum
' 6. 释放资源
GdipDisposeImage Image
GlobalFree MemoryHandle
SaveImageToFileFromArray = True
Exit Function
ErrorHandler:
If Image Then GdipDisposeImage Image
If MemoryHandle Then GlobalFree MemoryHandle
SaveImageToFileFromArray = False
End Function
' 将文件读取为字节数组
Public Function FileToByteArray(ByVal FilePath As String) As Byte()
Dim FileNum As Integer
Dim FileSize As Long
Dim ByteArray() As Byte
' 打开文件
FileNum = FreeFile
Open FilePath For Binary Access Read As #FileNum
' 获取文件大小
FileSize = LOF(FileNum)
' 分配字节数组
ReDim ByteArray(0 To FileSize - 1)
' 读取文件内容到字节数组
Get #FileNum, , ByteArray
' 关闭文件
Close #FileNum
' 返回字节数组
FileToByteArray = ByteArray
End Function
' 初始化 GDI+
Public Sub InitGDIPlus()
Dim StartupInput As GdiplusStartupInput
StartupInput.GdiplusVersion = 1
GdiplusStartup g_GdiplusToken, StartupInput
End Sub
' 释放 GDI+
Public Sub ShutdownGDIPlus()
If g_GdiplusToken <> 0 Then
GdiplusShutdown g_GdiplusToken
End If
End Sub
' 将字节数组转换为 StdPicture 对象
Public Function ArrayToPicture2(Data() As Byte) As IPicture
On Error GoTo ErrorHandler
Dim hGlobal As Long
Dim pStream As IUnknown
Dim hGdiPlusImage As Long
Dim hBitmap As Long
Dim Pic As PICTDESC
Dim IID_IPicture As GUID ' 使用GUID结构类型
Dim IPic As IPicture
' 初始化 GDI+
If g_GdiplusToken = 0 Then InitGDIPlus
' 分配全局内存并写入字节数组
Dim MemPtr As Long
Dim Size As Long
Size = UBound(Data) - LBound(Data) + 1
hGlobal = GlobalAlloc(GMEM_MOVEABLE, Size)
If hGlobal = 0 Then Exit Function
MemPtr = GlobalLock(hGlobal)
If MemPtr = 0 Then
GlobalFree hGlobal
Exit Function
End If
CopyMemory ByVal MemPtr, Data(LBound(Data)), Size
GlobalUnlock hGlobal
' 创建 IStream 对象
If CreateStreamOnHGlobal(hGlobal, 1, pStream) <> 0 Then
GlobalFree hGlobal
Exit Function
End If
' 使用 GDI+ 从 IStream 加载图片
If GdipLoadImageFromStream(pStream, hGdiPlusImage) <> 0 Then
Set pStream = Nothing
GlobalFree hGlobal
Exit Function
End If
' 将 GDI+ 图像转换为 HBITMAP
If GdipCreateHBITMAPFromBitmap(hGdiPlusImage, hBitmap, &HFFFFFF) <> 0 Then
GdipDisposeImage hGdiPlusImage
Set pStream = Nothing
GlobalFree hGlobal
Exit Function
End If
' 填充 PICTDESC 结构
With Pic
.Size = Len(Pic)
.Type = PICTYPE_BITMAP
.hBitmap = hBitmap
.hPalette = 0
End With
' 填充 GUID 结构 (正确的IPicture GUID)
With IID_IPicture
.Data1 = &H7BF80980
.Data2 = &H101A
.Data3 = &HBF32
.Data4(0) = &HAA
.Data4(1) = &H0
.Data4(2) = &HBB
.Data4(3) = &H8B
.Data4(4) = &HAB
.Data4(5) = &HC
.Data4(6) = &H30
.Data4(7) = &HC
End With
' 创建 StdPicture 对象
If OleCreatePictureIndirect(Pic, IID_IPicture, 1, IPic) = 0 Then
Set ArrayToPicture2 = IPic
Else
' 清理资源
DeleteObject hBitmap
GdipDisposeImage hGdiPlusImage
Set pStream = Nothing
GlobalFree hGlobal
Exit Function
End If
' 清理资源
GdipDisposeImage hGdiPlusImage
Set pStream = Nothing
GlobalFree hGlobal
Exit Function
ErrorHandler:
' 错误处理
If hBitmap Then DeleteObject hBitmap
If hGdiPlusImage Then GdipDisposeImage hGdiPlusImage
If Not pStream Is Nothing Then Set pStream = Nothing
If hGlobal Then GlobalFree hGlobal
Set ArrayToPicture2 = Nothing
End Function
我通过 Dim ImageData() As Byte
Dim PictureObj As IPicture
' 将图片文件转换为字节数组
ImageData = Gdip.FileToByteArray("D:\1.png")
' 调用 ArrayToPicture 函数将字节数组转换为 IPicture 对象
Set PictureObj = Gdip.ArrayToPicture2(ImageData)
' 检查是否成功加载图像
If PictureObj Is Nothing Then
MsgBox "无法加载图片，请检查文件路径和格式是否正确。", vbExclamation, "错误"
Else
' 将图片赋值给 PictureBox 控件
Set PicSrc.Picture = PictureObj
End If
调用，发现ArrayToPicture2（）函数里OleCreatePictureIndirect(Pic, IID_IPicture, 1, IPic)并不能正确返回0，都是返回负数，所以达不到效果，请解决。
最新发布
本文介绍了一种在Windows环境下使用C++实现的图片加载与显示的方法。具体步骤包括从磁盘读取图片文件到内存，利用COM组件将内存中的图片数据转换为可绘制的对象，并在指定的设备上下文中渲染图片。
扫一扫
3347
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
