BitCell

Your IT power source

Skip to content


Delphi - Fire effect

Post a reply

Delphi - Fire effect

Postby DarkByte » 18 Dec 2010, 23:59

Pentru ca inca nu mi-am facut curaj sa ma apuc de tutorialele de Delphi, m-am gandit ca ar fi bine sa postez macar niste programele (cu efecte dragute - eye-candy, I'd say) ale caror surse se pot dovedi folositoare.

Ca introducere va pot spune ca, in amintirea vremurilor din liceu cand programam in Pascal in modul 13h, m-am decis sa-mi programez un mic foc (la care sa ma incalzesc de Craciun ;))) in Delphi.

Singura problema e ca accesul la pixelii unui Canvas este destul de incet, motiv pentru care m-am multumit cu un foc mic (100x100 or so), pana cand mi-am adus aminte de ScanLines ... si atunci am ajuns la concluzia ca un foc mai serios n-ar strica ... ScanLines FTW B-)

Ceva in genul asta, mai exact :>
delphi, fire effect, scanline

Sursa programului (doar fisierul .PAS) arata in felul urmator:

Line number On/Off | Expand/Contract | Select all
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls, StdCtrls, ShellAPI;
  8.  
  9. type
  10.   TRGB32 = record
  11.     B, G, R, A: Byte;
  12.   end;
  13.   TRGB32Array = packed array[0 .. MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  14.   PRGB32Array = ^TRGB32Array;
  15.  
  16.   TForm1 = class(TForm)
  17.     imgFire: TImage;
  18.     Timer1: TTimer;
  19.     Button1: TButton;
  20.     Panel1: TPanel;
  21.     procedure Timer1Timer(Sender: TObject);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Button1Click(Sender: TObject);
  24.     procedure Panel1Click(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.     procedure ALittleSomething;
  30.  
  31.     procedure InitLowerLinesScanlines;
  32.     procedure DrawFlameScanlines;
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.   lBmp: TBitmap;
  38.  
  39. implementation
  40.  
  41. {$R *.dfm}
  42.  
  43. procedure TForm1.InitLowerLinesScanlines;
  44. var
  45.   i, j: Integer;
  46.   Line: PRGB32Array;
  47. begin
  48.   for j := imgFire.Height - 4 to imgFire.Height - 1 do
  49.     begin
  50.       Line := imgFire.Picture.Bitmap.ScanLine[j];
  51.       for i := 0 to imgFire.Width - 1 do
  52.         begin
  53.           Line[i].B := Random(100) + 40;
  54.           Line[i].G := Random(100) + 60;
  55.           Line[i].R := Random(50) + 200;
  56.           Line[i].A := 0;
  57.         end;
  58.     end;
  59.   imgFire.Invalidate;
  60. end;
  61.  
  62. procedure TForm1.DrawFlameScanlines;
  63. var
  64.   i, j: Integer;
  65.   Line, bLine, aLine: PRGB32Array;
  66. begin
  67.   for j := imgFire.Height - 3 downto 0 do
  68.     begin
  69.       Line := imgFire.Picture.Bitmap.ScanLine[j];
  70.       bLine := imgFire.Picture.Bitmap.ScanLine[j + 1];
  71.       if (j > 10) then
  72.         aLine := imgFire.Picture.Bitmap.ScanLine[j - 1];
  73.  
  74.       for i := 0 to imgFire.Width - 1 do
  75.         begin
  76.           Line[i].B := (Line[i - 2].B + Line[i + 2].B + bLine[i].B) div 3;
  77.           if (Line[i].B > 5) then
  78.             Dec(Line[i].B, Random(4));
  79.  
  80.           Line[i].G := (Line[i - 2].G + Line[i + 2].G + bLine[i].G) div 3;
  81.           if (Line[i].G > 5) then
  82.             Dec(Line[i].G, Random(3));
  83.  
  84.           Line[i].R := (Line[i - 1].R + Line[i + 1].R + bLine[i].R) div 3;
  85.           if (Line[i].R > 5) then
  86.             Dec(Line[i].R, Random(2));
  87.  
  88.           if ((i * j) mod (Random(50) + 5) = 0) then
  89.             begin
  90.               if (Line[i].B < 200) then
  91.                 Inc(Line[i].B, Random(10));
  92.               if (Line[i].G < 200) then
  93.                 Inc(Line[i].G, Random(10));
  94.               if (Line[i].R < 200) then
  95.                 Inc(Line[i].R, Random(10));
  96.             end;
  97.  
  98.           if ((i + j) mod (Random(2) + 2) = 0) and (j > 10) then
  99.             begin
  100.               aLine[i] := Line[i];
  101.             end;
  102.         end;
  103.     end;
  104. end;
  105.  
  106. procedure TForm1.Timer1Timer(Sender: TObject);
  107. begin
  108.   DrawFlameScanlines;
  109.   InitLowerLinesScanlines;
  110.  
  111.   Randomize;
  112. end;
  113.  
  114. procedure TForm1.ALittleSomething;
  115. var
  116.   x,y  : Integer;
  117.   Line : PRGB32Array;
  118. begin
  119.   with imgFire.Picture.Bitmap do
  120.   begin
  121.     PixelFormat := pf32bit;
  122.     Width := imgFire.Width;
  123.     Height := imgFire.Height;
  124.     for y := 0 to Height - 1 do
  125.     begin
  126.       Line := Scanline[y];
  127.       for x := 0 to Width - 1 do
  128.       begin
  129.         Line[x].B := 0;
  130.         Line[x].G := 0;
  131.         Line[x].R := x xor y;
  132.         Line[x].A := 0;
  133.       end;
  134.     end;
  135.   end;
  136.   imgFire.Invalidate;
  137. end;
  138.  
  139. procedure TForm1.FormCreate(Sender: TObject);
  140. begin
  141.   Randomize;
  142.   Panel1.Color := Self.Color;
  143.  
  144.   Self.ClientWidth := imgFire.Left + imgFire.Width + imgFire.Left;
  145.   Self.ClientHeight := imgFire.Top + imgFire.Height + imgFire.Left div 2;
  146.   ALittleSomething;
  147. end;
  148.  
  149. procedure TForm1.Button1Click(Sender: TObject);
  150. begin
  151.   Timer1.Enabled := True;
  152. end;
  153.  
  154. procedure TForm1.Panel1Click(Sender: TObject);
  155. begin
  156.   ShellExecute(0, 'open', PAnsiChar('http://www.bitcell.info'), nil, nil, 0);
  157. end;
  158.  
  159. end.


Executabilul si sursele complete le puteti downloada de mai jos.

Bafta & happy holiday programming ! :D
5p / 1 votes
Attachments
flame_src.zip
(7.63 KiB) Downloaded 36 times
flame_exe.zip
(200.98 KiB) Downloaded 56 times
User avatar
DarkByte
11011011
 
Joined: 29 Dec 2009
Status: 140

Re: Delphi - Fire effect

Postby v0id » 19 Dec 2010, 00:46

Sweet! Pana imi iau/construiesc o casa cu semineu, asta va fi un "replacement" bun :D
As avea si o sugestie pentru imbunatatirea"efectului de semineu" :) L-ai putea face sa mearga si in full-screen? Ar fi interesant de vazut daca ar merge OK si asa...
0,0p / 0 votes
A good coder is never on holiday - he may be working on a different machine, that's about as far as it gets.
User avatar
v0id
Word
 
Joined: 05 Jan 2010
Location: 127.0.0.1
Status: 42.5

Re: Delphi - Fire effect

Postby DarkByte » 19 Dec 2010, 00:56

In 1000x800 deja merge cam incet, but hey, we're talking Intel 4500 MHD here ... probabil ca pe placa ta video ar merge si full-screen. Give it a try si tine-ne la curent :)

Bafta
0,0p / 0 votes
User avatar
DarkByte
11011011
 
Joined: 29 Dec 2009
Status: 140

Re: Delphi - Fire effect

Postby smith » 19 Dec 2010, 01:08

Poate greșesc, dar nu trebuie să folosești un API special ca să "comunici" cu placa video? (gen directx).
0,0p / 0 votes
Ilea Cristian
User avatar
smith
Enum
 
Joined: 29 Dec 2009
Location: Cluj-Napoca
Status: 82

Re: Delphi - Fire effect

Postby DarkByte » 19 Dec 2010, 01:20

That's the next level.

Ce pot sa-ti spun e ca efectul asta de foc e facut doar cu posibilitatile grafice oferite de Delphi - si nu am facut niciun fel de optimizari (double-buffering, par example)
0,0p / 0 votes
User avatar
DarkByte
11011011
 
Joined: 29 Dec 2009
Status: 140

Re: Delphi - Fire effect

Postby v0id » 19 Dec 2010, 01:29

DarkByte, eu as incerca full-screen, dar cum?
I mean, TImage-ul ala are size fix. Daca i-am pus ancore si am recompilat programul, mi-a dat "EInvalidGraphicOperation - Scan line index out of range".
Sa ma apuc acum sa ma prind ce si cum prin cod... No chance :) N-am nervi.
0,0p / 0 votes
A good coder is never on holiday - he may be working on a different machine, that's about as far as it gets.
User avatar
v0id
Word
 
