╒ЁрэшЄхы№ ¤ъЁрэр╣2

╩юфшэу Spheres.dpr

program spheres;

 

uses

а Forms,

а SysUtils,

а cfg in 'cfg.pas' {CfgFrm},

а scrn in 'scrn.pas' {ScrnFrm};

 

{$R *.RES}

{$D SCRNSAVE Spheres 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;

 

type

а TScrnFrm = class(TForm)

ааа tmrTick: TTimer;

ааа procedure FormShow(Sender: TObject);

ааа procedure tmrTickTimer(Sender: TObject);

ааа procedure FormHide(Sender: TObject);

ааа procedure FormActivate(Sender: TObject);

а private

ааа { Private declarations }

ааа procedure DrawSphere(x, y, size : integer; color : TColor);

ааа procedure DeactivateScrnSaver(var Msg : TMsg; var Handled : boolean);

а public

ааа { Public declarations }

а end;

 

var

а ScrnFrm: TScrnFrm;

 

implementation

 

uses cfg;

 

var

аcrs:TPoint;

 

{$R *.DFM}

 

function Min(a, b : integer) : integer;

begin

if b < a

аthen

а Result := b

аelse

а Result := a;

end; {Min}

 

procedure TScrnFrm.DrawSphere(x, y, size : integer; color : TColor);

var

аi, dwааа : integer;

аcx, cyаа : integer;

аxy1, xy2 : integer;

аr, g, bа : byte;

begin

with Canvas do

begin

аPen.Style := psClear;

аBrush.Style := bsSolid;

аBrush.Color := color;

аr := GetRValue(color);

аg := GetGValue(color);

аb := GetBValue(color);

аdw := size div 16;

аfor i := 0 to 15 do

а begin

аа xy1 := (i * dw) div 2;

аа xy2 := size - xy1;

аа Brush.Color := RGB(Min(r + (i * 8), 255), Min(g + (i * 8), 255),

аа Min(b + (i * 8), 255));

аа Ellipse(x + xy1, y + xy1, x + xy2, y + xy2);

а end;

end;

end; {TScrnFrm.DrawSphere}

 

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);

аtmrTick.Interval:=1000-CfgFrm.spnSpeed.Value*90;

аtmrTick.Enabled:=true;

аApplication.OnMessage := DeactivateScrnSaver;

аShowCursor(false);

end;

 

procedure TScrnFrm.tmrTickTimer(Sender: TObject);

const

аsphcount:integer=0;

var

аx, yааа : integer;

аsizeааа : integer;

аr, g, b : byte;

аcolorаа : TColor;

begin

if sphcount > CfgFrm.spnSpheres.Value then begin

Refresh;

sphcount := 0;

end;

Inc(sphcount);

x := Random(ClientWidth);

y := Random(ClientHeight);

size := CfgFrm.spnSize.Value + Random(50) - 25;

x := x - size div 2;

y := y - size div 2;

r := Random($80);

g := Random($80);

b := Random($80);

DrawSphere(x, y, size, RGB(r, g, b));

end; {TScrnFrm.tmrTickTimer}

 

procedure TScrnFrm.FormHide(Sender: TObject);

begin

аApplication.OnMessage:=nil;

аtmrTick.Enabled:=false;

аShowCursor(true);

end;

 

procedure TScrnFrm.FormActivate(Sender: TObject);

begin

аWindowState:=wsMaximized;

end;

 

end.

 

╩юфшэу Cfg.pas

unit cfg;

 

interface

 

uses

а Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

а StdCtrls, Buttons, Spin, IniFiles;

 

type

а TCfgFrm = class(TForm)

ааа Label1: TLabel;

ааа Label2: TLabel;

ааа Label3: TLabel;

ааа spnSpheres: TSpinEdit;

ааа spnSize: TSpinEdit;

ааа spnSpeed: TSpinEdit;

ааа btnOK: TBitBtn;

ааа btnCancel: TBitBtn;

ааа btnTest: TBitBtn;

ааа 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 = 'SPHERES.INI';

 

procedure TCfgFrm.LoadConfig;

var

а inifile : TIniFile;

begin

inifile := TIniFile.Create(CfgFile);

try

аwith inifile do

аbegin

а spnSpheres.Value := ReadInteger('Config', 'Spheres', 50);

а spnSize.Valueааа := ReadInteger('Config', 'Size', 100);

а spnSpeed.Valueаа := ReadInteger('Config', 'Speed', 10);

а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', 'Spheres', spnSpheres.Value);

а WriteInteger('Config', 'Size', spnSize.Value);

а WriteInteger('Config', 'Speed', spnSpeed.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.