[Amin_Mansouri]

ویژوال بیسیک 6 رو اجرا کنید. یه پروژه ی Standard.EXE ایجاد کنید. یه شی Timer و یه شی PictureBox روی فرم بذارید و خاصیت AutoRedraw از PictureBox رو به False تنظیم کنید. حالا کد های زیر رو تو بخش کدنویسی قرار بدین.

کد:

'Real-time flames by Tanner Helland

'This great program creates real-time flames using a simple little
'method I thought up in math one day.  Basically, it runs a loop
'from the bottom of the picture to the top of the picture, drawing
'pixels of varying brightness depending on their height and a
'randomly determined amount.  It takes a little while to get started,
'but once it gets going the flames move pretty realistically.  Also,
'the way it gets the different colors is pretty snazzy - I hate
'trying to use palettes in VB because it's slow and obnoxious and
'tons of work, so I devised this method: double the red value, keep
'the green value the same, and halve the blue value.  This results
'in only red, orange, and yellow shades of pixels.  Cool, huh?  If
'you like what you see, post any comments and/or suggestions at
'planet source code.

'Feel free to use this code however you want, but please give
'me some credit and let me know how you use it.  E-mail me with
'comments or questions at tannerhelland@hotmail.com.

'Also, if you like graphic-based programming, look for some
'of my other projects at www.planet-source-code.com.  Also, feel
'free to e-mail me with any graphic-related (or VB in general)
'questions you may have.

'Read the enclosed game.txt file for info on our current game
'production 'Realms of Time.'

Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
'The array for the separate flame pixels
Private FlameArray() As Byte
'counts the frame
Private Frame As Integer
'this number is used to fade the colors to their different
'values, as well as determine the intensity (2nd #)
Const temp = 256 / 50

Private Sub Form_Load()
'sets the array to the correct size
ReDim FlameArray(0 To 50, 0 To 50) As Byte
'turns the bottom row of flames "on"
For x = 0 To 50
For y = 46 To 50
FlameArray(x, y) = 50
Next y
Next x
On Error Resume Next

Kill "Flames.lst"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next

Static x As Integer
Static y As Integer
Static Color As Integer
Static temp2 As Byte
'runs the loop for the y-axis
For y = 50 To 4 Step -1
'runs the loop for the x-axis
For x = 0 To 50
'set the random degree of cooldown
FlameArray(x, y) = FlameArray(x, y) - Int(Rnd * 3)
'set a new random number for the movement
temp2 = Int(Rnd * 3)
'move the pixel in the array
FlameArray(x, y - temp2) = FlameArray(x, y)
'get the color based on the "heat" value
Color = (Int(FlameArray(x, y) * temp))
'draw the pixel
SetPixel Picture1.hDC, x + (Rnd * 2), y, RGB(Color + Color, Color, Color / 2)
'end x loop
Next x
'end y loop
Next y

'make the bottom 4 rows hot again
For x = 0 To 50
For y = 46 To 50
FlameArray(x, y) = 50
Next y
Next x
Picture1.Refresh

'If you want, you could build a despeckle loop right here that may
'make the flames more realistic.  Maybe someday I'll get around to
'it, but in the meantime feel free to edit this as you like and
'send me the updates.

Exit Sub
'this is to save the frames as bitmaps

Static PicName As String
    Frame = Frame + 1
    
If Frame > 20 Then
PicName = "picflame" & (Frame - 15) & ".bmp"
SavePicture Picture1.Image, PicName
Open "Flames.lst" For Append As #1
Print #1, PicName
Close #1
End If

End Sub

برای اجرای برنامه و مشاهده ی نتیجه ، کلید F5 رو فشار بدین
منبع وبلاگ : http://mohammadhashemy.blogfa.com/post-331.aspx