Option Explicit
'指定されたウィンドウをロックして、更新できないようにします。一度にロックできるウィンドウは 1 つだけです。これは、インターフェイスのレイアウトが大きな円弧で変更された場合に使用できます。
Private Declare Function LockWindowUpdate Lib “user32” (ByVal hwndLock As Long) As Long
'指定したデバイス シーンのピクセルの RGB 値を設定する
Private Declare Function SetPixelV Lib “gdi32” (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
'あるデバイス コンテキストから別のデバイス コンテキストにビットマップをコピーします。ソース DC と宛先 DC は、互いに互換性がなければなりません。
プライベート宣言関数 BitBlt Lib “gdi32” (ByVal hDestDC As Long、ByVal X As Long、ByVal Y As Long、ByVal nWidth As Long、ByVal nHeight As Long、ByVal hSrcDC As Long、 ByVal xSrc As Long、ByVal ySrc As Long、ByVal dwRop As Long) As Long
Dim FX、FY As Integer
Dim EndingFlag As Boolean
Dim Frame As Integer
Dim ProcDem As Byte
Dim X As Integer
Dim Y As Integer
Dim FlameArray() As Byte
Dim Temp2 As Byte
Dim Uniformity As Byte
Dim Test As Byte
Dim Temp As Single
Dim Color As Integer
Dim FillVal As Byte
Dim WithEvents FadeAction As PictureBox
Dim WithEvents Go As CommandButton
Private Sub RunMain()
Do While Not EndingFlag = False
Frame = Frame + 1
If Frame Mod ProcDem = 0 Then DoEvents
For Y = FY To 4 Step -1
For X = 0 To FX Step 1
Temp2 = FlameArray(X, Y)
If Temp2 < Uniformity - 1 Then GoTo 1
Test = Int (Rnd * 均一性)
FlameArray(X, Y) = Temp2 - Test
FlameArray(X, Y - Test) = FlameArray(X, Y)
Color = FlameArray(X, Y) * Temp
SetPixelV FadeAction.hdc, X + (Rnd * 2), Y, RGB(Color + Color, Color, Color / 2)
1 次の X
次の Y
X = 0 の場合 FX
へ Y の場合 = FillVal へ FY
FlameArray(X, Y) = FY
次の Y
次の X
Me.Cls
BitBlt Me.hdc, (Me.ScaleWidth - FX) / 2, (Me.ScaleHeight - FY) / 2, FX, FY, FadeAction.hdc, 0, 0, vbSrcCopy
ループ
エンドサブ
Private Sub go_Click()
With Go
If Go.Caption = “開始” Then
.Caption = “暂停”
EndingFlag = True
RunMain
Else
Go.Caption = “開始”
EndingFlag = False
End If
End With
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
Me.BackColor = vbBlack
Me.Caption = “VB企现火焰的效果”
FX = 420
FY = 32
Set FadeAction = Me.Controls.Add(“VB.PictureBox”, “FadeAction” )
With FadeAction
.AutoRedraw = True
.ScaleMode = vbPixels
.BackColor = vbBlack
.Width = FX * Screen.TwipsPerPixelX + 4
.Height = FY * Screen.TwipsPerPixelY + 4
End With
Set Go = Me.Controls.Add(“VB.CommandButton ”, “Go”)
With Go
Go.Caption = “始め”
Go.Width = 80
Go.Height = 25
.Visible = True
End With
ReDim FlameArray(0 To FX, 0 To FY) As Byte
Uniformity = 2
ProcDem = 1
LockWindowUpdate FadeAction.hWnd
Temp = 256 / FY
FillVal = FY * 0.9
End Sub