Access.Image BMP图像高速切割函数

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

附件包含：

1、BMP切割公共函数模块（核心部分）
2、一个未使用BMP切割函数的割图演示（BMP Cutter）
3、一个使用了BMP切割函数的割图演示（BMP Cutter Advanced）
4、切割函数所用到的数据块存取函数（也是另外一个公共模块）

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

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

程序限制：
1、本程序不支持BMP5.0
2、本程序不支持压缩格式BMP

程序源码：

[ 公共模块部分 ]

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