【原创 / 源码】BMP图像高速切割公共函数

LucasLynn

本函数可以在你自己的程序中调用，从已有BMP中切割任意一个矩形块。使用本函数，即使你对BMP格式一窍不通，也可以在自己的程序中自由地切割BMP（比方说拼图游戏程序）。

附件包含：

1、BMP切割公共函数模块（核心部分）

2、一个未使用BMP切割函数的割图演示（BMP Cutter）

3、一个使用了BMP切割函数的割图演示（BMP Cutter Advanced）

4、切割函数所用到的数据块存取函数（也是另外一个公共模块）

（之所以保留未使用公共函数的演示，是因为从效率上来讲，使用公共函数有一点点降低，但是这也是公共化所无法避免的。）

调用方法在源码中有注释说明。

程序限制：

1、本程序不支持BMP5.0

2、本程序不支持压缩格式BMP

游客，如果您要查看本帖隐藏内容请回复

[此贴子已经被作者于2005-9-21 22:45:54编辑过]

LucasLynn

同时附上公共函数部分：

Option Compare Database

Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'调用说明：

'imgSrc：裁剪源图像控件对象

'imgDest：裁剪目标图像控件对象（可以和源对象相同）

'xDest,yDest：裁剪矩形的起点（左下角为0,0），单位为Pixel

'widthDest,heightDest：裁剪矩形的宽和高，单位为Pixel

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub BMP_Cut(ByRef imgSrc As Image, ByRef imgDest As Image, _

    ByVal xDest As Long, ByVal yDest As Long, widthDest As Long, heightDest As Long)

   

    Dim arrDest() As Byte, arrSrc() As Byte

    Dim widthSrc As Long, heightSrc As Long

    Dim scanLineDest As Long, scanLineSrc As Long

    Dim biBitCount As Long, biClrUsed As Long, biSize As Long, biCompression As Long

   

    arrSrc = imgSrc.PictureData

   

'获取和判断图像格式

    widthSrc = ReadBytes(arrSrc, 4, 4)

    heightSrc = ReadBytes(arrSrc, 8, 4)

    biBitCount = ReadBytes(arrSrc, 14, 2)

    biClrUsed = ReadBytes(arrSrc, 32, 2)

    biSize = ReadBytes(arrSrc, 0, 4)

    biCompression = ReadBytes(arrSrc, 16, 4)

   

    If biSize <> 40 Then

        MsgBox "不支持非DIB格式，无法完成裁剪。"

        Exit Sub

    ElseIf biCompression <> 0 Then

        MsgBox "不支持压缩格式或BMP 5.0格式，无法完成裁剪。"

        Exit Sub

    ElseIf xDest + widthDest > widthSrc Or yDest + heightDest > heightSrc Then

        MsgBox "切割范围超出了图形边界，无法完成裁剪。"

    End If

        

'初始化图形数据头

   

    scanLineSrc = biBitCount * widthSrc

    If scanLineSrc Mod 32 > 0 Then

        scanLineSrc = Fix(scanLineSrc / 32) * 4 + 4

    Else

        scanLineSrc = scanLineSrc / 8

    End If

   

    scanLineDest = biBitCount * widthDest

    If scanLineDest Mod 32 > 0 Then

        scanLineDest = Fix(scanLineDest / 32) * 4 + 4

    Else

        scanLineDest = scanLineDest / 8

    End If

   

    ReDim arrDest(scanLineDest * heightDest + biSize + biClrUsed * 4 - 1)

    CopyMemory ByVal VarPtr(arrDest(0)), ByVal VarPtr(arrSrc(0)), biSize + biClrUsed * 4

    WriteBytes arrDest, 4, widthDest, 4

    WriteBytes arrDest, 8, heightDest, 4

    WriteBytes arrDest, 20, scanLineDest * heightDest, 4

   

'裁剪图形数据

   

    Dim nY As Long

    For nY = 0 To heightDest - 1

        CopyMemory ByVal VarPtr(arrDest(nY * scanLineDest + biSize + biClrUsed * 4)), _

            ByVal VarPtr(arrSrc((yDest + nY) * scanLineSrc + (xDest) * biBitCount / 8 + biSize + biClrUsed * 4)), scanLineDest

    Next nY

   

    imgDest.PictureData = arrDest

End Sub









'以下为数据块存取公共函数



Public Function Byt2Lng(ByRef arrData() As Byte, ByVal p As Long) As Long

    CopyMemory VarPtr(Byt2Lng), VarPtr(arrData(p)), 4

End Function

Public Function Byt2Int(ByRef arrData() As Byte, ByVal p As Long) As Integer

    CopyMemory VarPtr(Byt2Int), VarPtr(arrData(p)), 2

End Function

Public Function ReadBytes(arrData() As Byte, p As Long, t As Integer) As Long

    If t >= 1 And t <= 4 Then CopyMemory VarPtr(ReadBytes), VarPtr(arrData(p)), t

End Function

Public Sub WriteBytes(ByRef arrData() As Byte, p As Long, Value As Long, t As Integer)

    If t >= 1 And t <= 4 Then CopyMemory VarPtr(arrData(p)), VarPtr(Value), t

End Sub

[此贴子已经被作者于2005-8-28 11:29:48编辑过]

LucasLynn

以下是引用esmile在2005-8-19 1:43:00的发言：

LucasLynn兄，能不能实现从其他程序中拷贝到系统粘贴板中的图像能在ＡＣＣＥＳＳ中直接贴到图像控件上吗？

不知道明不明白我表达的意思？

也就是说系统粘贴板中已有图片信息，如何在ＡＣＥＳＳ中通过ＶＢＡ直接提取粘贴板中的图像信息（bmp\JPG等）直接在image图像控件中显示？

这样就不用先将图片数据信息先保存为一个文件，然后再在图像中显示了．

谢谢！

可以的。我在论坛贴过一个源码，是Image数据到剪贴版，反向原理一样。

帖子地址：http://www.office-cn.net/BBS/dispbbs.asp?BoardID=2&ID=30513

[此贴子已经被作者于2005-8-19 12:39:13编辑过]

LucasLynn

重新发了附件和源码，增加了1色，2色，4色，16色BMP图像的支持。

secowu

用着开心不开心时，再搞几下，弄点毛病出来玩玩

chaojianan

谢谢分享。

ZHENGLIAN

调用方法在源码中有注释说明