VB6下的BitMap示例：模拟雨点程序(四)

Function BytesGetByPixels(ByRef pPixels() As tpPixelRGB24) As Byte()
'BytesGetByPixels函数
'语法：[tOutBytes()]=BytesGetByPixels(pPixels())
'功能：将tpPixelRGB24数组表示的位图数据转换成Byte数组。
'参数：tpPixelRGB24 pPixels() 必要参数。包含有位图数据的tpPixelRGB24数组
'返回：Byte tOutBytes() 必要参数。包含有位图数据的Byte数组
Dim tOutBytes() As Byte
Dim tOutBytesLength As Long

Dim tPixelsLength As Long

tPixelsLength = UBound(pPixels) + 1

tOutBytesLength = tPixelsLength * 3

ReDim tOutBytes(tOutBytesLength - 1)

CopyMemory tOutBytes(0), pPixels(0), tOutBytesLength

BytesGetByPixels = tOutBytes()
End Function

Function ByteLayersAlphaMix(pBackValue As Byte, pOverValue As Byte, pAlpha As Byte, Optional pAlphaLevel As Byte = 100) As Byte
'ByteLayersAlphaMix函数
'语法：[tOutByte]=ByteLayersAlphaMix(pBackValue, pOverValue, pAlpha, [pAlphaLevel])
'功能：将两个Byte类型的值进行Alpha混合运算，此函数是对像素进行Alpha混合的基础函数。
'参数：byte pBackValue 必要参数。做底色的亮度数据。
' byte pOverValue 必要参数。做覆盖色的亮度数据。
' byte pAlpha 必要参数。覆盖色的Alpha透明度，须对应pAlphaLevel的规定。
' byte pAlphaLevel 可选参数。Alpha的透明度级别，最大可到255。
'返回：byte tOutByte 混合后的Byte数据
Dim tOutByte As Byte

Dim tBackAlpha As Long
Dim tMixValue As Long

tBackAlpha = Abs(pAlphaLevel - pAlpha)

tMixValue = (CLng(pBackValue) * tBackAlpha + CLng(pOverValue) * CLng(pAlpha)) \ CLng(pAlphaLevel)

tOutByte = tMixValue Mod 256

ByteLayersAlphaMix = tOutByte
End Function


'[Other]

Function PixelSetToBitMapApplic(ByVal pX As Long, ByVal pY As Long, pBytes() As Byte, pBitMapInfoHeader As tpBitMapInfoHeader, pPixel As tpPixelRGB24)
Dim tBytesIndex As Long
Dim tPixelIndex As Long
Dim tX As Long
Dim tY As Long
Dim tWidth As Long
Dim tHeight As Long

With pBitMapInfoHeader
tWidth = .biWidth
tHeight = .biHeight
End With

tX = pX Mod tWidth
tY = pY Mod tHeight

tPixelIndex = tY * tWidth + tX
tBytesIndex = tPixelIndex * 3

With pPixel
pBytes(tBytesIndex) = .rgbBlue
pBytes(tBytesIndex + 1) = .rgbGreen
pBytes(tBytesIndex + 2) = .rgbRed
End With

'Form_Test.Text1.Text = tBytesIndex
End Function

Function PixelGetByBitMapApplic(ByVal pX As Long, ByVal pY As Long, pBitMapApplic As tpBitMapApplic) As tpPixelRGB24
Dim tOutPixel As tpPixelRGB24
Dim tBytes() As Byte
Dim tBytesIndex As Long
Dim tPixelIndex As Long
Dim tX As Long
Dim tY As Long
Dim tWidth As Long
Dim tHeight As Long

tBytes() = pBitMapApplic.bmaBytes

With pBitMapApplic.bmaHeader.bhInfoHeader
tWidth = .biWidth
tHeight = .biHeight
End With

tX = pX Mod tWidth
tY = pY Mod tHeight

tPixelIndex = tY * tHeight + tX
tBytesIndex = tPixelIndex * 3

With tOutPixel
.rgbBlue = tBytes(tBytesIndex)
.rgbGreen = tBytes(tBytesIndex + 1)
.rgbRed = tBytes(tBytesIndex + 2)
End With

PixelGetByBitMapApplic = tOutPixel
End Function

Function BytesAddLandBlur(pBytes As Variant, pLandWidth As Integer) As Byte()
Dim tLoop As Long

Dim tBytesSur() As Byte
Dim tBytesDes() As Byte

Dim tLoopOn As Long
Dim tLoopEnd As Long

Dim tIndex As Long
Dim tIndexB As Long
Dim tIndexP As Long

Dim tPixByte(2) As Long

tBytesSur() = pBytes
tBytesDes() = pBytes

tLoopOn = LBound(tBytesIn)
tLoopEnd = UBound(tBytesIn)

Form_Test.Text1.Text = ((tLoopEnd - tLoopOn) + 1) Mod 3

For tLoop = tLoopOn To tLoopEnd
tIndex = tLoop * 3
tIndexB = (tLoop - 1) * 3
tIndexP = (tLoop + 1) * 3
tB1 = (CLng(tBytesIn(tIndex)) + CLng(tBytesIn(tIndexB)) + CLng(tBytesIn(tIndexP))) \ 3
tB2 = (CLng(tBytesIn(tIndex + 1)) + CLng(tBytesIn(tIndexB + 1)) + CLng(tBytesIn(tIndexP + 1))) \ 3
tB3 = (CLng(tBytesIn(tIndex + 2)) + CLng(tBytesIn(tIndexB + 2)) + CLng(tBytesIn(tIndexP + 2))) \ 3
Next

BytesAddLandBlur = tBytesOut
End Function

Function ValueSetDefault(ByVal pValue As Long, ByVal pDefValue As Long) As Long
Dim tOutLong As Long

tOutLong = pValue + (pDefValue And (Not CBool(pValue)))

ValueSetDefault = tOutLong
End Function

Function RainDraw(pX As Long, pY As Long, pPixels() As tpPixelRGB24, pBitMapInfo As tpBitMapInfo, pLineLong As Long, pColorPixel As tpPixelRGB24, Optional pAlpha As Byte = 100)
Dim tLoop As Long
Dim tY As Long
Dim tPixel As tpPixelRGB24
Dim tBackPixel As tpPixelRGB24
Dim tAlpha As Byte
Dim tBitMapInfoHeader As tpBitMapInfoHeader
tBitMapInfoHeader = pBitMapInfo.bmiHeader

For tLoop = -pLineLong To pLineLong
tY = pY + tLoop
If tY < tBitMapInfoHeader.biHeight And tY >= 0 Then
tAlpha = (100 * (pLineLong - Abs(tLoop)) * pAlpha) \ pLineLong * 100
tBackPixel = PixelGetByPixels(pX, tY, pPixels(), tBitMapInfoHeader)
tPixel = PixelAlphaMix(tBackPixel, pColorPixel, tAlpha)
PixelSetToPixels pX, tY, pPixels(), tBitMapInfoHeader, tPixel
End If
Next
End Function

查看本文来源