如何从内存中获取图片
2006-03-07 09:45
288 查看
"SetBitmapBits:
vb声明: Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
作用: "将来自缓冲区的二进制位复制到一幅位图"
参数: hBitmap Long,位图的句柄
dwCount Long,欲复制的字节数量
lpBits Any,指向一个缓冲区的指针。这个缓冲区包含了为位图正确格式化的位图位
GetBitmapBits:
vb声明: Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
作用: "将来自位图的二进制位复制到一个缓冲区"
参数: hBitmap Long,位图的句柄
dwCount Long,欲复制的字节数。如设为零,表示取得位图中的字节数
lpBits Any,指向容纳位图位的一个缓冲区的指针。注意事先将缓冲区至少初始化成dwCount个字节 "
举一个例子,将图片旋转90度,下面是我写的顺时针旋转90度的函数.
假设目标图像的宽等于源图的长,目标图像的长等于源图的宽,两图颜色值占用的位数相等.
参数: hSrcBmp,源图位图的句柄,vb中对应的是Picture.Handle
hDestBmp,目标位图的句柄
其中用到的GetObject,CopyMemory函数与BITMAP类型,声明如下
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
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
'顺时针旋转90度的函数:
Public Function TurnBmp(hSrcBmp As Long, hDestBmp As Long) As Boolean
Dim X As Long, Y As Long
Dim BytesPixel As Long
Dim tSBmpInfo As BITMAP, tDBmpInfo As BITMAP
Dim sBits() As Byte, dBits() As Byte
'获得位图信息
Call GetObject(hSrcBmp, Len(tSBmpInfo), tSBmpInfo)
Call GetObject(hDestBmp, Len(tDBmpInfo), tDBmpInfo)
'申请空间
ReDim sBits(1 To tSBmpInfo.bmWidthBytes, 1 To tSBmpInfo.bmHeight)
ReDim dBits(1 To tDBmpInfo.bmWidthBytes, 1 To tDBmpInfo.bmHeight)
'获得源图与目标图二进制位
Call GetBitmapBits(hSrcBmp, tSBmpInfo.bmWidthBytes * tSBmpInfo.bmHeight, sBits(1, 1))
Call GetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))
'计算颜色值占用多少字节
BytesPixel = tSBmpInfo.bmBitsPixel / 8
'旋转
For Y = 1 To tSBmpInfo.bmHeight
For X = 1 To tSBmpInfo.bmWidth
Call CopyMemory(dBits((tSBmpInfo.bmHeight - Y) * BytesPixel + 1, X), sBits((X - 1) * BytesPixel + 1, Y), BytesPixel)
Next X
Next Y
'将旋转的结果复制到目标位图
Call SetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))
End Function
'调用,一定要用image属性,不然会有问题
Call TurnBmp(Picture1.Image.handle, Picture2.Image.handle)
在我的机上(独龙600,win2ksp3),处理一副600*800的图片,
在ide中运行约0.8秒,
编译成exe,编译选项是"Optimize for Fast Code".运行,<0.4秒
有兴趣的可以试试用SetPixelV,GetPixel做上面的事情,肯定会慢许多
SetPixelV,GetPixel对应的vb的方法是pset,point,这个就没必要试了,这个慢得更厉害
lingll
2003-7-5
利用IPersistStream接口和IStream接口实现
'可以从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载文件,下载后解压,并注册、引用olelib.tlb
Option Explicit
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem 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
Const PictureID = &H746C&
Private Type PictureHeader
Magic As Long
Size As Long
End Type
Public Sub Picture2Array(ByVal oObj As StdPicture, aBytes() As Byte)
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set oIPS = oObj
Set oStream = CreateStreamOnHGlobal(0, True)
oIPS.Save oStream, True
hGlobal = GetHGlobalFromStream(oStream)
lSize = GlobalSize(hGlobal)
lPtr = GlobalLock(hGlobal)
If lPtr Then
lSize = lSize - Len(Hdr)
ReDim aBytes(0 To lSize - 1)
MoveMemory aBytes(0), ByVal lPtr + Len(Hdr), lSize
End If
GlobalUnlock hGlobal
Set oStream = Nothing
End Sub
Public Function Array2Picture(aBytes() As Byte) As StdPicture
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set Array2Picture = New StdPicture
Set oIPS = Array2Picture
lSize = UBound(aBytes) - LBound(aBytes) + 1
hGlobal = GlobalAlloc(GHND, lSize + Len(Hdr))
If hGlobal Then
lPtr = GlobalLock(hGlobal)
Hdr.Magic = PictureID
Hdr.Size = lSize
MoveMemory ByVal lPtr, Hdr, Len(Hdr)
MoveMemory ByVal lPtr + Len(Hdr), aBytes(0), lSize
GlobalUnlock hGlobal
Set oStream = CreateStreamOnHGlobal(hGlobal, True)
oIPS.Load oStream
Set oStream = Nothing
End If
End Function
Private Sub Command1_Click()
Dim buff() As Byte
Picture2Array Picture1.Picture, buff
'测试
Set Picture2.Picture = Array2Picture(buff)
End Sub
vb声明: Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
作用: "将来自缓冲区的二进制位复制到一幅位图"
参数: hBitmap Long,位图的句柄
dwCount Long,欲复制的字节数量
lpBits Any,指向一个缓冲区的指针。这个缓冲区包含了为位图正确格式化的位图位
GetBitmapBits:
vb声明: Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
作用: "将来自位图的二进制位复制到一个缓冲区"
参数: hBitmap Long,位图的句柄
dwCount Long,欲复制的字节数。如设为零,表示取得位图中的字节数
lpBits Any,指向容纳位图位的一个缓冲区的指针。注意事先将缓冲区至少初始化成dwCount个字节 "
举一个例子,将图片旋转90度,下面是我写的顺时针旋转90度的函数.
假设目标图像的宽等于源图的长,目标图像的长等于源图的宽,两图颜色值占用的位数相等.
参数: hSrcBmp,源图位图的句柄,vb中对应的是Picture.Handle
hDestBmp,目标位图的句柄
其中用到的GetObject,CopyMemory函数与BITMAP类型,声明如下
Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
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
'顺时针旋转90度的函数:
Public Function TurnBmp(hSrcBmp As Long, hDestBmp As Long) As Boolean
Dim X As Long, Y As Long
Dim BytesPixel As Long
Dim tSBmpInfo As BITMAP, tDBmpInfo As BITMAP
Dim sBits() As Byte, dBits() As Byte
'获得位图信息
Call GetObject(hSrcBmp, Len(tSBmpInfo), tSBmpInfo)
Call GetObject(hDestBmp, Len(tDBmpInfo), tDBmpInfo)
'申请空间
ReDim sBits(1 To tSBmpInfo.bmWidthBytes, 1 To tSBmpInfo.bmHeight)
ReDim dBits(1 To tDBmpInfo.bmWidthBytes, 1 To tDBmpInfo.bmHeight)
'获得源图与目标图二进制位
Call GetBitmapBits(hSrcBmp, tSBmpInfo.bmWidthBytes * tSBmpInfo.bmHeight, sBits(1, 1))
Call GetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))
'计算颜色值占用多少字节
BytesPixel = tSBmpInfo.bmBitsPixel / 8
'旋转
For Y = 1 To tSBmpInfo.bmHeight
For X = 1 To tSBmpInfo.bmWidth
Call CopyMemory(dBits((tSBmpInfo.bmHeight - Y) * BytesPixel + 1, X), sBits((X - 1) * BytesPixel + 1, Y), BytesPixel)
Next X
Next Y
'将旋转的结果复制到目标位图
Call SetBitmapBits(hDestBmp, tDBmpInfo.bmWidthBytes * tDBmpInfo.bmHeight, dBits(1, 1))
End Function
'调用,一定要用image属性,不然会有问题
Call TurnBmp(Picture1.Image.handle, Picture2.Image.handle)
在我的机上(独龙600,win2ksp3),处理一副600*800的图片,
在ide中运行约0.8秒,
编译成exe,编译选项是"Optimize for Fast Code".运行,<0.4秒
有兴趣的可以试试用SetPixelV,GetPixel做上面的事情,肯定会慢许多
SetPixelV,GetPixel对应的vb的方法是pset,point,这个就没必要试了,这个慢得更厉害
lingll
2003-7-5
利用IPersistStream接口和IStream接口实现
'可以从http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip下载文件,下载后解压,并注册、引用olelib.tlb
Option Explicit
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem 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
Const PictureID = &H746C&
Private Type PictureHeader
Magic As Long
Size As Long
End Type
Public Sub Picture2Array(ByVal oObj As StdPicture, aBytes() As Byte)
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set oIPS = oObj
Set oStream = CreateStreamOnHGlobal(0, True)
oIPS.Save oStream, True
hGlobal = GetHGlobalFromStream(oStream)
lSize = GlobalSize(hGlobal)
lPtr = GlobalLock(hGlobal)
If lPtr Then
lSize = lSize - Len(Hdr)
ReDim aBytes(0 To lSize - 1)
MoveMemory aBytes(0), ByVal lPtr + Len(Hdr), lSize
End If
GlobalUnlock hGlobal
Set oStream = Nothing
End Sub
Public Function Array2Picture(aBytes() As Byte) As StdPicture
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set Array2Picture = New StdPicture
Set oIPS = Array2Picture
lSize = UBound(aBytes) - LBound(aBytes) + 1
hGlobal = GlobalAlloc(GHND, lSize + Len(Hdr))
If hGlobal Then
lPtr = GlobalLock(hGlobal)
Hdr.Magic = PictureID
Hdr.Size = lSize
MoveMemory ByVal lPtr, Hdr, Len(Hdr)
MoveMemory ByVal lPtr + Len(Hdr), aBytes(0), lSize
GlobalUnlock hGlobal
Set oStream = CreateStreamOnHGlobal(hGlobal, True)
oIPS.Load oStream
Set oStream = Nothing
End If
End Function
Private Sub Command1_Click()
Dim buff() As Byte
Picture2Array Picture1.Picture, buff
'测试
Set Picture2.Picture = Array2Picture(buff)
End Sub
相关文章推荐
- 如何获取手机内存视频(图片)略缩图
- 如何获取局域网中其它机器的内存,硬盘信息?
- 在Android系统的"图库"中点击某张图片进行分享,在自己的应用程序中如何获取那张图片的路径?
- 如何获取在gallery选中图片的地址
- 如何获取S60第三版上的图片缩略图
- 如何获取 Android 设备的CPU核数、时钟频率以及内存大小
- Android 异步获取网络图片并处理图片Out Of Memory 内存溢出问题
- 使用ViwePager显示图片时如何防止内存泄露。
- android如何获取一张图片(照相跟图库)
- SD卡路径问题以及如何获取SDCard 内存
- RT/Metro商店应用如何如何获取图片的宽高
- 如何将Webbrowser获取的验证码显示在图片框中
- 如何获取别人微信文章中的图片
- 如何获取qq空间图片的url
- iOS开发,图片太多占内存太大如何解决
- android SD卡路径问题以及如何获取SDCard 内存
- PHP内存使用情况如何获取
- Android开发中如何解决加载大图片时内存溢出的问题
- Android SD卡路径问题以及如何获取SDCard 内存
- java程序设计中如何获取电脑d盘目录下的所有图片