Delphiben tűz efekt

Delphiben tűz efekt
2012-10-08T17:19:04+02:00
2012-10-09T12:17:03+02:00
2022-11-27T01:55:37+01:00
mate2
Sziasztok szeretnék írni egy programot ami tűz fektet csinál.
Találtam az oldalon egy programot(itt) de az assemblybe van írva ahoz meg én nem értek és el se szeretném lopni azt a forráskódot. tudnátok e benne segíteni hogy hogyan tudnám megcsinálni a tűz efektes programot a formra vagy egy panelre írni.

előre is kösz asegítsége üdv Máté
Mutasd a teljes hozzászólást!
Végre valaki nem ôspascalban akar demoeffektezni :D
Win32 Delphi alol kicsit mashogy megy, de 14 ev tavlatabol is poen ez az effekt :D

A fobb dolgok, amik mashogy mennek win32 alol, mint dos alol:
- folyamatos kiralzolas: Application.OnIdle, FormPaint
- 8bit paletta: FirePalette()
- buffer: TBitmap
- buffer kirakasa a kepernyore: Canvas.Draw
- pixel eleres: kizarolag TBitmap.Scanline-val, ha megvan a sor, akkor meg mehet a pointerezes.
- TBitmap.sorhossz: 4 bytera igazitva!!!! (ez azert fontos, mert az a form terulete lehet akarhany pixeles)
- azt leszamitva kb tok ugyanaz: _Fire_Line()
- En inkabb kulon rakom az asm reszeket egy funkcioba: az elso 3 parameter rendre: eax,edx,ebx,aztan stack (ebp-hez relativ, nev szerint cimezd!), ebx,esi,edi tartalmat meg kell orizned, ebp-hez ne nyulj, az a stack frame.

Aztán hajrá

