窗体部分
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
上一页 下一页
