Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
Enum Equates Singular
IDC_Graphic
ID_Timer
End Enum
Global hDlg,hDC As Dword, bmp$
Global Flames(), Colors(), flameWidth, flameHeight As Long
Global qFreq, qStart, qStop As Quad
Function PBMain() As Long
Dialog New Pixels, 0, "Fire Demo",300,300,300,200, %WS_OverlappedWindow To hDlg
Control Add Graphic, hDlg, %IDC_Graphic,"", 0,0,200,200
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Graphic Color %Black, %Black
Graphic Clear
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long
Select Case Cb.Msg
Case %WM_InitDialog
QueryPerformanceFrequency qFreq
SetTimer(hDlg, %ID_Timer, 50, %NULL) 'sends %WM_Timer to dialog callback
Case %WM_Timer
QueryPerformanceCounter qStart
DrawFlames
QueryPerformanceCounter qStop
Dialog Set Text hDlg, "Fire Demo " + Format$(qFreq/(qStop-qStart),"###") & " FPS"
Case %WM_Size
Dialog Get Client hDlg To flameWidth, flameHeight
Control Set Size hDlg, %IDC_Graphic, flameWidth, flameHeight
Graphic Get Bits To bmp$
ReDim Flames(flameWidth,flameHeight)
ReDim Colors(flameWidth-1,flameHeight-1) At StrPtr(bmp$)+8
Case %WM_Destroy
KillTimer Cb.Hndl, %ID_Timer
End Select
End Function
Sub DrawFlames
Local curPixel, tmpValue, x,y, iColor As Long
For y = flameHeight-1 To 4 Step -1
For x = 0 To flameWidth-1
tmpValue = Rnd * 3 'random cooldown amount
Flames(x, y) = Flames(x,y) - tmpValue 'apply cooldown to pixel
Flames(x, y-tmpValue) = Flames(x, y) 'move pixel upward
iColor = 256 * Flames(x,y)\flameHeight 'generate pixel color
Colors(x,y) = RGB(iColor/2,iColor,2*iColor)
Next x
Next y
'Once all flames are processed, make the bottom 4 rows hot again
For y = flameHeight-4 To flameHeight
For x = 0 To flameWidth : Flames(x, y) = flameHeight : Next x
Next y
Graphic Set Bits bmp$
Graphic ReDraw
End Sub
'gbs_01413
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm