Скачать: CL | DM;

Помогите написать скринсейвер   Найти похожие ветки 

← →
child_sun ©   (2003-06-06 23:26) [0]

Доброго времени суток. Подскажите пожалуйста ссылку на статью о написании хранителя экрана.
Спасибо

---

← →
Danillo ©   (2003-06-07 01:09) [1]

Вот у меня тут исходничек есть......правда с глюками не когда было исправлять

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure OnMessage(var Msg: TMsg; var Handled: Boolean);
procedure OnIdle(Sender: TObject; var Done: Boolean);
end;

var
Form1: TForm1;
r, g, b: integer;
po: TPoint;
IniFileName: string;

procedure Draw(Canvas: TCanvas; var r, g, b: integer;
width, height: integer);

implementation

{$R *.dfm}
uses IniFiles;
procedure Draw(Canvas: TCanvas; var r, g, b: integer;
width, height: integer);
begin
with Canvas do begin
r := r + random(3) - 1;
if r < 0 then r := 0;
if r > 255 then r := 255;
g := g + random(3) - 1;
if g < 0 then g := 0;
if g > 255 then g := 255;
b := b + random(3) - 1;
if b < 0 then b := 0;
if b > 255 then b := 255;

Pen.Color := RGB(r, g, b);
LineTo(random(width), random(height));
end;
end;

procedure TForm1.OnMessage(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.message of
WM_KEYDOWN, WM_KEYUP,
WM_SYSKEYDOWN, WM_SYSKEYUP,
WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
: Close;
WM_MOUSEMOVE: begin
if (msg.pt.x <> po.x) or (msg.pt.y <> po.y) then Close;
end;
end;
end;

procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean);
begin
Draw(Canvas, r, g, b, Width, Height);
Done := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ini: TIniFile;
begin
Application.OnMessage := OnMessage;
Application.OnIdle := OnIdle;


BorderStyle := bsNone;
WindowState := wsMaximized;

ShowCursor(false);
GetCursorPos(po);

ini := TIniFile.Create(IniFileName);
if ini.ReadBool("settings", "clear", true)
then Brush.Color := clBlack
else Brush.Style := bsClear;
ini.Destroy;
end;


end.

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.46 MB
Время: 0.019 c