Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.06.19;
Скачать: 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 вся ветка

Текущий архив: 2003.06.19;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.02 c
11-60103
liho26
2002-09-26 13:06
2003.06.19
KOL and D-7


14-60369
Rzhevskiy
2003-06-01 17:38
2003.06.19
Экзамен уже завтра, а темы сочинений я ещё не знаю....


1-60183
Newman
2003-06-04 23:47
2003.06.19
Размер MDIChild


14-60400
JibSkeart
2003-06-03 14:56
2003.06.19
Где можно найти Boot утилиты для Seagate ?


1-60261
vv40
2003-06-05 11:18
2003.06.19
наследник от TImageList