VB6下的BitMap示例：模拟雨点程序
窗体部分
Dim N As tpBitMapApplic
Dim SPX() As tpPixelRGB24
Dim pubBitMapApplic As tpBitMapApplic
Dim pubPixels() As tpPixelRGB24
Dim pubBytes() As Byte
Dim pubBitMapInfo As tpBitMapInfo
Dim pubBitMapInfoHeader As tpBitMapInfoHeader
Dim pubX() As Long
Dim pubY() As Long
Dim pubZ() As Long
Dim pubRainLength As Long
Dim pubWorking As Boolean
Dim pubAutoLength As Boolean
Dim pubShowButtom As Boolean
Private Sub Command3_Click()
pubAutoLength = Not pubAutoLength
End Sub
Private Sub Command1_Click()
Dim tLoop As Long
Dim tPixels() As tpPixelRGB24
Dim tPixel As tpPixelRGB24
Dim tLineLong As Long
Dim tDoTimer As Long
pubWorking = True
Command1.Enabled = False
Do
tDoTimer = Timer * 100
tPixels() = pubPixels()
tPixel = PixelGetBySet(255, 255, 255)
For tLoop = 0 To pubRainLength
pubY(tLoop) = pubY(tLoop) + pubZ(tLoop) + 20
If pubY(tLoop) > pubBitMapInfoHeader.biHeight Then
pubX(tLoop) = Int(Rnd * pubBitMapInfoHeader.biWidth)
pubZ(tLoop) = Int(Rnd * 100)
pubY(tLoop) = 0 - (pubZ(tLoop) * 2) + Int(Rnd * 20)
End If
RainDraw pubX(tLoop), pubY(tLoop), tPixels(), pubBitMapInfo, (pubZ(tLoop) / 2) + 10, tPixel, CByte(pubZ(tLoop) / 2)
Next
'StretchDIBits Form_Test.hDC, 0, 0, pubBitMapInfoHeader.biWidth, pubBitMapInfoHeader.biHeight, 0, 0, pubBitMapInfoHeader.biWidth, pubBitMapInfoHeader.biHeight, tPixels(0), pubBitMapInfo, 0, &HCC0020
StretchDIBits Form_Test.hDC, 0, 0, Form_Test.ScaleWidth, Form_Test.ScaleHeight, 0, 0, pubBitMapInfoHeader.biWidth, pubBitMapInfoHeader.biHeight, tPixels(0), pubBitMapInfo, 0, &HCC0020
DoEvents
'If (Timer * 100) - tDoTimer > 10 And pubAutoLength And pubRainLength > 10 Then HScroll1.Value = HScroll1.Value - 1
Loop While pubWorking
Command1.Enabled = True
End Sub
Private Sub Command2_Click()
pubWorking = False
End Sub
Private Sub Form_DblClick()
pubShowButtom = Not pubShowButtom
Command1.Visible = pubShowButtom
Command2.Visible = pubShowButtom
Text1.Visible = pubShowButtom
HScroll1.Visible = pubShowButtom
End Sub
Private Sub Form_Load()
pubRainLength = 400
ReDim pubX(pubRainLength)
ReDim pubY(pubRainLength)
ReDim pubZ(pubRainLength)
HScroll1.Max = pubRainLength
HScroll1.Value = pubRainLength / 2
pubBitMapApplic = BitMapApplicGetByFile("Test.bmp")
'pubBitMapApplic.bmaHeader.bhInfoHeader.biWidth = pubBitMapApplic.bmaHeader.bhInfoHeader.biWidth + (CBool(pubBitMapApplic.bmaHeader.bhInfoHeader.biWidth Mod 4) And 1)
pubBytes() = pubBitMapApplic.bmaBytes
pubPixels() = PixelsGetByBytes(pubBytes())
pubBitMapInfo = BitMapInfoGetByBitMapApplic(pubBitMapApplic)
pubBitMapInfoHeader = pubBitMapApplic.bmaHeader.bhInfoHeader
Text1.Text = pubBitMapInfoHeader.biWidth
End Sub
Sub GY(pX, pY)
Dim tN As tpBitMapApplic
Dim tR As Long
Dim tX As Long
Dim tY As Long
Dim tL As Long
Dim tCol As Long
Dim SYBI() As Byte
Dim SYPX() As tpPixelRGB24
Dim BH As tpBitMapInfoHeader
Dim BN As tpBitMapInfo
tN = N
SYPX() = SPX()
BN = BitMapInfoGetByBitMapApplic(tN)
tR = 50
Dim tPix As tpPixelRGB24
BH = N.bmaHeader.bhInfoHeader
'SYBI() = N.bmaBytes
'SYPX() = PixelsGetByBytes(SYBI())
For tX = pX - tR To pX + tR
For tY = pY - tR To pY + tR
tL = tR - Sqr(Abs(tX - pX) ^ 2 + Abs(tY - pY) ^ 2)
If tL < 0 Then tL = 0
tCol = (tL * 100) / tR
If tX > 0 And tY > 0 Then tPix = PixelGetByPixels(tX, tY, SYPX(), BH)
tPix.rgbGreen = ByteLayersAlphaMix(tPix.rgbGreen, 255, CByte(tCol)) '(255 * tCol) / 255 + (tPix.rgbGreen * (255 - tCol) / 255)
If tX > 0 And tY > 0 Then PixelSetToPixels tX, tY, SYPX(), BH, tPix
Next
Next
StretchDIBits Form_Test.hDC, 0, 0, BH.biWidth, BH.biHeight, 0, 0, BH.biWidth, BH.biHeight, SYPX(0), BN, 0, &HCC0020
'tN.bmaBytes = BytesGetByPixels(SYPX())
'BitMapApplicShow Form_Test.hDC, tN
End Sub
Private Sub Form_Unload(Cancel As Integer)
pubWorking = False
End
End Sub
Private Sub HScroll1_Change()
pubRainLength = HScroll1.Value
Text1.Text = pubRainLength
End Sub
模块部分
Public Type tpBitMapFileHeader
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Public Type tpBitMapInfoHeader
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type tpRGBQuad
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type tpPixelRGB24
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
End Type
Public Type tpPixelRGB32
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbAlpha As Byte
End Type
Public Type tpBitMapHeader
bhFileHeader As tpBitMapFileHeader
bhInfoHeader As tpBitMapInfoHeader
End Type
Public Type tpBitMapInfo
bmiHeader As tpBitMapInfoHeader
bmiColors As tpRGBQuad
End Type
Public Type tpBitMapApplic
bmaHeader As tpBitMapHeader
bmaBytes As Variant
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function StretchDIBits Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As tpBitMapInfo, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Public Const DIB_PAL_COLORS = 1
Public Const DIB_RGB_COLORS = 0
Public Const SRCCOPY = &HCC0020
Function BitMapGetByBytes(ByRef pBytes() As Byte, Optional ByVal pWidth As Long = 800) As tpBitMapHeader
Dim tOutAny As tpBitMapHeader
Dim tOffByte As Long
tOffByte = UBound(pBytes)
tOutAny = BitMapGetBySpace(pWidth)
With tOutAny.bhFileHeader
.bfSize = LenB(tOutAny) + tOffByte + 1
End With
With tOutAny.bhInfoHeader
.biHeight = tOffByte / .biWidth / 3
End With
BitMapGetByBytes = tOutAny
End Function
Function BitMapGetBySpace(Optional ByVal pWidth As Long = 800) As tpBitMapHeader
Dim tOutAny As tpBitMapHeader
With tOutAny.bhFileHeader
.bfType = &H4D42
.bfSize = LenB(tOutAny)
.bfReserved1 = 0
.bfReserved2 = 0
.bfOffBits = LenB(tOutAny)
End With
With tOutAny.bhInfoHeader
.biBitCount = 24
.biClrImportant = 0
.biClrUsed = 0
.biCompression = 0
.biHeight = 0
.biPlanes = 1
.biSize = 40
.biSizeImage = 0
.biWidth = pWidth
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
End With
BitMapGetBySpace = tOutAny
End Function
Function BytesGetByFile(ByVal pFileName As String) As Byte()
Dim tOutBytes() As Byte
Dim tFileNumber As Integer
Dim tOffByte As Long
tFileNumber = FreeFile
Open pFileName For Binary As #tFileNumber
tOffByte = LOF(tFileNumber) - 1
ReDim tOutBytes(tOffByte)
Get #tFileNumber, 1, tOutBytes()
Close #tFileNumber
BytesGetByFile = tOutBytes()
End Function
'Form_Test.Text1.Text = Hex(tBitMapHeader.bhFileHeader.bfType)
'[BitMapInfo]
Public Function BitMapInfoGetByBitMapApplic(ByRef pBitMapApplic As tpBitMapApplic) As tpBitMapInfo
Dim tOutBitMapInfo As tpBitMapInfo
With tOutBitMapInfo
.bmiHeader = pBitMapApplic.bmaHeader.bhInfoHeader
End With
BitMapInfoGetByBitMapApplic = tOutBitMapInfo
End Function
'[BitMapApplic]
Public Function BitMapApplicShow(ByVal pDC As Long, ByRef pBitMapApplic As tpBitMapApplic, Optional ByVal pTop As Long, Optional ByVal pLeft As Long, Optional ByVal pWidth As Long, Optional ByVal pHeight As Long) As Long
Dim tOutLong As Long
Dim tBitMapInfo As tpBitMapInfo
Dim tBytes() As Byte
Dim tDesTop As Long
Dim tDesLeft As Long
Dim tDesWidth As Long
Dim tDesHeight As Long
Dim tSurTop As Long
Dim tSurLeft As Long
Dim tSurWidth As Long
Dim tSurHeight As Long
tBitMapInfo = BitMapInfoGetByBitMapApplic(pBitMapApplic)
tBytes() = pBitMapApplic.bmaBytes
With tBitMapInfo.bmiHeader
tSurTop = 0
tSurLeft = 0
tSurWidth = .biWidth
tSurHeight = .biHeight
End With
tDesTop = ValueSetDefault(pTop, tSurTop)
tDesLeft = ValueSetDefault(pLeft, tSurLeft)
tDesWidth = ValueSetDefault(pWidth, tSurWidth)
tDesHeight = ValueSetDefault(pHeight, tSurHeight)
tOutLong = StretchDIBits(pDC, tDesLeft, tDesTop, tDesWidth, tDesHeight, tSurLeft, tSurTop, tSurWidth, tSurHeight, tBytes(0), tBitMapInfo, 0, &HCC0020)
BitMapApplicShow = tOutLong
End Function
Public Function BitMapApplicIsBitMap(ByRef pBitMapApplic As tpBitMapApplic) As Boolean
'BitMapApplicIsBitMap函数
'语法：[tOutBool]=BitMapApplicIsBitMap(pBitMapApplic)
'功能：判断一个BitMapApplic是否有效
'参数：tpBitMapApplic pBitMapApplic 必要参数。有效文件名
'返回：Boolean tOutBool 逻辑值。如pBitMapApplic有效则为真。
'说明：本函数仅接受24bit位图。
Dim tOutBool As Boolean
With pBitMapApplic.bmaHeader
tOutBool = (.bhFileHeader.bfType = &H4D42) And (.bhInfoHeader.biBitCount = 24)
End With
BitMapApplicIsBitMap = tOutBool
End Function
Public Function BitMapApplicPutToFile(ByVal pFileName As String, ByRef pBitMapApplic As tpBitMapApplic) As Long
'BitMapApplicPutToFile函数
'语法：[tOutLength]=BitMapApplicPutToFile(pFileName, pBitMapApplic)
'功能：将一个BitMapApplic存储到文件中。
'参数：string pFileName 必要参数。有效文件名
' tpBitMapApplic pBitMapApplic 必要参数。位图的BitMapApplic
'返回：long tOutLength 位图文件的长度
'说明：本函数并不检测BMP文件是否是正确的格式，仅接受24bit位图。
Dim tOutLength As Long
Dim tBitMapHeader As tpBitMapHeader
Dim tBytes() As Byte
Dim tBytesCount As Long
Dim tFileNumber As Integer
Dim tOffBits As Long
tFileNumber = FreeFile
tBitMapHeader = pBitMapApplic.bmaHeader
tBytes() = pBitMapApplic.bmaBytes
tOffBits = tBitMapHeader.bhFileHeader.bfOffBits
Open pFileName For Binary As #tFileNumber
Put #tFileNumber, 1, tBitMapHeader
Put #tFileNumber, tOffBits + 1, tBytes()
tOutLength = LOF(tFileNumber)
Close #tFileNumber
BitMapApplicPutToFile = tOutLength
End Function
Public Function BitMapApplicGetByFile(ByVal pFileName As String) As tpBitMapApplic
'BitMapApplicGetByFile函数
'语法：[tOutBitMapApplic]=BitMapApplicGetByFile(pFileName)
'功能：从文件中获得一个BitMapApplic
'参数：string pFileName 必要参数。有效文件名
'返回：tpBitMapApplic tOutBitMapApplic
'说明：本函数并不检测BMP文件是否是正确的格式，仅接受24bit位图。
Dim tOutBitMapApplic As tpBitMapApplic
Dim tBitMapHeader As tpBitMapHeader
Dim tBytes() As Byte
Dim tBytesCount As Long
Dim tFileNumber As Integer
Dim tOffBits As Long
tFileNumber = FreeFile
Open pFileName For Binary As #tFileNumber
Get #tFileNumber, 1, tBitMapHeader
With tBitMapHeader
tOffBits = .bhFileHeader.bfOffBits
.bhInfoHeader.biWidth = .bhInfoHeader.biWidth + (CBool(.bhInfoHeader.biWidth Mod 2) And 1)
tBytesCount = .bhInfoHeader.biWidth * .bhInfoHeader.biHeight * .bhInfoHeader.biBitCount / 8
End With
ReDim tBytes(tBytesCount - 1)
Get #tFileNumber, tOffBits + 1, tBytes()
Close #tFileNumber
With tOutBitMapApplic
.bmaHeader = tBitMapHeader
.bmaBytes = tBytes()
End With
BitMapApplicGetByFile = tOutBitMapApplic
End Function
'[Pixels]
Function PixelsShow(ByRef pPixels() As tpPixelRGB24, pBitMapInfo As tpBitMapInfo)
End Function
Function PixelsGetByBytes(ByRef pBytes() As Byte) As tpPixelRGB24()
'PixelsGetByBytes函数
'语法：[tOutPixels()]=PixelsGetByBytes(pBytes())
'功能：将Byte数组表示的位图数据转换成tpPixelRGB24数组。
'参数：byte pBytes() 必要参数。包含有位图数据的Byte数组
'返回：tpPixelRGB24 tOutPixels() 必要参数。包含有位图数据的tpPixelRGB24数组
Dim tOutPixels() As tpPixelRGB24
Dim tOutPixelsLength As Long
Dim tBytesLength As Long
tBytesLength = UBound(pBytes) + 1
tOutPixelsLength = tBytesLength / 3
ReDim tOutPixels(tOutPixelsLength - 1)
CopyMemory tOutPixels(0), pBytes(0), tBytesLength
PixelsGetByBytes = tOutPixels()
End Function
Function PixelGetBySet(ByVal pRed As Byte, ByVal pGreen As Byte, ByVal pBlue As Byte) As tpPixelRGB24
Dim tOutPixel As tpPixelRGB24
With tOutPixel
.rgbBlue = pBlue
.rgbGreen = pGreen
.rgbRed = pRed
End With
PixelGetBySet = tOutPixel
End Function
Function PixelAlphaMix(ByRef pBackPix As tpPixelRGB24, ByRef pOverPix As tpPixelRGB24, ByVal pAlpha As Byte, Optional ByVal pAlphaLevel As Byte = 100) As tpPixelRGB24
Dim tOutPixel As tpPixelRGB24
With tOutPixel
.rgbBlue = ByteLayersAlphaMix(pBackPix.rgbBlue, pOverPix.rgbBlue, pAlpha, pAlphaLevel)
.rgbGreen = ByteLayersAlphaMix(pBackPix.rgbGreen, pOverPix.rgbGreen, pAlpha, pAlphaLevel)
.rgbRed = ByteLayersAlphaMix(pBackPix.rgbRed, pOverPix.rgbRed, pAlpha, pAlphaLevel)
End With
PixelAlphaMix = tOutPixel
End Function
Function PixelGetByPixels(ByVal pX As Long, ByVal pY As Long, pPixels() As tpPixelRGB24, pBitMapInfoHeader As tpBitMapInfoHeader) 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 = tHeight - (pY Mod tHeight) - 1
tPixelIndex = tY * tWidth + tX
PixelGetByPixels = pPixels(tPixelIndex)
End Function
Function PixelSetToPixels(ByVal pX As Long, ByVal pY As Long, pPixels() As tpPixelRGB24, 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 = tHeight - (pY Mod tHeight) - 1
tPixelIndex = tY * tWidth + tX
pPixels(tPixelIndex) = pPixel
End Function
'[Bytes]
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
VB6下的BitMap示例：模拟雨点程序相关推荐
- VB6监视/操作剪贴板示例(VB6.0代码)
剪贴板的监视,需要先使用SetClipboardViewer设置某个句柄为剪贴板查看器的一员. 然后当剪贴板发生改变时,系统就会向这个句柄发送WM_DRAWCLIPBOARD消息. 只要使用子类化拦截 ...
- GPIO模拟I2C程序实现
GPIO模拟I2C程序实现. I2C是由Philips公司发明的一种串行数据通信协议,仅使用两根信号线:SerialClock(简称SCL)和SerialData(简称SDA).I2C是总线结构,1个 ...
- matlab腔内光子寿命,mcFORnp matlab环境下，利用蒙特卡洛模拟光子包在生物组织内的光路传输 271万源代码下载- www.pudn.com...
文件名称: mcFORnp下载 收藏√ [ 5 4 3 2 1 ] 开发工具: matlab 文件大小: 215 KB 上传时间: 2014-12-29 下载次数: 8 提 供 者: 徐某 ...
- 单片机IO口模拟串口程序（发送+接收
单片机IO口模拟串口程序(发送+接收)[转] qcmc 发表于 - 2011-6-23 0:42:00 前一阵一直在做单片机的程序,由于串口不够,需要用IO口来模拟出一个串口.经过若干曲折并参考了一些 ...
- Android下利用Bitmap切割图片
在自己自定义的一个组件中由于需要用图片显示数字编号,而当前图片就只有一张,上面有0-9是个数字,于是不得不考虑将其中一个个的数字切割下来,需要显示什么数字,只需要组合一下就好了. 下面是程序的关键代码 ...
- linux下进程调度算法实验,Linux下进程调度算法的模拟实现.doc
Linux下进程调度算法的模拟实现 枣 庄 学 院 信息科学与工程学院课程设计任务书 题目: Linux下进程调度算法的模拟实现 学 生1: 学 生2: 学 生3: 专 业: 计算机应用技术 课 程: ...
- 串口发送程序linux,单片机IO口模拟串口程序（发送+接收
前一阵一直在做单片机的程序,由于串口不够,需要用IO口来模拟出一个串口.经过若干曲折并参考了一些现有的资料,基本上完成了.现在将完整的测试程序,以及其中一些需要总结的部分贴出来. 程序硬件平台:11. ...
- android弱网模拟路由器,Mac 下使用命令行模拟弱网环境
做音视频开发,我们经常需要模拟弱网环境,观察 app 在弱网下的表现,比如,丢包.延迟.抖动.限制带宽条件等,Mac 系统有一个弱网工具 APP,叫做 "Network Link Condi ...
- 微信开放平台 帐号管理 绑定在同一个开放平台帐号下的公众号及小程序让用户unionid一致...
开发十年,就只剩下这套架构体系了! >>> 第三方平台在获得此权限后,可以代替已授权的公众号/小程序创建开放平台帐号或进行绑定/解绑操作. 绑定在同一个开放平台帐号下的公众号及 ...
- 简单的模拟电话簿程序（java）
要求: 编写一个模拟电话簿程序,实现对联系人的增删查 提示: HashMap存储联系人,Key为联系人姓名,Value为其电话号码 在console控制台中模拟增删查改 一.搭建项目结构 项目分层, ...
最新文章
- nero 8.0刻录系统光盘
- 一个软件公司需要多少前端_制作一个小程序商城需要多少钱？开发小程序公司哪家强？...
- C#设置WebBrowser IE浏览器版本
- [转]Joomla! 1.5中form表单的实现方式
- SpringSecurity remember功能基本实现
- python根据数据生成图像_从三个numpy数组生成图像数据
- java 解压到内存,Java GZip 基于内存实现压缩和解压的方法
- keil4怎么移植其他人的程序_【调试笔记】韦东山：在100ask_imx6ull上移植使用六轴传感器ICM20608...
- 拖动精灵的三种方法比较
- zxr10交换机配置手册vlan_中兴ZXR10 G系列交换机SVLAN使用指导
- 计算机网络 职中,职中计算机网络基础期中考试试卷.pdf
- maven 编译命令
- CCNP精粹系列之三----OSPF（open short path first）
- 华泰证券高薪诚聘 技术大牛/运维平台架构师
- 回不去原来是没有 实现这个 代理方法，
- android+流量防火墙,流量防火墙APP
- tbslog乱码转换_word 编码 转换器 在线转换器
- 单线程模型中Message、Handler、Message Queue、Looper之间的关系
- 压力换算公斤单位换算_压力表单位换算
- 小豆社保「社保代缴」短信接口被盗刷解决方案-企业短信防火墙