╒ЁрэшЄхы№ ¤ъЁрэр ╣1
┬эрўрых яЁштюцє ъюфшэу яЁюхъЄра fire.dpr
program fire;
uses
а Forms,
а SysUtils,
а cfg in 'cfg.pas'
{CfgFrm},
а scrn in 'scrn.pas'
{ScrnFrm};
{$R *.RES}
{$D SCRNSAVE Fire Screen Saver}
begin
if hPrevInst = 0 then
begin
аif (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S')
а then
аа begin
ааа Application.CreateForm(TScrnFrm, ScrnFrm);
ааа Application.CreateForm(TCfgFrm, CfgFrm);
аа end
а else
аа begin
ааа Application.CreateForm(TCfgFrm, CfgFrm);
ааа Application.CreateForm(TScrnFrm, ScrnFrm);
аа end;
аApplication.Run;
end;
end.
╩юфшэу scrn.pas
unit scrn;
interface
uses
а
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
а ExtCtrls, StdCtrls, OpenGL;
type
а TScrnFrm = class(TForm)
ааа procedure FormShow(Sender: TObject);
ааа procedure FormHide(Sender: TObject);
ааа procedure FormActivate(Sender: TObject);
ааа procedure FormCreate(Sender: TObject);
ааа procedure FormDestroy(Sender: TObject);
ааа procedure FormResize(Sender: TObject);
а private
ааа { Private declarations }
ааа DC : HDC;
ааа hrc: HGLRC;
а protected
ааа procedure WMPaint(var Msg: TWMPaint);
message WM_PAINT;
ааа procedure Idle (Sender:TObject;var
Done:boolean);
ааа procedure DeactivateScrnSaver(var Msg : TMsg;
var Handled : boolean);
а public
ааа { Public declarations }
а end;
type
а TCol = record
аааа r : GLfloat;
аааа g : GLfloat;
аааа b : GLfloat;
а end;
var
а Step:real;аааа {0.04}
а Fade:real;а ааа{0.385}
а NumX:integer;а {50}
а NumY:integer;а {50}
а Fire : array [1..200, 1..200] of TCol;
а PreF :
array [1..200] of TCol;
а ScrnFrm: TScrnFrm;
implementation
uses cfg;
var crs:Tpoint;
{$R *.DFM}
procedure DrawPix(X,Y:integer);
begin
а Step:=CfgFrm.spnstep.value/100;
а glBegin(GL_QUADS);
ааа glColor3fv(@Fire[x , y]);
ааа
glVertex2f(x*(step)-1, y*step-1.1);
ааа glColor3fv(@Fire[x,y + 1]);
ааа
glVertex2f(x*(step)-1, y*step + step-1.1);
ааа glColor3fv(@Fire[x + 1,y + 1]);
ааа
glVertex2f(x*(step) + step-1, y*step + step-1.1);
ааа glColor3fv(@Fire[x + 1,y]);
ааа
glVertex2f(x*(step) + step-1, y*step-1.1);
а glEnd;
end;
procedure SetFire;
var
а i : GLint;
а f : GLfloat;
begin
а NumX:=CfgFrm.spnnumx.value;
а For i := 2 to
NumX-1 do begin
ааааа f := random(300) / 100 - 0.8;
ааааа PreF[i].r :=
f;
ааааа PreF[i].g :=
f / 1.4;
ааааа PreF[i].b :=
f / 2;
а end;
end;
procedure MixFire;
var
а i, j : GLint;
begin
а NumX:=CfgFrm.spnnumx.value;
а NumY:=CfgFrm.spnnumy.value;
а For i := 2 to
NumX - 1 do begin
ааааа Fire[i,1].r := (PreF[i - 1].r + PreF[i + 1].r + PreF[i].r)/3;
ааааа Fire[i,1].g := (PreF[i - 1].g + PreF[i + 1].g + PreF[i].g)/3;
ааааа Fire[i,1].b := (PreF[i - 1].b + PreF[i + 1].b + PreF[i].b)/3;
а end;
а For j := 2 to NumY - 1 do
а For i := 2 to
NumX-1 do begin
ааааа
Fire[i,j].r:=(Fire[i-1,j].r+Fire[i+1,j].r+Fire[i-1,j-1].r+Fire[i,j-1].r+
ааааааааааааааааааа Fire[i+1,j-1].r+Fire[i,j].r)/5;
ааааа
Fire[i,j].g:=(Fire[i-1,j].g+Fire[i+1,j].g+Fire[i-1,j-1].g+Fire[i,j-1].g+
ааааааааааааааааааа Fire[i+1,j-1].g+Fire[i,j].g)/5;
ааааа
Fire[i,j].b:=(Fire[i-1,j].b+Fire[i+1,j].b+Fire[i-1,j-1].b+Fire[i,j-1].b+
ааааааааааааааааааа Fire[i+1,j-1].b+Fire[i,j].b)/5;
ааа end;
end;
procedure FireUp;
var
а i, j : GLint;
begin
а
Fade:=CfgFrm.spnfade.value/1000;
а NumX:=CfgFrm.spnnumx.value;
а NumY:=CfgFrm.spnnumy.value;
а For j := NumY downto
2 do
ааа For i := 1 to
NumX do begin
ааааа Fire[i, j].r := Fire[i,j - 1].r - Fade;
ааааа Fire[i, j].g := Fire[i,j - 1].g - Fade;
ааааа Fire[i, j].b := Fire[i,j - 1].b - Fade;
ааа end;
end;
procedure DrawFire;
var
а i, j : GLint;
begin
а NumX:=CfgFrm.spnnumx.value;
а NumY:=CfgFrm.spnnumy.value;
а SetFire;
а MixFire;
а For j := 2 to NumY - 1 do
ааа For i:=2 to NumX-1 do
ааааа DrawPix(i,j);
а FireUp;
end;
procedure SetDCPixelFormat
(hdc : HDC);
var
аpfd : TPixelFormatDescriptor;
аnPixelFormat : Integer;
begin
аFillChar (pfd, SizeOf (pfd), 0);
аpfd.dwFlagsа := PFD_DRAW_TO_WINDOW or
PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
аnPixelFormat := ChoosePixelFormat (hdc,
@pfd);
аSetPixelFormat (hdc, nPixelFormat,
@pfd);
end;
procedure TScrnFrm.FormCreate(Sender:
TObject);
begin
аDC := GetDC (Handle);
аSetDCPixelFormat(DC);
аhrc := wglCreateContext(DC);
аwglMakeCurrent(DC,
hrc);
аApplication.OnIdle := Idle;
end;
procedure TScrnFrm.FormDestroy(Sender:
TObject);
begin
аwglMakeCurrent(0,
0);
аwglDeleteContext(hrc);
аReleaseDC (Handle, DC);
аDeleteDC (DC);
end;
procedure TScrnFrm.FormResize(Sender:
TObject);
begin
аglViewPort (0, 0, ClientWidth, ClientHeight);
аInvalidateRect(Handle,
nil, False);
end;
procedure TScrnFrm.WMPaint(var Msg: TWMPaint);
var
аps : TPaintStruct;
begin
аBeginPaint(Handle,
ps);
аglClear(GL_COLOR_BUFFER_BIT);
аDrawFire;
аSwapBuffers(DC);
аEndPaint(Handle,
ps);
end;
procedure TScrnFrm.Idle
(Sender:TObject;var Done:boolean);
begin
а InvalidateRect(Handle,
nil, False);
end;
procedure TScrnFrm.DeactivateScrnSaver(var Msg : TMsg;
var Handled : boolean);
var
аdone : boolean;
begin
if Msg.message =
WM_MOUSEMOVE
аthen
а done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or
ааааааааа
(Abs(HIWORD(Msg.lParam)
- crs.y) > 5)
аelse
а done := (Msg.message =
WM_KEYDOWN)аааа or (Msg.message
= WM_KEYUP)а or
аааааа (Msg.message = WM_SYSKEYDOWN)а or (Msg.message
= WM_SYSKEYUP)а or
аааа (Msg.message = WM_ACTIVATE)ааа or (Msg.message =
WM_NCACTIVATE)а or
ааа (Msg.message = WM_ACTIVATEAPP) or (Msg.message
= WM_LBUTTONDOWN)а or
ааа (Msg.message = WM_RBUTTONDOWN) or (Msg.message
= WM_MBUTTONDOWN);
if done
аthen
а Close;
end; {TScrnFrm.DeactivateScrnSaver}
procedure TScrnFrm.FormShow(Sender:
TObject);
begin
аGetCursorPos(crs);
аApplication.OnMessage := DeactivateScrnSaver;
аShowCursor(false);
end;
procedure TScrnFrm.FormHide(Sender:
TObject);
begin
аApplication.OnMessage:=nil;
аShowCursor(true);
end;
procedure TScrnFrm.FormActivate(Sender:
TObject);
begin
аWindowState:=wsMaximized;
end;
end.
╩юфшэу ёfg.pas
unit cfg;
interface
uses
а
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
а StdCtrls, Buttons, Spin, IniFiles;
type
а TCfgFrm = class(TForm)
ааа btnOK: TBitBtn;
ааа btnCancel: TBitBtn;
ааа btnTest: TBitBtn;
ааа
Label1: TLabel;
ааа
Label2: TLabel;
ааа
Label3: TLabel;
ааа
Label4: TLabel;
ааа spnStep: TSpinEdit;
ааа spnFade: TSpinEdit;
ааа spnNumX: TSpinEdit;
ааа spnNumY: TSpinEdit;
ааа procedure FormCreate(Sender: TObject);
ааа procedure btnOKClick(Sender: TObject);
ааа procedure btnCancelClick(Sender: TObject);
ааа procedure btnTestClick(Sender: TObject);
а private
ааа { Private declarations }
ааа procedure LoadConfig;
ааа procedure SaveConfig;
а public
ааа { Public declarations }
а end;
var
а CfgFrm: TCfgFrm;
implementation
uses scrn;
{$R *.DFM}
const
а CfgFile = 'Fire.INI';
procedure TCfgFrm.LoadConfig;
var
а inifile :
TIniFile;
begin
inifile := TIniFile.Create(CfgFile);
try
аwith inifile do
аbegin
аspnStep.value:=readinteger('Config','Step',4);
аspnFade.value:=readinteger('Config','Fade',385);
аspnNumX.value:=readinteger('Config','NumX',50);
аspnNumY.value:=readinteger('Config','NumY',50);
аend;
finally
аinifile.Free;
end;
end; {TCfgFrm.LoadConfig}
procedure TCfgFrm.SaveConfig;
var
а inifile :
TIniFile;
begin
inifile := TIniFile.Create(CfgFile);
try
аwith inifile do
аbegin
а writeinteger('Config','Step',spnStep.value);
а writeinteger('Config','Fade',spnFade.value);
а writeinteger('Config','NumX',spnNumX.value);
а writeinteger('Config','NumY',spnNumY.value);
аend;
finally
аinifile.Free;
end;
end; {TCfgFrm.SaveConfig}
procedure TCfgFrm.FormCreate(Sender:
TObject);
begin
аLoadConfig;
end;
procedure TCfgFrm.btnOKClick(Sender:
TObject);
begin
аSaveConfig;
аClose;
end;
procedure TCfgFrm.btnCancelClick(Sender:
TObject);
begin
аClose;
end;
procedure TCfgFrm.btnTestClick(Sender:
TObject);
begin
аScrnFrm.Show;
end;
end.
╧юяЁюсє■ яЁшьхЁэю ЁрсюЄє яЁюуЁрьь√. ╤ючфрхь юс√ўэ√щ яЁюхъЄ. ╘юЁьх яЁшётрштрхь ўхЁэ√щ (шыш ы■сющ фЁєующ) ЎтхЄ.
а