我的方法如下:
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 SubPrivate Sub Command1_Click()
SetBitmapBits Picture1.Image, UBound(gblByteAry), gblByteAry(0)
End Sub可是显示出来的图像发生了变形。我测试的图像是24位的BMP,宽和高都是8个像素。这样做的目的是,我把所有程序需要的图像文件保存在一个我自己定义的二进制文件中,程序中需要图像时,不是用LoadPicture函数,而是从自定义的文件中读取文件内容的字节数组,再显示在Picture控件中。
我可以对图像的内容随意加密,一般人除了截屏,很难用得上我的图像。找了一天,研究了SetBitmapBits、SetDIBits、OleLoadPicture,还有一个什么什么Device。没有找到好用的代码。
不需要原理,请给出代码。谢谢!
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 SubPrivate Sub Command1_Click()
SetBitmapBits Picture1.Image, UBound(gblByteAry), gblByteAry(0)
End Sub可是显示出来的图像发生了变形。我测试的图像是24位的BMP,宽和高都是8个像素。这样做的目的是,我把所有程序需要的图像文件保存在一个我自己定义的二进制文件中,程序中需要图像时,不是用LoadPicture函数,而是从自定义的文件中读取文件内容的字节数组,再显示在Picture控件中。
我可以对图像的内容随意加密,一般人除了截屏,很难用得上我的图像。找了一天,研究了SetBitmapBits、SetDIBits、OleLoadPicture,还有一个什么什么Device。没有找到好用的代码。
不需要原理,请给出代码。谢谢!
与使用第三方的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的电脑中都有吗?