Mega Code Archive
Ekran koruyucu
<![CDATA[
Codec By GeNiUS !
genius@turkiye.com
Bir ekran koruyucusu nasıl olur. İşte örneği:
· Proje dosyasına, projenin ekran koruyucu olacağına dair bir bilgi satırı eklenmelidir.
{$D SCRSAVE <Ekran koruyucu adı}>
· Ana formdaki kenarlıklar, ve ikonlar tamamen kaldırılmalıdır.
· Form aktif hale gelirken, Left ve Top değerleri "0" a eşitlenmelidir.
· Form.Windowstate=WsMaximized olmalıdır.
· Formun yaratılması esnasında, Application.Onmessage olay yordamına, Ekran koruyucunun devreden çıkmasını sağlayacak yordam atanmalıdır.
· Program parametrelerine "/c" eklenmelidir. (Run | Parameters menüsünden)
· Program derlendikten sonra uzantısı "SCR" olarak değiştirilmeli ve Windows dizinine kopyalanmalıdır.
Scrn.PAS
unit Scrn;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls;
type
TScrnFrm = class(TForm)
tmrTick: TTimer;
procedure tmrTickTimer(Sender: TObject);
procedure FormShow(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
{$R *.DFM}
var
crs : TPoint; {Fare imlecinin orjinal yeri.}
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
{Fırça ve kalem şekilleri.}
Pen.Style := psClear;
Brush.Style := bsSolid;
Brush.Color := color;
{Renk karışımları.}
r := GetRValue(color);
g := GetGValue(color);
b := GetBValue(color);
{Topların çizimi.}
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.tmrTickTimer(Sender: TObject);
const
sphcount : integer = 0;
var
x, y : integer;
size : integer;
r, g, b : byte;
color : TColor;
begin
Inc(sphcount);
x := Random(ClientWidth);
y := Random(ClientHeight);
size := 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.FormShow(Sender: TObject);
begin
GetCursorPos(crs);
tmrTick.Interval := 100;
tmrTick.Enabled := true;
Application.OnMessage := DeactivateScrnSaver;
ShowCursor(false);
end; {TScrnFrm.FormShow}
procedure TScrnFrm.FormHide(Sender: TObject);
begin
Application.OnMessage := nil;
tmrTick.Enabled := false;
ShowCursor(true);
end; {TScrnFrm.FormHide}
procedure TScrnFrm.FormActivate(Sender: TObject);
begin
WindowState := wsMaximized;
end; {TScrnFrm.FormActivate}
end.
Spheres.DPR
program Spheres;
uses
Forms,
SysUtils,
Scrn in 'SCRN.PAS' {ScrnFrm};
{$R *.RES}
{$D SCRNSAVE Spheres Ekran koruyucu}
begin
{Sadece birkez çalışmalı.}
if hPrevInst = 0 then
begin
if (ParamCount > 0) and (UpperCase(ParamStr(1)) = '/S') then
begin
Application.CreateForm(TScrnFrm, ScrnFrm);
application.initialize;
Application.Run;
end else application.Terminate;
end;
end.
]]>