PropertyBag 的问题,谢谢
这是段客户端接收winsock传过来的图片直接在picture中显示的代码:
Dim bytData() As Byte '接收图片 Dim PBag As New PropertyBag '图片信息 ReDim bytData(1 To Winsock1.BytesReceived) '接收图片大小 Winsock1.GetData bytData '读取缓冲区数据 PBag.Contents = bytData Set Picture1.Picture = PBag.ReadProperty("Picture") '设置图片 cmdReceive.Enabled = False
Option Explicit'常量声明Private Const ClsidJPEG As String = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"Private Const EncoderParameterValueTypeLong As Long = 4&Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"Private Const GdiPlusVersion As Long = 1&'结构声明Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As ByteEnd TypePrivate Type IID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As ByteEnd TypePrivate Type PICTDESC cbSizeOfStruct As Long picType As Long hgdiObj As Long hPalOrXYExt As LongEnd TypePrivate Type EncoderParameter GUID As GUID NumberOfValues As Long Type As Long Value As LongEnd TypePrivate Type EncoderParameters Count As Long Parameter(15) As EncoderParameterEnd TypePrivate Type GDIPlusStartupInput GdiPlusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As LongEnd TypePrivate Type GdiplusStartupOutput NotificationHook As Long NotificationUnhook As LongEnd Type'枚举声明Private Enum Status OK = 0 GenericError = 1 InvalidParameter = 2 OutOfMemory = 3 ObjectBusy = 4 InsufficientBuffer = 5 NotImplemented = 6 Win32Error = 7 WrongState = 8 Aborted = 9 FileNotFound = 10 ValueOverflow = 11 AccessDenied = 12 UnknownImageFormat = 13 FontFamilyNotFound = 14 FontStyleNotFound = 15 NotTrueTypeFont = 16 UnsupportedGdiplusVersion = 17 GdiplusNotInitialized = 18 PropertyNotFound = 19 PropertyNotSupported = 20 ProfileNotFound = 21End Enum'API声明Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, ByRef bitmap As Long) As StatusPrivate Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" (ByVal bitmap As Long, ByRef hbmReturn As Long, ByVal Background As Long) As StatusPrivate Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As StatusPrivate Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, ByRef image As Long) As StatusPrivate Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As StatusPrivate Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, ByRef lpOutput As GdiplusStartupOutput) As StatusPrivate Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal Stream As IStream, ByRef clsidEncoder As GUID, ByRef encoderParams As Any) As StatusPrivate Declare Function CLSIDFromString Lib "ole32" (ByVal Str As Long, ByRef id As GUID) As LongPrivate Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any) As LongPrivate Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef lpPictDesc As PICTDESC, ByRef riid As IID, ByVal fOwn As Boolean, ByRef lplpvObj As Object)'根据版本初始化GDI+Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Long Dim GdipToken As Long Dim GdipStartupInput As GDIPlusStartupInput Dim GdipStartupOutput As GdiplusStartupOutput GdipStartupInput.GdiPlusVersion = GdipVersion If GdiplusStartup(GdipToken, GdipStartupInput, GdipStartupOutput) = OK Then StartUpGDIPlus = GdipToken End IfEnd Function'从图像转换为流Public Function PictureToStream(ByVal Picture As StdPicture, Optional ByVal JpegQuality As Long = 85) As IStream Dim picStream As IStream Dim lBitmap As Long Dim tGUID As GUID Dim bytBuff() As Byte Dim tParams As EncoderParameters Dim lngGdipToken As Long lngGdipToken = StartUpGDIPlus(GdiPlusVersion) '检查JPG压缩比率 If JpegQuality > 100 Then JpegQuality = 100 If JpegQuality < 0 Then JpegQuality = 0 '创建Bitmap If GdipCreateBitmapFromHBITMAP(Picture.Handle, 0, lBitmap) = OK Then '创建Stream If CreateStreamOnHGlobal(ByVal 0, False, picStream) = 0 Then '转换GUID If CLSIDFromString(StrPtr(ClsidJPEG), tGUID) = 0 Then '设置JPG相关参数值 tParams.Count = 1 With tParams.Parameter(0) CLSIDFromString StrPtr(EncoderQuality), .GUID .NumberOfValues = 1 .Type = EncoderParameterValueTypeLong .Value = VarPtr(JpegQuality) End With '将Bitmap数据保存到流(JPG格式) If GdipSaveImageToStream(lBitmap, picStream, tGUID, tParams) = OK Then Set PictureToStream = picStream End If End If Set picStream = Nothing End If End If GdipDisposeImage lBitmap GdiplusShutdown lngGdipTokenEnd Function'从流转换为图像Public Function StreamToPicture(ByVal Stream As IStream) As StdPicture Dim picStream As IStream Dim lBitmap As Long Dim hBitmap As Long Dim lngGdipToken As Long Dim tPictDesc As PICTDESC Dim IID_IPicture As IID Dim oPicture As IPicture lngGdipToken = StartUpGDIPlus(GdiPlusVersion) Set picStream = Stream '从Stream加载Bitmap If GdipLoadImageFromStream(picStream, lBitmap) = OK Then '根据Bitmap创建hBitbmp If GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0) = OK Then With tPictDesc .cbSizeOfStruct = Len(tPictDesc) .picType = vbPicTypeBitmap .hgdiObj = hBitmap .hPalOrXYExt = 0 End With ' 初始化IPicture With IID_IPicture .Data1 = &H7BF80981 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(3) = &HAA .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With Call OleCreatePictureIndirect(tPictDesc, IID_IPicture, True, oPicture) Set StreamToPicture = oPicture End If End If Set picStream = Nothing GdipDisposeImage lBitmap GdiplusShutdown lngGdipTokenEnd Function
[解决办法]
通过网络传输时数据被自动分包了,一个 PropertyBag.Contents 会有多次 DataArrival 事件触发,你仅仅将第1个包的字节数组赋值给 PropertyBag.Contents 当然会出错了。
需要自己作一下缓存:
a)发送端首先发送一个 Long 值表示字节数组的长度,然后再发送字节数组。
b)接受端
1)先接收到总长的 Long 值,然后定义一个总长的模块级缓存数组,
2)以后每次收到的数据都复制到缓存数组中
3)一直到缓存数组被填满,才用 PropertyBag 转换成图片进行显示。