24位的BMP图像的内容保存为字节数组后,如何显示在其他Picture控件中?我用 SetBitmapBits 显示出来的图像变形了。

xuyang0109 2007-04-16 11:08:26
我的方法如下:
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private gblByteAry() As Byte '图像文件的内容字节数组

Private Sub Form_Load()
ReDim gblPicBits(FileLen(App.Path & "\test.bmp") - 1)
Open App.Path & "\test.bmp" For Binary As #1
Get #1, 1, gblByteAry
Close #1
End Sub

Private Sub Command1_Click()
SetBitmapBits Picture1.Image, UBound(gblByteAry), gblByteAry(0)
End Sub

可是显示出来的图像发生了变形。我测试的图像是24位的BMP,宽和高都是8个像素。

这样做的目的是,我把所有程序需要的图像文件保存在一个我自己定义的二进制文件中,程序中需要图像时,不是用LoadPicture函数,而是从自定义的文件中读取文件内容的字节数组,再显示在Picture控件中。
我可以对图像的内容随意加密,一般人除了截屏,很难用得上我的图像。

找了一天,研究了SetBitmapBits、SetDIBits、OleLoadPicture,还有一个什么什么Device。没有找到好用的代码。
不需要原理,请给出代码。谢谢!
...全文
732 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
rainstormmaster 2007-04-17
  • 打赏
  • 举报
回复
看http://topic.csdn.net/t/20040319/16/2862487.html里我的回复,其中olelib.tlb的下载地址现在已经失效 ,可以尝试从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载
homezj 2007-04-17
  • 打赏
  • 举报
回复
我只知道原理,没有代码^_^

位图分为DIB与DDB两种,存成文件的都是DIB,因为文件传播必须做到设备无关性。SetBitmapBits是用于设置DDB位图数据的,与显示设备当前的位图格式有关,现在显卡几乎没有24位格式的了,不是16位就是32位,你将DIB数据强行放入DDB,会出问题的。不仅色深格式不对,而且扫描线还是相反的。

以上只是其一,位图文件还会有一个文件头部,而内存DIB是没有文件头部的,二者不能直接Set。

你的设想是可行的,将位图文件合并在一起,需要时用Byte数组加载,然后用OleLoadPicture转成Picture对象,是完全能做到的。至于放弃Bmp头部,直接存DIB数据,用时先CreateDIBSection,再SetDIBits,估计也是可行了,但我没试过,只是猜测。
laviewpbt 2007-04-17
  • 打赏
  • 举报
回复
看错了,原来是一维的。
laviewpbt 2007-04-17
  • 打赏
  • 举报
回复
praFileByteAry 是几维的数组啊?是二维的吗?那岂不是是灰度图像或256色索引图像,怎么会是彩色的图像呢?
xuyang0109 2007-04-17
  • 打赏
  • 举报
回复
谢谢各位的回复!

最终我采用 OleLoadPicture 的办法了。唯一担心的就是那个Picture的GUID{7BF80980-BF32-101A-8BBB-00AA00300CAB}。会不会有的电脑的注册表里面没有这个GUID呢?哪位知道?
与使用第三方的olelib.tlb相比,使用 OleLoadPicture 也许更可靠一些。

我的代码如下,希望对不会的人有帮助:
********************************************************

'声明 读取BMP 开始
'从字节数组中创建 IPicture 对象 开始
'只能用Global内存,不能直接使用VB的Byte数组
Private Enum CBoolean ' enum members are Long data types
CFalse = 0
CTrue = 1
End Enum

Private Type GUID '16 bytes (128 bits)
dwData1 As Long '4 bytes
wData2 As Integer '2 bytes
wData3 As Integer '2 bytes
abData4(7) As Byte '8 bytes, zero based
End Type

Private Const S_OK = 0 ' indicates successful HRESULT
Private Const GMEM_MOVEABLE = &H2
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

'创建流数据
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long

'可将内存中的流数据转为Picture对象,Picture的GUID为{7BF80980-BF32-101A-8BBB-00AA00300CAB}。
'从信息流里加载图像,并创建一个能够用来显示图像的新的IPicture对象
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 CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) 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
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
'从字节数组中创建 IPicture 对象 结束

'得到BMP图像信息 开始
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'得到BMP图像信息 结束
'声明 读取BMP 结束


'函数,从字节数组中创建BMP IPicture 对象 not StdPicture!!
'用法:
' Dim mySizeAry() As Integer 'BMP图像的宽和高组成的数组
' Picture1.Picture = funPictureFromFileByteAry(praFileByteAry:=gblFileByteAry, _
' praSizeAry:=mySizeAry)
' Picture1.Refresh
'参数:
' praFileByteAry BMP图象文件的字节数组
' praSizeAry 可选参数,BMP图像的宽和高组成的数组
Private Function funPictureFromFileByteAry(ByRef praFileByteAry() As Byte, _
Optional ByRef praSizeAry As Variant) As IPicture
Dim nLow As Long
Dim cbMem As Long
Dim hMem As Long
Dim lpMem As Long
Dim IID_IPicture As GUID
Dim istm As stdole.IUnknown 'IStream

' Get the size of the picture's bits
nLow = LBound(praFileByteAry)
cbMem = (UBound(praFileByteAry) - nLow) + 1

' Allocate a global memory object
hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
If hMem Then
' Lock the memory object and get a pointer to it.
lpMem = GlobalLock(hMem)
If lpMem Then
' Copy the picture bits to the memory pointer and unlock the handle.
MoveMemory ByVal lpMem, praFileByteAry(nLow), cbMem
Call GlobalUnlock(hMem)
' Create an ISteam from the pictures bits (we can explicitly free hMem
' below, but we'll have the call do it...)
If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
' Create an IPicture from the IStream (the docs say the call does not
' AddRef its last param, but it looks like the reference counts are correct..)
Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, funPictureFromFileByteAry)

'得到图像信息 开始
If Not IsMissing(praSizeAry) = True Then
Dim myBitmapInfo As BITMAP
GetObjectAPI funPictureFromFileByteAry.handle, Len(myBitmapInfo), myBitmapInfo

ReDim praSizeAry(1) As Integer
praSizeAry(0) = myBitmapInfo.bmWidth
praSizeAry(1) = myBitmapInfo.bmHeight
End If
'得到图像信息 结束

End If ' CLSIDFromString
End If ' CreateStreamOnHGlobal
End If ' lpMem
Call GlobalFree(hMem)
End If ' hMem
End Function

********************************************************

至于数据的冗余部分,我不但心。
因为我把BMP、JPG等图像读入字节数组,自定义一个结构,按照一定的规律保存这些字节数组,使用的时候将图像内容的字节数组从结构体中完全复制出来(另存的话,就是一个完整的BMP图像了),它愿意有几个Bmp头部就有几个Bmp头部,愿意有多少冗余部分就有冗余部分。

再请教一下,OleLoadPicture 中的那个Picture的GUID{7BF80980-BF32-101A-8BBB-00AA00300CAB},每个XP的电脑中都有吗?
laviewpbt 2007-04-17
  • 打赏
  • 举报
回复
位图文件会有一个文件信息头部,你这样读取的数据有冗余部分!
xuyang0109 2007-04-16
  • 打赏
  • 举报
回复
查了。没有找到可用的。
能麻烦给个连接吗?
rainstormmaster 2007-04-16
  • 打赏
  • 举报
回复
搜索一下以前的帖子吧,回答过n次了

1,488

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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