unit UFire; //a FormPaint eventet kosd be! interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TFrmFire = class(TForm) procedure FormPaint(Sender: TObject); public bmp:array[0..1]of TBitmap; actbmp:integer; procedure WMERASEBKGND(var m:TMessage);message WM_ERASEBKGND;//form torles event felulirva procedure MyIdle(Sender:TObject;var Done:boolean); end; var FrmFire: TFrmFire; implementation {$R *.dfm} { TFormFire } procedure TFrmFire.WMERASEBKGND(var m: TMessage); begin m.Result:=1;end; //nem torli a kepernyot procedure TFrmFire.MyIdle(Sender: TObject; var Done: boolean); begin Invalidate;Done:=false;end; //allandoan frissuljon a form //based on http://prog.hu/cikkek/43/Tuz+effekt.html procedure _Fire_line(src,dst:pbyte;linesize:integer); asm //eax edc ecx stack push esi push ebx push edi mov esi, ecx neg esi //fejjel lefele van a bitmap sub ecx,2 //loop cntr inc eax inc edx @1: movzx ebx, byte ptr[eax-1] movzx edi, byte ptr[eax+1] add ebx,edi // .x. movzx edi, byte ptr[eax+esi-1] add ebx,edi // ... movzx edi, byte ptr[eax+esi*1] add ebx,edi // ... //x=center, .=sum movzx edi, byte ptr[eax+esi+1] add ebx,edi movzx edi, byte ptr[eax+esi*2-1] add ebx,edi movzx edi, byte ptr[eax+esi*2] add ebx,edi movzx edi, byte ptr[eax+esi*2+1] add ebx,edi //kesz az oszzeg mov edi,ebx shr edi,6 add ebx,edi //legyen kicsit hatvanyosan erosebb a tuz shr ebx,3 //8 szin atlaga mov [edx],bl add edx,1 add eax,1 sub ecx,1; jnz @1 pop edi pop ebx pop esi end; procedure FireEfx(const bSrc,bDst:TBitmap); var w,h:integer; procedure burnat(x,y:integer);//veletlenszeru lang x,y kozeleben begin x:=x+random(10)-5; y:=y+random(10)-5; if(x>0)and(y>0)and(x<w-1)and(y<h-1)then pbyte(integer(bSrc.ScanLine[y])+x)^:=255; end; var i,x,y:integer; begin w:=bSrc.Width; h:=bSrc.Height; //tuz alul for i:=0 to bSrc.Width div 8 do burnat(random(w),h-10); for y:=bSrc.Height-300 to bSrc.Height-5 do _Fire_line(bSrc.ScanLine[y], bDst.ScanLine[y], (w+3)and not 3{4 byte-ra igazitva vannak a bitmap sorai} ); end; procedure TFrmFire.FormPaint(Sender: TObject);//itt kell ujrarajzolni a formot function FirePalette:THandle; var pal:^TLogPalette; procedure p(n, r,g,b:integer);//beallit egy paletta erteket. Kumm forrasa alapjan, ami 6bites csak begin with pal.palPalEntry[n] do begin peRed:=r shl 2; peGreen:=g shl 2; peBlue:=b shl 2; peFlags:=0; end;end; var n:integer; begin pal:=GetMemory(256*4+4); with pal^ do try palVersion:=$300; palNumEntries:=256; //based on http://prog.hu/cikkek/43/Tuz+effekt.html p(0, 0,0,0); for n:=1 to 32 do p(n, 2*n-1, 0, 0); for n:=33 to 160 do p(n, 63,n, 0); for n:=129 to 255 do p(n, 63,63,(n-129) div 2); result:=CreatePalette(pal^); finally FreeMemory(pal); end; end; var i:integer; begin //ha nincs még work bitmap, akkor letrehozzuk, es egyeb inicializalasok if bmp[0]=nil then begin Application.OnIdle:=MyIdle;//frissito esemeny bekotese for i:=0 to 1 do begin bmp[i]:=TBitmap.Create; bmp[i].PixelFormat:=pf8bit; end; bmp[0].Palette:=FirePalette; bmp[1].Palette:=bmp[0].Palette; end; //ha valtozott az ablakmeret... if(bmp[0].width<>ClientWidth)or(bmp[0].Height<>ClientHeight)then for i:=0 to 1 do with bmp[i]do begin Width:=ClientWidth; Height:=ClientHeight; canvas.Brush.Color:=clBlack; canvas.FillRect(rect(0,0,width,height)); end; FireEfx(bmp[actBmp],bmp[1-actBmp]);//effekt update actBmp:=1-actBmp;//bufferCsere Canvas.Draw(0,0,bmp[actBmp]);//kirajzolas end; end.
Mutasd a teljes hozzászólást!

  • Most akkor kész kód kell, vagy meg szeretnéd írni? Mert utóbbi esetben amit linkeltél, ott szépen le van írva az elmélet(is). Egyébként, nagyon jó gyakorló feladat egy kezdőnek. De ha már ott el vagy akadva, hogyan változtasd meg egy pont szinét, akkor inkább előbb annak járj utána. Ha megvan, már csak egy tömböt kell manipulálni (a leírtak szerint) és az alapján kirakni a pontokat.
    Mutasd a teljes hozzászólást!
  • tudok formra rajzolni amit akarok 3d-s elemtöl elkezdve midnent levan írva meg minden csak nem értem és nem kell kész forráskód mert azzal nem tanulok semmit az ottlévő magyarázat ba ezt értem :
    procedure initpal; var n: integer; begin palette[0].R:=0;palette[0].G:=0;palette[0].B:=0; for n:=1 to 32 do begin palette[n].R:=2*n-1;palette[n].G:=0;palette[n].B:=0;end; for n:=33 to 160 do begin palette[n].R:=63;palette[n].G:=(n-33) div 2; end; for n:=129 to 255 do begin palette[n].R:=63;palette[n].G:=63;palette[n].B:=(n-129) div 2;end; end;
    de a többit nem
    Mutasd a teljes hozzászólást!
  • Végre valaki nem ôspascalban akar demoeffektezni :D
    Win32 Delphi alol kicsit mashogy megy, de 14 ev tavlatabol is poen ez az effekt :D

    A fobb dolgok, amik mashogy mennek win32 alol, mint dos alol:
    - folyamatos kiralzolas: Application.OnIdle, FormPaint
    - 8bit paletta: FirePalette()
    - buffer: TBitmap
    - buffer kirakasa a kepernyore: Canvas.Draw
    - pixel eleres: kizarolag TBitmap.Scanline-val, ha megvan a sor, akkor meg mehet a pointerezes.
    - TBitmap.sorhossz: 4 bytera igazitva!!!! (ez azert fontos, mert az a form terulete lehet akarhany pixeles)
    - azt leszamitva kb tok ugyanaz: _Fire_Line()
    - En inkabb kulon rakom az asm reszeket egy funkcioba: az elso 3 parameter rendre: eax,edx,ebx,aztan stack (ebp-hez relativ, nev szerint cimezd!), ebx,esi,edi tartalmat meg kell orizned, ebp-hez ne nyulj, az a stack frame.

    Aztán hajrá

    unit UFire; //a FormPaint eventet kosd be! interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TFrmFire = class(TForm) procedure FormPaint(Sender: TObject); public bmp:array[0..1]of TBitmap; actbmp:integer; procedure WMERASEBKGND(var m:TMessage);message WM_ERASEBKGND;//form torles event felulirva procedure MyIdle(Sender:TObject;var Done:boolean); end; var FrmFire: TFrmFire; implementation {$R *.dfm} { TFormFire } procedure TFrmFire.WMERASEBKGND(var m: TMessage); begin m.Result:=1;end; //nem torli a kepernyot procedure TFrmFire.MyIdle(Sender: TObject; var Done: boolean); begin Invalidate;Done:=false;end; //allandoan frissuljon a form //based on http://prog.hu/cikkek/43/Tuz+effekt.html procedure _Fire_line(src,dst:pbyte;linesize:integer); asm //eax edc ecx stack push esi push ebx push edi mov esi, ecx neg esi //fejjel lefele van a bitmap sub ecx,2 //loop cntr inc eax inc edx @1: movzx ebx, byte ptr[eax-1] movzx edi, byte ptr[eax+1] add ebx,edi // .x. movzx edi, byte ptr[eax+esi-1] add ebx,edi // ... movzx edi, byte ptr[eax+esi*1] add ebx,edi // ... //x=center, .=sum movzx edi, byte ptr[eax+esi+1] add ebx,edi movzx edi, byte ptr[eax+esi*2-1] add ebx,edi movzx edi, byte ptr[eax+esi*2] add ebx,edi movzx edi, byte ptr[eax+esi*2+1] add ebx,edi //kesz az oszzeg mov edi,ebx shr edi,6 add ebx,edi //legyen kicsit hatvanyosan erosebb a tuz shr ebx,3 //8 szin atlaga mov [edx],bl add edx,1 add eax,1 sub ecx,1; jnz @1 pop edi pop ebx pop esi end; procedure FireEfx(const bSrc,bDst:TBitmap); var w,h:integer; procedure burnat(x,y:integer);//veletlenszeru lang x,y kozeleben begin x:=x+random(10)-5; y:=y+random(10)-5; if(x>0)and(y>0)and(x<w-1)and(y<h-1)then pbyte(integer(bSrc.ScanLine[y])+x)^:=255; end; var i,x,y:integer; begin w:=bSrc.Width; h:=bSrc.Height; //tuz alul for i:=0 to bSrc.Width div 8 do burnat(random(w),h-10); for y:=bSrc.Height-300 to bSrc.Height-5 do _Fire_line(bSrc.ScanLine[y], bDst.ScanLine[y], (w+3)and not 3{4 byte-ra igazitva vannak a bitmap sorai} ); end; procedure TFrmFire.FormPaint(Sender: TObject);//itt kell ujrarajzolni a formot function FirePalette:THandle; var pal:^TLogPalette; procedure p(n, r,g,b:integer);//beallit egy paletta erteket. Kumm forrasa alapjan, ami 6bites csak begin with pal.palPalEntry[n] do begin peRed:=r shl 2; peGreen:=g shl 2; peBlue:=b shl 2; peFlags:=0; end;end; var n:integer; begin pal:=GetMemory(256*4+4); with pal^ do try palVersion:=$300; palNumEntries:=256; //based on http://prog.hu/cikkek/43/Tuz+effekt.html p(0, 0,0,0); for n:=1 to 32 do p(n, 2*n-1, 0, 0); for n:=33 to 160 do p(n, 63,n, 0); for n:=129 to 255 do p(n, 63,63,(n-129) div 2); result:=CreatePalette(pal^); finally FreeMemory(pal); end; end; var i:integer; begin //ha nincs még work bitmap, akkor letrehozzuk, es egyeb inicializalasok if bmp[0]=nil then begin Application.OnIdle:=MyIdle;//frissito esemeny bekotese for i:=0 to 1 do begin bmp[i]:=TBitmap.Create; bmp[i].PixelFormat:=pf8bit; end; bmp[0].Palette:=FirePalette; bmp[1].Palette:=bmp[0].Palette; end; //ha valtozott az ablakmeret... if(bmp[0].width<>ClientWidth)or(bmp[0].Height<>ClientHeight)then for i:=0 to 1 do with bmp[i]do begin Width:=ClientWidth; Height:=ClientHeight; canvas.Brush.Color:=clBlack; canvas.FillRect(rect(0,0,width,height)); end; FireEfx(bmp[actBmp],bmp[1-actBmp]);//effekt update actBmp:=1-actBmp;//bufferCsere Canvas.Draw(0,0,bmp[actBmp]);//kirajzolas end; end.
    Mutasd a teljes hozzászólást!
  • nagyon szépen köszönöm :)
    Mutasd a teljes hozzászólást!
  • a formpaint hogy érted hogy oda kössembe ?
    Mutasd a teljes hozzászólást!
  • Hat hogy hozd letre az a form onpaint eventjét. De gondolom ez akkor sikerult.
    Mutasd a teljes hozzászólást!
  • már minden működik tökéletesen köszönöm szépen :)
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd