GDI+ IStream、StdPicture、Byte() 互转~~~散分~~~

tzwsoho 2010-01-17 02:37:24
加精
很多年前就想做一个远程控制的软件，只是一直以来图片的压缩速度总是提升不上去，而我也参考过很多网上的关于图片压缩的例子，比如zyl910的GIF_LZW压缩方法，Huffman压缩方法，以至到GDI+的直接生成JPG、PNG的方法（这种方法无论从压缩率和速度上都是最佳的，可惜这种方法网上一直没找到直接保存为Byte()的例子，见得最多的例子就是用GdipSaveImageToFile保存到磁盘，然后再读取发送了，但是我做的可是远程控制软件，每秒不知道要写多少M的数据进磁盘！），近来在偶然机会重新拾起了完成这个程序的念头，而且很巧的是搜索到了Modest的《VB6结合GDI+实现内存(Stream)压缩/解压缩JPG(JPEG)图像》，这篇文章给了我很大的启发，在此感谢Modest！！！

Modest的代码已经实现了StdPicture和IStream的互转，我另外使用了GlobalAlloc、GlobalLock、GlobalUnlock、GlobalFree等函数创建一个缓冲区（指针为hGlobal），将Modest代码中CreateStreamOnHGlobal(ByVal 0&, False, picStream)改成CreateStreamOnHGlobal(ByVal hGlobal, False, picStream)，这样我便可根据hGlobal来读写picStream的内容了，具体代码如下：
'By TZWSOHO   

'从图像转换为流再转为字节数组   

Public Function PictureToByteArray(ByVal Picture As StdPicture, Optional ByVal JpegQuality As Long = 85) As Byte()   

    Dim picStream As IStream   

    Dim lBitmap As Long  

    Dim tGUID As GUID   

    Dim bytBuff() As Byte  

    Dim tParams As EncoderParameters   

    Dim lngGdipToken As Long  

       

    Dim hGlobal As Long, lpBuffer As Long, dwSize As Long, Buff() As Byte  

       

    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  

        hGlobal = GlobalAlloc(GMEM_MOVEABLE, Picture.Width * Picture.Height \ 256) '创建缓冲区   

        '创建Stream   

        If CreateStreamOnHGlobal(ByVal hGlobal, 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  

                    'GetHGlobalFromStream picStream, hGlobal   

                       

                    picStream.Seek 0, STREAM_SEEK_CUR, dwSize '获取图像大小   

                    lpBuffer = GlobalLock(hGlobal) '获取缓冲区读写指针   

                    ReDim Buff(dwSize - 1): CopyMemory Buff(0), ByVal lpBuffer, dwSize '读取图像   

                    GlobalUnlock hGlobal: GlobalFree hGlobal '释放分配的缓冲区空间   

                    PictureToByteArray = Buff   

                End If  

            End If  

            Set picStream = Nothing  

        End If  

    End If  

    GdipDisposeImage lBitmap   

    GdiplusShutdown lngGdipToken   

End Function

若要把Byte()转化为StdPicture，我的方法是先用CreateStreamOnHGlobal把Byte()转化为IStream，然后再调用Modest代码里面的StreamToPicture函数最终转化为StdPicture，具体代码如下：
'By TZWSOHO   

'从字节数组转换为流再转换为图像   

Public Function ByteArrayToPicture(sBuf() As Byte) 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   

    Dim hGlobal As Long, lpBuffer As Long  

       

    lngGdipToken = StartUpGDIPlus(GdiPlusVersion)   

       

    hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(sBuf) + 1) '创建缓冲区   

    lpBuffer = GlobalLock(hGlobal) '获取缓冲区读写指针   

    CopyMemory ByVal lpBuffer, sBuf(0), UBound(sBuf) + 1 '复制字节数组内容到缓冲区   

    '创建Stream   

    If CreateStreamOnHGlobal(ByVal hGlobal, False, picStream) = 0 Then  

        '从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 ByteArrayToPicture = StreamToPicture(picStream)   

            End If  

        End If  

        GlobalUnlock hGlobal: GlobalFree hGlobal '释放分配的缓冲区空间   

        Set picStream = Nothing  

    End If  

    GdipDisposeImage lBitmap   

    GdiplusShutdown lngGdipToken   

End Function

完整的模块代码太长了。。。请到我空间看。。。
如果要测试，可以把以上代码保存成一个模块，然后创建一个新的窗体，放置一个Picture1（加载一张图片）、一个Picture2（留空白）、一个Command1，粘贴以下代码：
Option Explicit



'*********************************************************************************

'StdPicture、IStream、Byte() 互转

'作者：TZWSOHO

'

'参考了魏滔序的《VB6 结合 GDI+ 实现内存（Stream）压缩/解压缩 JPG 图像》

'http://blog.csdn.net/Modest/archive/2009/08/31/4505237.aspx

'非常感谢魏滔序的代码！！！

'

'欢迎访问我的博客：http://blog.csdn.net/tzwsoho

'*********************************************************************************



'示例

Private Sub Command1_Click()

    

    'By Modest

    'Dim s As IStream

    'Set s = PictureToStream(Picture1.Picture, 5)

    'Set Picture2.Picture = StreamToPicture(s)

    

    'By TZWSOHO

    Dim Buf() As Byte

    Buf = PictureToByteArray(Picture1.Picture, 5)

    Set Picture2.Picture = ByteArrayToPicture(Buf)

End Sub
...全文
1691 48 打赏 收藏 转发到动态 举报
写回复
用AI写文章
48 条回复
切换为时间正序
请发表友善的回复…
发表回复
shiguangxin 2010-12-17
  • 打赏
  • 举报
 回复
我看是差在 GMEM_MOVEABLE


shiguangxin 2010-12-17
  • 打赏
  • 举报
 回复
纯数组实现版
ReDim Buff(Picture.Width * Picture.Height \ 256) '创建缓冲区

......

ReDim Preserve Buff(dwSize - 1)

我试了 不好用

使用 GlobalAlloc 创建的缓冲区 好用
tzwsoho 2010-01-22
  • 打赏
  • 举报
 回复
根据41# lyserver的意见，发一个纯数组实现版。。。。
'By TZWSOHO

'从图像转换为流再转为字节数组

Public Function PictureToByteArray(ByVal Picture As StdPicture, Optional ByVal JpegQuality As Long = 85) As Byte()

    Dim picStream As IStream

    Dim lBitmap As Long

    Dim tGUID As GUID

    Dim tParams As EncoderParameters

    Dim lngGdipToken As Long

    

    Dim hGlobal As Long, lpBuffer As Long, dwSize As Long, Buff() As Byte

    

    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

        ReDim Buff(Picture.Width * Picture.Height \ 256)  '创建缓冲区

        '创建Stream

        If CreateStreamOnHGlobal(Buff(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

                    picStream.Seek 0, STREAM_SEEK_CUR, dwSize '获取图像大小

                    ReDim Preserve Buff(dwSize - 1)

                    PictureToByteArray = Buff

                End If

            End If

            Set picStream = Nothing

        End If

    End If

    GdipDisposeImage lBitmap

    GdiplusShutdown lngGdipToken

End Function



'By TZWSOHO

'从字节数组转换为流再转换为图像

Public Function ByteArrayToPicture(sBuf() As Byte) As StdPicture

    Dim picStream As IStream

    Dim hGlobal As Long, lpBuffer As Long

    

    '创建Stream

    If CreateStreamOnHGlobal(sBuf(0), False, picStream) = 0 Then

        Set ByteArrayToPicture = StreamToPicture(picStream)

        Set picStream = Nothing

    End If

End Function
tzwsoho 2010-01-21
  • 打赏
  • 举报
 回复
[Quote=引用 41 楼 lyserver 的回复:]
如果为了代码的可读性，可以不使用GlobalAlloc函数申请内存，而是直接使用VB的数组就可以了，另外，单纯从图像方面来说，使用IPicture不是一个好选择，可以使用GDI+从流转换为IMAGE，这样支持的格式更多。
至于远程控件，则不用考虑上面的说法，而是侧重于性能，可以从两个方面入手，一是使用256色代替24位或32位真彩色，二是采取图像缩放，三是采取区域比较和更新。
具体而言，如果屏幕设置为1024*768和32位真彩色，那么其位图数据量为1024*768*4，等于3M多，如果压缩32位真彩取为256色，则数据量为1024*768，等于768K，如果再对256色位图进行缩小，假设缩小为300*400，则数据量为300*400，等于117K，这时基本上能满足局域网内即时传输了，如果机器性能可以，还可以对图像数据进行压缩（比如行程、ZIP、GIF等），此外，还可以视情况决定是否采取区域比较和更新（如果远程主机在看电影，则这种方式不可取），基本上，最终数据量可以为20-50K，那么，这个结果在广域网上传输也是可以的。
[/Quote]

很详细。。。非常感谢~~~~~
IThurricane 2010-01-21
  • 打赏
  • 举报
 回复
学习一下
lsvine 2010-01-20
  • 打赏
  • 举报
 回复
mark 收藏
guyehanxinlei 2010-01-20
  • 打赏
  • 举报
 回复
支持!
yuanhuiqiao 2010-01-20
  • 打赏
  • 举报
 回复
接分
lyserver 2010-01-20
  • 打赏
  • 举报
 回复
如果为了代码的可读性，可以不使用GlobalAlloc函数申请内存，而是直接使用VB的数组就可以了，另外，单纯从图像方面来说，使用IPicture不是一个好选择，可以使用GDI+从流转换为IMAGE，这样支持的格式更多。
至于远程控件，则不用考虑上面的说法，而是侧重于性能，可以从两个方面入手，一是使用256色代替24位或32位真彩色，二是采取图像缩放，三是采取区域比较和更新。
具体而言，如果屏幕设置为1024*768和32位真彩色，那么其位图数据量为1024*768*4，等于3M多，如果压缩32位真彩取为256色，则数据量为1024*768，等于768K，如果再对256色位图进行缩小，假设缩小为300*400，则数据量为300*400，等于117K，这时基本上能满足局域网内即时传输了，如果机器性能可以，还可以对图像数据进行压缩（比如行程、ZIP、GIF等），此外，还可以视情况决定是否采取区域比较和更新（如果远程主机在看电影，则这种方式不可取），基本上，最终数据量可以为20-50K，那么，这个结果在广域网上传输也是可以的。
IThurricane 2010-01-19
  • 打赏
  • 举报
 回复
学习了
年华似鸿水 2010-01-19
  • 打赏
  • 举报
 回复
好，支持！
x2304 2010-01-18
  • 打赏
  • 举报
 回复
最后，你实现的方法用汉文说一下呗。


就是改成流（stream）了，就快了？
liguicd 2010-01-18
  • 打赏
  • 举报
 回复
哇！果然是高质量的帖子啊！高手云集！学习innnnnnnng
tzwsoho 2010-01-18
  • 打赏
  • 举报
 回复
[Quote=引用 33 楼 x2304 的回复:]
引用 20 楼 tzwsoho 的回复:
引用 14 楼 laviewpbt 的回复:
远程控制用JPG流在广域网上基本不太可能具有很大的实用性，除非双方的机器配置一流网络速度也一流。

是不管你用什么库也好，JPG压缩和解压终究是个耗时的工作。


没错啊。。。。全屏图像压缩始终是个治标不治本的方法。。。如果可以的话最好能找出屏幕改变的地方，然后对这些改变的地方进行压缩再处理。。。相当于在线将屏幕录像成视频数据流传输。。。。只是目前还比较菜，这个方法也只能从YY中实现了。。。适量YY有益健康哈。。。。


我等是菜鸟，看你们贴的代码大段大段的，感觉云里雾里的，

最好是：大虾们把想法用汉文说一下，我等菜鸟学习其主旨方法，忽略具体实现细节，这样对初学者帮助更大！

OK？
[/Quote]

这个。。。。学习API的话。。。。只能靠经验了。。。还有。。。经常逛MSDN。。。。
好了。。。结贴了。。。。
monster 2010-01-18
  • 打赏
  • 举报
 回复
学习了，不错。。。。
x2304 2010-01-18
  • 打赏
  • 举报
 回复
[Quote=引用 20 楼 tzwsoho 的回复:]
引用 14 楼 laviewpbt 的回复:
远程控制用JPG流在广域网上基本不太可能具有很大的实用性，除非双方的机器配置一流网络速度也一流。

是不管你用什么库也好，JPG压缩和解压终究是个耗时的工作。


没错啊。。。。全屏图像压缩始终是个治标不治本的方法。。。如果可以的话最好能找出屏幕改变的地方，然后对这些改变的地方进行压缩再处理。。。相当于在线将屏幕录像成视频数据流传输。。。。只是目前还比较菜，这个方法也只能从YY中实现了。。。适量YY有益健康哈。。。。
[/Quote]

我等是菜鸟，看你们贴的代码大段大段的，感觉云里雾里的，

最好是：大虾们把想法用汉文说一下，我等菜鸟学习其主旨方法，忽略具体实现细节，这样对初学者帮助更大！

OK？
chenhui530 2010-01-18
  • 打赏
  • 举报
 回复
我记得以前有一份vb的远程桌面连接代码，可惜速度不太理想
如果是捕获全屏发送的话，速度和占用资源肯定是不行，还是
得直接发送修改了的地方这样才是比较好的一种方法。
vbman2003 2010-01-18
  • 打赏
  • 举报
 回复
不懂图像处理的路过顶下...
xc_aspnet 2010-01-18
  • 打赏
  • 举报
 回复
ding
IThurricane 2010-01-18
  • 打赏
  • 举报
 回复
学习了
加载更多回复（28）
IStream.zip IStream.tlb
[VB]GDI+ IStream StdPicture Byte 互转 原网页已经删除了 所以在这里提供了
VC GDI+ 窗口截图内存BMP转JPG,压缩、JPG再转IStream流，IStream流再转 BYTE
VC GDI+ 窗口截图内存BMP转JPG,压缩、JPG再转IStream流，IStream流再转 BYTE 上体见 http://blog.csdn.net/q610098308/article/details/78181933
VB6 gdi+图形处理封装mGdip.bas
GDI+内存创建bitmap，并将其保存为各种图像。以及将其与byte()、IStream、StdPicture、Bitmap的转换
[VB]GDI+ IStream、StdPicture、Byte() 互转
很多年前就想做一个远程控制的软件，只是一直以来图片的压缩速度总是提升不上去，而我也参考过很多网上的关于图片压缩的例子，比如zyl910的GIF_LZW压缩方法，Huffman压缩方法，以至到GDI+的直接生成JPG、PNG的方法...
GDI+ 在Delphi、C++Builder程序的应用 -- IStream
GDI+的Image及派生类中涉及到IStream流，在Delphi和C++Builder中广泛使用的TStream不能直接作为参数进行传递，VCL提供了一个TStreamAdapter类，用于把VCL流TStream转换为IStream。TStreamAdapter的构造过程原型如下...
多媒体

809

社区成员

8,275

社区内容

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章