Joined: 05 Jan 2010
Location: 127.0.0.1
Status: 42.5

Re: Delphi - Fire effect

Postby DarkByte » 19 Dec 2010, 01:54

Comenteaza liniile alea doua din FormCreate care modifica size-ul formului si pune in loc
Line number On/Off | Expand/Contract | Select all
  1.  imgFire.Left := 0;
  2.  imgFire.Top := 0;
  3.  imgFire.Align := alClient;

Muta apelul lui "ALittleSomething" in Button1Click, inainte de
Line number On/Off | Expand/Contract | Select all
  1.  Timer1.Enabled := True;

This should do the trick. Programul va porni normal, in fereastra originala, dar ii poti da maximize, apoi click pe butonul "Fire".

Spor !
0,0p / 0 votes
User avatar
DarkByte
11011011
 
Joined: 29 Dec 2009
Status: 140

Re: Delphi - Fire effect

Postby v0id » 19 Dec 2010, 02:42

Va trebui sa ma multumesc cu size-ul "standard" al ferestrei. In full-screen mi se misca über-slow :(

E interesant ce grafic de usage al CPU-ului produce acest program. In lista de procese a Task Manager-ului, "Flame.exe" are un usage constant de 12-13%.
Pe procesorul meu, asta ar insemna un singur core in 100%. Graficul de usage al CPU-ului arata insa asa:

Image

Ciudat pentru o aplicatie cu un singur thread :)
Mentionez ca graficul arata asa indiferent daca ii dau aplicatiei full-screen sau nu.
0,0p / 0 votes
A good coder is never on holiday - he may be working on a different machine, that's about as far as it gets.
User avatar
v0id
Word
 
Joined: 05 Jan 2010
Location: 127.0.0.1
Status: 42.5

Re: Delphi - Fire effect

Postby smith » 19 Dec 2010, 02:49

Păi de ce ziceam eu că nu cred că se folosește de placa video ci de CPU?
0,0p / 0 votes
Ilea Cristian
User avatar
smith
Enum
 
Joined: 29 Dec 2009
Location: Cluj-Napoca
Status: 82

Re: Delphi - Fire effect

Postby v0id » 20 Dec 2010, 10:10

Pai... Eu n-am zis altceva :D
0,0p / 0 votes
A good coder is never on holiday - he may be working on a different machine, that's about as far as it gets.
User avatar
v0id
Word
 
Joined: 05 Jan 2010
Location: 127.0.0.1
Status: 42.5
Post a reply

Return to Tutoriale Delphi

Who is online

Users browsing this forum: No registered users and 0 guests


Powered by phpBB © phpBB Group
cron